Post Reply 
BASIC Programs on HP 50G
03-11-2014, 03:20 PM
Post: #27
RE: BASIC Programs on HP 50G
version 0.2 the MY UBasic:

Code:

// UBASIC
// Created 06/03/2010

//#include <hpgcc49.h>
#include <stdio.h>
#include <math.h>
#include <string.h>
/* # include <kbd.h> */
#include <setjmp.h>
#include <ctype.h>
#include <stdlib.h>
#include <conio.h>
/* ## include <args.h>
## include <graph.h>
## include <statline.h> 
## include <estack.h>
*/

//#include <termios.h>
//#include <unistd.h>
/*int getch(void)
{
struct termios oldt,
newt;
int ch;
tcgetattr( STDIN_FILENO, &oldt );
newt = oldt;
newt.c_lflag &= ~( ICANON | ECHO );
tcsetattr( STDIN_FILENO, TCSANOW, &newt );
ch = getchar();
tcsetattr( STDIN_FILENO, TCSANOW, &oldt );
return ch;
}
*/

void clrscr()
{
   system("cls"); //clears the screen


void clear_screen()
{
  clrscr();
}
#include <windows.h>

//Emulador de gotoxy
void gotoxy(int x, int y)
{
COORD coord;
coord.X=x;
coord.Y=y;
SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE),coord);


//gotoxy function
//void gotoxy(int x,int y)
//{
//   printf("%c[%d;%df",0x1B,y,x);
//}

#define trunc(x) (int) (x)

float AtoF(char *s) 
{    
   char c;
   int i;
   
   for (i = 0; (c = s[i]); i++)
                  // Yes, the second '=' is really '=', not '=='...
   {
      if (c == '-') s[i] = 0xAD;
      if ((c|32) == 'e') s[i] = 0x95;
   }
   return atof(s);
}

#define WAIT_CANCEL system("PAUSE")
#define sys_slowOn() ;
#define sys_slowOff() ;
#define sat_stack_pop_string_alloc(n) ;
#define sat_pop_real(n)  ;
#define sat_stack_push_string(n) ;
//#define beep() ;
/****************************************************************/


#define VERSIONUBASIC "UBasic v 0.2b\n"

#define NUM_LAB 1000
#define LAB_LEN 20
#define FOR_NEST 100
#define SUB_NEST 250
#define WHILE_NEST 100
#define DO_LOOP_NEST 100
#define IF_NEST 100
#define PROG_SIZE 160000

#define DELIMITADOR 1
#define VARIABLE    2
#define NUMERO      3
#define ORDEN       4
#define CADENA      5
#define COMILLA     6
#define FUNCION     7
#define MSTRING     8
#define MATRIX     20

#define EOL         9
#define FINISHED   10
#define AND        11
#define OR         12
#define IGUAL      '='
#define NOIGUAL    14
#define MAYOR      '>'
#define MAYORIGUAL 16
#define MENOR      '<'
#define MENORIGUAL 18
#define NOT        19
#define MOD        20

#define PRINT    21
#define INPUT    22
#define IF       23
#define ELSE     24
#define FOR      25
#define NEXT     26
#define GOTO     27
#define GOSUB    28
#define RETURN   29
#define REM      30
#define CLS      31
#define LOCATE   32
#define PAUSE    33
#define WHILE    34
#define WEND     35
#define DO       36
#define LOOP     37
#define DIM      38
#define EXIT     39
#define LET      40
#define BEEP     41
#define DATA     42
#define READ     43
#define RESTORE  44
#define FIX      45
#define PUSH     46
#define CLEAR    47
#define PLAY     48
#define END      49

#define THEN     53
#define TO       54
#define STEP     55
#define UNTIL    56

#define ABS    70
#define ACOS   71
#define ACOSH  72
#define ASIN   73
#define ASINH  74
#define ATAN   75
#define ATANH  76
#define VALOR  77
#define CIELO  78
#define COS    79
#define COSH   80
#define EXP    81
#define FLOOR  82
#define LOG    83
#define LOG10  84
#define SIN    85
#define SINH   86
#define SQRT   87
#define TAN    88
#define TANH   89
#define PII    90
#define TRUNC  91
#define FRACC  92
#define SIGN   93
#define RND    94
#define LEN    95
#define ASC    96
#define INSTR  97
#define INT    98
#define POP    99

#define LEFT  100
#define RIGHT 101
#define MID   102
#define TAB   103
#define CHR   104
#define STRING 105
#define POPSTR 106
#define STR    107
#define INKEY  108
 
#define PI       3.141516

#define trunc(x) (int) (x)

char *prog, *prog_begin;
char *p_buf;
double fixval = 6.2;
FILE *datread;

int obtiene_simbolo(), esdelim(), esalfa(), esdigito(),
     esblanco(), busca(),obtiene_siguiente_etiqueta(),
     carga_programa(), buscaf(), indice_cad();

double encuentra_var(), funcion();
void obtiene_exp(), nivel0(), nivel1(), nivel2(), nivel3(), nivel4(), nivel5();
void nivel6(),primitiva(), arit(), unario();
void visualiza_error(), retorno(), asignar();
void rem(), locate(), ejecuta_dim(), ejecuta_exit();

void printbasic(), examina_etiquetas(), encuentra_eol(), ejecuta_goto();
void ejecuta_if(), ejecuta_for(), siguiente(), fempuja(), input(), Pause();
void gosub(), greturn(), gempuja(), inicializa_eti(), ejecuta_while(), end_while();
void ejecuta_doloop(), end_doloop(), ejecuta_else(), encuentra_else();
void /*beep(),*/ data(), restore(), Read(), fix(), push(), play(), final();

/*
typedef void (*xyx)(void);

 xyx XYX[] = {
  printbasic,
  input,
  ejecuta_if,
  ejecuta_else,
  ejecuta_for,
  siguiente,
  ejecuta_goto,
  gosub,
  greturn,
  rem,
  clear_screen,
  locate,
  pause,
  ejecuta_while,
  end_while,
  ejecuta_doloop,
  ejecuta_dim,
  ejecuta_exit,
  asignar,
  beep,
  data,
  read,
  fix,
  push,
  clear,
  play
}; 
*/
/*
typedef union {
              double val;
              double *matrix;
              char *str;
              char *mstring;
    } tipos;
*/ 
typedef struct Var {
    char *name;
    short type;
    int   filas, columnas;
    union {
              double val;
              double *matrix;
              char *str;
              char *mstring;
    } u;
    struct Var *next;
} Var;

Var *varlist = 0;

Var *lookup(char *s)
{
    Var *sp;
    
    for (sp = varlist; sp !=NULL; sp = sp->next)
        if (strcmp(sp->name, s) == 0)
           return sp;
    return 0;
}

void LiberaRamVar()
{
      Var *sp, temp;
        
      for (sp = varlist; sp != NULL; sp = temp.next) {
            if (sp->type == CADENA) 
             free(sp->u.str);
            else if (sp->type == MATRIX)
             free(sp->u.matrix);
            free(sp->name);
            temp.next = sp->next;
            free(sp);
      }      
}

