1737 lines
45 KiB
C
1737 lines
45 KiB
C
/* #includes */ /*{{{C}}}*//*{{{*/
|
|
#include "config.h"
|
|
|
|
#include <sys/stat.h>
|
|
#include <sys/types.h>
|
|
#include <sys/wait.h>
|
|
#include <assert.h>
|
|
#include <ctype.h>
|
|
#include <errno.h>
|
|
#include <fcntl.h>
|
|
#ifdef HAVE_GETTEXT
|
|
#include <libintl.h>
|
|
#define _(String) gettext(String)
|
|
#else
|
|
#define _(String) String
|
|
#endif
|
|
#include <limits.h>
|
|
#include <math.h>
|
|
#include <string.h>
|
|
#include <stdlib.h>
|
|
#include <stdio.h>
|
|
#include <time.h>
|
|
#include <unistd.h>
|
|
|
|
#include "getopt.h"
|
|
|
|
#include "auto.h"
|
|
#include "bas.h"
|
|
#include "error.h"
|
|
#include "fs.h"
|
|
#include "global.h"
|
|
#include "program.h"
|
|
#include "value.h"
|
|
#include "var.h"
|
|
|
|
#ifdef USE_DMALLOC
|
|
#include "dmalloc.h"
|
|
#endif
|
|
/*}}}*/
|
|
/* #defines */ /*{{{*/
|
|
#define DIRECTMODE (pc.line==-1)
|
|
#ifndef __GNUC__
|
|
#define inline
|
|
#endif
|
|
/*}}}*/
|
|
|
|
/* types */ /*{{{*/
|
|
enum LabelType
|
|
{
|
|
L_IF=1,
|
|
L_ELSE,
|
|
L_DO,
|
|
L_DOcondition,
|
|
L_FOR,
|
|
L_FOR_VAR,
|
|
L_FOR_LIMIT,
|
|
L_FOR_BODY,
|
|
L_REPEAT,
|
|
L_SELECTCASE,
|
|
L_WHILE,
|
|
L_FUNC
|
|
};
|
|
|
|
struct LabelStack
|
|
{
|
|
enum LabelType type;
|
|
struct Pc patch;
|
|
};
|
|
/*}}}*/
|
|
/* variables */ /*{{{*/
|
|
static unsigned int labelStackPointer,labelStackCapacity;
|
|
static struct LabelStack *labelStack;
|
|
static struct Pc *lastdata;
|
|
static struct Pc curdata;
|
|
static struct Pc nextdata;
|
|
static enum { DECLARE, COMPILE, INTERPRET } pass;
|
|
static int stopped;
|
|
static int optionbase;
|
|
static struct Pc pc;
|
|
static struct Auto stack;
|
|
static struct Program program;
|
|
static struct Global globals;
|
|
static int run_restricted;
|
|
|
|
int bas_argc;
|
|
char *bas_argv0;
|
|
char **bas_argv;
|
|
int bas_end;
|
|
/*}}}*/
|
|
/* forward prototypes */ /*{{{*/
|
|
static struct Value *statements(struct Value *value);
|
|
static struct Value *compileProgram(struct Value *v, int clearGlobals);
|
|
static struct Value *eval(struct Value *value, const char *desc);
|
|
/*}}}*/
|
|
|
|
static char *mytmpnam(void) /*{{{*/
|
|
{
|
|
static char buf[_POSIX_PATH_MAX];
|
|
const char *tmpdir;
|
|
unsigned int i;
|
|
int fd=-1;
|
|
|
|
if ((tmpdir=getenv("TMPDIR"))==(char*)0) tmpdir="/tmp";
|
|
if ((strlen(tmpdir)+1+8+1)>=_POSIX_PATH_MAX) return (char*)0;
|
|
i=getpid();
|
|
while (i<0xffffffff && (snprintf(buf,sizeof(buf),"%s/%08x",tmpdir,i),(fd=open(buf,O_RDWR|O_CREAT|O_EXCL,0600)))==-1 && errno==EEXIST) ++i;
|
|
if (fd==-1) return (char*)0;
|
|
close(fd);
|
|
return buf;
|
|
}
|
|
/*}}}*/
|
|
static int cat(const char *filename) /*{{{*/
|
|
{
|
|
int fd;
|
|
char buf[4096];
|
|
ssize_t l;
|
|
int err;
|
|
|
|
if ((fd=open(filename,O_RDONLY))==-1) return -1;
|
|
while ((l=read(fd,buf,sizeof(buf)))>0)
|
|
{
|
|
ssize_t off,w;
|
|
|
|
off=0;
|
|
while (off<l)
|
|
{
|
|
if ((w=write(1,buf+off,l-off))==-1)
|
|
{
|
|
err=errno;
|
|
close(fd);
|
|
errno=err;
|
|
return -1;
|
|
}
|
|
off+=w;
|
|
}
|
|
}
|
|
if (l==-1)
|
|
{
|
|
err=errno;
|
|
close(fd);
|
|
errno=err;
|
|
return -1;
|
|
}
|
|
close(fd);
|
|
return 0;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *lvalue(struct Value *value) /*{{{*/
|
|
{
|
|
struct Symbol *sym;
|
|
struct Pc lvpc=pc;
|
|
|
|
sym=pc.token->u.identifier->sym;
|
|
assert(pass==DECLARE || sym->type==GLOBALVAR || sym->type==GLOBALARRAY || sym->type==LOCALVAR);
|
|
if ((pc.token+1)->type==T_OP)
|
|
{
|
|
struct Pc idxpc;
|
|
unsigned int dim,capacity;
|
|
int *idx;
|
|
|
|
pc.token+=2;
|
|
dim=0;
|
|
capacity=0;
|
|
idx=(int*)0;
|
|
while (1)
|
|
{
|
|
if (dim==capacity && pass==INTERPRET) /* enlarge idx */ /*{{{*/
|
|
{
|
|
int *more;
|
|
|
|
more=realloc(idx,sizeof(unsigned int)*(capacity?(capacity*=2):(capacity=3)));
|
|
if (!more)
|
|
{
|
|
if (capacity) free(idx);
|
|
return Value_new_ERROR(value,OUTOFMEMORY);
|
|
}
|
|
idx=more;
|
|
}
|
|
/*}}}*/
|
|
idxpc=pc;
|
|
if (eval(value,_("index"))->type==V_ERROR || VALUE_RETYPE(value,V_INTEGER)->type==V_ERROR)
|
|
{
|
|
if (capacity) free(idx);
|
|
pc=idxpc;
|
|
return value;
|
|
}
|
|
if (pass==INTERPRET)
|
|
{
|
|
idx[dim]=value->u.integer;
|
|
++dim;
|
|
}
|
|
Value_destroy(value);
|
|
if (pc.token->type==T_COMMA) ++pc.token;
|
|
else break;
|
|
}
|
|
if (pc.token->type!=T_CP)
|
|
{
|
|
assert(pass!=INTERPRET);
|
|
return Value_new_ERROR(value,MISSINGCP);
|
|
}
|
|
else ++pc.token;
|
|
switch (pass)
|
|
{
|
|
case INTERPRET:
|
|
{
|
|
if ((value=Var_value(&(sym->u.var),dim,idx,value))->type==V_ERROR) pc=lvpc;
|
|
free(idx);
|
|
return value;
|
|
}
|
|
case DECLARE:
|
|
{
|
|
return Value_nullValue(V_INTEGER);
|
|
}
|
|
case COMPILE:
|
|
{
|
|
return Value_nullValue(sym->type==GLOBALARRAY ? sym->u.var.type : Auto_varType(&stack,sym));
|
|
}
|
|
default: assert(0);
|
|
}
|
|
return (struct Value*)0;
|
|
}
|
|
else
|
|
{
|
|
++pc.token;
|
|
switch (pass)
|
|
{
|
|
case INTERPRET: return VAR_SCALAR_VALUE(sym->type==GLOBALVAR ? &(sym->u.var) : Auto_local(&stack,sym->u.local.offset));
|
|
case DECLARE: return Value_nullValue(V_INTEGER);
|
|
case COMPILE: return Value_nullValue(sym->type==GLOBALVAR? sym->u.var.type : Auto_varType(&stack,sym));
|
|
default: assert(0);
|
|
}
|
|
return (struct Value*)0;
|
|
}
|
|
}
|
|
/*}}}*/
|
|
static struct Value *func(struct Value *value) /*{{{*/
|
|
{
|
|
struct Identifier *ident;
|
|
struct Pc funcpc=pc;
|
|
int firstslot=-99;
|
|
int args=0;
|
|
struct Symbol *sym;
|
|
|
|
assert(pc.token->type==T_IDENTIFIER);
|
|
/*
|
|
Evaluating a function in direct mode may start a program, so it needs to
|
|
be compiled. If in direct mode, programs will be compiled after the
|
|
direct mode pass DECLARE, but errors are ignored at that point, because
|
|
the program may not be needed. If the program is fine, its symbols will
|
|
be available during the compile phase already. If not and we need it
|
|
at this point, compile it again to get the error and abort.
|
|
*/
|
|
if (DIRECTMODE && !program.runnable && pass!=DECLARE)
|
|
{
|
|
if (compileProgram(value,0)->type==V_ERROR) return value;
|
|
Value_destroy(value);
|
|
}
|
|
ident=pc.token->u.identifier;
|
|
assert(pass==DECLARE || ident->sym->type==BUILTINFUNCTION || ident->sym->type==USERFUNCTION);
|
|
++pc.token;
|
|
if (pass!=DECLARE)
|
|
{
|
|
firstslot=stack.stackPointer;
|
|
if (ident->sym->type==USERFUNCTION && ident->sym->u.sub.retType!=V_VOID)
|
|
{
|
|
struct Var *v=Auto_pushArg(&stack);
|
|
Var_new(v,ident->sym->u.sub.retType,0,(const unsigned int*)0,0);
|
|
}
|
|
}
|
|
if (pc.token->type==T_OP) /* push arguments to stack */ /*{{{*/
|
|
{
|
|
++pc.token;
|
|
if (pc.token->type!=T_CP) while (1)
|
|
{
|
|
if (pass==DECLARE)
|
|
{
|
|
if (eval(value,_("actual parameter"))->type==V_ERROR) return value;
|
|
Value_destroy(value);
|
|
}
|
|
else
|
|
{
|
|
struct Var *v=Auto_pushArg(&stack);
|
|
|
|
Var_new_scalar(v);
|
|
if (eval(v->value,(const char*)0)->type==V_ERROR)
|
|
{
|
|
Value_clone(value,v->value);
|
|
while (stack.stackPointer>firstslot) Var_destroy(&stack.slot[--stack.stackPointer].var);
|
|
return value;
|
|
}
|
|
v->type=v->value->type;
|
|
}
|
|
++args;
|
|
if (pc.token->type==T_COMMA) ++pc.token;
|
|
else break;
|
|
}
|
|
if (pc.token->type!=T_CP)
|
|
{
|
|
if (pass!=DECLARE)
|
|
{
|
|
while (stack.stackPointer>firstslot) Var_destroy(&stack.slot[--stack.stackPointer].var);
|
|
}
|
|
return Value_new_ERROR(value,MISSINGCP);
|
|
}
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
if (pass==DECLARE) Value_new_null(value,ident->defaultType);
|
|
else
|
|
{
|
|
int i;
|
|
int nomore;
|
|
int argerr;
|
|
int overloaded;
|
|
|
|
if (pass==INTERPRET && ident->sym->type==USERFUNCTION)
|
|
{
|
|
for (i=0; i<ident->sym->u.sub.u.def.localLength; ++i)
|
|
{
|
|
struct Var *v=Auto_pushArg(&stack);
|
|
Var_new(v,ident->sym->u.sub.u.def.localTypes[i],0,(const unsigned int*)0,0);
|
|
}
|
|
}
|
|
Auto_pushFuncRet(&stack,firstslot,&pc);
|
|
|
|
sym=ident->sym;
|
|
overloaded=(pass==COMPILE && sym->type==BUILTINFUNCTION && sym->u.sub.u.bltin.next);
|
|
do
|
|
{
|
|
nomore=(pass==COMPILE && !(sym->type==BUILTINFUNCTION && sym->u.sub.u.bltin.next));
|
|
argerr=0;
|
|
if (args<sym->u.sub.argLength) /*{{{*/
|
|
{
|
|
if (nomore) Value_new_ERROR(value,TOOFEW);
|
|
argerr=1;
|
|
}
|
|
/*}}}*/
|
|
else if (args>sym->u.sub.argLength) /*{{{*/
|
|
{
|
|
if (nomore) Value_new_ERROR(value,TOOMANY);
|
|
argerr=1;
|
|
}
|
|
/*}}}*/
|
|
else /*{{{*/
|
|
{
|
|
for (i=0; i<args; ++i)
|
|
{
|
|
struct Value *arg=Var_value(Auto_local(&stack,i),0,(int*)0,value);
|
|
|
|
assert(arg->type!=V_ERROR);
|
|
if (overloaded)
|
|
{
|
|
if (arg->type!=sym->u.sub.argTypes[i])
|
|
{
|
|
if (nomore) Value_new_ERROR(value,TYPEMISMATCH2,i+1);
|
|
argerr=1;
|
|
break;
|
|
}
|
|
}
|
|
else if (Value_retype(arg,sym->u.sub.argTypes[i])->type==V_ERROR)
|
|
{
|
|
if (nomore) Value_new_ERROR(value,TYPEMISMATCH3,arg->u.error.msg,i+1);
|
|
argerr=1;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
/*}}}*/
|
|
if (argerr)
|
|
{
|
|
if (nomore)
|
|
{
|
|
Auto_funcReturn(&stack,(struct Pc*)0);
|
|
pc=funcpc;
|
|
return value;
|
|
}
|
|
else sym=sym->u.sub.u.bltin.next;
|
|
}
|
|
} while (argerr);
|
|
ident->sym=sym;
|
|
if (sym->type==BUILTINFUNCTION)
|
|
{
|
|
if (pass==INTERPRET)
|
|
{
|
|
if (sym->u.sub.u.bltin.call(value,&stack)->type==V_ERROR) pc=funcpc;
|
|
}
|
|
else Value_new_null(value,sym->u.sub.retType);
|
|
}
|
|
else if (sym->type==USERFUNCTION)
|
|
{
|
|
if (pass==INTERPRET)
|
|
{
|
|
int r=1;
|
|
|
|
pc=sym->u.sub.u.def.scope.start;
|
|
if (pc.token->type==T_COLON) ++pc.token;
|
|
else Program_skipEOL(&program,&pc,STDCHANNEL,1);
|
|
do
|
|
{
|
|
if (statements(value)->type==V_ERROR)
|
|
{
|
|
if (strchr(value->u.error.msg,'\n')==(char*)0)
|
|
{
|
|
Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,value);
|
|
Program_PCtoError(&program,&pc,value);
|
|
}
|
|
if (stack.onerror.line!=-1)
|
|
{
|
|
stack.resumeable=1;
|
|
pc=stack.onerror;
|
|
}
|
|
else
|
|
{
|
|
Auto_frameToError(&stack,&program,value);
|
|
break;
|
|
}
|
|
}
|
|
else if (value->type!=V_NIL) break;
|
|
Value_destroy(value);
|
|
} while ((r=Program_skipEOL(&program,&pc,STDCHANNEL,1)));
|
|
if (!r) Value_new_VOID(value);
|
|
}
|
|
else Value_new_null(value,sym->u.sub.retType);
|
|
}
|
|
Auto_funcReturn(&stack,pass==INTERPRET && value->type!=V_ERROR ? &pc : (struct Pc*)0);
|
|
}
|
|
return value;
|
|
}
|
|
/*}}}*/
|
|
|
|
#ifdef USE_LR0
|
|
/* Grammar with LR(0) sets */ /*{{{*/
|
|
/*
|
|
Grammar:
|
|
|
|
1 EV -> E
|
|
2 E -> E op E
|
|
3 E -> op E
|
|
4 E -> ( E )
|
|
5 E -> value
|
|
|
|
i0:
|
|
EV -> . E goto(0,E)=5
|
|
E -> . E op E goto(0,E)=5
|
|
E -> . op E +,- shift 2
|
|
E -> . ( E ) ( shift 3
|
|
E -> . value value shift 4
|
|
|
|
i5:
|
|
EV -> E . else accept
|
|
E -> E . op E op shift 1
|
|
|
|
i2:
|
|
E -> op . E goto(2,E)=6
|
|
E -> . E op E goto(2,E)=6
|
|
E -> . op E +,- shift 2
|
|
E -> . ( E ) ( shift 3
|
|
E -> . value value shift 4
|
|
|
|
i3:
|
|
E -> ( . E ) goto(3,E)=7
|
|
E -> . E op E goto(3,E)=7
|
|
E -> . op E +,- shift 2
|
|
E -> . ( E ) ( shift 3
|
|
E -> . value value shift 4
|
|
|
|
i4:
|
|
E -> value . reduce 5
|
|
|
|
i1:
|
|
E -> E op . E goto(1,E)=8
|
|
E -> . E op E goto(1,E)=8
|
|
E -> . op E +,- shift 2
|
|
E -> . ( E ) ( shift 3
|
|
E -> . value value shift 4
|
|
|
|
i6:
|
|
E -> op E . reduce 3
|
|
E -> E . op E op* shift 1 *=if stack[-2] contains op of unary lower priority
|
|
|
|
i7:
|
|
E -> ( E . ) ) shift 9
|
|
E -> E . op E op shift 1
|
|
|
|
i8:
|
|
E -> E op E . reduce 2
|
|
E -> E . op E op* shift 1 *=if stack[-2] contains op of lower priority or if
|
|
if it is of equal priority and right associative
|
|
|
|
i9:
|
|
E -> ( E ) . reduce 4
|
|
|
|
*/
|
|
/*}}}*/
|
|
static struct Value *eval(struct Value *value, const char *desc) /*{{{*/
|
|
{
|
|
/* variables */ /*{{{*/
|
|
static const int gotoState[10]={ 5,8,6,7,-1,-1,-1,-1,-1,-1 };
|
|
int capacity=10;
|
|
struct Pdastack
|
|
{
|
|
union
|
|
{
|
|
enum TokenType token;
|
|
struct Value value;
|
|
} u;
|
|
char state;
|
|
};
|
|
struct Pdastack *pdastack=malloc(capacity*sizeof(struct Pdastack));
|
|
struct Pdastack *sp=pdastack;
|
|
struct Pdastack *stackEnd=pdastack+capacity-1;
|
|
enum TokenType ip;
|
|
/*}}}*/
|
|
|
|
sp->state=0;
|
|
while (1)
|
|
{
|
|
if (sp==stackEnd)
|
|
{
|
|
pdastack=realloc(pdastack,(capacity+10)*sizeof(struct Pdastack));
|
|
sp=pdastack+capacity-1;
|
|
capacity+=10;
|
|
stackEnd=pdastack+capacity-1;
|
|
}
|
|
ip=pc.token->type;
|
|
switch (sp->state)
|
|
{
|
|
case 0:
|
|
case 1:
|
|
case 2:
|
|
case 3: /*{{{*/ /* including 4 */
|
|
{
|
|
if (ip==T_IDENTIFIER) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 4\n",sp->state); */
|
|
/* printf("state 4: reduce E -> value\n"); */
|
|
++sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
if (pass==COMPILE)
|
|
{
|
|
if
|
|
(
|
|
((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
|
|
&& Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0
|
|
)
|
|
{
|
|
Value_new_ERROR(value,UNDECLARED);
|
|
goto error;
|
|
}
|
|
}
|
|
if (pass!=DECLARE && (pc.token->u.identifier->sym->type==GLOBALVAR || pc.token->u.identifier->sym->type==GLOBALARRAY || pc.token->u.identifier->sym->type==LOCALVAR))
|
|
{
|
|
struct Value *l;
|
|
|
|
if ((l=lvalue(value))->type==V_ERROR) goto error;
|
|
Value_clone(&sp->u.value,l);
|
|
}
|
|
else
|
|
{
|
|
struct Pc var=pc;
|
|
|
|
func(&sp->u.value);
|
|
if (sp->u.value.type==V_VOID)
|
|
{
|
|
pc=var;
|
|
Value_new_ERROR(value,VOIDVALUE);
|
|
goto error;
|
|
}
|
|
}
|
|
}
|
|
/*}}}*/
|
|
else if (ip==T_INTEGER) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 4\n",sp->state); */
|
|
/* printf("state 4: reduce E -> value\n"); */
|
|
++sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.integer);
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else if (ip==T_REAL) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 4\n",sp->state); */
|
|
/* printf("state 4: reduce E -> value\n"); */
|
|
++sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
VALUE_NEW_REAL(&sp->u.value,pc.token->u.real);
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else if (TOKEN_ISUNARYOPERATOR(ip)) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 2\n",sp->state); */
|
|
++sp;
|
|
sp->state=2;
|
|
sp->u.token=ip;
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else if (ip==T_HEXINTEGER) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 4\n",sp->state); */
|
|
/* printf("state 4: reduce E -> value\n"); */
|
|
++sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.hexinteger);
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else if (ip==T_OCTINTEGER) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 4\n",sp->state); */
|
|
/* printf("state 4: reduce E -> value\n"); */
|
|
++sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
VALUE_NEW_INTEGER(&sp->u.value,pc.token->u.octinteger);
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else if (ip==T_OP) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 3\n",sp->state); */
|
|
++sp;
|
|
sp->state=3;
|
|
sp->u.token=T_OP;
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else if (ip==T_STRING) /*{{{*/
|
|
{
|
|
/* printf("state %d: shift 4\n",sp->state); */
|
|
/* printf("state 4: reduce E -> value\n"); */
|
|
++sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
Value_new_STRING(&sp->u.value);
|
|
String_destroy(&sp->u.value.u.string);
|
|
String_clone(&sp->u.value.u.string,pc.token->u.string);
|
|
++pc.token;
|
|
}
|
|
/*}}}*/
|
|
else /*{{{*/
|
|
{
|
|
char state=sp->state;
|
|
|
|
if (state==0)
|
|
{
|
|
if (desc) Value_new_ERROR(value,MISSINGEXPR,desc);
|
|
else value=(struct Value*)0;
|
|
}
|
|
else Value_new_ERROR(value,MISSINGEXPR,_("operand"));
|
|
goto error;
|
|
}
|
|
/*}}}*/
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case 5: /*{{{*/
|
|
{
|
|
if (TOKEN_ISBINARYOPERATOR(ip))
|
|
{
|
|
/* printf("state %d: shift 1\n",sp->state); */
|
|
++sp;
|
|
sp->state=1;
|
|
sp->u.token=ip;
|
|
++pc.token;
|
|
break;
|
|
}
|
|
else
|
|
{
|
|
assert(sp==pdastack+1);
|
|
*value=sp->u.value;
|
|
free(pdastack);
|
|
return value;
|
|
}
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case 6: /*{{{*/
|
|
{
|
|
if (TOKEN_ISBINARYOPERATOR(ip) && TOKEN_UNARYPRIORITY((sp-1)->u.token)<TOKEN_BINARYPRIORITY(ip))
|
|
{
|
|
assert(TOKEN_ISUNARYOPERATOR((sp-1)->u.token));
|
|
/* printf("state %d: shift 1 (not reducing E -> op E)\n",sp->state); */
|
|
++sp;
|
|
sp->state=1;
|
|
sp->u.token=ip;
|
|
++pc.token;
|
|
}
|
|
else
|
|
{
|
|
enum TokenType op;
|
|
|
|
/* printf("reduce E -> op E\n"); */
|
|
--sp;
|
|
op=sp->u.token;
|
|
sp->u.value=(sp+1)->u.value;
|
|
switch (op)
|
|
{
|
|
case T_PLUS: break;
|
|
case T_MINUS: Value_uneg(&sp->u.value,pass==INTERPRET); break;
|
|
case T_NOT: Value_unot(&sp->u.value,pass==INTERPRET); break;
|
|
default: assert(0);
|
|
}
|
|
sp->state=gotoState[(sp-1)->state];
|
|
if (sp->u.value.type==V_ERROR)
|
|
{
|
|
*value=sp->u.value;
|
|
--sp;
|
|
goto error;
|
|
}
|
|
}
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case 7: /*{{{*/ /* including 9 */
|
|
{
|
|
if (TOKEN_ISBINARYOPERATOR(ip))
|
|
{
|
|
/* printf("state %d: shift 1\n"sp->state); */
|
|
++sp;
|
|
sp->state=1;
|
|
sp->u.token=ip;
|
|
++pc.token;
|
|
}
|
|
else if (ip==T_CP)
|
|
{
|
|
/* printf("state %d: shift 9\n",sp->state); */
|
|
/* printf("state 9: reduce E -> ( E )\n"); */
|
|
--sp;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
sp->u.value=(sp+1)->u.value;
|
|
++pc.token;
|
|
}
|
|
else
|
|
{
|
|
Value_new_ERROR(value,MISSINGCP);
|
|
goto error;
|
|
}
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case 8: /*{{{*/
|
|
{
|
|
int p1,p2;
|
|
|
|
if
|
|
(
|
|
TOKEN_ISBINARYOPERATOR(ip)
|
|
&&
|
|
(
|
|
((p1=TOKEN_BINARYPRIORITY((sp-1)->u.token))<(p2=TOKEN_BINARYPRIORITY(ip)))
|
|
|| (p1==p2 && TOKEN_ISRIGHTASSOCIATIVE((sp-1)->u.token))
|
|
)
|
|
)
|
|
{
|
|
/* printf("state %d: shift 1\n",sp->state); */
|
|
++sp;
|
|
sp->state=1;
|
|
sp->u.token=ip;
|
|
++pc.token;
|
|
}
|
|
else
|
|
{
|
|
/* printf("state %d: reduce E -> E op E\n",sp->state); */
|
|
if (Value_commonType[(sp-2)->u.value.type][sp->u.value.type]==V_ERROR)
|
|
{
|
|
Value_destroy(&sp->u.value);
|
|
sp-=2;
|
|
Value_destroy(&sp->u.value);
|
|
Value_new_ERROR(value,INVALIDOPERAND);
|
|
--sp;
|
|
goto error;
|
|
}
|
|
else switch ((sp-1)->u.token)
|
|
{
|
|
case T_LT: Value_lt(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_LE: Value_le(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_EQ: Value_eq(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_GE: Value_ge(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_GT: Value_gt(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_NE: Value_ne(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_PLUS: Value_add(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_MINUS: Value_sub(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_MULT: Value_mult(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_DIV: Value_div(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_IDIV: Value_idiv(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_MOD: Value_mod(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_POW: Value_pow(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_AND: Value_and(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_OR: Value_or(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_XOR: Value_xor(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_EQV: Value_eqv(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
case T_IMP: Value_imp(&(sp-2)->u.value,&sp->u.value,pass==INTERPRET); break;
|
|
default: assert(0);
|
|
}
|
|
Value_destroy(&sp->u.value);
|
|
sp-=2;
|
|
sp->state=gotoState[(sp-1)->state];
|
|
if (sp->u.value.type==V_ERROR)
|
|
{
|
|
*value=sp->u.value;
|
|
--sp;
|
|
goto error;
|
|
}
|
|
}
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
}
|
|
}
|
|
error:
|
|
while (sp>pdastack)
|
|
{
|
|
switch (sp->state)
|
|
{
|
|
case 5:
|
|
case 6:
|
|
case 7:
|
|
case 8: Value_destroy(&sp->u.value);
|
|
}
|
|
--sp;
|
|
}
|
|
free(pdastack);
|
|
return value;
|
|
}
|
|
/*}}}*/
|
|
#else
|
|
static inline struct Value *binarydown(struct Value *value, struct Value *(level)(struct Value *value), const int prio) /*{{{*/
|
|
{
|
|
enum TokenType op;
|
|
struct Pc oppc;
|
|
|
|
if (level(value)==(struct Value*)0) return (struct Value*)0;
|
|
if (value->type==V_ERROR) return value;
|
|
do
|
|
{
|
|
struct Value x;
|
|
|
|
op=pc.token->type;
|
|
if (!TOKEN_ISBINARYOPERATOR(op) || TOKEN_BINARYPRIORITY(op)!=prio) return value;
|
|
oppc=pc;
|
|
++pc.token;
|
|
if (level(&x)==(struct Value*)0)
|
|
{
|
|
Value_destroy(value);
|
|
return Value_new_ERROR(value,MISSINGEXPR,_("binary operand"));
|
|
}
|
|
if (x.type==V_ERROR)
|
|
{
|
|
Value_destroy(value);
|
|
*value=x;
|
|
return value;
|
|
}
|
|
if (Value_commonType[value->type][x.type]==V_ERROR)
|
|
{
|
|
Value_destroy(value);
|
|
Value_destroy(&x);
|
|
return Value_new_ERROR(value,INVALIDOPERAND);
|
|
}
|
|
else switch (op)
|
|
{
|
|
case T_LT: Value_lt(value,&x,pass==INTERPRET); break;
|
|
case T_LE: Value_le(value,&x,pass==INTERPRET); break;
|
|
case T_EQ: Value_eq(value,&x,pass==INTERPRET); break;
|
|
case T_GE: Value_ge(value,&x,pass==INTERPRET); break;
|
|
case T_GT: Value_gt(value,&x,pass==INTERPRET); break;
|
|
case T_NE: Value_ne(value,&x,pass==INTERPRET); break;
|
|
case T_PLUS: Value_add(value,&x,pass==INTERPRET); break;
|
|
case T_MINUS: Value_sub(value,&x,pass==INTERPRET); break;
|
|
case T_MULT: Value_mult(value,&x,pass==INTERPRET); break;
|
|
case T_DIV: Value_div(value,&x,pass==INTERPRET); break;
|
|
case T_IDIV: Value_idiv(value,&x,pass==INTERPRET); break;
|
|
case T_MOD: Value_mod(value,&x,pass==INTERPRET); break;
|
|
case T_POW: Value_pow(value,&x,pass==INTERPRET); break;
|
|
case T_AND: Value_and(value,&x,pass==INTERPRET); break;
|
|
case T_OR: Value_or(value,&x,pass==INTERPRET); break;
|
|
case T_XOR: Value_xor(value,&x,pass==INTERPRET); break;
|
|
case T_EQV: Value_eqv(value,&x,pass==INTERPRET); break;
|
|
case T_IMP: Value_imp(value,&x,pass==INTERPRET); break;
|
|
default: assert(0);
|
|
}
|
|
Value_destroy(&x);
|
|
} while (value->type!=V_ERROR);
|
|
if (value->type==V_ERROR) pc=oppc;
|
|
return value;
|
|
}
|
|
/*}}}*/
|
|
static inline struct Value *unarydown(struct Value *value, struct Value *(level)(struct Value *value), const int prio) /*{{{*/
|
|
{
|
|
enum TokenType op;
|
|
struct Pc oppc;
|
|
|
|
op=pc.token->type;
|
|
if (!TOKEN_ISUNARYOPERATOR(op) || TOKEN_UNARYPRIORITY(op)!=prio) return level(value);
|
|
oppc=pc;
|
|
++pc.token;
|
|
if (unarydown(value,level,prio)==(struct Value*)0) return Value_new_ERROR(value,MISSINGEXPR,_("unary operand"));
|
|
if (value->type==V_ERROR) return value;
|
|
switch (op)
|
|
{
|
|
case T_PLUS: Value_uplus(value,pass==INTERPRET); break;
|
|
case T_MINUS: Value_uneg(value,pass==INTERPRET); break;
|
|
case T_NOT: Value_unot(value,pass==INTERPRET); break;
|
|
default: assert(0);
|
|
}
|
|
if (value->type==V_ERROR) pc=oppc;
|
|
return value;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval8(struct Value *value) /*{{{*/
|
|
{
|
|
switch (pc.token->type)
|
|
{
|
|
case T_IDENTIFIER: /*{{{*/
|
|
{
|
|
struct Pc var;
|
|
struct Value *l;
|
|
|
|
var=pc;
|
|
if (pass==COMPILE)
|
|
{
|
|
if
|
|
(
|
|
((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
|
|
&& Global_find(&globals,pc.token->u.identifier,(pc.token+1)->type==T_OP)==0
|
|
) return Value_new_ERROR(value,UNDECLARED);
|
|
}
|
|
assert(pass==DECLARE || pc.token->u.identifier->sym);
|
|
if (pass!=DECLARE && (pc.token->u.identifier->sym->type==GLOBALVAR || pc.token->u.identifier->sym->type==GLOBALARRAY || pc.token->u.identifier->sym->type==LOCALVAR))
|
|
{
|
|
if ((l=lvalue(value))->type==V_ERROR) return value;
|
|
Value_clone(value,l);
|
|
}
|
|
else
|
|
{
|
|
func(value);
|
|
if (value->type==V_VOID)
|
|
{
|
|
Value_destroy(value);
|
|
pc=var;
|
|
return Value_new_ERROR(value,VOIDVALUE);
|
|
}
|
|
}
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case T_INTEGER: /*{{{*/
|
|
{
|
|
VALUE_NEW_INTEGER(value,pc.token->u.integer);
|
|
++pc.token;
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case T_REAL: /*{{{*/
|
|
{
|
|
VALUE_NEW_REAL(value,pc.token->u.real);
|
|
++pc.token;
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case T_STRING: /*{{{*/
|
|
{
|
|
Value_new_STRING(value);
|
|
String_destroy(&value->u.string);
|
|
String_clone(&value->u.string,pc.token->u.string);
|
|
++pc.token;
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case T_HEXINTEGER: /*{{{*/
|
|
{
|
|
VALUE_NEW_INTEGER(value,pc.token->u.hexinteger);
|
|
++pc.token;
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case T_OCTINTEGER: /*{{{*/
|
|
{
|
|
VALUE_NEW_INTEGER(value,pc.token->u.octinteger);
|
|
++pc.token;
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
case T_OP: /*{{{*/
|
|
{
|
|
++pc.token;
|
|
if (eval(value,_("parenthetic"))->type==V_ERROR) return value;
|
|
if (pc.token->type!=T_CP)
|
|
{
|
|
Value_destroy(value);
|
|
return Value_new_ERROR(value,MISSINGCP);
|
|
}
|
|
++pc.token;
|
|
break;
|
|
}
|
|
/*}}}*/
|
|
default: /*{{{*/
|
|
{
|
|
return (struct Value *)0;
|
|
}
|
|
/*}}}*/
|
|
}
|
|
return value;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval7(struct Value *value) /*{{{*/
|
|
{
|
|
return binarydown(value,eval8,7);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval6(struct Value *value) /*{{{*/
|
|
{
|
|
return unarydown(value,eval7,6);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval5(struct Value *value) /*{{{*/
|
|
{
|
|
return binarydown(value,eval6,5);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval4(struct Value *value) /*{{{*/
|
|
{
|
|
return binarydown(value,eval5,4);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval3(struct Value *value) /*{{{*/
|
|
{
|
|
return binarydown(value,eval4,3);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval2(struct Value *value) /*{{{*/
|
|
{
|
|
return unarydown(value,eval3,2);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval1(struct Value *value) /*{{{*/
|
|
{
|
|
return binarydown(value,eval2,1);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *eval(struct Value *value, const char *desc) /*{{{*/
|
|
{
|
|
/* avoid function calls for atomic expression */
|
|
switch (pc.token->type)
|
|
{
|
|
case T_STRING:
|
|
case T_REAL:
|
|
case T_INTEGER:
|
|
case T_HEXINTEGER:
|
|
case T_OCTINTEGER:
|
|
case T_IDENTIFIER: if (!TOKEN_ISBINARYOPERATOR((pc.token+1)->type) && (pc.token+1)->type!=T_OP) return eval7(value);
|
|
default: break;
|
|
}
|
|
if (binarydown(value,eval1,0)==(struct Value*)0)
|
|
{
|
|
if (desc) return Value_new_ERROR(value,MISSINGEXPR,desc);
|
|
else return (struct Value*)0;
|
|
}
|
|
else return value;
|
|
}
|
|
/*}}}*/
|
|
#endif
|
|
|
|
static void new(void) /*{{{*/
|
|
{
|
|
Global_destroy(&globals);
|
|
Global_new(&globals);
|
|
Auto_destroy(&stack);
|
|
Auto_new(&stack);
|
|
Program_destroy(&program);
|
|
Program_new(&program);
|
|
FS_closefiles();
|
|
optionbase=0;
|
|
}
|
|
/*}}}*/
|
|
static void pushLabel(enum LabelType type, struct Pc *patch) /*{{{*/
|
|
{
|
|
if (labelStackPointer==labelStackCapacity)
|
|
{
|
|
struct LabelStack *more;
|
|
|
|
more=realloc(labelStack,sizeof(struct LabelStack)*(labelStackCapacity?(labelStackCapacity*=2):(32)));
|
|
labelStack=more;
|
|
}
|
|
labelStack[labelStackPointer].type=type;
|
|
labelStack[labelStackPointer].patch=*patch;
|
|
++labelStackPointer;
|
|
}
|
|
/*}}}*/
|
|
static struct Pc *popLabel(enum LabelType type) /*{{{*/
|
|
{
|
|
if (labelStackPointer==0 || labelStack[labelStackPointer-1].type!=type) return (struct Pc*)0;
|
|
else return &labelStack[--labelStackPointer].patch;
|
|
}
|
|
/*}}}*/
|
|
static struct Pc *findLabel(enum LabelType type) /*{{{*/
|
|
{
|
|
int i;
|
|
|
|
for (i=labelStackPointer-1; i>=0; --i) if (labelStack[i].type==type) return &labelStack[i].patch;
|
|
return (struct Pc*)0;
|
|
}
|
|
/*}}}*/
|
|
static void labelStackError(struct Value *v) /*{{{*/
|
|
{
|
|
assert(labelStackPointer);
|
|
pc=labelStack[labelStackPointer-1].patch;
|
|
switch (labelStack[labelStackPointer-1].type)
|
|
{
|
|
case L_IF: Value_new_ERROR(v,STRAYIF); break;
|
|
case L_DO: Value_new_ERROR(v,STRAYDO); break;
|
|
case L_DOcondition: Value_new_ERROR(v,STRAYDOcondition); break;
|
|
case L_ELSE: Value_new_ERROR(v,STRAYELSE2); break;
|
|
case L_FOR_BODY:
|
|
{
|
|
Value_new_ERROR(v,STRAYFOR);
|
|
pc=*findLabel(L_FOR);
|
|
break;
|
|
}
|
|
case L_WHILE: Value_new_ERROR(v,STRAYWHILE); break;
|
|
case L_REPEAT: Value_new_ERROR(v,STRAYREPEAT); break;
|
|
case L_SELECTCASE: Value_new_ERROR(v,STRAYSELECTCASE); break;
|
|
case L_FUNC: Value_new_ERROR(v,STRAYFUNC); break;
|
|
default: assert(0);
|
|
}
|
|
}
|
|
/*}}}*/
|
|
static const char *topLabelDescription(void) /*{{{*/
|
|
{
|
|
if (labelStackPointer==0)
|
|
{
|
|
return _("program");
|
|
}
|
|
switch (labelStack[labelStackPointer-1].type)
|
|
{
|
|
case L_IF: return _("`if' branch");
|
|
case L_DO: return _("`do' loop");
|
|
case L_DOcondition: return _("`do while' or `do until' loop");
|
|
case L_ELSE: return _("`else' branch");
|
|
case L_FOR_BODY: return _("`for' loop");
|
|
case L_WHILE: return _("`while' loop");
|
|
case L_REPEAT: return _("`repeat' loop");
|
|
case L_SELECTCASE: return _("`select case' control structure");
|
|
case L_FUNC: return _("function or procedure");
|
|
default: assert(0);
|
|
}
|
|
/* NOTREACHED */
|
|
return (const char*)0;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *assign(struct Value *value) /*{{{*/
|
|
{
|
|
struct Pc expr;
|
|
|
|
if (strcasecmp(pc.token->u.identifier->name,"mid$")==0) /* mid$(a$,n,m)=b$ */ /*{{{*/
|
|
{
|
|
long int n,m;
|
|
struct Value *l;
|
|
|
|
++pc.token;
|
|
if (pc.token->type!=T_OP) return Value_new_ERROR(value,MISSINGOP);
|
|
++pc.token;
|
|
if (pc.token->type!=T_IDENTIFIER) return Value_new_ERROR(value,MISSINGSTRIDENT);
|
|
if (pass==DECLARE)
|
|
{
|
|
if
|
|
(
|
|
((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
|
|
&& Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0
|
|
)
|
|
{
|
|
return Value_new_ERROR(value,REDECLARATION);
|
|
}
|
|
}
|
|
if ((l=lvalue(value))->type==V_ERROR) return value;
|
|
if (pass==COMPILE && l->type!=V_STRING) return Value_new_ERROR(value,TYPEMISMATCH4);
|
|
if (pc.token->type!=T_COMMA) return Value_new_ERROR(value,MISSINGCOMMA);
|
|
++pc.token;
|
|
if (eval(value,_("position"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
|
|
n=value->u.integer;
|
|
Value_destroy(value);
|
|
if (pass==INTERPRET && n<1) return Value_new_ERROR(value,OUTOFRANGE,"position");
|
|
if (pc.token->type==T_COMMA)
|
|
{
|
|
++pc.token;
|
|
if (eval(value,_("length"))->type==V_ERROR || Value_retype(value,V_INTEGER)->type==V_ERROR) return value;
|
|
m=value->u.integer;
|
|
if (pass==INTERPRET && m<0) return Value_new_ERROR(value,OUTOFRANGE,_("length"));
|
|
Value_destroy(value);
|
|
}
|
|
else m=-1;
|
|
if (pc.token->type!=T_CP) return Value_new_ERROR(value,MISSINGCP);
|
|
++pc.token;
|
|
if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ);
|
|
++pc.token;
|
|
if (eval(value,_("rhs"))->type==V_ERROR || Value_retype(value,V_STRING)->type==V_ERROR) return value;
|
|
if (pass==INTERPRET)
|
|
{
|
|
if (m==-1) m=value->u.string.length;
|
|
String_set(&l->u.string,n-1,&value->u.string,m);
|
|
}
|
|
}
|
|
/*}}}*/
|
|
else /*{{{*/
|
|
{
|
|
struct Value **l=(struct Value**)0;
|
|
int i, used=0, capacity=0;
|
|
struct Value retyped_value;
|
|
|
|
for (;;)
|
|
{
|
|
if (used==capacity)
|
|
{
|
|
struct Value **more;
|
|
|
|
capacity=capacity?2*capacity:2;
|
|
more=realloc(l,capacity*sizeof(*l));
|
|
l=more;
|
|
}
|
|
|
|
if (pass==DECLARE)
|
|
{
|
|
if
|
|
(
|
|
((pc.token+1)->type==T_OP || Auto_find(&stack,pc.token->u.identifier)==0)
|
|
&& Global_variable(&globals,pc.token->u.identifier,pc.token->u.identifier->defaultType,(pc.token+1)->type==T_OP?GLOBALARRAY:GLOBALVAR,0)==0
|
|
)
|
|
{
|
|
if (capacity) free(l);
|
|
return Value_new_ERROR(value,REDECLARATION);
|
|
}
|
|
}
|
|
if ((l[used]=lvalue(value))->type==V_ERROR) return value;
|
|
++used;
|
|
if (pc.token->type==T_COMMA) ++pc.token;
|
|
else break;
|
|
}
|
|
if (pc.token->type!=T_EQ) return Value_new_ERROR(value,MISSINGEQ);
|
|
++pc.token;
|
|
expr=pc;
|
|
if (eval(value,_("rhs"))->type==V_ERROR) return value;
|
|
for (i=0; i<used; ++i)
|
|
{
|
|
Value_clone(&retyped_value,value);
|
|
if (pass!=DECLARE && VALUE_RETYPE(&retyped_value,(l[i])->type)->type==V_ERROR)
|
|
{
|
|
pc=expr;
|
|
free(l);
|
|
Value_destroy(value);
|
|
*value=retyped_value;
|
|
return value;
|
|
}
|
|
if (pass==INTERPRET)
|
|
{
|
|
Value_destroy(l[i]);
|
|
*(l[i])=retyped_value;
|
|
}
|
|
}
|
|
free(l);
|
|
Value_destroy(value);
|
|
*value=retyped_value; /* for status only */
|
|
}
|
|
/*}}}*/
|
|
return value;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *compileProgram(struct Value *v, int clearGlobals) /*{{{*/
|
|
{
|
|
struct Pc begin;
|
|
|
|
stack.resumeable=0;
|
|
if (clearGlobals)
|
|
{
|
|
Global_destroy(&globals);
|
|
Global_new(&globals);
|
|
}
|
|
else Global_clearFunctions(&globals);
|
|
if (Program_beginning(&program,&begin))
|
|
{
|
|
struct Pc savepc;
|
|
int savepass;
|
|
|
|
savepc=pc;
|
|
savepass=pass;
|
|
Program_norun(&program);
|
|
for (pass=DECLARE; pass!=INTERPRET; ++pass)
|
|
{
|
|
if (pass==DECLARE)
|
|
{
|
|
stack.begindata.line=-1;
|
|
lastdata=&stack.begindata;
|
|
}
|
|
optionbase=0;
|
|
FS_intr=0;
|
|
stopped=0;
|
|
program.runnable=1;
|
|
pc=begin;
|
|
while (1)
|
|
{
|
|
statements(v);
|
|
if (v->type==V_ERROR) break;
|
|
Value_destroy(v);
|
|
if (!Program_skipEOL(&program,&pc,0,0)) { Value_new_NIL(v); break; }
|
|
}
|
|
if (v->type!=V_ERROR && labelStackPointer>0)
|
|
{
|
|
Value_destroy(v);
|
|
labelStackError(v);
|
|
}
|
|
if (v->type==V_ERROR)
|
|
{
|
|
labelStackPointer=0;
|
|
Program_norun(&program);
|
|
if (stack.cur) Auto_funcEnd(&stack); /* Always correct? */
|
|
pass=savepass;
|
|
return v;
|
|
}
|
|
}
|
|
pc=begin;
|
|
if (Program_analyse(&program,&pc,v))
|
|
{
|
|
labelStackPointer=0;
|
|
Program_norun(&program);
|
|
if (stack.cur) Auto_funcEnd(&stack); /* Always correct? */
|
|
pass=savepass;
|
|
return v;
|
|
}
|
|
curdata=stack.begindata;
|
|
pc=savepc;
|
|
pass=savepass;
|
|
}
|
|
return Value_new_NIL(v);
|
|
}
|
|
/*}}}*/
|
|
static void runline(struct Token *line) /*{{{*/
|
|
{
|
|
struct Value value;
|
|
|
|
FS_flush(STDCHANNEL);
|
|
for (pass=DECLARE; pass!=INTERPRET; ++pass)
|
|
{
|
|
curdata.line=-1;
|
|
pc.line=-1;
|
|
pc.token=line;
|
|
optionbase=0;
|
|
FS_intr=0;
|
|
stopped=0;
|
|
statements(&value);
|
|
if (value.type!=V_ERROR && pc.token->type!=T_EOL)
|
|
{
|
|
Value_destroy(&value);
|
|
Value_new_ERROR(&value,SYNTAX);
|
|
}
|
|
if (value.type!=V_ERROR && labelStackPointer>0)
|
|
{
|
|
Value_destroy(&value);
|
|
labelStackError(&value);
|
|
}
|
|
if (value.type==V_ERROR)
|
|
{
|
|
struct String s;
|
|
|
|
Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,&value);
|
|
Program_PCtoError(&program,&pc,&value);
|
|
labelStackPointer=0;
|
|
FS_putChars(STDCHANNEL,_("Error: "));
|
|
String_new(&s);
|
|
Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0);
|
|
Value_destroy(&value);
|
|
FS_putString(STDCHANNEL,&s);
|
|
String_destroy(&s);
|
|
return;
|
|
}
|
|
if (!program.runnable && pass==COMPILE)
|
|
{
|
|
Value_destroy(&value);
|
|
(void)compileProgram(&value,0);
|
|
}
|
|
}
|
|
|
|
pc.line=-1;
|
|
pc.token=line;
|
|
optionbase=0;
|
|
curdata=stack.begindata;
|
|
nextdata.line=-1;
|
|
Value_destroy(&value);
|
|
pass=INTERPRET;
|
|
FS_allowIntr(1);
|
|
do
|
|
{
|
|
assert(pass==INTERPRET);
|
|
statements(&value);
|
|
assert(pass==INTERPRET);
|
|
if (value.type==V_ERROR)
|
|
{
|
|
if (strchr(value.u.error.msg,'\n')==(char*)0)
|
|
{
|
|
Auto_setError(&stack,Program_lineNumber(&program,&pc),&pc,&value);
|
|
Program_PCtoError(&program,&pc,&value);
|
|
}
|
|
if (stack.onerror.line!=-1)
|
|
{
|
|
stack.resumeable=1;
|
|
pc=stack.onerror;
|
|
}
|
|
else
|
|
{
|
|
struct String s;
|
|
|
|
String_new(&s);
|
|
if (!stopped)
|
|
{
|
|
stopped=0;
|
|
FS_putChars(STDCHANNEL,_("Error: "));
|
|
}
|
|
Auto_frameToError(&stack,&program,&value);
|
|
Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0);
|
|
while (Auto_gosubReturn(&stack,(struct Pc*)0));
|
|
FS_putString(STDCHANNEL,&s);
|
|
String_destroy(&s);
|
|
Value_destroy(&value);
|
|
break;
|
|
}
|
|
}
|
|
Value_destroy(&value);
|
|
} while (pc.token->type!=T_EOL || Program_skipEOL(&program,&pc,STDCHANNEL,1));
|
|
FS_allowIntr(0);
|
|
}
|
|
/*}}}*/
|
|
static struct Value *evalGeometry(struct Value *value, unsigned int *dim, unsigned int geometry[]) /*{{{*/
|
|
{
|
|
struct Pc exprpc=pc;
|
|
|
|
if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
|
|
if (pass==INTERPRET && value->u.integer<optionbase)
|
|
{
|
|
Value_destroy(value);
|
|
pc=exprpc;
|
|
return Value_new_ERROR(value,OUTOFRANGE,_("dimension"));
|
|
}
|
|
geometry[0]=value->u.integer-optionbase+1;
|
|
Value_destroy(value);
|
|
if (pc.token->type==T_COMMA)
|
|
{
|
|
++pc.token;
|
|
exprpc=pc;
|
|
if (eval(value,_("dimension"))->type==V_ERROR || (pass!=DECLARE && Value_retype(value,V_INTEGER)->type==V_ERROR)) return value;
|
|
if (pass==INTERPRET && value->u.integer<optionbase)
|
|
{
|
|
Value_destroy(value);
|
|
pc=exprpc;
|
|
return Value_new_ERROR(value,OUTOFRANGE,_("dimension"));
|
|
}
|
|
geometry[1]=value->u.integer-optionbase+1;
|
|
Value_destroy(value);
|
|
*dim=2;
|
|
}
|
|
else *dim=1;
|
|
if (pc.token->type==T_CP) ++pc.token;
|
|
else return Value_new_ERROR(value,MISSINGCP);
|
|
return (struct Value*)0;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *convert(struct Value *value, struct Value *l, struct Token *t) /*{{{*/
|
|
{
|
|
switch (l->type)
|
|
{
|
|
case V_INTEGER:
|
|
{
|
|
char *datainput;
|
|
char *end;
|
|
long int v;
|
|
int overflow;
|
|
|
|
if (t->type!=T_DATAINPUT) return Value_new_ERROR(value,BADCONVERSION,_("integer"));
|
|
datainput=t->u.datainput;
|
|
v=Value_vali(datainput,&end,&overflow);
|
|
if (end==datainput || (*end!='\0' && *end!=' ' && *end!='\t')) return Value_new_ERROR(value,BADCONVERSION,_("integer"));
|
|
if (overflow) return Value_new_ERROR(value,OUTOFRANGE,_("converted value"));
|
|
Value_destroy(l);
|
|
VALUE_NEW_INTEGER(l,v);
|
|
break;
|
|
}
|
|
case V_REAL:
|
|
{
|
|
char *datainput;
|
|
char *end;
|
|
double v;
|
|
int overflow;
|
|
|
|
if (t->type!=T_DATAINPUT) return Value_new_ERROR(value,BADCONVERSION,_("real"));
|
|
datainput=t->u.datainput;
|
|
v=Value_vald(datainput,&end,&overflow);
|
|
if (end==datainput || (*end!='\0' && *end!=' ' && *end!='\t')) return Value_new_ERROR(value,BADCONVERSION,_("real"));
|
|
if (overflow) return Value_new_ERROR(value,OUTOFRANGE,_("converted value"));
|
|
Value_destroy(l);
|
|
VALUE_NEW_REAL(l,v);
|
|
break;
|
|
}
|
|
case V_STRING:
|
|
{
|
|
Value_destroy(l);
|
|
Value_new_STRING(l);
|
|
if (t->type==T_STRING) String_appendString(&l->u.string,t->u.string);
|
|
else String_appendChars(&l->u.string,t->u.datainput);
|
|
break;
|
|
}
|
|
default: assert(0);
|
|
}
|
|
return (struct Value*)0;
|
|
}
|
|
/*}}}*/
|
|
static struct Value *dataread(struct Value *value, struct Value *l) /*{{{*/
|
|
{
|
|
if (curdata.line==-1)
|
|
{
|
|
return Value_new_ERROR(value,ENDOFDATA);
|
|
}
|
|
if (curdata.token->type==T_DATA)
|
|
{
|
|
nextdata=curdata.token->u.nextdata;
|
|
++curdata.token;
|
|
}
|
|
if (convert(value,l,curdata.token))
|
|
{
|
|
return value;
|
|
}
|
|
++curdata.token;
|
|
if (curdata.token->type==T_COMMA) ++curdata.token;
|
|
else curdata=nextdata;
|
|
return (struct Value*)0;
|
|
}
|
|
/*}}}*/
|
|
static struct Value more_statements;
|
|
#include "statement.c"
|
|
static struct Value *statements(struct Value *value) /*{{{*/
|
|
{
|
|
more:
|
|
if (pc.token->statement)
|
|
{
|
|
struct Value *v;
|
|
|
|
if ((v=pc.token->statement(value)))
|
|
{
|
|
if (v==&more_statements) goto more;
|
|
else return value;
|
|
}
|
|
}
|
|
else return Value_new_ERROR(value,MISSINGSTATEMENT);
|
|
|
|
if (FS_intr)
|
|
{
|
|
stopped=1;
|
|
return Value_new_ERROR(value,BREAK);
|
|
}
|
|
else if (pc.token->type==T_COLON && (pc.token+1)->type==T_ELSE) ++pc.token;
|
|
else if ((pc.token->type==T_COLON && (pc.token+1)->type!=T_ELSE) || pc.token->type==T_QUOTE)
|
|
{
|
|
++pc.token;
|
|
goto more;
|
|
}
|
|
else if ((pass==DECLARE || pass==COMPILE) && pc.token->type!=T_EOL && pc.token->type!=T_ELSE)
|
|
{
|
|
return Value_new_ERROR(value,MISSINGCOLON);
|
|
}
|
|
return Value_new_NIL(value);
|
|
}
|
|
/*}}}*/
|
|
|
|
void bas_init(int backslash_colon, int restricted, int uppercase, int lpfd) /*{{{*/
|
|
{
|
|
#ifdef HAVE_GETTEXT
|
|
bindtextdomain("bas",LOCALEDIR);
|
|
textdomain("bas");
|
|
#endif
|
|
stack.begindata.line=-1;
|
|
Token_init(backslash_colon,uppercase);
|
|
Global_new(&globals);
|
|
Auto_new(&stack);
|
|
Program_new(&program);
|
|
FS_opendev(STDCHANNEL,0,1);
|
|
FS_opendev(LPCHANNEL,-1,lpfd);
|
|
run_restricted=restricted;
|
|
}
|
|
/*}}}*/
|
|
void bas_runFile(const char *runFile) /*{{{*/
|
|
{
|
|
struct Value value;
|
|
int dev;
|
|
|
|
new();
|
|
if ((dev=FS_openin(runFile))==-1)
|
|
{
|
|
const char *errmsg=FS_errmsg;
|
|
|
|
FS_putChars(0,_("bas: Executing `"));
|
|
FS_putChars(0,runFile);
|
|
FS_putChars(0,_("' failed ("));
|
|
FS_putChars(0,errmsg);
|
|
FS_putChars(0,_(").\n"));
|
|
}
|
|
else if (Program_merge(&program,dev,&value))
|
|
{
|
|
struct String s;
|
|
|
|
FS_putChars(0,"bas: ");
|
|
String_new(&s);
|
|
Value_toString(&value,&s,' ',-1,0,0,0,0,-1,0,0);
|
|
FS_putString(0,&s);
|
|
String_destroy(&s);
|
|
FS_putChar(0,'\n');
|
|
Value_destroy(&value);
|
|
}
|
|
else
|
|
{
|
|
struct Token line[2];
|
|
|
|
Program_setname(&program,runFile);
|
|
line[0].type=T_RUN;
|
|
line[0].statement=stmt_RUN;
|
|
line[1].type=T_EOL;
|
|
line[1].statement=stmt_COLON_EOL;
|
|
|
|
FS_close(dev);
|
|
runline(line);
|
|
}
|
|
}
|
|
/*}}}*/
|
|
void bas_runLine(const char *runLine) /*{{{*/
|
|
{
|
|
struct Token *line;
|
|
|
|
line=Token_newCode(runLine);
|
|
runline(line+1);
|
|
Token_destroy(line);
|
|
}
|
|
/*}}}*/
|
|
void bas_interpreter(void) /*{{{*/
|
|
{
|
|
if (FS_istty(STDCHANNEL))
|
|
{
|
|
//FS_putChars(STDCHANNEL,"bas " VERSION "\n"); //acassis: fix it
|
|
FS_putChars(STDCHANNEL,"Copyright 1999-2014 Michael Haardt.\n");
|
|
FS_putChars(STDCHANNEL,_("This is free software with ABSOLUTELY NO WARRANTY.\n"));
|
|
}
|
|
new();
|
|
while (1)
|
|
{
|
|
struct Token *line;
|
|
struct String s;
|
|
|
|
FS_intr=0; stopped=0;
|
|
FS_allowIntr(1);
|
|
FS_nextline(STDCHANNEL);
|
|
if (FS_istty(STDCHANNEL)) FS_putChars(STDCHANNEL,"> ");
|
|
FS_flush(STDCHANNEL);
|
|
String_new(&s);
|
|
if (FS_appendToString(STDCHANNEL,&s,1)==-1)
|
|
{
|
|
if (FS_intr)
|
|
{
|
|
FS_putChars(STDCHANNEL,_("\nBreak\n"));
|
|
FS_flush(STDCHANNEL);
|
|
String_destroy(&s);
|
|
continue;
|
|
}
|
|
else
|
|
{
|
|
FS_putChars(STDCHANNEL,FS_errmsg);
|
|
FS_flush(STDCHANNEL);
|
|
String_destroy(&s);
|
|
break;
|
|
}
|
|
}
|
|
if (s.length==0)
|
|
{
|
|
String_destroy(&s);
|
|
break;
|
|
}
|
|
line=Token_newCode(s.character);
|
|
String_destroy(&s);
|
|
if (line->type!=T_EOL)
|
|
{
|
|
if (line->type==T_INTEGER && line->u.integer>0)
|
|
{
|
|
if (program.numbered)
|
|
{
|
|
if ((line+1)->type==T_EOL)
|
|
{
|
|
struct Pc where;
|
|
|
|
if (Program_goLine(&program,line->u.integer,&where)==(struct Pc*)0) FS_putChars(STDCHANNEL,(NOSUCHLINE));
|
|
else Program_delete(&program,&where,&where);
|
|
Token_destroy(line);
|
|
}
|
|
else Program_store(&program,line,line->u.integer);
|
|
}
|
|
else
|
|
{
|
|
FS_putChars(STDCHANNEL,_("Use `renum' to number program first"));
|
|
Token_destroy(line);
|
|
}
|
|
}
|
|
else if (line->type==T_UNNUMBERED)
|
|
{
|
|
runline(line+1);
|
|
Token_destroy(line);
|
|
if (FS_istty(STDCHANNEL) && bas_end>0)
|
|
{
|
|
FS_putChars(STDCHANNEL,_("END program\n"));
|
|
bas_end=0;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
FS_putChars(STDCHANNEL,_("Invalid line\n"));
|
|
Token_destroy(line);
|
|
}
|
|
}
|
|
else Token_destroy(line);
|
|
}
|
|
FS_allowIntr(0);
|
|
}
|
|
/*}}}*/
|
|
void bas_exit(void) /*{{{*/
|
|
{
|
|
Auto_destroy(&stack);
|
|
Global_destroy(&globals);
|
|
Program_destroy(&program);
|
|
if (labelStack) free(labelStack);
|
|
FS_closefiles();
|
|
FS_close(LPCHANNEL);
|
|
FS_close(STDCHANNEL);
|
|
}
|
|
/*}}}*/
|