Post Reply 
BASIC Programs on HP 50G
03-09-2014, 07:02 PM
Post: #21
RE: BASIC Programs on HP 50G
(03-09-2014 05:10 PM)Manolo Sobrino Wrote:  Short answer: no.

You're asking for a way to run x86 code on an ARM processor. Straight translation isn't easy, so people use emulators. I don't think anybody has tried to port anything like DOSBox to the HP 50G or that it can be done.

If you have an Android phone/tablet you could install DOSBox and run your binaries there. I'd go for this.

Being there you could also try an Android BASIC like this: http://laughton.com/basic/

A relatively inexpensive recent calculator option should be BBC BASIC on a TI 83+/84+, after installing the official free flash application. This is a classic standard BASIC straight from the CP/M era. Before getting one it would be a good idea to check everything first with a PC emulator like Wabbitemu.

Almost every other calculator would be far easier to program than a HP 50G in RPL, but you'll have essentially to learn their specific language.


Thank you very much Manolo.

I will have a look to TI.
RPL is not a easy thing and I have no time to spend with it.
I need something that makes "my life easier".
Find all posts by this user
Quote this message in a reply
03-09-2014, 07:20 PM (This post was last modified: 03-09-2014 07:22 PM by churichuro.)
Post: #22
RE: BASIC Programs on HP 50G
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.

example:

Code:

CLS
FIX 0
INPUT "NUM=",N
FOR I=1 TO N
  LOCATE 1,1
  PRINT I
NEXT
END

this must be a string in a SD card whit name for example "CONT"
put the string "CONT" in the stack
then run the program BAS

then the program BAS look for the file or string in the SD card
and interpret the program line to line
is very fast.

you need the HP50 with the library HPGCC
Find all posts by this user
Quote this message in a reply
03-10-2014, 07:35 AM
Post: #23
RE: BASIC Programs on HP 50G
(03-09-2014 07:02 PM)Alvaro Wrote:  RPL is not a easy thing and I have no time to spend with it. I need something that makes "my life easier".

TINSTAAFL! Especially not in matters technical.

It ain't OVER 'till it's 2 PICK
Find all posts by this user
Quote this message in a reply
03-11-2014, 03:05 AM
Post: #24
RE: BASIC Programs on HP 50G
(03-06-2014 12:33 PM)Alvaro Wrote:  I have a several BASIC programs writen for my CASIO FX 850P and I am looking for a EASY way to run them with the HP.
If you post the source code here, there's a good chance that someone will be willing to port them to RPL for you.

Then 3 dozen people will find ways to make the code 50% faster and 25% smaller.... Smile