Var *install(char *s, int t, double d)
{
    Var *sp;
    
    if ((sp = (Var *) malloc(sizeof(Var))) == NULL) 
         visualiza_error("install",20);
    if ((sp->name = (char *) malloc(strlen(s)+1)) == NULL) 
         visualiza_error("install",20);
    strcpy(sp->name, s);
    sp->type = t;
    sp->u.val = d;
    sp->next = varlist;
    varlist = sp;
    return sp;
}

/*--------------------------------------------------------------------------*/

char simbolo[200];
char simbolo_tipo, simb;
char var_tipo;

char e[23][40] = {
        "error de sintaxis",
        "parentesis no balanceados",
        "ninguna expresion presente",
        "signo igual esperado",
        "no es una variable",
        "tabla de etiquetas llena",
        "etiqueta duplicada",
        "etiqueta no definida",
        "THEN esperado",
        "TO esperado",
        "demasiados bucles FOR anidados",
        "NEXT sin FOR",
        "demasiados GOSUBs anidados",
        "RETURN sin GOSUB",
        "Division por CERO",
        "demasiados bucles WHILE anidados",
        "WEND sin WHILE",
        "STOP por el usuario",
        "demasiados bucles DO anidados",
        "LOOP sin DO",
        "Fallo de Memoria",
        "No se permite Redimensionar var",
        "argumento negativo"
    };

struct ordenes {
    char orden[20];
    char simb;
} tabla[] = {
 {"print", PRINT},
 {"input", INPUT},
 {"and",AND},
 {"or",OR},
 {"not",NOT},
 {"if", IF},
 {"then", THEN},
 {"else",ELSE},
 {"goto", GOTO},
 {"for", FOR},
 {"next", NEXT},
 {"to", TO},
 {"gosub", GOSUB},
 {"return", RETURN},
 {"rem", REM},
 {"step", STEP},
 {"cls", CLS },
 {"locate",LOCATE},
 {"pause",PAUSE},
 {"while", WHILE},
 {"wend",WEND},
 {"do", DO},
 {"loop", LOOP},
 {"until", UNTIL},
 {"continue",NEXT},
 {"dim", DIM},
 {"exit",EXIT},
 {"let",LET},
 {"stop",END},
 {"beep", BEEP},
 {"restore",RESTORE},
 {"data",DATA},
 {"read",READ},
 {"end", END},
 {"fix", FIX},
 {"push", PUSH},
 {"clear", CLEAR},
 {"play", PLAY},
 {"mod", MOD},
 {"", END}    
};

struct ordenes tablaf[] = {
    {"abs",ABS},
    {"acos",ACOS},
    {"acosh",ACOSH},
    {"asin",ASIN},
    {"asinh",ASINH},
    {"atan",ATAN},
    {"atanh",ATANH},
    {"val",VALOR},
    {"ceil",CIELO},
    {"cos",COS},
    {"cosh",COSH},
    {"exp",EXP},
    {"floor",FLOOR},
    {"log",LOG},
    {"log10",LOG10},
    {"sin",SIN},
    {"sinh",SINH},
    {"sqr",SQRT},
    {"tan",TAN},
    {"tanh",TANH},
    {"pi",PII},
    {"int",TRUNC},
    {"fracc",FRACC},
    {"sign",SIGN},
    {"rnd",RND},
    {"len",LEN},
    {"asc",ASC},
    {"instr",INSTR},
    {"int",INT},
    {"pop",POP},
    {"",END}
};

struct ordenes tablafstr[] = {
    {"inkey", INKEY},
    {"left", LEFT},
    {"right", RIGHT},
    {"mid", MID},
    {"chr", CHR},
    {"str", STR},
    {"tab", TAB},
    {"string", STRING},
    {"popstr", POPSTR},
    {"", END}
};

struct etiqueta {
  char nombre[LAB_LEN];
  char *p;    
};

struct etiqueta etiqueta_tabla[NUM_LAB];
char *encuentra_etiqueta(), *gpop();

struct pila_for {
    Var *var;   
    double objeto;
    double step;
    char *loc;
} fstack[FOR_NEST];

struct pila_for fpop();
char *wpila[WHILE_NEST];
char *gpila[SUB_NEST];
char *dpila[DO_LOOP_NEST];
int ifpila[IF_NEST];

int ftos;
int gtos;
int wtos;
int dtos;
int iftos;

#define DATAFILENAME "datbasfl.dat"
int DataOK;

void obtiene_exp(double *resultado)
{
    obtiene_simbolo();              
    if(!*simbolo) {
        visualiza_error("obtiene simbolo",2);
        return;
    }
    nivel0(resultado);
    retorno();
}

void nivel0(double *resultado)
{
    register int op;
    double hold;
    
  nivel1(resultado);
  while ((op = simb) == AND || op == OR) {
      obtiene_simbolo();
      nivel1(&hold);
      arit(op, resultado, &hold);
  }    
}

void nivel1(double *resultado) 
{
    register int op;
    double hold;
  
  nivel2(resultado);
  while ((op=simb) ==IGUAL || op==NOIGUAL || op==MAYOR 
        || op==MAYORIGUAL || op==MENOR || op==MENORIGUAL)
  {
      obtiene_simbolo();
      nivel2(&hold);
      arit(op, resultado, &hold);
  }    
}

void nivel2(double *resultado)
{
    register char op;
    double hold;
    
    nivel3(resultado);
    while ((op = *simbolo) == '+' || op == '-') {
        obtiene_simbolo();
        nivel3(&hold);
        arit(op, resultado, &hold);
    }
}

void nivel3(double *resultado)
{
    register char op;
    double hold;
    
    nivel4(resultado);
    while ((op = *simbolo) == '*' || op == '/' || simb == MOD) {
        if (simb == MOD) op = simb; else op = *simbolo;
        obtiene_simbolo();
        nivel4(&hold);
        arit(op, resultado, &hold);
    }
}

void nivel4(double *resultado)
{
    double hold;
    
    nivel5(resultado);
    if (*simbolo == '^') {
        obtiene_simbolo();
        nivel4(&hold);
        arit('^', resultado, &hold);
    }
}

void nivel5(double *resultado)
{
    register char op;
    
    op = 0;
    if ((simbolo_tipo == DELIMITADOR) && ((*simbolo == (char) 173) || 
                             (*simbolo == '+') || (*simbolo == '-') || (simb == NOT))) {
        if (simb == NOT ) op = simb; else op = *simbolo;
        obtiene_simbolo();
    }
    nivel6(resultado);
    if (op == NOT) *resultado = !(*resultado);
    else if (op)
      unario (op, resultado);
}

void nivel6(double *resultado)
{
    if ((*simbolo == '(') && (simbolo_tipo == DELIMITADOR )) {
        obtiene_simbolo();
        nivel0(resultado);
        if (*simbolo != ')')
         visualiza_error("nivel6",1);
        obtiene_simbolo();
    }
    else
     primitiva(resultado);
}

