Post Reply 
BASIC Programs on HP 50G
03-11-2014, 03:17 PM
Post: #26
RE: BASIC Programs on HP 50G
(03-11-2014 04:18 AM)Joe Horn Wrote:  
(03-09-2014 07:20 PM)churichuro Wrote:  well, I do a Basic in C from scratch for the HP50
and for TI-89/Ti-voyager
but never finish it, this work but in beta state.
the name is UBASIC (U= useless), and do it only for hobby.

FYI, the name "UBASIC" is already in use. UBASIC has a bunch of Number Theory functions built in, and adjustable accuracy. Runs great under Windows 7 in a DOS window (except the graphics commands). Here's the Wikipedia article about it.

UBASIC then I think I was not very imaginative, right?

BASIC this has nothing to do with these wonders you say.

This BASIC program it from scratch.

here I leave the version 0.1 and version 0.2
version 0.1 if it runs well on the HP50, that is the version specified for the HP calculator, unfortunately lost the info of my drive and could only recover the database to version 0.2, ie the version base from which to derive versions for texas instrument, linux, windows xp, and the HP-50.

never ever shared the code that was not yet ready. but as
I do not have time to continue with this project I leave the code sources so that if someone is interested to continue with the project.

who initially see it somewhat useless why is UselessBasicWink

as it is good to make your programs on the calculator, and they run much faster than the rpl programs.

regards

version 0.1
Code:

// C Source File
// Created 27/10/2004; 02:13:01 p.m.

#include <stdio.h>
#include <math.h>
/* # include <math.h> */
#include <string.h>
/* # include <kbd.h> */
#include <setjmp.h>
#include <ctype.h>
#include <stdlib.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;
}

#define NUM_LAB 1000
#define LAB_LEN 50
#define FOR_NEST 250
#define SUB_NEST 2500
#define WHILE_NEST 250
#define DO_LOOP_NEST 250
#define IF_NEST 100
#define PROG_SIZE 640000

#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 PRINT    21
#define INPUT    22
#define IF       23
#define THEN     24
#define ELSE     25
#define FOR      26
#define NEXT     27
#define TO       28
#define GOTO     29
#define GOSUB    30
#define RETURN   31
#define END      32
#define REM      33
#define STEP     34
#define CLS      35
#define LOCATE   36
#define PAUSE    37
#define WHILE    38
#define WEND     39
#define DO       40
#define LOOP     41
#define UNTIL    42
#define DIM      43
#define EXIT     44
#define LET      45
#define PI       3.141516

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



//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);
}

char *prog;
jmp_buf e_buf;

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

float 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();

//float variables[26];
/*--------------------------------------------------------------------------*/

typedef struct Var {
    char *name;
    short type;
    int   filas, columnas;
    union {
              float val;
              float *matrix;
              char *str;
              char *mstring;
    } u;
    struct Var *next;
} Var;

Var *varlist = 0;

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

void LiberaRamVar()
{
      Var *sp, temp;
        
      for (sp = varlist; sp != (Var *) 0; 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, float d)
/* char *s; 
int t; 
float d; */
{
    Var *sp;
    
    if ((sp = (Var *) malloc(sizeof(Var))) == (Var *) 0) visualiza_error("install",20);
    if ((sp->name = (char *) malloc(strlen(s)+1)) == (char *) 0) 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[22][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"
    };

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},
 {"end", END},
 {"", END}    
};

#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

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},
    {"",END}
};

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

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

struct pila_for {
    Var *var;   //int var;
    float objeto;
    float 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;
//int exit;


void print(), examina_etiquetas(), encuentra_eol(), ejecuta_goto();
void ejecuta_if(), ejecuta_for(), siguiente(), fempuja(), input();
void gosub(), greturn(), gempuja(), inicializa_eti(), ejecuta_while(), end_while();
void ejecuta_doloop(), end_doloop(), ejecuta_else(), encuentra_else();


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

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

void nivel1(float *resultado) 
{
    register int op;
    float 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(float *resultado)
{
    register char op;
    float hold;
    
    nivel3(resultado);
    while ((op = *simbolo) == '+' || op == '-') {
        obtiene_simbolo();
        nivel3(&hold);
        arit(op, resultado, &hold);
    }
}

void nivel3(float *resultado)
{
    register char op;
    float hold;
    
    nivel4(resultado);
    while ((op = *simbolo) == '*' || op == '/' || op == '%') {
        obtiene_simbolo();
        nivel4(&hold);
        arit(op, resultado, &hold);
    }
}

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

void nivel5(float *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(float *resultado)
{
    if ((*simbolo == '(') && (simbolo_tipo == DELIMITADOR )) {
        obtiene_simbolo();
        nivel0(resultado);
        if (*simbolo != ')')
         visualiza_error("nivel6",1);
        obtiene_simbolo();
    }
    else
     primitiva(resultado);
}

void primitiva(resultado)
float *resultado;
{
  Var *s; 
  float 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);
    }
}

float funcion(ind)
int ind;
{
   float valor = 0.0;
   
   if (ind == PII) return PI;
 
   obtiene_simbolo();
   if (*simbolo != '(') visualiza_error("funcion",1);
     obtiene_simbolo();
     if (ind != VALOR) 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 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:
                 valor =  sqrt(valor);
                 break;
        case TAN:
                 valor =  tan(valor);
                 break;
        case TANH:
                 valor =  tanh(valor);
                 break;
        case TRUNC:
                 valor =  (float) 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 = (float) random();
                  break;
        default:
            valor =  0.0;
            break;
   }      
   if (*simbolo != ')') visualiza_error("funcion",1);   
   return valor;
}