Dave
Find all posts by this user
Quote this message in a reply
03-11-2014, 04:18 AM
Post: #25
RE: BASIC Programs on HP 50G
(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.

X<> c
-Joe-
Visit this user's website Find all posts by this user
Quote this message in a reply
03-11-2014, 07:21 AM
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.

In the '80s there was an "ubasic" for MSI barcode readers... Wink

Greetings,
    Massimo

-+×÷ ↔ left is right and right is wrong
Visit this user's website Find all posts by this user
Quote this message in a reply
03-11-2014, 03:17 PM
Post: #27
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
03-11-2014, 03:20 PM
Post: #28
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
03-11-2014, 03:29 PM (This post was last modified: 03-11-2014 03:33 PM by churichuro.)
Post: #29
RE: BASIC Programs on HP 50G
examp #1: area of circle, here use the stack!

D=POP
A=D*D*PI/4
PRINT "AREA=";A
PUSH A
END

examp #2: from C bible the program Celsius

lower=0
upper=300
step1=20
fahr=lower
while fahr<=upper
celsius=(5.0/9.0)*(fahr-32.0)
print fahr,celsius
fahr=fahr+step1
Wend
end

examp #3: Int. SIMPSON ver 1.
print "Integral por el metodo SIMPSON"
input "lim. inf=",a
input "lim. sup=",b
input "# intervalos=",c
h=(b-a)/c
x=a
gosub 1000
i=f
for m=1 to c/2
x=x+h
gosub 1000
i=i+f*4
x=x+h
gosub 1000
i=i+f*2
next
x=b
gosub 1000
i=i-f
print "i=";i*h/3
end
1000 f=x^3+x^2-x-1
return
end

examp #4: use DATA and READ instructions

print "Ejemplo de datas"
read x,y,z$
print "X=";x
print "Y=";y
print "Z=";z$
data 10, 25.4, "hola!!!"
end

examp #5: here the user can write an equation for X and is evaluate
INPUT "X = ",X
INPUT "EQ=",E$
PRINT VAL(E$)
END

examp #6: int. SIMPSON ver 2.

print "Integral por el metodo SIMPSON"
print "Ecuacion en funcion de x"
input "ejemplo: x^3+x^2-x-1 :",e$
input "limite inf=",a
input "limite sup=",b
input "# intervalos=",c
print "resolviendo para : f=";e$
h=(b-a)/c
x=a
f=val(e$)
i=f
for m=1 to c/2
x=x+h
f=val(e$)
i=i+f*4
x=x+h
f=val(e$)
i=i+f*2
next
x=b
f=val(e$)
i=i-f
print "i=";i*h/3
end
Find all posts by this user
Quote this message in a reply
03-11-2014, 03:46 PM
Post: #30
RE: BASIC Programs on HP 50G
instructions for use UBASIC in HP50

I have the program in a directory called BASIC, BAS with the name, and I also have the S2FL program by that name in the same directory.

write the program as a string
and then I write another string that is the name you want to give to the program.

with the program at level 2 of the stack
and the name on the level 1 of the stack
S2FL use the program and this program writes the file to the SD memory
(I did not S2FL program this as an example HPGCC files)

then write the string with the name of the program
and I run the BAS program, which starts the execution of the program.

UBASIC is not a complete interpetre that only runs programs stored in
the SD memory, you can not have a truly interactive environment as in the real BASIC
Find all posts by this user
Quote this message in a reply
03-12-2014, 10:00 PM
Post: #31
RE: BASIC Programs on HP 50G
(03-11-2014 03:46 PM)churichuro Wrote:  instructions for use UBASIC in HP50

I have the program in a directory called BASIC, BAS with the name, and I also have the S2FL program by that name in the same directory.

write the program as a string
and then I write another string that is the name you want to give to the program.

with the program at level 2 of the stack
and the name on the level 1 of the stack
S2FL use the program and this program writes the file to the SD memory
(I did not S2FL program this as an example HPGCC files)

then write the string with the name of the program
and I run the BAS program, which starts the execution of the program.

UBASIC is not a complete interpetre that only runs programs stored in
the SD memory, you can not have a truly interactive environment as in the real BASIC

I did start to re-write one of my BAISC programms in ALgebraic Mode , but I was forced to give up because I absolutly need to use Arrays in the programms and the PUT command in ALgebraic Mode is not changing the content of the respective variable, so for me that is FULL STOP with the HP 50g.
That also means that I will not use at all the programing.

It is a shame, such a nice calculator, so powerfull with so many functions , difficult to find in any other calculator, not to have a High Level language like BASIC implemented.
Well, I will have to look for another solution.
Find all posts by this user
Quote this message in a reply
03-13-2014, 08:07 PM
Post: #32
RE: BASIC Programs on HP 50G
after playing around with this BASIC on the HP50 and the version for Mac OSX
I think I will continue on with the development of this project in my spare time.

the first step will be to handle IF-THEN-ELSE-ENDIF for several lines

the program has the necessary structure to include in future versions handling integer variables, although not one of my priorities.

A major challenge is that the code is not interpreted line by line directly, but rather generate an intermediate code (microcode) as does java, so to have 2 programs one parcer and another to run the semi-compiled code.
Find all posts by this user
Quote this message in a reply
03-13-2014, 09:21 PM
Post: #33
RE: BASIC Programs on HP 50G
(03-13-2014 08:07 PM)churichuro Wrote:  after playing around with this BASIC on the HP50 and the version for Mac OSX
I think I will continue on with the development of this project in my spare time.

the first step will be to handle IF-THEN-ELSE-ENDIF for several lines

the program has the necessary structure to include in future versions handling integer variables, although not one of my priorities.

A major challenge is that the code is not interpreted line by line directly, but rather generate an intermediate code (microcode) as does java, so to have 2 programs one parcer and another to run the semi-compiled code.

I just want to thank churichuro for sharing his/her (?) code. I'll switch to Spanish to do it properly.

Hola churichuro,

Muchas gracias por compartir tu código aquí. No estoy en posición de analizar si es bueno o malo, pero no deja de ser tu trabajo personal y a fin de cuentas son 2000 líneas en las que entre otras cosas implementas un parser. Me extraña que nadie te agradezca al menos el gesto de hacerlo público, pero lo cierto es que a veces esta (llamémosle) comunidad es bastante peculiar. (Eso sí, a bote pronto luciría mucho más si corrigieras el valor de PI, el que has puesto daña gravemente la vista Big Grin).

Un saludo,

Manolo
Find all posts by this user
Quote this message in a reply
03-14-2014, 12:08 PM
Post: #34
RE: BASIC Programs on HP 50G
(03-13-2014 08:07 PM)churichuro Wrote:  after playing around with this BASIC on the HP50 and the version for Mac OSX
I think I will continue on with the development of this project in my spare time.

the first step will be to handle IF-THEN-ELSE-ENDIF for several lines

the program has the necessary structure to include in future versions handling integer variables, although not one of my priorities.

A major challenge is that the code is not interpreted line by line directly, but rather generate an intermediate code (microcode) as does java, so to have 2 programs one parcer and another to run the semi-compiled code.

Hi churichuro,

Thank you you answer and of course for code.
I have no knowledge of C or even LINUX .
So far I could understand from your UBASIC Project, it is a BASIC to C converter.
I feel that it is a very challenging project, and it involves surely at lot of Knowledge and huge effort from yourself, and also have the fealing that it would be very difficult to get it run for everybody. I think there will be always problems, then it depends very much on how the people are writting there BASIC Programs.

I am wondering if it would not be much more easyier to write a BASIC Interpreter that would run as a Program in the HP.
Somehow your doing, more or less, something like a BASIC Interpreter.

It would be very nice and very usefull if there was a BASIC Interpreter for the HP, at least for, so that the User could write on-the-fly , a BASIC Program.

It would be interesting to know the opinion and of the need of a sBASIC (=short) for the HP Calculators from other HP users.

Once again, thank you.
Regards.
Find all posts by this user
Quote this message in a reply
03-14-2014, 01:44 PM
Post: #35
RE: BASIC Programs on HP 50G
(03-14-2014 12:08 PM)Alvaro Wrote:  
(03-13-2014 08:07 PM)churichuro Wrote:  after playing around with this BASIC on the HP50 and the version for Mac OSX
I think I will continue on with the development of this project in my spare time.

the first step will be to handle IF-THEN-ELSE-ENDIF for several lines

the program has the necessary structure to include in future versions handling integer variables, although not one of my priorities.

A major challenge is that the code is not interpreted line by line directly, but rather generate an intermediate code (microcode) as does java, so to have 2 programs one parcer and another to run the semi-compiled code.

Hi churichuro,

Thank you you answer and of course for code.
I have no knowledge of C or even LINUX .
So far I could understand from your UBASIC Project, it is a BASIC to C converter.
I feel that it is a very challenging project, and it involves surely at lot of Knowledge and huge effort from yourself, and also have the fealing that it would be very difficult to get it run for everybody. I think there will be always problems, then it depends very much on how the people are writting there BASIC Programs.

I am wondering if it would not be much more easyier to write a BASIC Interpreter that would run as a Program in the HP.
Somehow your doing, more or less, something like a BASIC Interpreter.

It would be very nice and very usefull if there was a BASIC Interpreter for the HP, at least for, so that the User could write on-the-fly , a BASIC Program.

It would be interesting to know the opinion and of the need of a sBASIC (=short) for the HP Calculators from other HP users.

Once again, thank you.
Regards.

There are several lightweight open-source BASIC interpreters around that could potentially be compiled under HPGCC.
Find all posts by this user
Quote this message in a reply
03-14-2014, 02:28 PM (This post was last modified: 03-14-2014 02:51 PM by churichuro.)
Post: #36
RE: BASIC Programs on HP 50G
(03-13-2014 09:21 PM)Manolo Sobrino Wrote:  I just want to thank churichuro for sharing his/her (?) code. I'll switch to Spanish to do it properly.

Hola churichuro,

Muchas gracias por compartir tu código aquí. No estoy en posición de analizar si es bueno o malo, pero no deja de ser tu trabajo personal y a fin de cuentas son 2000 líneas en las que entre otras cosas implementas un parser. Me extraña que nadie te agradezca al menos el gesto de hacerlo público, pero lo cierto es que a veces esta (llamémosle) comunidad es bastante peculiar. (Eso sí, a bote pronto luciría mucho más si corrigieras el valor de PI, el que has puesto daña gravemente la vista Big Grin).

Un saludo,

Manolo

Manolo Many thanks for your kind words, thank you for your words lifted my spirits, I thought my comments were invisible.

and above all thank you very much for taking the time to do it in Spanish.

Gracias Manolo!, sobre PI, siendo hoy el día donde se festeja este fenómeno matemático, ya lo corregí en la nueva versión que estoy trabajando.
el nuevo valor de PI sera 3.14159265358979323846, no exacto pero al menos mas correcto Wink
Find all posts by this user
Quote this message in a reply
03-14-2014, 02:46 PM
Post: #37
RE: BASIC Programs on HP 50G
(03-14-2014 12:08 PM)Alvaro Wrote:  Hi churichuro,

Thank you you answer and of course for code.
I have no knowledge of C or even LINUX .
So far I could understand from your UBASIC Project, it is a BASIC to C converter.
I feel that it is a very challenging project, and it involves surely at lot of Knowledge and huge effort from yourself, and also have the fealing that it would be very difficult to get it run for everybody. I think there will be always problems, then it depends very much on how the people are writting there BASIC Programs.

I am wondering if it would not be much more easyier to write a BASIC Interpreter that would run as a Program in the HP.
Somehow your doing, more or less, something like a BASIC Interpreter.

It would be very nice and very usefull if there was a BASIC Interpreter for the HP, at least for, so that the User could write on-the-fly , a BASIC Program.

It would be interesting to know the opinion and of the need of a sBASIC (=short) for the HP Calculators from other HP users.

Once again, thank you.
Regards.

Hello Alvaro

no, my UBasic is not a BASIC to C converter.

my basic is an interpreter, and does exactly what you're asking for.

just that it's still very easy to get the calculator to crash, because my program lacks better error handling.

 UBasic works great for me because I know better, now I have several ideas to make it better and safer to use.

right now, you can write your basic program directly into the calculator and run in it, but is more comfortable typing on a regular keyboard and then move this program to the calculator with an SD memory.

and the best part is that compiling the source code UBASIC can have the same program running on your computer, either with Linux, Windows and Mac OSX, and even in a Ti-89, TI-92 and TI-Voyager calculator
Find all posts by this user
Quote this message in a reply
03-15-2014, 07:23 PM
Post: #38
RE: BASIC Programs on HP 50G
(03-14-2014 01:44 PM)dizzy Wrote:  [quote='Alvaro' pid='6875' dateline='1394798926']


There are several lightweight open-source BASIC interpreters around that could potentially be compiled under HPGCC.

Yes, I found there is the "FreeBASIC". There is also available the SOURCE code. That sounds good.
I have not enough knowledge to go on "FreeBASIC for HP."
Find all posts by this user
Quote this message in a reply
03-16-2014, 02:45 PM
Post: #39
RE: BASIC Programs on HP 50G
(03-15-2014 07:23 PM)Alvaro Wrote:  
(03-14-2014 01:44 PM)dizzy Wrote:  [quote='Alvaro' pid='6875' dateline='1394798926']


There are several lightweight open-source BASIC interpreters around that could potentially be compiled under HPGCC.

Yes, I found there is the "FreeBASIC". There is also available the SOURCE code. That sounds good.
I have not enough knowledge to go on "FreeBASIC for HP."

and there is also the "X11-Basic" that runs in almost every platform, including Android (it runs very well on my ARM-Cortex-´Droid), even it runs on a TomTom Car Navigator System! (But not on a Hp 50g Sad )

http://x11-basic.sourceforge.net/
Find all posts by this user
Quote this message in a reply
03-19-2014, 03:55 PM (This post was last modified: 03-19-2014 03:57 PM by dfnr2.)
Post: #40
RE: BASIC Programs on HP 50G
(03-13-2014 08:07 PM)churichuro Wrote:  after playing around with this BASIC on the HP50 and the version for Mac OSX
I think I will continue on with the development of this project in my spare time.

the first step will be to handle IF-THEN-ELSE-ENDIF for several lines

the program has the necessary structure to include in future versions handling integer variables, although not one of my priorities.

A major challenge is that the code is not interpreted line by line directly, but rather generate an intermediate code (microcode) as does java, so to have 2 programs one parcer and another to run the semi-compiled code.
Very nice, Churichuro. Thanks for sharing. I like your notion of integrating the BASIC with the existing stack mechanism and other calculator functions. I imagine this could turn into a must-have tool for the HP-50G, possibly attracting new users.
Find all posts by this user
Quote this message in a reply
Post Reply 




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