void primitiva(resultado)
double *resultado;
{
  Var *s; 
  double valor;
  int filas, columnas;
                                         
    switch(simbolo_tipo) {
        case VARIABLE:
               if (( s = lookup(simbolo)) == 0 )
              s = install(simbolo, var_tipo, 0.0);
                                           
        if (s->type == MATRIX) {                                    
           obtiene_simbolo();
             if ( *simbolo != '(' ) visualiza_error("primitiva",0);
      
             obtiene_exp(&valor);
             filas = trunc(valor);
             columnas = 1;
      
             obtiene_simbolo();
      
             if (*simbolo == ',') {
                  obtiene_exp(&valor);
                  columnas = trunc(valor);
                  obtiene_simbolo();
             }                        
        
             if (*simbolo != ')') visualiza_error("primitiva",1);
             if (filas < 1 || columnas <1) visualiza_error("primitiva",0);    
                                    
             if (filas > s->filas || columnas > s->columnas) visualiza_error("primitiva",0);
             
               *resultado = s->u.matrix[(filas-1)*(s->columnas)+(columnas-1)];
                                                
        }
        else 
               *resultado = s->u.val;       
               
           obtiene_simbolo();
           return;
        case NUMERO:
          *resultado = atof(simbolo);
          obtiene_simbolo();
          return;
        case FUNCION:
          *resultado= funcion(simb);     
          obtiene_simbolo();                         
          return;
        default:
          visualiza_error("primitiva default",0);
    }
}



double acosh(double valor) {return(log(valor+sqrt(valor*valor-1.0)));};
double asinh(double valor) {return(log(valor+sqrt(valor*valor+1.0)));};
double atanh(double valor) {return(0.5*log((1.0+valor)/(1.0-valor)));};
double cosh(double valor) {return((exp(valor)+exp(-valor))/2.0);};
double sinh(double valor) {return((exp(valor)-exp(-valor))/2.0);};
double tanh(double valor) {return(sinh(valor)/cosh(valor));};


double funcion(ind)
int ind;
{
   double valor = 0.0;
   
   if (ind == PII) return PI;
   if (ind == POP) {
       //char *c;
      // double x;
      // c= sat_stack_pop_string_alloc();
      // x= sat_pop_real();
     //  sat_stack_push_string(c);
     //  return(x);
    }
     
   obtiene_simbolo();
   if (*simbolo != '(') visualiza_error("funcion",1);
     obtiene_simbolo();
     if (!((ind == VALOR) || (ind == LEN) || (ind == ASC) || (ind == INSTR)))  nivel0(&valor);
  
   switch (ind) {
             case ABS:
                 valor =  abs(valor);
                 break;
          case ACOS:
                 valor =  acos(valor);
                 break;
          case ACOSH:
                 valor =  acosh(valor);
                 break;
        case ASIN:
                 valor =  asin(valor);
                 break;
        case ASINH:
                 valor =  asinh(valor);
                 break;
        case ATAN:
                 valor =  atan(valor);
                 break;
        case ATANH:
                 valor =  atanh(valor);
                 break;
        case VALOR:
            if (simbolo_tipo == COMILLA)
             {
                char *temp, simb[80];
                temp = prog;
                strcpy(simb,simbolo);
                prog = simb;           
                obtiene_exp(&valor);   
                prog = temp;
                obtiene_simbolo();
                break;
            }  
            
            if ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))
            {
                Var *s;
                char *temp, simb[80];
               
                if((s = lookup(simbolo)) == 0) 
                   visualiza_error("funcion val",4); 
                temp = prog;
                strcpy(simb,s->u.str);
                prog = simb;           
                obtiene_exp(&valor);   
                prog = temp;                   
                obtiene_simbolo();
                     break;
               }  
               visualiza_error("funcion val",0);
               break;
        case LEN:
            if (simbolo_tipo == COMILLA)
             {
                valor = strlen(simbolo);
                obtiene_simbolo();
                break;
            }  
            
            if ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))
            {
                Var *s;
               
                if((s = lookup(simbolo)) == 0) 
                   visualiza_error("funcion len",4);
                valor = strlen(s->u.str);
                obtiene_simbolo();
                break;
            }
            visualiza_error("funcion len",0);
            break;
        case ASC:
            if (simbolo_tipo == COMILLA)
             {
                valor = (double) simbolo[0];
                obtiene_simbolo();
                break;
            }  
            
            if ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))
            {
                Var *s;
               
                if((s = lookup(simbolo)) == 0) 
                   visualiza_error("funcion asc",4);
                valor = (double) (s->u.str)[0];
                obtiene_simbolo();
                break;
            }
            visualiza_error("funcion asc",0);
            break;
        case INSTR:
            {
                char buffer1[200],buffer2[200];
                
               if (!(simbolo_tipo == COMILLA || ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))))    
                   visualiza_error("funcion instr", 0);
                   
               if (simbolo_tipo == COMILLA)
                   strcpy(buffer1,simbolo);
                else if ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))
                {
                    Var *s;
                               
                    if((s = lookup(simbolo)) == 0) 
                        visualiza_error("funcion instr",4); 
                    strcpy(buffer1,s->u.str);
                }
               
                obtiene_simbolo();
                if (*simbolo != ',') visualiza_error("funcion instr",0);
                obtiene_simbolo();
                
                if (!(simbolo_tipo == COMILLA || ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))    ))
                   visualiza_error("funcion instr", 0);
                   
               if (simbolo_tipo == COMILLA)
                   strcpy(buffer2,simbolo);
                else if ((simbolo_tipo == VARIABLE) && (var_tipo == CADENA))
                {
                    Var *s;
                               
                    if((s = lookup(simbolo)) == 0) 
                        visualiza_error("funcion instr",4); 
                    strcpy(buffer2,s->u.str);
                }
               
                obtiene_simbolo();
                                
                valor = (double) indice_cad(buffer1, buffer2);
                     break;
               }  
            
               visualiza_error("funcion instr",0);
            break;
        case CIELO:
                 valor =  ceil(valor);
                 break;
        case COS:
                 valor =  cos(valor);
                 break;
        case COSH:
                 valor =  cosh(valor);
                 break;
        case EXP:
                 valor =  exp(valor);
                 break;
        case FLOOR:
                 valor =  floor(valor);
                 break;
        case LOG:
                 valor =  log(valor);
                 break;
        case LOG10:
                 valor =  log10(valor);
                 break;
        case SIN:
                 valor =  sin(valor);
                 break;
        case SINH:
                 valor =  sinh(valor);
                 break;
        case SQRT:
            if (valor<0) visualiza_error("sqrt",22);
                 valor =  sqrt(valor);
                 break;
        case TAN:
                 valor =  tan(valor);
                 break;
        case TANH:
                 valor =  tanh(valor);
                 break;
        case TRUNC:
                 valor =  (double) trunc(valor);
                 break;
        case INT:
            valor = (double) trunc(valor);
            break;    
             case FRACC:
                  valor =  (valor - trunc(valor));
                  break;
             case SIGN:
                  if (valor > 0) valor = 1;
                  else if (valor < 0) valor = -1;
                  else if (!valor) valor = 0;
                  break;
             case RND:
                  valor = (double) rand();
                  break;
        default:
            valor =  0.0;
            break;
   }      
   if (*simbolo != ')') visualiza_error("funcion",1);   
   return valor;
}

