Files
zSoft/apps/mbasic/basic.c

3007 lines
58 KiB
C

/*****************************************************************
* Mini BASIC *
* by Malcolm McLean *
* version 1.0 *
*****************************************************************/
#ifdef __cplusplus
extern "C" {
#endif
#if defined(__K64F__)
#include <stdio.h>
#include <unistd.h>
#include <math.h>
#include <limits.h>
#include <stdlib.h>
#include <stdarg.h>
#include "k64f_soc.h"
#include <ctype.h>
#include <../../libraries/include/stdmisc.h>
#undef stdout
#undef stdin
#undef stderr
extern FILE *stdout;
extern FILE *stdin;
extern FILE *stderr;
#elif defined(__ZPU__)
#include <stdint.h>
#include <stdio.h>
#include "zpu_soc.h"
#define acos acosf
#define floor floorf
#define sin sinf
#define cos cosf
#define tan tanf
#define log logf
#define pow powf
#define sqrt sqrtf
#define asin asinf
#define atan atanf
#define fmod fmodf
#else
#error "Target CPU not defined, use __ZPU__ or __K64F__"
#endif
#include "interrupts.h"
#include "ff.h" /* Declarations of FatFs API */
#include <string.h>
#include <readline.h>
#include "utils.h"
//
#if defined __ZPUTA__
#include "zputa_app.h"
#elif defined __ZOS__
#include "zOS_app.h"
#else
#error OS not defined, use __ZPUTA__ or __ZOS__
#endif
//
#include "mbasic.h"
FORLOOP forstack[MAXFORS]; /* stack for for loop conrol */
int nfors; /* number of fors on stack */
VARIABLE *variables; /* the script's variables */
int nvariables; /* number of variables */
DIMVAR *dimvariables; /* dimensioned arrays */
int ndimvariables; /* number of dimensioned arrays */
LINE *lines = NULL; /* list of line starts */
int nlines = 0; /* number of BASIC lines in program */
const char *string; /* string we are parsing */
int token; /* current token (lookahead) */
int errorflag; /* set when error in input encountered */
void cleanup(void);
void reporterror(int lineno);
int findline(int no);
int line(int);
void doprint(int);
void dolet(int);
void dodim(int);
int doif(int);
int dogoto(int);
int doinput(int);
void dorem(int);
int dofor(int);
int donext(int);
void lvalue(LVALUE *lv);
int boolexpr(void);
int boolfactor(void);
int relop(void);
double expr(void);
double term(void);
double factor(void);
double instr(void);
double variable(void);
double dimvariable(void);
VARIABLE *findvariable(const char *id);
DIMVAR *finddimvar(const char *id);
DIMVAR *dimension(const char *id, int ndims, ...);
void *getdimvar(DIMVAR *dv, ...);
VARIABLE *addfloat(const char *id);
VARIABLE *addstring(const char *id);
DIMVAR *adddimvar(const char *id);
char *stringexpr(void);
char *chrstring(void);
char *strstring(void);
char *leftstring(void);
char *rightstring(void);
char *midstring(void);
char *stringstring(void);
char *stringdimvar(void);
char *stringvar(void);
char *stringliteral(void);
int integer(double x);
void match(int tok);
void seterror(int errorcode);
int getnextline(int);
int gettoken(const char *str);
int tokenlen(const char *str, int token);
int isstring(int token);
double getvalue(const char *str, int *len);
void getid(const char *str, char *out, int *len);
void mystrgrablit(char *dest, const char *src);
char *mystrend(const char *str, char quote);
int mystrcount(const char *str, char ch);
char *mystrdup(const char *str);
char *mystrconcat(const char *str, const char *cat);
double factorial(double x);
// Method to run the basic script, the lines array is prebuilt.
// Returns: 0 on success, 1 on error condition.
//
int execBasicScript(void)
{
int curline = 0;
int nextline;
int answer = 0;
int8_t keyIn;
// Sanity check, no script no run!
//
if(nlines == 0)
return(0);
// Initialise variables.
nvariables = 0;
variables = 0;
dimvariables = 0;
ndimvariables = 0;
while(curline != -1)
{
string = lines[curline].str;
token = gettoken(string);
errorflag = 0;
nextline = line(curline);
if(errorflag)
{
reporterror(lines[curline].no);
answer = 1;
break;
}
// if(nextline == -1)
// break;
// Check to see if user is requesting an action.
#if defined __K64F__
int usb_serial_getchar(void);
keyIn = usb_serial_getchar();
#elif defined __ZPU__
keyIn = getserial_nonblocking();
#else
#error "Target CPU not defined, use __ZPU__ or __K64F__"
#endif
if(nextline == -1 || keyIn == CTRL_C)
{
printf("\nExecution stopped, user request.\n");
break;
}
if(nextline == 0)
{
curline++;
if(curline == nlines)
break;
}
else
{
curline = findline(nextline);
if(curline == -1)
{
printf("line %d not found\n", nextline);
answer = 1;
break;
}
}
}
cleanup();
return answer;
}
/*
frees all the memory we have allocated
*/
void cleanup(void)
{
int i;
int ii;
int size;
for(i=0;i<nvariables;i++)
if(variables[i].sval)
sys_free(variables[i].sval);
if(variables)
sys_free(variables);
variables = 0;
nvariables = 0;
for(i=0;i<ndimvariables;i++)
{
if(dimvariables[i].type == STRID)
{
if(dimvariables[i].str)
{
size = 1;
for(ii=0;ii<dimvariables[i].ndims;ii++)
size *= dimvariables[i].dim[ii];
for(ii=0;ii<size;ii++)
if(dimvariables[i].str[ii])
sys_free(dimvariables[i].str[ii]);
sys_free(dimvariables[i].str);
}
}
else
if(dimvariables[i].dval)
sys_free(dimvariables[i].dval);
}
if(dimvariables)
sys_free(dimvariables);
dimvariables = 0;
ndimvariables = 0;
if(lines)
sys_free(lines);
lines = 0;
nlines = 0;
}
/*
error report function.
for reporting errors in the user's script.
checks the global errorflag.
Params: lineno - the line on which the error occurred
*/
void reporterror(int lineno)
{
switch(errorflag)
{
case ERR_CLEAR:
assert(0);
break;
case ERR_SYNTAX:
printf("Syntax error line %d\n", lineno);
break;
case ERR_OUTOFMEMORY:
printf("Out of memory line %d\n", lineno);
break;
case ERR_IDTOOLONG:
printf("Identifier too long line %d\n", lineno);
break;
case ERR_NOSUCHVARIABLE:
printf("No such variable line %d\n", lineno);
break;
case ERR_BADSUBSCRIPT:
printf("Bad subscript line %d\n", lineno);
break;
case ERR_TOOMANYDIMS:
printf("Too many dimensions line %d\n", lineno);
break;
case ERR_TOOMANYINITS:
printf("Too many initialisers line %d\n", lineno);
break;
case ERR_BADTYPE:
printf("Illegal type line %d\n", lineno);
break;
case ERR_TOOMANYFORS:
printf("Too many nested fors line %d\n", lineno);
break;
case ERR_NONEXT:
printf("For without matching next line %d\n", lineno);
break;
case ERR_NOFOR:
printf("Next without matching for line %d\n", lineno);
break;
case ERR_DIVIDEBYZERO:
printf("Divide by zero lne %d\n", lineno);
break;
case ERR_NEGLOG:
printf("Negative logarithm line %d\n", lineno);
break;
case ERR_NEGSQRT:
printf("Negative square root line %d\n", lineno);
break;
case ERR_BADSINCOS:
printf("Sine or cosine out of range line %d\n", lineno);
break;
case ERR_EOF:
printf("End of input file %d\n", lineno);
break;
case ERR_ILLEGALOFFSET:
printf("Illegal offset line %d\n", lineno);
break;
case ERR_TYPEMISMATCH:
printf("Type mismatch line %d\n", lineno);
break;
case ERR_INPUTTOOLONG:
printf("Input too long line %d\n", lineno);
break;
case ERR_BADVALUE:
printf("Bad value at line %d\n", lineno);
break;
case ERR_NOTINT:
printf("Not an integer at line %d\n", lineno);
break;
default:
printf("ERROR line %d\n", lineno);
break;
}
}
/*
binary search for a line
Params: no - line number to find
Returns: index of the line, or -1 on fail.
*/
int findline(int no)
{
int high;
int low;
int mid;
low = 0;
high = nlines-1;
while(high > low + 1)
{
mid = (high + low)/2;
if(lines[mid].no == no)
return mid;
if(lines[mid].no > no)
high = mid;
else
low = mid;
}
if(lines[low].no == no)
mid = low;
else if(lines[high].no == no)
mid = high;
else
mid = -1;
return mid;
}
/*
Parse a line. High level parse function
*/
int line(int curline)
{
int answer = 0;
const char *str;
match(VALUE);
switch(token)
{
case PRINT:
doprint(curline);
break;
case LET:
dolet(curline);
break;
case DIM:
dodim(curline);
break;
case IF:
answer = doif(curline);
break;
case GOTO:
answer = dogoto(curline);
break;
case BINPUT:
answer = doinput(curline);
break;
case REM:
dorem(curline);
return 0;
break;
case FOR:
answer = dofor(curline);
break;
case NEXT:
answer = donext(curline);
break;
// Poke a value into a memory location.
//
case POKE:
answer = dopoke(curline);
break;
default:
seterror(ERR_SYNTAX);
break;
}
if(token != EOS)
{
/*match(VALUE);*/
/* check for a newline */
str = string;
while(isspace(*str))
{
if(*str == '\n')
break;
str++;
}
if(*str != '\n')
seterror(ERR_SYNTAX);
}
return answer;
}
/*
the PRINT statement
*/
void doprint(int curline)
{
char *str;
double x;
char output[20];
match(PRINT);
while(1)
{
if(isstring(token))
{
str = stringexpr();
if(str)
{
printf("%s", str);
sys_free(str);
}
}
else
{
x = expr();
sprintf(output, "%g", x);
//printf("%g", x);
fputs(output, stdout);
}
if(token == COMMA)
{
printf(" ");
match(COMMA);
}
else
break;
}
if(token == SEMICOLON)
{
match(SEMICOLON);
}
else
printf("\r\n");
}
/*
the LET statement
*/
void dolet(int curline)
{
LVALUE lv;
char *temp;
match(LET);
lvalue(&lv);
match(EQUALS);
switch(lv.type)
{
case FLTID:
*lv.dval = expr();
break;
case STRID:
temp = *lv.sval;
*lv.sval = stringexpr();
if(temp)
sys_free(temp);
break;
default:
break;
}
}
/*
the DIM statement
*/
void dodim(int curline)
{
int ndims = 0;
double dims[6];
char name[32];
int len;
DIMVAR *dimvar;
int i;
int size = 1;
match(DIM);
switch(token)
{
case DIMFLTID:
case DIMSTRID:
getid(string, name, &len);
match(token);
dims[ndims++] = expr();
while(token == COMMA)
{
match(COMMA);
dims[ndims++] = expr();
if(ndims > 5)
{
seterror(ERR_TOOMANYDIMS);
return;
}
}
match(CPAREN);
for(i=0;i<ndims;i++)
{
if(dims[i] < 0 || dims[i] != (int) dims[i])
{
seterror(ERR_BADSUBSCRIPT);
return;
}
}
switch(ndims)
{
case 1:
dimvar = dimension(name, 1, (int) dims[0]);
break;
case 2:
dimvar = dimension(name, 2, (int) dims[0], (int) dims[1]);
break;
case 3:
dimvar = dimension(name, 3, (int) dims[0], (int) dims[1], (int) dims[2]);
break;
case 4:
dimvar = dimension(name, 4, (int) dims[0], (int) dims[1], (int) dims[2], (int) dims[3]);
break;
case 5:
dimvar = dimension(name, 5, (int) dims[0], (int) dims[1], (int) dims[2], (int) dims[3], (int) dims[4]);
break;
}
break;
default:
seterror(ERR_SYNTAX);
return;
}
if(dimvar == 0)
{
/* out of memory */
seterror(ERR_OUTOFMEMORY);
return;
}
if(token == EQUALS)
{
match(EQUALS);
for(i=0;i<dimvar->ndims;i++)
size *= dimvar->dim[i];
switch(dimvar->type)
{
case FLTID:
i = 0;
dimvar->dval[i++] = expr();
while(token == COMMA && i < size)
{
match(COMMA);
dimvar->dval[i++] = expr();
if(errorflag)
break;
}
break;
case STRID:
i = 0;
if(dimvar->str[i])
sys_free(dimvar->str[i]);
dimvar->str[i++] = stringexpr();
while(token == COMMA && i < size)
{
match(COMMA);
if(dimvar->str[i])
sys_free(dimvar->str[i]);
dimvar->str[i++] = stringexpr();
if(errorflag)
break;
}
break;
}
if(token == COMMA)
seterror(ERR_TOOMANYINITS);
}
}
/*
the IF statement.
if jump taken, returns new line no, else returns 0
*/
int doif(int curline)
{
int condition;
int jump;
match(IF);
condition = boolexpr();
match(THEN);
jump = integer( expr() );
if(condition)
return jump;
else
return 0;
}
/*
the GOTO satement
returns new line number
*/
int dogoto(int curline)
{
match(GOTO);
return integer( expr() );
}
/*
The FOR statement.
Pushes the for stack.
Returns line to jump to, or -1 to end program
*/
int dofor(int curline)
{
LVALUE lv;
char id[32];
char nextid[32];
int len;
int idx;
double initval;
double toval;
double stepval;
const char *savestring;
int answer;
match(FOR);
getid(string, id, &len);
lvalue(&lv);
if(lv.type != FLTID)
{
seterror(ERR_BADTYPE);
return -1;
}
match(EQUALS);
initval = expr();
match(TO);
toval = expr();
if(token == STEP)
{
match(STEP);
stepval = expr();
}
else
{
stepval = 1.0;
}
*lv.dval = initval;
if(nfors > MAXFORS - 1)
{
seterror(ERR_TOOMANYFORS);
return -1;
}
if((stepval < 0 && initval < toval) || (stepval > 0 && initval > toval))
{
savestring = string;
for(idx=curline+1; idx < nlines; idx++)
{
string = lines[idx].str;
errorflag = 0;
token = gettoken(string);
match(VALUE);
if(token == NEXT)
{
match(NEXT);
if(token == FLTID || token == DIMFLTID)
{
getid(string, nextid, &len);
if(!strcmp(id, nextid))
{
answer = getnextline(curline);
string = savestring;
token = gettoken(string);
return answer ? answer : -1;
}
}
}
}
seterror(ERR_NONEXT);
return -1;
}
else
{
strcpy(forstack[nfors].id, id);
forstack[nfors].nextline = getnextline(curline);
forstack[nfors].step = stepval;
forstack[nfors].toval = toval;
nfors++;
return 0;
}
}
/*
the NEXT statement
updates the counting index, and returns line to jump to
*/
int donext(int curline)
{
char id[32];
int len;
LVALUE lv;
match(NEXT);
if(nfors)
{
getid(string, id, &len);
lvalue(&lv);
if(lv.type != FLTID)
{
seterror(ERR_BADTYPE);
return -1;
}
*lv.dval += forstack[nfors-1].step;
if( (forstack[nfors-1].step < 0 && *lv.dval < forstack[nfors-1].toval) ||
(forstack[nfors-1].step > 0 && *lv.dval > forstack[nfors-1].toval) )
{
nfors--;
return 0;
}
else
{
return forstack[nfors-1].nextline;
}
}
else
{
seterror(ERR_NOFOR);
return -1;
}
}
/*
the INPUT statement
*/
int doinput(int curline)
{
LVALUE lv;
char buff[1024];
char *end;
match(BINPUT);
lvalue(&lv);
switch(lv.type)
{
case FLTID:
do {
readline((uint8_t *)buff, sizeof(buff), NULL);
if(buff[0] == CTRL_C)
{
return(-1);
}
*lv.dval = strtod(buff, &end);
} while(end == buff);
break;
case STRID:
if(*lv.sval)
{
sys_free(*lv.sval);
*lv.sval = 0;
}
// Readline will return entered data, null terminated, upto endof limit given.
readline((uint8_t *)buff, sizeof(buff), NULL);
if(buff[0] == CTRL_C)
{
return(-1);
}
*lv.sval = mystrdup(buff);
if(!*lv.sval)
{
seterror(ERR_OUTOFMEMORY);
return(-1);
}
break;
default:
return(0);
}
return(0);
}
/*
the REM statement.
Note is unique as the rest of the line is not parsed
*/
void dorem(int curline)
{
match(REM);
return;
}
// The POKE statement. Format is POKE WIDTH, ADDR, DATA
// Takes a value and *pokes* (writes) it into a memory location.
//
int dopoke(int curline)
{
uint32_t addr;
uint32_t data;
uint32_t width;
match(POKE);
width = integer( expr() );
match(COMMA);
addr = integer( expr() );
match(COMMA);
data = integer( expr() );
switch(width)
{
case 8:
*(uint8_t *)(addr) = data;
break;
case 16:
*(uint16_t *)(addr) = data;
break;
case 32:
*(uint32_t *)(addr) = data;
break;
default:
seterror( ERR_BADVALUE );
break;
}
return 0;
}
/*
Get an lvalue from the environment
Params: lv - structure to fill.
Notes: missing variables (but not out of range subscripts)
are added to the variable list.
*/
void lvalue(LVALUE *lv)
{
char name[32];
int len;
VARIABLE *var;
DIMVAR *dimvar;
int index[5];
void *valptr = 0;
int type;
lv->type = ERROR;
lv->dval = 0;
lv->sval = 0;
switch(token)
{
case FLTID:
getid(string, name, &len);
match(FLTID);
var = findvariable(name);
if(!var)
var = addfloat(name);
if(!var)
{
seterror(ERR_OUTOFMEMORY);
return;
}
lv->type = FLTID;
lv->dval = &var->dval;
lv->sval = 0;
break;
case STRID:
getid(string, name, &len);
match(STRID);
var = findvariable(name);
if(!var)
var = addstring(name);
if(!var)
{
seterror(ERR_OUTOFMEMORY);
return;
}
lv->type = STRID;
lv->sval = &var->sval;
lv->dval = 0;
break;
case DIMFLTID:
case DIMSTRID:
type = (token == DIMFLTID) ? FLTID : STRID;
getid(string, name, &len);
match(token);
dimvar = finddimvar(name);
if(dimvar)
{
switch(dimvar->ndims)
{
case 1:
index[0] = integer( expr() );
if(errorflag == 0)
valptr = getdimvar(dimvar, index[0]);
break;
case 2:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
if(errorflag == 0)
valptr = getdimvar(dimvar, index[0], index[1]);
break;
case 3:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
if(errorflag == 0)
valptr = getdimvar(dimvar, index[0], index[1], index[2]);
break;
case 4:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
match(COMMA);
index[3] = integer( expr() );
if(errorflag == 0)
valptr = getdimvar(dimvar, index[0], index[1], index[2], index[3]);
break;
case 5:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
match(COMMA);
index[3] = integer( expr() );
match(COMMA);
index[4] = integer( expr() );
if(errorflag == 0)
valptr = getdimvar(dimvar, index[0], index[1], index[2], index[3]);
break;
}
match(CPAREN);
}
else
{
seterror(ERR_NOSUCHVARIABLE);
return;
}
if(valptr)
{
lv->type = type;
if(type == FLTID)
lv->dval = valptr;
else if(type == STRID)
lv->sval = valptr;
else
assert(0);
}
break;
default:
seterror(ERR_SYNTAX);
}
}
/*
parse a boolean expression
consists of expressions or strings and relational operators,
and parentheses
*/
int boolexpr(void)
{
int left;
int right;
left = boolfactor();
while(1)
{
switch(token)
{
case AND:
match(AND);
right = boolexpr();
return (left && right) ? 1 : 0;
case OR:
match(OR);
right = boolexpr();
return (left || right) ? 1 : 0;
default:
return left;
}
}
}
/*
boolean factor, consists of expression relop expression
or string relop string, or ( boolexpr() )
*/
int boolfactor(void)
{
int answer;
double left;
double right;
int op;
char *strleft;
char *strright;
int cmp;
switch(token)
{
case OPAREN:
match(OPAREN);
answer = boolexpr();
match(CPAREN);
break;
default:
if(isstring(token))
{
strleft = stringexpr();
op = relop();
strright = stringexpr();
if(!strleft || !strright)
{
if(strleft)
sys_free(strleft);
if(strright)
sys_free(strright);
return 0;
}
cmp = strcmp(strleft, strright);
switch(op)
{
case ROP_EQ:
answer = cmp == 0 ? 1 : 0;
break;
case ROP_NEQ:
answer = cmp == 0 ? 0 : 1;
break;
case ROP_LT:
answer = cmp < 0 ? 1 : 0;
break;
case ROP_LTE:
answer = cmp <= 0 ? 1 : 0;
break;
case ROP_GT:
answer = cmp > 0 ? 1 : 0;
break;
case ROP_GTE:
answer = cmp >= 0 ? 1 : 0;
break;
default:
answer = 0;
}
sys_free(strleft);
sys_free(strright);
}
else
{
left = expr();
op = relop();
right = expr();
switch(op)
{
case ROP_EQ:
answer = (left == right) ? 1 : 0;
break;
case ROP_NEQ:
answer = (left != right) ? 1 : 0;
break;
case ROP_LT:
answer = (left < right) ? 1 : 0;
break;
case ROP_LTE:
answer = (left <= right) ? 1 : 0;
break;
case ROP_GT:
answer = (left > right) ? 1 : 0;
break;
case ROP_GTE:
answer = (left >= right) ? 1 : 0;
break;
default:
errorflag = 1;
return 0;
}
}
}
return answer;
}
/*
get a relational operator
returns operator parsed or ERROR
*/
int relop(void)
{
switch(token)
{
case EQUALS:
match(EQUALS);
return ROP_EQ;
case GREATER:
match(GREATER);
if(token == EQUALS)
{
match(EQUALS);
return ROP_GTE;
}
return ROP_GT;
case LESS:
match(LESS);
if(token == EQUALS)
{
match(EQUALS);
return ROP_LTE;
}
else if(token == GREATER)
{
match(GREATER);
return ROP_NEQ;
}
return ROP_LT;
default:
seterror(ERR_SYNTAX);
return ERROR;
}
}
/*
parses an expression
*/
double expr(void)
{
double left;
double right;
left = term();
while(1)
{
switch(token)
{
case PLUS:
match(PLUS);
right = term();
left += right;
break;
case MINUS:
match(MINUS);
right = term();
left -= right;
break;
default:
return left;
}
}
}
/*
parses a term
*/
double term(void)
{
double left;
double right;
left = factor();
while(1)
{
switch(token)
{
case MULT:
match(MULT);
right = factor();
left *= right;
break;
case DIV:
match(DIV);
right = factor();
if(right != 0.0)
left /= right;
else
seterror(ERR_DIVIDEBYZERO);
break;
case MOD:
match(MOD);
right = factor();
left = fmod(left, right);
break;
default:
return left;
}
}
}
/*
parses a factor
*/
double factor(void)
{
double answer = 0;
char *str;
char *end;
int len;
uint32_t addr;
uint32_t width;
switch(token)
{
case OPAREN:
match(OPAREN);
answer = expr();
match(CPAREN);
break;
case VALUE:
answer = getvalue(string, &len);
match(VALUE);
break;
case MINUS:
match(MINUS);
answer = -factor();
break;
case FLTID:
answer = variable();
break;
case DIMFLTID:
answer = dimvariable();
break;
case BE:
answer = exp(1.0);
match(BE);
break;
case BPI:
answer = acos(0.0) * 2.0;
match(BPI);
break;
case SIN:
match(SIN);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = sin(answer);
break;
case COS:
match(COS);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = cos(answer);
break;
case TAN:
match(TAN);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = tan(answer);
break;
case LN:
match(LN);
match(OPAREN);
answer = expr();
match(CPAREN);
if(answer > 0)
answer = log(answer);
else
seterror(ERR_NEGLOG);
break;
case POW:
match(POW);
match(OPAREN);
answer = expr();
match(COMMA);
answer = pow(answer, expr());
match(CPAREN);
break;
case SQRT:
match(SQRT);
match(OPAREN);
answer = expr();
match(CPAREN);
if(answer >= 0.0)
answer = sqrt(answer);
else
seterror(ERR_NEGSQRT);
break;
case ABS:
match(ABS);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = fabs(answer);
break;
case LEN:
match(LEN);
match(OPAREN);
str = stringexpr();
match(CPAREN);
if(str)
{
answer = strlen(str);
sys_free(str);
}
else
answer = 0;
break;
case ASCII:
match(ASCII);
match(OPAREN);
str = stringexpr();
match(CPAREN);
if(str)
{
answer = *str;
sys_free(str);
}
else
answer = 0;
break;
case ASIN:
match(ASIN);
match(OPAREN);
answer = expr();
match(CPAREN);
if(answer >= -1 && answer <= 1)
answer = asin(answer);
else
seterror(ERR_BADSINCOS);
break;
case ACOS:
match(ACOS);
match(OPAREN);
answer = expr();
match(CPAREN);
if(answer >= -1 && answer <= 1)
answer = acos(answer);
else
seterror(ERR_BADSINCOS);
break;
case ATAN:
match(ATAN);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = atan(answer);
break;
case INT:
match(INT);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = floor(answer);
break;
case RND:
match(RND);
match(OPAREN);
answer = expr();
match(CPAREN);
answer = integer(answer);
if(answer > 1)
answer = floor(rand()/(RAND_MAX + 1.0) * answer);
else if(answer == 1)
answer = rand()/(RAND_MAX + 1.0);
else
{
if(answer < 0)
srand( (unsigned) -answer);
answer = 0;
}
break;
case VAL:
match(VAL);
match(OPAREN);
str = stringexpr();
match(CPAREN);
if(str)
{
answer = strtod(str, 0);
sys_free(str);
}
else
answer = 0;
break;
case VALLEN:
match(VALLEN);
match(OPAREN);
str = stringexpr();
match(CPAREN);
if(str)
{
strtod(str, &end);
answer = end - str;
sys_free(str);
}
else
answer = 0.0;
break;
case INSTR:
answer = instr();
break;
// Peek a given location and return value. Format: PEEK(width, addr)
//
case PEEK:
match(PEEK);
match(OPAREN);
width = integer( expr() );
match(COMMA);
addr = integer( expr() );
match(CPAREN);
switch(width)
{
case 8:
answer = *(uint8_t *)(addr);
break;
case 16:
answer = *(uint16_t *)(addr);
break;
case 32:
answer = *(uint32_t *)(addr);
break;
default:
seterror( ERR_BADVALUE );
break;
}
break;
default:
if(isstring(token))
seterror(ERR_TYPEMISMATCH);
else
seterror(ERR_SYNTAX);
break;
}
while(token == SHRIEK)
{
match(SHRIEK);
answer = factorial(answer);
}
return answer;
}
/*
calcualte the INSTR() function.
*/
double instr(void)
{
char *str;
char *substr;
char *end;
double answer = 0;
int offset;
match(INSTR);
match(OPAREN);
str = stringexpr();
match(COMMA);
substr = stringexpr();
match(COMMA);
offset = integer( expr() );
offset--;
match(CPAREN);
if(!str || ! substr)
{
if(str)
sys_free(str);
if(substr)
sys_free(substr);
return 0;
}
if(offset >= 0 && offset < (int) strlen(str))
{
end = strstr(str + offset, substr);
if(end)
answer = end - str + 1.0;
}
sys_free(str);
sys_free(substr);
return answer;
}
/*
get the value of a scalar variable from string
matches FLTID
*/
double variable(void)
{
VARIABLE *var;
char id[32];
int len;
getid(string, id, &len);
match(FLTID);
var = findvariable(id);
if(var)
return var->dval;
else
{
seterror(ERR_NOSUCHVARIABLE);
return 0.0;
}
}
/*
get value of a dimensioned variable from string.
matches DIMFLTID
*/
double dimvariable(void)
{
DIMVAR *dimvar;
char id[32];
int len;
int index[5];
double *answer;
answer = NULL;
getid(string, id, &len);
match(DIMFLTID);
dimvar = finddimvar(id);
if(!dimvar)
{
seterror(ERR_NOSUCHVARIABLE);
return 0.0;
}
if(dimvar)
{
switch(dimvar->ndims)
{
case 1:
index[0] = integer( expr() );
answer = getdimvar(dimvar, index[0]);
break;
case 2:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1]);
break;
case 3:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1], index[2]);
break;
case 4:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
match(COMMA);
index[3] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1], index[2], index[3]);
break;
case 5:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
match(COMMA);
index[3] = integer( expr() );
match(COMMA);
index[4] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1], index[2], index[3], index[4]);
break;
}
match(CPAREN);
}
if(answer)
return *answer;
return 0.0;
}
/*
find a scalar variable invariables list
Params: id - id to get
Returns: pointer to that entry, 0 on fail
*/
VARIABLE *findvariable(const char *id)
{
int i;
for(i=0;i<nvariables;i++)
if(!strcmp(variables[i].id, id))
return &variables[i];
return 0;
}
/*
get a dimensioned array by name
Params: id (includes opening parenthesis)
Returns: pointer to array entry or 0 on fail
*/
DIMVAR *finddimvar(const char *id)
{
int i;
for(i=0;i<ndimvariables;i++)
if(!strcmp(dimvariables[i].id, id))
return &dimvariables[i];
return 0;
}
/*
dimension an array.
Params: id - the id of the array (include leading ()
ndims - number of dimension (1-5)
... - integers giving dimension size,
*/
DIMVAR *dimension(const char *id, int ndims, ...)
{
DIMVAR *dv;
va_list vargs;
int size = 1;
int oldsize = 1;
int i;
int dimensions[5];
double *dtemp;
char **stemp;
assert(ndims <= 5);
if(ndims > 5)
return 0;
dv = finddimvar(id);
if(!dv)
dv = adddimvar(id);
if(!dv)
{
seterror(ERR_OUTOFMEMORY);
return 0;
}
if(dv->ndims)
{
for(i=0;i<dv->ndims;i++)
oldsize *= dv->dim[i];
}
else
oldsize = 0;
va_start(vargs, ndims);
for(i=0;i<ndims;i++)
{
dimensions[i] = va_arg(vargs, int);
size *= dimensions[i];
}
va_end(vargs);
switch(dv->type)
{
case FLTID:
dtemp = sys_realloc(dv->dval, size * sizeof(double));
if(dtemp)
dv->dval = dtemp;
else
{
seterror(ERR_OUTOFMEMORY);
return 0;
}
break;
case STRID:
if(dv->str)
{
for(i=size;i<oldsize;i++)
if(dv->str[i])
{
sys_free(dv->str[i]);
dv->str[i] = 0;
}
}
stemp = sys_realloc(dv->str, size * sizeof(char *));
if(stemp)
{
dv->str = stemp;
for(i=oldsize;i<size;i++)
dv->str[i] = 0;
}
else
{
for(i=0;i<oldsize;i++)
if(dv->str[i])
{
sys_free(dv->str[i]);
dv->str[i] = 0;
}
seterror(ERR_OUTOFMEMORY);
return 0;
}
break;
default:
assert(0);
}
for(i=0;i<5;i++)
dv->dim[i] = dimensions[i];
dv->ndims = ndims;
return dv;
}
/*
get the address of a dimensioned array element.
works for both string and real arrays.
Params: dv - the array's entry in variable list
... - integers telling which array element to get
Returns: the address of that element, 0 on fail
*/
void *getdimvar(DIMVAR *dv, ...)
{
va_list vargs;
int index[5];
int i;
void *answer = 0;
va_start(vargs, dv);
for(i=0;i<dv->ndims;i++)
{
index[i] = va_arg(vargs, int);
index[i]--;
}
va_end(vargs);
for(i=0;i<dv->ndims;i++)
if(index[i] >= dv->dim[i] || index[i] < 0)
{
seterror(ERR_BADSUBSCRIPT);
return 0;
}
if(dv->type == FLTID)
{
switch(dv->ndims)
{
case 1:
answer = &dv->dval[ index[0] ];
break;
case 2:
answer = &dv->dval[ index[1] * dv->dim[0]
+ index[0] ];
break;
case 3:
answer = &dv->dval[ index[2] * (dv->dim[0] * dv->dim[1])
+ index[1] * dv->dim[0]
+ index[0] ];
break;
case 4:
answer = &dv->dval[ index[3] * (dv->dim[0] + dv->dim[1] + dv->dim[2])
+ index[2] * (dv->dim[0] * dv->dim[1])
+ index[1] * dv->dim[0]
+ index[0] ];
case 5:
answer = &dv->dval[ index[4] * (dv->dim[0] + dv->dim[1] + dv->dim[2] + dv->dim[3])
+ index[3] * (dv->dim[0] + dv->dim[1] + dv->dim[2])
+ index[2] * (dv->dim[0] + dv->dim[1])
+ index[1] * dv->dim[0]
+ index[0] ];
break;
}
}
else if(dv->type == STRID)
{
switch(dv->ndims)
{
case 1:
answer = &dv->str[ index[0] ];
break;
case 2:
answer = &dv->str[ index[1] * dv->dim[0]
+ index[0] ];
break;
case 3:
answer = &dv->str[ index[2] * (dv->dim[0] * dv->dim[1])
+ index[1] * dv->dim[0]
+ index[0] ];
break;
case 4:
answer = &dv->str[ index[3] * (dv->dim[0] + dv->dim[1] + dv->dim[2])
+ index[2] * (dv->dim[0] * dv->dim[1])
+ index[1] * dv->dim[0]
+ index[0] ];
case 5:
answer = &dv->str[ index[4] * (dv->dim[0] + dv->dim[1] + dv->dim[2] + dv->dim[3])
+ index[3] * (dv->dim[0] + dv->dim[1] + dv->dim[2])
+ index[2] * (dv->dim[0] + dv->dim[1])
+ index[1] * dv->dim[0]
+ index[0] ];
break;
}
}
return answer;
}
/*
add a real varaible to our variable list
Params: id - id of varaible to add.
Returns: pointer to new entry in table
*/
VARIABLE *addfloat(const char *id)
{
VARIABLE *vars;
vars = sys_realloc(variables, (nvariables + 1) * sizeof(VARIABLE));
if(vars)
{
variables = vars;
strcpy(variables[nvariables].id, id);
variables[nvariables].dval = 0;
variables[nvariables].sval = 0;
nvariables++;
return &variables[nvariables-1];
}
else
seterror(ERR_OUTOFMEMORY);
return 0;
}
/*
add a string variable to table.
Params: id - id of variable to get (including trailing $)
Retruns: pointer to new entry in table, 0 on fail.
*/
VARIABLE *addstring(const char *id)
{
VARIABLE *vars;
vars = sys_realloc(variables, (nvariables + 1) * sizeof(VARIABLE));
if(vars)
{
variables = vars;
strcpy(variables[nvariables].id, id);
variables[nvariables].sval = 0;
variables[nvariables].dval = 0;
nvariables++;
return &variables[nvariables-1];
}
else
seterror(ERR_OUTOFMEMORY);
return 0;
}
/*
add a new array to our symbol table.
Params: id - id of array (include leading ()
Returns: pointer to new entry, 0 on fail.
*/
DIMVAR *adddimvar(const char *id)
{
DIMVAR *vars;
vars = sys_realloc(dimvariables, (ndimvariables + 1) * sizeof(DIMVAR));
if(vars)
{
dimvariables = vars;
strcpy(dimvariables[ndimvariables].id, id);
dimvariables[ndimvariables].dval = 0;
dimvariables[ndimvariables].str = 0;
dimvariables[ndimvariables].ndims = 0;
dimvariables[ndimvariables].type = strchr(id, '$') ? STRID : FLTID;
ndimvariables++;
return &dimvariables[ndimvariables-1];
}
else
seterror(ERR_OUTOFMEMORY);
return 0;
}
/*
high level string parsing function.
Returns: a malloced pointer, or 0 on error condition.
caller must free!
*/
char *stringexpr(void)
{
char *left;
char *right;
char *temp;
switch(token)
{
case DIMSTRID:
left = mystrdup(stringdimvar());
break;
case STRID:
left = mystrdup(stringvar());
break;
case QUOTE:
left = stringliteral();
break;
case CHRSTRING:
left = chrstring();
break;
case STRSTRING:
left = strstring();
break;
case LEFTSTRING:
left = leftstring();
break;
case RIGHTSTRING:
left = rightstring();
break;
case MIDSTRING:
left = midstring();
break;
case STRINGSTRING:
left = stringstring();
break;
default:
if(!isstring(token))
seterror(ERR_TYPEMISMATCH);
else
seterror(ERR_SYNTAX);
return mystrdup("");
}
if(!left)
{
seterror(ERR_OUTOFMEMORY);
return 0;
}
switch(token)
{
case PLUS:
match(PLUS);
right = stringexpr();
if(right)
{
temp = mystrconcat(left, right);
sys_free(right);
if(temp)
{
sys_free(left);
left = temp;
}
else
seterror(ERR_OUTOFMEMORY);
}
else
seterror(ERR_OUTOFMEMORY);
break;
default:
return left;
}
return left;
}
/*
parse the CHR$ token
*/
char *chrstring(void)
{
double x;
char buff[6];
char *answer;
match(CHRSTRING);
match(OPAREN);
x = integer( expr() );
match(CPAREN);
buff[0] = (char) x;
buff[1] = 0;
answer = mystrdup(buff);
if(!answer)
seterror(ERR_OUTOFMEMORY);
return answer;
}
/*
parse the STR$ token
*/
char *strstring(void)
{
double x;
char buff[64];
char *answer;
match(STRSTRING);
match(OPAREN);
x = expr();
match(CPAREN);
sprintf(buff, "%g", x);
answer = mystrdup(buff);
if(!answer)
seterror(ERR_OUTOFMEMORY);
return answer;
}
/*
parse the LEFT$ token
*/
char *leftstring(void)
{
char *str;
int x;
char *answer;
match(LEFTSTRING);
match(OPAREN);
str = stringexpr();
if(!str)
return 0;
match(COMMA);
x = integer( expr() );
match(CPAREN);
if(x > (int) strlen(str))
return str;
if(x < 0)
{
seterror(ERR_ILLEGALOFFSET);
return str;
}
str[x] = 0;
answer = mystrdup(str);
sys_free(str);
if(!answer)
seterror(ERR_OUTOFMEMORY);
return answer;
}
/*
parse the RIGHT$ token
*/
char *rightstring(void)
{
int x;
char *str;
char *answer;
match(RIGHTSTRING);
match(OPAREN);
str = stringexpr();
if(!str)
return 0;
match(COMMA);
x = integer( expr() );
match(CPAREN);
if( x > (int) strlen(str))
return str;
if(x < 0)
{
seterror(ERR_ILLEGALOFFSET);
return str;
}
answer = mystrdup( &str[strlen(str) - x] );
sys_free(str);
if(!answer)
seterror(ERR_OUTOFMEMORY);
return answer;
}
/*
parse the MID$ token
*/
char *midstring(void)
{
char *str;
int x;
int len;
char *answer;
char *temp;
match(MIDSTRING);
match(OPAREN);
str = stringexpr();
match(COMMA);
x = integer( expr() );
match(COMMA);
len = integer( expr() );
match(CPAREN);
if(!str)
return 0;
if(len == -1)
len = strlen(str) - x + 1;
if( x > (int) strlen(str) || len < 1)
{
sys_free(str);
answer = mystrdup("");
if(!answer)
seterror(ERR_OUTOFMEMORY);
return answer;
}
if(x < 1.0)
{
seterror(ERR_ILLEGALOFFSET);
return str;
}
temp = &str[x-1];
answer = sys_malloc(len + 1);
if(!answer)
{
seterror(ERR_OUTOFMEMORY);
return str;
}
strncpy(answer, temp, len);
answer[len] = 0;
sys_free(str);
return answer;
}
/*
parse the string$ token
*/
char *stringstring(void)
{
int x;
char *str;
char *answer;
int len;
int N;
int i;
match(STRINGSTRING);
match(OPAREN);
x = integer( expr() );
match(COMMA);
str = stringexpr();
match(CPAREN);
if(!str)
return 0;
N = x;
if(N < 1)
{
sys_free(str);
answer = mystrdup("");
if(!answer)
seterror(ERR_OUTOFMEMORY);
return answer;
}
len = strlen(str);
answer = sys_malloc( N * len + 1 );
if(!answer)
{
sys_free(str);
seterror(ERR_OUTOFMEMORY);
return 0;
}
for(i=0; i < N; i++)
{
strcpy(answer + len * i, str);
}
sys_free(str);
return answer;
}
/*
read a dimensioned string variable from input.
Returns: pointer to string (not malloced)
*/
char *stringdimvar(void)
{
char id[32];
int len;
DIMVAR *dimvar;
char **answer;
int index[5];
answer = NULL;
getid(string, id, &len);
match(DIMSTRID);
dimvar = finddimvar(id);
if(dimvar)
{
switch(dimvar->ndims)
{
case 1:
index[0] = integer( expr() );
answer = getdimvar(dimvar, index[0]);
break;
case 2:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1]);
break;
case 3:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1], index[2]);
break;
case 4:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
match(COMMA);
index[3] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1], index[2], index[3]);
break;
case 5:
index[0] = integer( expr() );
match(COMMA);
index[1] = integer( expr() );
match(COMMA);
index[2] = integer( expr() );
match(COMMA);
index[3] = integer( expr() );
match(COMMA);
index[4] = integer( expr() );
answer = getdimvar(dimvar, index[0], index[1], index[2], index[3], index[4]);
break;
}
match(CPAREN);
}
else
seterror(ERR_NOSUCHVARIABLE);
if(!errorflag)
if(*answer)
return *answer;
return "";
}
/*
parse a string variable.
Returns: pointer to string (not malloced)
*/
char *stringvar(void)
{
char id[32];
int len;
VARIABLE *var;
getid(string, id, &len);
match(STRID);
var = findvariable(id);
if(var)
{
if(var->sval)
return var->sval;
return "";
}
seterror(ERR_NOSUCHVARIABLE);
return "";
}
/*
parse a string literal
Returns: malloced string literal
Notes: newlines aren't allwed in literals, but blind
concatenation across newlines is.
*/
char *stringliteral(void)
{
int len = 1;
char *answer = 0;
char *temp;
char *substr;
char *end;
while(token == QUOTE)
{
while(isspace(*string))
string++;
end = mystrend(string, '"');
if(end)
{
len = end - string;
substr = sys_malloc(len);
if(!substr)
{
seterror(ERR_OUTOFMEMORY);
return answer;
}
mystrgrablit(substr, string);
if(answer)
{
temp = mystrconcat(answer, substr);
sys_free(substr);
sys_free(answer);
answer = temp;
if(!answer)
{
seterror(ERR_OUTOFMEMORY);
return answer;
}
}
else
answer = substr;
string = end;
}
else
{
seterror(ERR_SYNTAX);
return answer;
}
match(QUOTE);
}
return answer;
}
/*
cast a double to an integer, triggering errors if out of range
*/
int integer(double x)
{
#if defined(__ZPU__)
#define INT_MIN -2147483648L
#define INT_MAX 2147483647L
#endif
if( x < INT_MIN || x > INT_MAX )
seterror( ERR_BADVALUE );
if( x != floor(x) )
seterror( ERR_NOTINT );
return (int) x;
}
/*
check that we have a token of the passed type
(if not set the errorflag)
Move parser on to next token. Sets token and string.
*/
void match(int tok)
{
if(token != tok)
{
seterror(ERR_SYNTAX);
return;
}
while(isspace(*string))
string++;
string += tokenlen(string, token);
token = gettoken(string);
if(token == ERROR)
seterror(ERR_SYNTAX);
}
/*
set the errorflag.
Params: errorcode - the error.
Notes: ignores error cascades
*/
void seterror(int errorcode)
{
if(errorflag == 0 || errorcode == 0)
errorflag = errorcode;
}
/*
get the next line number
Params: curline - line being processed.
Returns: line no of next line, 0 if end
Notes: goes to next line then finds
first line starting with a digit.
*/
int getnextline(int curline)
{
int idx;
const char *str;
for(idx=curline+1; idx < nlines; idx++)
{
str = lines[idx].str;
while(*str && *str == ' ') str++;
if(*str == 0)
return 0;
if(isdigit(*str))
return atoi(str);
}
return 0;
}
/*
get a token from the string
Params: str - string to read token from
Notes: ignores white space between tokens
*/
int gettoken(const char *str)
{
while(isspace(*str))
str++;
if(isdigit(*str))
return VALUE;
switch(*str)
{
case 0:
return EOS;
case '\n':
return EOL;
case '/':
return DIV;
case '*':
return MULT;
case '(':
return OPAREN;
case ')':
return CPAREN;
case '+':
return PLUS;
case '-':
return MINUS;
case '!':
return SHRIEK;
case ',':
return COMMA;
case ';':
return SEMICOLON;
case '"':
return QUOTE;
case '=':
return EQUALS;
case '<':
return LESS;
case '>':
return GREATER;
default:
if(!strncmp(str, "e", 1) && !isalnum(str[1]))
return BE;
if(isupper(*str))
{
if(!strncmp(str, "SIN", 3) && !isalnum(str[3]))
return SIN;
if(!strncmp(str, "COS", 3) && !isalnum(str[3]))
return COS;
if(!strncmp(str, "TAN", 3) && !isalnum(str[3]))
return TAN;
if(!strncmp(str, "LN", 2) && !isalnum(str[2]))
return LN;
if(!strncmp(str, "POW", 3) && !isalnum(str[3]))
return POW;
if(!strncmp(str, "PI", 2) && !isalnum(str[2]))
return BPI;
if(!strncmp(str, "SQRT", 4) && !isalnum(str[4]))
return SQRT;
if(!strncmp(str, "PRINT", 5) && !isalnum(str[5]))
return PRINT;
if(!strncmp(str, "LET", 3) && !isalnum(str[3]))
return LET;
if(!strncmp(str, "DIM", 3) && !isalnum(str[3]))
return DIM;
if(!strncmp(str, "IF", 2) && !isalnum(str[2]))
return IF;
if(!strncmp(str, "THEN", 4) && !isalnum(str[4]))
return THEN;
if(!strncmp(str, "AND", 3) && !isalnum(str[3]))
return AND;
if(!strncmp(str, "OR", 2) && !isalnum(str[2]))
return OR;
if(!strncmp(str, "GOTO", 4) && !isalnum(str[4]))
return GOTO;
if(!strncmp(str, "INPUT", 5) && !isalnum(str[5]))
return BINPUT;
if(!strncmp(str, "REM", 3) && !isalnum(str[3]))
return REM;
if(!strncmp(str, "FOR", 3) && !isalnum(str[3]))
return FOR;
if(!strncmp(str, "TO", 2) && !isalnum(str[2]))
return TO;
if(!strncmp(str, "NEXT", 4) && !isalnum(str[4]))
return NEXT;
if(!strncmp(str, "STEP", 4) && !isalnum(str[4]))
return STEP;
if(!strncmp(str, "POKE", 4) && !isalnum(str[4]))
return POKE;
if(!strncmp(str, "MOD", 3) && !isalnum(str[3]))
return MOD;
if(!strncmp(str, "ABS", 3) && !isalnum(str[3]))
return ABS;
if(!strncmp(str, "LEN", 3) && !isalnum(str[3]))
return LEN;
if(!strncmp(str, "ASCII", 5) && !isalnum(str[5]))
return ASCII;
if(!strncmp(str, "ASIN", 4) && !isalnum(str[4]))
return ASIN;
if(!strncmp(str, "ACOS", 4) && !isalnum(str[4]))
return ACOS;
if(!strncmp(str, "ATAN", 4) && !isalnum(str[4]))
return ATAN;
if(!strncmp(str, "INT", 3) && !isalnum(str[3]))
return INT;
if(!strncmp(str, "RND", 3) && !isalnum(str[3]))
return RND;
if(!strncmp(str, "VAL", 3) && !isalnum(str[3]))
return VAL;
if(!strncmp(str, "VALLEN", 6) && !isalnum(str[6]))
return VALLEN;
if(!strncmp(str, "INSTR", 5) && !isalnum(str[5]))
return INSTR;
if(!strncmp(str, "PEEK", 4) && !isalnum(str[4]))
return PEEK;
if(!strncmp(str, "CHR$", 4))
return CHRSTRING;
if(!strncmp(str, "STR$", 4))
return STRSTRING;
if(!strncmp(str, "LEFT$", 5))
return LEFTSTRING;
if(!strncmp(str, "RIGHT$", 6))
return RIGHTSTRING;
if(!strncmp(str, "MID$", 4))
return MIDSTRING;
if(!strncmp(str, "STRING$", 7))
return STRINGSTRING;
}
/* end isupper() */
if(isalpha(*str))
{
while(isalnum(*str))
str++;
switch(*str)
{
case '$':
return str[1] == '(' ? DIMSTRID : STRID;
case '(':
return DIMFLTID;
default:
return FLTID;
}
}
return ERROR;
}
}
/*
get the length of a token.
Params: str - pointer to the string containing the token
token - the type of the token read
Returns: length of the token, or 0 for EOL to prevent
it being read past.
*/
int tokenlen(const char *str, int token)
{
int len = 0;
char buff[32];
switch(token)
{
case EOS:
return 0;
case EOL:
return 1;
case VALUE:
getvalue(str, &len);
return len;
case DIMSTRID:
case DIMFLTID:
case STRID:
getid(str, buff, &len);
return len;
case FLTID:
getid(str, buff, &len);
return len;
case BPI:
return 2;
case BE:
return 1;
case SIN:
return 3;
case COS:
return 3;
case TAN:
return 3;
case LN:
return 2;
case POW:
return 3;
case SQRT:
return 4;
case DIV:
return 1;
case MULT:
return 1;
case OPAREN:
return 1;
case CPAREN:
return 1;
case PLUS:
return 1;
case MINUS:
return 1;
case SHRIEK:
return 1;
case COMMA:
return 1;
case QUOTE:
return 1;
case EQUALS:
return 1;
case LESS:
return 1;
case GREATER:
return 1;
case SEMICOLON:
return 1;
case ERROR:
return 0;
case PRINT:
return 5;
case LET:
return 3;
case DIM:
return 3;
case IF:
return 2;
case THEN:
return 4;
case AND:
return 3;
case OR:
return 2;
case GOTO:
return 4;
case BINPUT:
return 5;
case REM:
return 3;
case FOR:
return 3;
case TO:
return 2;
case NEXT:
return 4;
case STEP:
return 4;
case POKE:
return 4;
case MOD:
return 3;
case ABS:
return 3;
case LEN:
return 3;
case ASCII:
return 5;
case ASIN:
return 4;
case ACOS:
return 4;
case ATAN:
return 4;
case INT:
return 3;
case RND:
return 3;
case VAL:
return 3;
case VALLEN:
return 6;
case INSTR:
return 5;
case PEEK:
return 4;
case CHRSTRING:
return 4;
case STRSTRING:
return 4;
case LEFTSTRING:
return 5;
case RIGHTSTRING:
return 6;
case MIDSTRING:
return 4;
case STRINGSTRING:
return 7;
default:
assert(0);
return 0;
}
}
/*
test if a token represents a string expression
Params: token - token to test
Returns: 1 if a string, else 0
*/
int isstring(int token)
{
if(token == STRID || token == QUOTE || token == DIMSTRID
|| token == CHRSTRING || token == STRSTRING
|| token == LEFTSTRING || token == RIGHTSTRING
|| token == MIDSTRING || token == STRINGSTRING)
return 1;
return 0;
}
/*
get a numerical value from the parse string
Params: str - the string to search
len - return pinter for no chars read
Retuns: the value of the string.
*/
double getvalue(const char *str, int *len)
{
double answer;
char *end;
answer = strtod(str, &end);
assert(end != str);
*len = end - str;
return answer;
}
/*
getid - get an id from the parse string:
Params: str - string to search
out - id output [32 chars max ]
len - return pointer for id length
Notes: triggers an error if id > 31 chars
the id includes the $ and ( qualifiers.
*/
void getid(const char *str, char *out, int *len)
{
int nread = 0;
while(isspace(*str))
str++;
assert(isalpha(*str));
while(isalnum(*str))
{
if(nread < 31)
out[nread++] = *str++;
else
{
seterror(ERR_IDTOOLONG);
break;
}
}
if(*str == '$')
{
if(nread < 31)
out[nread++] = *str++;
else
seterror(ERR_IDTOOLONG);
}
if(*str == '(')
{
if(nread < 31)
out[nread++] = *str++;
else
seterror(ERR_IDTOOLONG);
}
out[nread] = 0;
*len = nread;
}
/*
grab a literal from the parse string.
Params: dest - destination string
src - source string
Notes: strings are in quotes, double quotes the escape
*/
void mystrgrablit(char *dest, const char *src)
{
assert(*src == '"');
src++;
while(*src)
{
if(*src == '"')
{
if(src[1] == '"')
{
*dest++ = *src;
src++;
src++;
}
else
break;
}
else
*dest++ = *src++;
}
*dest++ = 0;
}
/*
find where a source string literal ends
Params: src - string to check (must point to quote)
quote - character to use for quotation
Returns: pointer to quote which ends string
Notes: quotes escape quotes
*/
char *mystrend(const char *str, char quote)
{
assert(*str == quote);
str++;
while(*str)
{
while(*str != quote)
{
if(*str == '\n' || *str == 0)
return 0;
str++;
}
if(str[1] == quote)
str += 2;
else
break;
}
return (char *) (*str? str : 0);
}
/*
Count the instances of ch in str
Params: str - string to check
ch - character to count
Returns: no time chs occurs in str.
*/
int mystrcount(const char *str, char ch)
{
int answer = 0;
while(*str)
{
if(*str++ == ch)
answer++;
}
return answer;
}
/*
duplicate a string:
Params: str - string to duplicate
Returns: malloced duplicate.
*/
char *mystrdup(const char *str)
{
char *answer;
answer = sys_malloc(strlen(str) + 1);
if(answer)
strcpy(answer, str);
return answer;
}
/*
concatenate two strings
Params: str - firsts string
cat - second string
Returns: malloced string.
*/
char *mystrconcat(const char *str, const char *cat)
{
int len;
char *answer;
len = strlen(str) + strlen(cat);
answer = sys_malloc(len + 1);
if(answer)
{
strcpy(answer, str);
strcat(answer, cat);
}
return answer;
}
/*
compute x!
*/
double factorial(double x)
{
double answer = 1.0;
double t;
if( x > 1000.0)
x = 1000.0;
for(t=1;t<=x;t+=1.0)
answer *= t;
return answer;
}