void arit(o,r,h)
 char o;
 float *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 '%' :
          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;
float *r;
{
    if ((o == '-') || (o == (char) 173 )) *r = -(*r);
}

float 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]);
    longjmp(e_buf, 1);
}


/***************************************************/
int obtiene_simbolo()
{
    register char *temp, op;
    
    simbolo_tipo = 0; simb = 0;  var_tipo = VARIABLE; 
    temp = simbolo;
    
    /* if (kbhit() == KEY_ESC) { GKeyFlush(); visualiza_error("obtiene_simbolo",17);} */
    
    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;        
        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",1);
        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;
            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') return 1;
    else return 0;
}

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

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

/******************************************************/
// Main Function
int main(int argc,char *argv[])
{
  char *p_buf;
//  char name[12];
  char instruccion[255];
  char *path= "./", name[128];

   
   
   
//  FILE *out;
  
  clrscr(); 
  printf("Useless BASIC V 0.1B\n");

  if (argc< 2) {
     printf("\nUSE: BASIC FileName\n");
     exit(1);
   }

  varlist = NULL;
  
  if (!(p_buf = (char *) malloc(PROG_SIZE))) {
      printf("\nasignacion fracasada.");
      exit(1);
  }
  
  //strcpy(name, "bas");
  sprintf(name,"%s%s.bas",path,argv[1]);
  
  if(!carga_programa(p_buf, name)) { free(p_buf); exit(1); };
  
  
  if (setjmp(e_buf)) { 
       LiberaRamVar(); 
       free(p_buf); 
       exit(1); 
  }
  
  prog = p_buf;
  examina_etiquetas();
  ftos = 0;
  gtos = 0;
  wtos = 0;
  dtos = 0;
  iftos = 0;
  var_tipo = VARIABLE;
  
 /* 
  out = fopen("lst","wt");
  while (*prog) {
      obtiene_simbolo();
      if (*simbolo == '\n') {*simbolo = '\n'; simbolo[1]= '\0';}
      fprintf(out,"simb=%s,tipo:%d,char:%d\n", simbolo, simbolo_tipo, simb);
  }
  fclose(out);
  prog = p_buf;
 */  
  //GKeyIn (NULL, 0); free(p_buf); exit(1);
  
  //**************
  do {
  //**************     
  
  do {
      simbolo_tipo = obtiene_simbolo();

    //printf("[%s]",simbolo);
                                        
      if (simbolo_tipo == VARIABLE) {
          retorno();                       
          asignar();                        
      }
      else
        switch(simb) {
            
          case LET:
             asignar();
             break;
            case PRINT:
              print();
              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:
               clrscr();
               break;
            case LOCATE:
               locate();
               break;
            case PAUSE:
               getch();
               break;
            case DO:
               ejecuta_doloop();
               break;
            case LOOP:
               end_doloop();
               break;
            case DIM :
               ejecuta_dim();
               break;
            case EXIT:
               ejecuta_exit();
               break;
            case END:
              free(p_buf);
              exit(0);
        }
  } while ( simb != FINISHED);
  
 //********************************************************
 printf("\n? ");
 //scanf("%s",instruccion); //
 fgets(instruccion,sizeof(instruccion),stdin);
 //printf(instruccion);
 prog = instruccion;
 obtiene_simbolo();
 retorno();
 } while (simb != FINISHED);
 //********************************************************  
 free(p_buf);
 LiberaRamVar();
 printf("Bye!\n\n");
 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 = getc(fp);                 
        p++; i++;
        
    } while (!feof(fp) && i < PROG_SIZE);
    *(--p) = '\0';
    fclose(fp);
    return 1;
}

void asignar()
{
    int filas, columnas;
    float 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 print()
{
    float result;
    int len = 0, espacios;
    char ultimo_delim= '\0';
    char buffer[80];
    
    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,"%f",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 examina_etiquetas()
{
    register int loc;
    char *temp;
    
    inicializa_eti();
    temp = prog;
    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 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()
{
    float 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;
  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;
    float 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;
    float valor, index;
    Var *s;
     
     do {
            obtiene_simbolo();
            if (simbolo_tipo == COMILLA) {
                 printf(simbolo);
                 obtiene_simbolo();
                 if (*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 == ',');
      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() 
{
    float 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()
{
   float 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()
{
    float 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();
  exit(1);    
}


void ejecuta_dim()
{
      Var *s;
      int i, j, filas, columnas;
      short tipo;
      float 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 = (float *) malloc((filas)*(columnas)*sizeof(float))) == 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 == ',');              
                                     
}

version 0.2 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: 4 Guest(s)