void arit(o,r,h)
 char o;
 double *r, *h;
{
    register int t;
    
    switch(o) {
        case '-':
          *r = *r - *h;
          break;
        case '+':
          *r = *r + *h;
          break;
        case '*':
          *r = *r * *h;
          break;
        case '/':
          if (*h == 0) visualiza_error("arit",14);
          *r = (*r)/(*h);
          break;
        case MOD :
          t = (*r) / (*h);
          *r = *r - (t * (*h));
          break;
        case '^':
          *r = pow(*r,*h);
          break;
        case AND:
          *r = *r && *h;
          break;
        case OR:
          *r = *r || *h;
          break;
        case IGUAL:
          *r = *r == *h;
          break;
        case NOIGUAL:
          *r = *r != *h;
          break;
        case MAYOR:
          *r = *r > *h;
          break;
        case MAYORIGUAL:
          *r = *r >= *h;
          break;
        case MENOR:
          *r = *r < *h;
          break;
        case MENORIGUAL:
          *r = *r <= *h;
          break;          
    }
}

void unario(o,r)
char o;
double *r;
{
    if ((o == '-') || (o == (char) 173 )) *r = -(*r);
}

double encuentra_var(s)
char *s;
{
  Var *v;
  
    if (!esalfa(*s)) {
        visualiza_error("encuentra_var",4);
        return 0;
    }
    
    if (( v = lookup(simbolo)) == 0 )
        v = install(simbolo, var_tipo, 0.0);
        
    return  v->u.val;         
}

void visualiza_error(rutina,error)
char *rutina;
int error;
{
    printf("\n%s Error #%d:\n%s\n", rutina, error, e[error]);
    encuentra_eol();
    /*
    LiberaRamVar();
    sys_slowOn();
    beep();
    printf("press [ON].");
    WAIT_CANCEL;
    if (datread != NULL) fclose(datread);
    if (p_buf != NULL) free(p_buf);
    exit(1);  */
//    longjmp(e_buf, 1);
}


/***************************************************/
int obtiene_simbolo()
{
    register char *temp, op;
    
    simbolo_tipo = 0; simb = 0;  var_tipo = VARIABLE; 
    temp = simbolo;
    
    if (*prog == '\0') {
        *simbolo = 0;
        simb = FINISHED;
        return(simbolo_tipo = DELIMITADOR);
    }
    
    while (esblanco(*prog)) ++prog;
    
    if (*prog == ':') {
        
        *temp = *prog;
        ++prog; temp++; 
        temp = '\0';
        simb = EOL;   
        return (simbolo_tipo = DELIMITADOR);
    }
    
    if ((*prog == '\n') || (*prog == '\r')) {
        ++prog;        
        iftos = 0;
        simb = EOL;   
        *simbolo = '\0';
        return (simbolo_tipo = DELIMITADOR);
    }
    
    if (*prog == '\'') {
        *temp = *prog; ++prog; ++temp; temp= '\0';
         simb = REM; 
         return (simbolo_tipo= ORDEN); 
    }
    
    if (strchr("<>=", *prog)) {
      *temp = *prog;
      op = *prog;
        prog++;
        temp++;
        
        switch (op) {
            case '>' :  
                      if (*prog == '=') { simb= MAYORIGUAL; prog++; temp++; }
                else simb= MAYOR; 
                break;
            case '<' : 
                      if (*prog == '=') { simb = MENORIGUAL; prog++; temp++; }
                      else if (*prog == '>') { simb = NOIGUAL; prog++; temp++; }
                      else simb = MENOR;
                      break;
            case '=' : simb = IGUAL;
                      break;
        }
        *temp = 0;
        return ( simbolo_tipo = DELIMITADOR);    
    }
    
    if (strchr("+-*/^;(),", *prog) || *prog == (char) 173) {   
        *temp = *prog;
        prog++;
        temp++;
        *temp = 0;
        return ( simbolo_tipo = DELIMITADOR);
    }
    
    if (*prog == '"') {
        prog++;
        while (*prog != '"' && *prog != '\n') 
             *temp++ = *prog++;
        //if ( *prog == '\n') 
          //   visualiza_error("obtiene_simbolo",0);
        prog++; *temp = 0;
        return( simbolo_tipo = COMILLA);
    }
    
    if (esdigito( *prog) || *prog == '.' ) {
        while ( !esdelim(*prog)) *temp++ = *prog++;
        *temp = '\0';
        return (simbolo_tipo = NUMERO);
    }
    
    if (esalfa(*prog)) {
        while (!esdelim(*prog)) *temp++ = *prog++;
        if (*(temp-1) == '$') var_tipo = CADENA; else var_tipo = VARIABLE; 
        simbolo_tipo = CADENA;   
    }
    
    *temp = '\0';                     
    
    if(simbolo_tipo == CADENA ) {        
        simb = busca(simbolo);                    
        if (!simb) {  
            simb = buscaf(simbolo);     
            if (!simb) 
               simbolo_tipo = VARIABLE; 
            else 
               simbolo_tipo = FUNCION;
        } 
        else 
          switch (simb) {              
            case AND:
                 simbolo_tipo = DELIMITADOR;
                 break;
            case OR:
                 simbolo_tipo = DELIMITADOR;
                 break;
            case NOT:
                 simbolo_tipo = DELIMITADOR;
                 break;
            case MOD:
                 simbolo_tipo = DELIMITADOR;
                 break;     
            default :
                   simbolo_tipo = ORDEN;
                   break;
          }          
    }                                
    return simbolo_tipo;
}

/***********************************************************/

void retorno()
{
    char *t;
    
    t = simbolo;                           
    if (*simbolo == '\0') prog--;
    else
    for ( ; *t; t++ ) prog-- ;
}

int busca(s)
char *s;
{
    register int i;
    char *p;
    
    p = s;
    while (*p) {
        *p = tolower(*p); p++;
    }
    
    for (i = 0; *tabla[i].orden; i++)
      if (!strcmp(tabla[i].orden, s)) return tabla[i].simb;
    return 0;
}

int buscaf(s)
char *s;
{
    register int i;
    char *p;
    
    p = s;
    while (*p) {
        *p = tolower(*p); p++;
    }
    
    for (i = 0; *tablaf[i].orden; i++)
      if (!strcmp(tablaf[i].orden, s)) return tablaf[i].simb;
    return 0;
}

int esblanco(c)
char c;
{
    if (c== ' ' || c == '\t') return 1;
    else return 0;
}


int esdelim(c)
char c;
{
    if (strchr(" +-*/^;=(),<>:", c) || c == '\n' || c == '\r') return 1;
    else return 0;
}

int esalfa(c)
char c;
{
  return isalpha(c);    
}

int esdigito(c)
char c;
{
    return isdigit(c);
}

int indice_cad(char *cadena, char *subcadena)
{
   int i,j,k;
   
   if ((cadena== NULL) || (subcadena == NULL)) return(0);
   for(i=0; cadena[i] != (char *)NULL; i++)
      for (j=i, k=0; subcadena[k] == cadena[j]; k++, j++)
         if ( subcadena[k+1] == NULL)
            return(i+1);
   return(0);    
}

void Pause(void) 
{

  getch();
/*
   while(1)
      if (keyb_isAnyKeyPressed())
         break;
*/
  //  sys_setupTimers();
  //  sys_waitTicks(300000);
  //  sys_restoreTimers();

}

/******************************************************/
// Main Function

// int main(void)
int main(int argc, char *argv[])
{
  //char *p_buf;
  char name[128];
  char *path= "./";
 
//  SAT_STACK_ELEMENT e;
//  SAT_STACK_DATA d;

//  char instruccion[255];
//  FILE *out;
 
//  sat_get_stack_element(1, &e);
//  sat_decode_stack_element(&d, &e);
//  if (d.type == SAT_DATA_TYPE_STRING) {
//        name = str_unquote(d.sval, '\'');
//   } else {
//        sat_stack_push_string("Missing Filename");
//        sat_push_real(1);
//        return (0);
//   }
   
//  sys_slowOff();  
/****************************************************/
if (argc< 2) {
     printf("\nUSE: BASIC FileName\n");
     system("PAUSE");    
     exit(1);
   }
       
 sprintf(name,"%s%s",path,argv[1]);
/****************************************************/
  clear_screen(); 
  printf(VERSIONUBASIC);
  //printf(name);

  varlist = NULL;
  
  if (!(p_buf = (char *) malloc(PROG_SIZE))) {
      printf("\nasignacion fracasada.");
      exit(1);
  }
  

  if(!carga_programa(p_buf, name)) { free(p_buf); exit(1); };
  
  prog_begin = p_buf;
  prog = p_buf;
  fixval = 6.2;
  
  examina_etiquetas();
  restore();
  prog= prog_begin;
  
  if (DataOK) 
  {   
      if ((datread = fopen(DATAFILENAME, "rt")) == NULL) 
        printf("no hay DATA disponible\n");
      
  }
    
  ftos = 0;
  gtos = 0;
  wtos = 0;
  dtos = 0;
  iftos = 0;
  //var_tipo = VARIABLE;
   
 // do {
   
  do {
      simbolo_tipo = obtiene_simbolo();
   // if(keyb_isAnyKeyPressed())
    // {  printf("User Stop.");
    //    break;
    // } 
    //printf("[%s]",simbolo);
                                        
      if (simbolo_tipo == VARIABLE) {
          retorno();                       
          asignar();                        
      }
      else { /*
      if ((simb > (PRINT-1)) && (simb < (END))) 
      {
        XYX[simb-PRINT](); //printf("|");
      }    
      else 
      */
        switch(simb) {
            case LET:
             asignar();
             break;
            case PRINT:
              printbasic();
              break;
            case GOTO:
              ejecuta_goto();
              break;
            case IF:
              ejecuta_if();
              break;
            case ELSE:
              ejecuta_else();
              break;
            case FOR:
              ejecuta_for();
              break;
            case NEXT:
              siguiente();
              break;
            case WHILE:
              ejecuta_while();
              break;
            case WEND:
              end_while();
              break;
            case INPUT:
              input();
              break;
            case GOSUB:
              gosub();
              break;
            case RETURN:
              greturn();
              break;
            case REM:
               rem();
               break;
            case CLS:
               clear_screen();
               break;
            case LOCATE:
               locate();
               break;
            case PAUSE:
               Pause();
               break;
            case DO:
               ejecuta_doloop();
               break;
            case LOOP:
               end_doloop();
               break;
            case DIM :
               ejecuta_dim();
               break;
            case EXIT:
               ejecuta_exit();
               break;
        case BEEP:
           beep();
           break;   
        case FIX:
           fix();
           break;
        case RESTORE:
           restore();
           break;   
        case READ:
           Read();
           break;
        case DATA:
           data();
           break;   
        case PUSH:
           push();
           break;
        case CLEAR:
           LiberaRamVar();
           break;
        case PLAY:
           play();
           break;   
            case END:
          simb = FINISHED;
          break;
         }
    }
  } while ( simb != FINISHED);
  
 /********************************************************
 printf("\n? ");
 //scanf("%s",instruccion); //
 gets(instruccion);
 //printf(instruccion);
 prog = instruccion;
 obtiene_simbolo();
 retorno();
 } while (simb != FINISHED);
 */
 //********************************************************  
 
 LiberaRamVar();
 printf("ready!\n\n");
 
 sys_slowOn();
 beep();
 printf("press << ON >>\n");
 WAIT_CANCEL;
    
 if (datread != NULL)  fclose(datread);
 if (p_buf != NULL)  free(p_buf);
 return(0);
}

/******************************************************/

int carga_programa( char *p, char *fnombre)
{
    FILE *fp;
    int i = 0;
    
    if (!(fp = fopen(fnombre, "rt"))) return 0;
    i = 0;

    do {
        *p = fgetc(fp);                 
        p++; i++;
        
    } while (!feof(fp) && i < PROG_SIZE);
    *(--p) = '\0';
    fclose(fp);
    return 1;
}

void asignar()
{
    int filas, columnas;
    double valor;
    Var *s;
    
    filas = 0; columnas= 1;
    
    obtiene_simbolo();
    if (!esalfa(*simbolo)) {
        visualiza_error("asignar",4);
        return;
    }
    
    if (( s = lookup(simbolo)) == 0 )
        s = install(simbolo, var_tipo, 0.0);
        
  if (s->type == MATRIX) {
           obtiene_simbolo();
             if ( *simbolo != '(' ) visualiza_error("asignar",0);
      
             obtiene_exp(&valor);
             filas = trunc(valor);
             columnas = 1;
      
             obtiene_simbolo();
      
             if (*simbolo == ',') {
                  obtiene_exp(&valor);
                  columnas = trunc(valor);
                  obtiene_simbolo();
             }
        
             if (*simbolo != ')') visualiza_error("asignar",1);
             if (filas < 1 || columnas <1) visualiza_error("asignar",0);
             if (filas > s->filas || columnas > s->columnas) visualiza_error("asignar",0);
        }
                                                    
    obtiene_simbolo();                          
    if (*simbolo != '=') {
        visualiza_error("asignar",3);
        return;
    }
    
    obtiene_simbolo();
    if (simbolo_tipo == COMILLA) {
         if ((s->u.str = (char *) malloc(strlen(simbolo)+1)) == 0) visualiza_error("asignar",20);
         strcpy(s->u.str, simbolo);
    } 
    else {
         retorno();
        obtiene_exp(&valor);
        if (s->type == MATRIX)
           s->u.matrix[(filas-1)*s->columnas+columnas-1]= valor;  
        else 
           s->u.val = valor;  
    }
}


void play()
{
    double tono, duracion;
    
    obtiene_exp(&tono);
    obtiene_simbolo();
      
    if (*simbolo != ',') visualiza_error("play",0);
    
    obtiene_exp(&duracion);
        
    //sys_setupTimers();    
    //sys_playTone( (unsigned int) tono, (unsigned int) duracion);
    //sys_restoreTimers();
}

// la parte entera es el tamaÃ’o total del campo y 
//la parte decimal es la precision de los decimales
//
void fix()
{
    double result;
        
    obtiene_exp(&result);
    fixval = result;
}

void printbasic()
{
    double result;
    int len = 0, espacios;
    char ultimo_delim= '\0';
    char buffer[80], ffix[4],format[20];
    
    sprintf(ffix, "%2.1f", fixval);
    strcpy(format,"%");
    strcat(format,ffix);
    strcat(format,"f");
        
    do {
      
        obtiene_simbolo();                                                    
        if ( simb == EOL || simb == FINISHED) break;
        
        if ( simbolo_tipo == COMILLA) {
            printf(simbolo);
            len += strlen(simbolo);
            obtiene_simbolo();                         
        }
        else if ( (simbolo_tipo == VARIABLE) && (var_tipo == CADENA) ) {
            
             Var *s;
          
             if (( s = lookup(simbolo)) == 0 )
                 s = install(simbolo, var_tipo, 0.0);
        
            printf(s->u.str);
            obtiene_simbolo();
        } 
        else {                                        
            retorno();                                                                                         
            obtiene_exp(&result);
            obtiene_simbolo();                              
            sprintf(buffer,format,result);
            printf(buffer);
            len += strlen(buffer);
        }
         
        ultimo_delim = *simbolo;
        
        if (*simbolo == ',') {                     
            espacios = 4 - (len % 4);
            len += espacios;
            while (espacios) {
                printf(" ");
                espacios--;
            }
        }
        else if (*simbolo == ';') ;
        else if (simb != EOL && simb != FINISHED) visualiza_error("print",0);
    } while ( *simbolo == ';' || *simbolo == ',');
                                                         
    if (simb == EOL || simb == FINISHED) {
        if (!(ultimo_delim == ';' || ultimo_delim == ',')) printf ("\n");
    }
    else visualiza_error("print",0);

}

void push()
{
    double result;
    int len = 0;
    char ultimo_delim= '\0';
    char /*buffer[80],*/ ffix[4],format[20];
    
    sprintf(ffix, "%2.1f", fixval);
    strcpy(format,"%");
    strcat(format,ffix);
    strcat(format,"f");
        
    do {
      
        obtiene_simbolo();                                                    
        if ( simb == EOL || simb == FINISHED) break;
        
        if ( simbolo_tipo == COMILLA) {
            sat_stack_push_string(simbolo);
            len += strlen(simbolo);
            obtiene_simbolo();                         
        }
        else if ( (simbolo_tipo == VARIABLE) && (var_tipo == CADENA) ) {
            
             Var *s;
          
             if (( s = lookup(simbolo)) == 0 )
                 s = install(simbolo, var_tipo, 0.0);
        
            sat_stack_push_string(s->u.str);
            obtiene_simbolo();
        } 
        else {                                        
            retorno();                                                                                         
            obtiene_exp(&result);
            obtiene_simbolo();                              
            //sprintf(buffer,format,result);
            //sat_stack_push_double(result);
            //len += strlen(buffer);
        }
         
        ultimo_delim = *simbolo;
        
        if (*simbolo == ','||*simbolo == ';') ;
        else if (simb != EOL && simb != FINISHED) visualiza_error("push",0);
    } while ( *simbolo == ';' || *simbolo == ',');
}

void examina_etiquetas()
{
    register int loc;
    char *temp;
        
    temp = prog;
    inicializa_eti();

    obtiene_simbolo();
    if (simbolo_tipo == NUMERO) {
        strcpy(etiqueta_tabla[0].nombre, simbolo);
        etiqueta_tabla[0].p = prog;
    }
    
    encuentra_eol();
    do {
        obtiene_simbolo();
        if ( simbolo_tipo == NUMERO ) {
            loc = obtiene_siguiente_etiqueta(simbolo);
            if ( loc == -1 || loc == -2 ) {
                (loc == -1) ? visualiza_error("examina_etiquetas",5) : visualiza_error("examina_etiquetas",6);
            }
            strcpy(etiqueta_tabla[loc].nombre, simbolo);
            etiqueta_tabla[loc].p = prog;
        }
        if (simb != EOL ) encuentra_eol();
        
    } while (simb != FINISHED);
    prog = temp;
}

void restore() 
{
   FILE *datafile;
   char *temp;
   
   DataOK = 0;
   datafile = fopen(DATAFILENAME, "wt");
   temp = prog;
   prog= prog_begin;
      
   do {
       obtiene_simbolo(); 
      
       if (strcmp(simbolo, "data") == 0) {
           DataOK = 1;
           do {
              obtiene_simbolo();
              if ( (simbolo_tipo == COMILLA) || (simbolo_tipo == NUMERO) ) 
                 fprintf(datafile, "%s\n",simbolo);
            } while (simb != EOL );
        }
   } while (simb != FINISHED);
   fclose(datafile);
   prog = temp;
}

void data()
{
    encuentra_eol();
}

void Read()
{
    char str[81]; 
    int filas, columnas;
    double valor, index;
    Var *s;
     
     do {
            obtiene_simbolo();
                
               if (( s = lookup(simbolo)) == 0 )
                s = install(simbolo, var_tipo, 0.0);  
        
            if (fgets(str, 80, datread) == NULL) 
                visualiza_error("read",2);                         
            
            if (var_tipo == VARIABLE)
            {
                char *temp, simb[80];
                temp = prog;
                strcpy(simb,str);
                prog = simb;           
                obtiene_exp(&valor);   
                prog = temp;
                
             
               if (s->type == MATRIX) 
               {                                    
                  obtiene_simbolo();
                  if ( *simbolo != '(' ) 
                    visualiza_error("read",0);
      
                  obtiene_exp(&index);
                  filas = trunc(index);
                  columnas = 1;
       
                  obtiene_simbolo();
      
                  if (*simbolo == ',') {
                        obtiene_exp(&index);
                        columnas = trunc(index);
                        obtiene_simbolo();
                    }                        
        
                  if (*simbolo != ')') 
                      visualiza_error("read",1);
                    
                  if (filas < 1 || columnas <1) 
                      visualiza_error("read",0);    
                                    
                  if (filas > s->filas || columnas > s->columnas) 
                      visualiza_error("read",0);
             
                    s->u.matrix[(filas-1)*(s->columnas)+(columnas-1)]= valor;
                                                
                }
                else 
                    s->u.val = valor;               
            }
            else {
                 if ((s->u.str = (char *) malloc(strlen(str)+1)) == 0) 
                     visualiza_error("read",20);
                 strcpy(s->u.str, str);
            }  

            obtiene_simbolo();
            
        } while(*simbolo == ',' || *simbolo == ';');
      retorno();
}


void encuentra_eol()
{
    while( *prog != '\n' && *prog != '\0' && *prog != '\r') ++prog;
    if (*prog) prog++;
}

int obtiene_siguiente_etiqueta(char *s)
{
    register int t;
    
    for (t = 0; t<NUM_LAB; ++t) {
        if (etiqueta_tabla[t].nombre[0] == 0) return t;
        if (!strcmp(etiqueta_tabla[t].nombre,s)) return -2;
    }
    return -1;
}

char *encuentra_etiqueta(char *s)
{
    register int t;
    
    for (t = 0; t<NUM_LAB; ++t)
      if ( !strcmp(etiqueta_tabla[t].nombre,s)) return etiqueta_tabla[t].p;
    return '\0';
}

void ejecuta_goto()
{
    char *loc;
    
    obtiene_simbolo();                    
    loc = encuentra_etiqueta(simbolo);
    if (loc == '\0')
      visualiza_error("ejecuta_goto",7);
    else prog = loc;
}

void inicializa_eti()
{
    register int t;
    
    for ( t = 0; t<NUM_LAB; ++t) etiqueta_tabla[t].nombre[0] = '\0';
}

void ejecuta_if()
{
    double x;
    
    obtiene_exp(&x);
    
    if (x) {
        obtiene_simbolo();
        
        if ( simb != THEN) {
              visualiza_error("ejecuta_if",8); 
              return;
        }
                
        obtiene_simbolo();
        
        if (simbolo_tipo == NUMERO) {
              retorno();
              ejecuta_goto();
              return;
        } 
        else retorno();
        
        ifpila[iftos++] = 1;
    }
    else { ifpila[iftos++] = 0; encuentra_else();}
}

void encuentra_else()

  int count = 0;                              //  ( simb != EOL && simb != ELSE)   
  while ((count >0) || (*simbolo == ':') || ( simb != EOL && simb != ELSE) ) {       
      if (simb == IF)   count++;
      if (simb == ELSE) count--;
      obtiene_simbolo(); 
  }
  retorno();
}

void ejecuta_else()
{
    if (ifpila[--iftos]) encuentra_eol();  
}


void ejecuta_for()
{
    struct pila_for i;
    double valor;
    int count = 1;
    
    obtiene_simbolo();
    if (!esalfa(*simbolo)) {
        visualiza_error("ejecuta_for",4);
        return;
    }
    
    if (( i.var = lookup(simbolo)) == 0 )
        i.var = install(simbolo, var_tipo, 0.0);     
    
    obtiene_simbolo();
    if (*simbolo != '=' ) {
        visualiza_error("ejecuta_for",3);
        return;
    }
    
    obtiene_exp(&valor);
    i.var->u.val = valor;           
    
    obtiene_simbolo();
    if ( simb != TO ) visualiza_error("ejecuta_for",9);
    
    obtiene_exp(&i.objeto);     
    
    obtiene_simbolo();
    if (simb == STEP) 
      obtiene_exp(&i.step);
    else {
        retorno();
        i.step = 1.0;
    }
                         
    if ( ((i.objeto >= valor) && (i.step > 0)) || 
            ((i.objeto < valor) && (i.step < 0)) ) {                       
        i.loc = prog;
        fempuja(i);
    }
    else 
        do { 
              if (simb == FOR ) count ++;
              if (simb == NEXT) count --;
              obtiene_simbolo();
    } while (count > 0);
}

void siguiente()
{
    struct pila_for i;
        
    i = fpop();
    i.var->u.val = i.var->u.val + i.step;        
    if (i.var->u.val > i.objeto) return;   
    fempuja(i);
    prog = i.loc;
}


void fempuja(struct pila_for i)
{
    if (ftos > FOR_NEST)
      visualiza_error("fempuja",10);
      
    fstack[ftos] = i;
    ftos++;
}

struct pila_for fpop()
{
    ftos--;
    if (ftos<0) visualiza_error("fpop",11);
    return( fstack[ftos]);
}

void input()
{
    char str[80]; 
    int filas, columnas;
    double valor, index;
    Var *s;
     
     do {
            obtiene_simbolo();
            if (simbolo_tipo == COMILLA) {
                 printf(simbolo);
                 obtiene_simbolo();
                 if (!((*simbolo == ',') || (*simbolo == ';'))) visualiza_error("input",1);
                 obtiene_simbolo();
            };
    
            printf("? ");
    
               if (( s = lookup(simbolo)) == 0 )
                s = install(simbolo, var_tipo, 0.0);  
        
            /*scanf("%s", str); */ gets(str);
            
            if (var_tipo == VARIABLE)
            {
                char *temp, simb[80];
                temp = prog;
                strcpy(simb,str);
                prog = simb;           
                obtiene_exp(&valor);   
                prog = temp;
                
             
             if (s->type == MATRIX) {                                    
                obtiene_simbolo();
                  if ( *simbolo != '(' ) 
                    visualiza_error("input",0);
      
                  obtiene_exp(&index);
                  filas = trunc(index);
                  columnas = 1;
       
                  obtiene_simbolo();
      
                  if (*simbolo == ',') {
                        obtiene_exp(&index);
                        columnas = trunc(index);
                        obtiene_simbolo();
                 }                        
        
                 if (*simbolo != ')') 
                    visualiza_error("input",1);
                    
                 if (filas < 1 || columnas <1) 
                     visualiza_error("input",0);    
                                    
                 if (filas > s->filas || columnas > s->columnas) 
                     visualiza_error("input",0);
             
                   s->u.matrix[(filas-1)*(s->columnas)+(columnas-1)]= valor;
                                                
             }
              else 
                    s->u.val = valor;               
          }
          else {
                 if ((s->u.str = (char *) malloc(strlen(str)+1)) == 0) 
                     visualiza_error("input",20);
                 strcpy(s->u.str, str);
          }  

            //putchar('\n');
            obtiene_simbolo();
            
      } while(*simbolo == ',' || *simbolo == ';');
      retorno();
}

void gosub()
{
    char *loc;
    
    obtiene_simbolo();
    loc = encuentra_etiqueta(simbolo);
    if (loc == '\0')
      visualiza_error("gosub",7);
    else {
        gempuja(prog);
        prog = loc;
    }
}

void greturn()
{
    prog = gpop();
}

void gempuja(char *s)
{
    gtos ++;
    
    if ( gtos == SUB_NEST) {
        visualiza_error("gempuja",12);
        return;
    }
    gpila[gtos]= s;
}

char *gpop()
{
    if (gtos == 0) {
        visualiza_error("gpop",13);
        return 0;
    }
    return (gpila[gtos--]);
}

void wempuja(char *s)
{
   wtos++;
   
   if (wtos == WHILE_NEST) {
         visualiza_error("wempuja",15);
         return;
   }    
   wpila[wtos]= s;
}

char *wpop()
{
     if (wtos == 0) {
           visualiza_error("wpop",16);
           return 0;
     }
     return (wpila[wtos--]);
}

void ejecuta_while() 
{
    double valor;
    int count = 1;
    
    retorno();              //regresa simbolo while
    wempuja(prog);           // toma nota de la posicion 
    obtiene_simbolo();       // recupera el simbolo while
    obtiene_exp(&valor);     // ve si se va a ejecutar
    if (!valor) {            // si no se salta hasta el wend final
    do {
       if (simb == WHILE ) count++;
       if (simb == WEND )  count--;    
       obtiene_simbolo();
    }    while (count > 0);
    wtos--;                                  
    }
}

void end_while()
{
    prog = wpop();
}

void dempuja(char *s)
{
   dtos++;
   
   if (dtos == DO_LOOP_NEST) {
         visualiza_error("dempuja",18);
         return;
   }    
   dpila[dtos]= s;
}

char *dpop()
{       
  if (dtos == 0) {
       visualiza_error("dpop",19);
            return 0;
        };
        
    return dpila[dtos];
}

void ejecuta_doloop()
{
   dempuja(prog);    
}

void end_doloop()
{
   double valor;
   
   obtiene_simbolo();
   switch (simb) {
         case WHILE: 
            obtiene_exp(&valor);
            if (valor) prog = dpop();
            else dtos--;
            break;
         case UNTIL:
            obtiene_exp(&valor);
            if (!valor) prog = dpop();
            else dtos --;
            break;
         default :  //do - loop sin fin
            prog= dpop();
            //visualiza_error("end_doloop",0);
            break;
   }
}

void rem()
{
    encuentra_eol();
}

void locate()
{
    double valor;
    int x, y;
    
    obtiene_exp(&valor);
    x= trunc(valor);
    obtiene_simbolo();
    if (*simbolo != ',') visualiza_error("locate",0);
    obtiene_exp(&valor);
    y= trunc(valor);
    gotoxy(x,y);
}

void ejecuta_exit()
{
  LiberaRamVar();
  beep();
  printf("press [ON].");
  sys_slowOn();

  WAIT_CANCEL;
  if (p_buf != NULL)  free(p_buf);
  exit(1);    
}


void ejecuta_dim()
{
      Var *s;
      int i, j, filas, columnas;
      short tipo;
      double valor;
      
      do {
          
          obtiene_simbolo();
          
          if (simbolo_tipo != VARIABLE) visualiza_error("ejecuta_dim",0);
          
          if (var_tipo == VARIABLE) 
             tipo = MATRIX;
          else
             tipo = MSTRING;
             
          if ((s = lookup(simbolo)) == 0)
               s = install(simbolo, tipo, 0.0);
          else 
               visualiza_error("ejecuta_dim",21);
           
          obtiene_simbolo();
          if ( *simbolo != '(' ) visualiza_error("ejecuta_dim",0);
      
          obtiene_exp(&valor);
          filas = trunc(valor); s->filas = filas;
          columnas = 1;         s->columnas = columnas;
      
          obtiene_simbolo();
      
          if (*simbolo == ',') {
                 obtiene_exp(&valor);
                 columnas = trunc(valor);
                 s->columnas = columnas;
                 obtiene_simbolo();
          }
        
          if (*simbolo != ')') visualiza_error("ejecuta_dim",1);
      
          if (tipo == MATRIX) {  
              if ((s->u.matrix = (double *) malloc((filas)*(columnas)*sizeof(double))) == 0) 
                   visualiza_error("ejecuta_dim",20);
           
                for (i = 0; i < filas; i++)
                   for (j = 0; j < columnas; j++)
                       s->u.matrix[i*columnas+j] = 0.0; 
          }
          else {
               if ((s->u.mstring = (char *) malloc(filas*columnas*255*sizeof(char))) == 0 )
                    visualiza_error("ejecuta_dim",20);
                      
               for (i = 0; i < filas; i++)
                  for (j = 0; j < columnas; j++)
                      s->u.mstring[(i*columnas+j)]='\0';
          }
                 
          obtiene_simbolo();
          
       } while (*simbolo == ',');              
                                     
}

some examples in the next post
Find all posts by this user
Quote this message in a reply
Post Reply 


Messages In This Thread
BASIC Programs on HP 50G - Alvaro - 03-06-2014, 12:33 PM
RE: BASIC Programs on HP 50G - Namir - 03-08-2014, 11:59 PM
RE: BASIC Programs on HP 50G - RMollov - 03-09-2014, 04:17 AM
RE: BASIC Programs on HP 50G - RMollov - 03-09-2014, 04:04 AM
RE: BASIC Programs on HP 50G - HP67 - 03-09-2014, 10:31 AM
RE: BASIC Programs on HP 50G - r. pienne - 03-09-2014, 11:33 AM
RE: BASIC Programs on HP 50G - HP67 - 03-09-2014, 11:40 AM
RE: BASIC Programs on HP 50G - r. pienne - 03-09-2014, 11:57 AM
RE: BASIC Programs on HP 50G - HP67 - 03-09-2014, 12:59 PM
RE: BASIC Programs on HP 50G - r. pienne - 03-09-2014, 01:09 PM
RE: BASIC Programs on HP 50G - HP67 - 03-09-2014, 01:19 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-09-2014, 11:43 AM
RE: BASIC Programs on HP 50G - HP67 - 03-09-2014, 11:45 AM
RE: BASIC Programs on HP 50G - Wes Loewer - 03-26-2014, 06:00 PM
RE: BASIC Programs on HP 50G - HP67 - 03-26-2014, 06:13 PM
RE: BASIC Programs on HP 50G - Wes Loewer - 03-26-2014, 07:54 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-26-2014, 07:56 PM
RE: BASIC Programs on HP 50G - Namir - 03-09-2014, 01:59 PM
RE: BASIC Programs on HP 50G - HP67 - 03-09-2014, 03:00 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-09-2014, 07:02 PM
RE: BASIC Programs on HP 50G - HP67 - 03-10-2014, 07:35 AM
RE: BASIC Programs on HP 50G - churichuro - 03-09-2014, 07:20 PM
RE: BASIC Programs on HP 50G - Joe Horn - 03-11-2014, 04:18 AM
RE: BASIC Programs on HP 50G - churichuro - 03-11-2014, 03:17 PM
RE: BASIC Programs on HP 50G - Howard Owen - 03-19-2014, 06:16 PM
RE: BASIC Programs on HP 50G - RMollov - 03-20-2014, 07:57 AM
RE: BASIC Programs on HP 50G - Alvaro - 04-20-2014, 12:39 PM
RE: BASIC Programs on HP 50G - churichuro - 04-21-2014, 01:02 AM
RE: BASIC Programs on HP 50G - Alvaro - 04-21-2014, 09:39 AM
RE: BASIC Programs on HP 50G - churichuro - 04-21-2014, 09:27 PM
RE: BASIC Programs on HP 50G - churichuro - 03-11-2014 03:20 PM
RE: BASIC Programs on HP 50G - churichuro - 03-11-2014, 03:29 PM
RE: BASIC Programs on HP 50G - churichuro - 03-11-2014, 03:46 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-12-2014, 10:00 PM
RE: BASIC Programs on HP 50G - churichuro - 03-13-2014, 08:07 PM
RE: BASIC Programs on HP 50G - churichuro - 03-14-2014, 02:28 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-14-2014, 12:08 PM
RE: BASIC Programs on HP 50G - dizzy - 03-14-2014, 01:44 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-15-2014, 07:23 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-16-2014, 02:45 PM
RE: BASIC Programs on HP 50G - churichuro - 03-14-2014, 02:46 PM
RE: BASIC Programs on HP 50G - dfnr2 - 03-19-2014, 03:55 PM
RE: BASIC Programs on HP 50G - churichuro - 03-23-2014, 01:08 AM
RE: BASIC Programs on HP 50G - Alvaro - 03-23-2014, 09:18 PM
RE: BASIC Programs on HP 50G - HP67 - 03-26-2014, 08:09 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-26-2014, 08:46 PM
RE: BASIC Programs on HP 50G - RMollov - 03-27-2014, 03:54 AM
RE: BASIC Programs on HP 50G - Alvaro - 03-27-2014, 08:05 AM
RE: BASIC Programs on HP 50G - RMollov - 03-27-2014, 09:02 AM
RE: BASIC Programs on HP 50G - Han - 03-27-2014, 09:29 PM
RE: BASIC Programs on HP 50G - Wes Loewer - 03-27-2014, 03:41 PM
RE: BASIC Programs on HP 50G - Alvaro - 03-27-2014, 06:24 PM
RE: BASIC Programs on HP 50G - RMollov - 03-28-2014, 02:43 AM
RE: BASIC Programs on HP 50G - Howard Owen - 03-29-2014, 03:32 AM



User(s) browsing this thread: 1 Guest(s)