ack/lang/basic/src/basic.g
1991-11-29 13:57:24 +00:00

793 lines
17 KiB
Plaintext

/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
%token ILLEGAL ;
%token ASSYM ;
%token BASESYM ;
%token CALLSYM ;
%token CLEARSYM ;
%token CLOSESYM ;
%token DATASYM ;
%token DEFINTSYM ;
%token DEFSNGSYM ;
%token DEFDBLSYM ;
%token DEFSTRSYM ;
%token DEFSYM ;
%token DIMSYM ;
%token ELSESYM ;
%token ERRSYM ;
%token ERLSYM ;
%token ERRORSYM ;
%token FIELDSYM ;
%token FORSYM ;
%token FUNCTION ;
%token FUNCTID ;
%token INKEYSYM ;
%token GETSYM ;
%token GOSUBSYM ;
%token GOTOSYM ;
%token IFSYM ;
%token INPUTSYM ;
%token LETSYM ;
%token LINESYM ;
%token LSETSYM ;
%token MIDSYM ;
%token NEXTSYM ;
%token ONSYM ;
%token OPENSYM ;
%token OPTIONSYM ;
%token PRINTSYM ;
%token POKESYM ;
%token PUTSYM ;
%token RANDOMIZESYM ;
%token READSYM ;
%token REMSYM ;
%token RESTORESYM ;
%token RETURNSYM ;
%token ENDSYM ;
%token STOPSYM ;
%token STEPSYM ;
%token SWAPSYM ;
%token THENSYM ;
%token TOSYM ;
%token TRONOFFSYM ;
%token USINGSYM ;
%token USRSYM ;
%token WHILESYM ;
%token WENDSYM ;
%token WRITESYM ;
/* special tokens */
%token EOLN ;
%token INTVALUE ;
%token FLTVALUE ;
%token DBLVALUE ;
%token STRVALUE ;
%token UNARYSYM ;
%token IDENTIFIER ;
%token ANDSYM ;
%token ORSYM ;
%token IMPSYM ;
%token EQVSYM ;
%token XORSYM ;
%token VARPTR ;
/* Those were originally %left */
%token BOOLOP ;
%token NOTSYM ;
%token RELOP ;
%token MODSYM ;
/* Some contstant declared as tokens (?) */
%token LESYM ;
%token GESYM ;
%token NESYM ;
%token UNARYMINUS ;
{
#define YYDEBUG
#include "bem.h"
#include "llmess.c"
typedef union {
int integer ;
Symbol *Sptr ;
char *cptr ;
} YYSTYPE ;
int basicline;
int yydebug;
YYSTYPE yylval;
int ival;
char *dval;
char *sval;
int in_data = 0; /* set if processing DATA statement */
char *formatstring; /* formatstring used for printing */
Symbol *s; /* Symbol dummy */
#include "yylexp.c"
#include "basic.lex"
}
%lexical yylexp;
%start LLparse,programline ;
programline
: INTVALUE
{ basicline = ival;newblock(ival); newemblock(ival); }
stmts EOLN
| '#' INTVALUE STRVALUE EOLN
| EOLN
;
stmts : singlestmt
[ %while ( LLsymb == ':' ) ':' singlestmt ]*
;
singlestmt { int d2 ; }
: callstmt
| clearstmt
| CLOSESYM closestmt
| datastmt
| defstmt
| defvarstmt
| dimstmt
| ERRORSYM expression(&d2) { errorstmt(d2); }
| fieldstmt
| forstmt
| getstmt
| gosubstmt
| onstmt
| ifstmt
| illegalstmt
| inputstmt
| letstmt
| lineinputstmt
| lsetstmt
| midstmt
| NEXTSYM nextstmt
| GOTOSYM INTVALUE { gotostmt(ival); }
| openstmt
| optionstmt
| pokestmt
| printstmt
| randomizestmt
| readstmt
| REMSYM
| restorestmt
| returnstmt
| ENDSYM { C_loc((arith) 0 );
C_cal("_hlt");
C_asp((arith) BEMINTSIZE);
}
| STOPSYM { C_cal("_stop"); }
| swapstmt
| TRONOFFSYM { tronoff=yylval.integer; }
| whilestmt
| wendstmt
| writestmt
| /* EMPTY STATEMENT */
;
illegalstmt: ILLEGAL { illegalcmd(); }
;
callstmt { Symbol *id; int i; }
: CALLSYM
IDENTIFIER { id = yylval.Sptr; }
[ parmlist(&i)
{ C_cal(id->symname);
C_asp((arith) (i*BEMPTRSIZE));
}
| /* empty */
{ C_cal(id->symname); }
]
;
parmlist(int *ip;) { int var ; }
: '('
variable(&var) { *ip = 1; }
[ ',' variable(&var) { *ip = *ip + 1; } ]*
')'
;
clearstmt { int exp; }
: CLEARSYM [ ',' expression(&exp) ]*2
{ warning("statement ignored"); }
;
closestmt: filelist
| /* empty */ { C_cal("_close"); }
;
filelist { int intv; }
: cross
intvalue(&intv)
{ C_loc((arith) ival);
C_cal("_clochn");
C_asp((arith) BEMINTSIZE);
}
[ ','
cross
intvalue(&intv)
{ C_loc((arith) ival);
C_cal("_clochn");
C_asp((arith) BEMINTSIZE);
}
]* ;
datastmt: DATASYM { datastmt(); in_data = 1;}
datalist { fprint(datfile,"\n"); in_data = 0; }
;
dataelm : INTVALUE { fprint(datfile,"%d",ival); }
| '-' [ INTVALUE { fprint(datfile,"%d",-ival); }
| FLTVALUE { fprint(datfile,"-%s",dval); }
]
| FLTVALUE { fprint(datfile,dval); }
| STRVALUE { fprint(datfile,"\"%s\"",sval); }
| IDENTIFIER { fprint(datfile,"\"%s\"",sval); }
;
datalist: dataelm
[ ',' { fprint(datfile,","); }
dataelm ]*
;
defstmt : DEFSYM
[ deffnstmt
| defusrstmt
]
;
deffnstmt { int exp; }
: heading '=' expression(&exp)
{ endscope(exp); }
;
heading : FUNCTID { newscope(yylval.Sptr); }
[ '(' idlist ')' ]? { heading(); }
;
idlist : IDENTIFIER { dclparm(yylval.Sptr); }
[ ',' IDENTIFIER { dclparm(yylval.Sptr); }
]*
;
defvarstmt: DEFINTSYM { setdefaulttype( INTTYPE); }
| DEFSNGSYM { setdefaulttype( FLOATTYPE); }
| DEFDBLSYM { setdefaulttype( DOUBLETYPE); }
| DEFSTRSYM { setdefaulttype( STRINGTYPE); }
;
defusrstmt: USRSYM ':' { illegalcmd(); }
;
dimstmt { Symbol *symp; }
: DIMSYM arraydcl(&symp) ')' { dclarray(symp); }
[ ',' arraydcl(&symp) ')' { dclarray(symp); }
]*
;
arraydcl(Symbol **sympp;)
: IDENTIFIER { *sympp = s = yylval.Sptr; }
'('
INTVALUE
{
s->dimlimit[s->dimensions]=ival;
s->dimensions++;
}
[ ','
INTVALUE
{
if(s->dimensions<MAXDIMENSIONS) {
s->dimlimit[s->dimensions]=ival;
s->dimensions++;
} else error("too many dimensions");
}
]* ;
fieldstmt { int intv; }
: FIELDSYM cross intvalue(&intv)
{ setchannel(ival); }
',' fieldlist { notyetimpl(); }
;
fieldlist { int intv; int var; }
: intvalue(&intv) ASSYM variable(&var)
[ ',' intvalue(&intv) ASSYM variable(&var) ]*
;
forstmt { int exp; }
: FORSYM IDENTIFIER { forinit(yylval.Sptr); }
'=' expression(&exp) { forexpr(exp); }
TOSYM expression(&exp) { forlimit(exp); }
step
;
step { int exp; }
: STEPSYM expression(&exp) { forstep(exp); }
| /*EMPTY*/ {
C_loc((arith) 1);
forstep(INTTYPE);
}
;
nextstmt: [ IDENTIFIER { nextstmt(yylval.Sptr); }
| /* empty */ { nextstmt((Symbol *)0); }
]
[ ',' IDENTIFIER { nextstmt(yylval.Sptr); }
]*
;
getstmt { char *cp; int intv; }
: getput(&cp)
[ /* empty */
{ C_loc((arith) 0);
C_cal(cp);
C_asp((arith) BEMINTSIZE);
}
| ',' intvalue(&intv)
{ C_loc((arith) ival);
C_cal(cp);
C_asp((arith) BEMINTSIZE);
}
]
;
getput(char **cpp;) { int intv; }
: GETSYM cross intvalue(&intv)
{ setchannel(ival);
*cpp = "$_getrec";
}
| PUTSYM cross intvalue(&intv)
{ setchannel(ival);
*cpp = "$_putsym";
}
;
gosubstmt: GOSUBSYM INTVALUE { gosubstmt(ival); }
;
returnstmt: RETURNSYM { returnstmt(); }
;
ifstmt { int exp; int d1; }
: IFSYM expression(&exp) { d1=ifstmt(exp); }
thenpart { d1=thenpart(d1); }
elsepart { elsepart(d1); }
;
thenpart: THENSYM [ INTVALUE { gotostmt(ival); }
| stmts
]
| GOTOSYM INTVALUE { gotostmt(ival); }
;
elsepart: %prefer ELSESYM
[ INTVALUE { gotostmt(ival); }
| stmts
]
| /* empty */
;
inputstmt { int intv; }
: INPUTSYM [ semiprompt readlist
| '#' intvalue(&intv)
{ setchannel(ival); }
',' readlist
]
;
semiprompt { int str; }
: semi STRVALUE { str = yylval.integer; }
[ ';' { loadstr(str);
prompt(1);
}
| ',' { loadstr(str);
prompt(0);
}
]
| /*EMPTY*/
{ setchannel(-1);
C_cal("_qstmark");
}
;
semi : ';'
| /* empty */
;
letstmt { int var; int exp; }
: LETSYM
variable(&var) { save_address(); }
'=' expression(&exp) { assign(var,exp); }
|
variable(&var) { save_address(); }
'=' expression(&exp) { assign(var,exp); }
;
lineinputstmt { int var; int intv; }
: LINESYM
[ INPUTSYM
semiprompt { setchannel(-1); }
variable(&var) { linestmt(var); }
| '#'
intvalue(&intv) { setchannel(ival); }
','
variable(&var) { linestmt(var); }
]
;
readlist: readelm
[ ',' readelm ]*
;
readelm { int var; }
: variable(&var) { readelm(var); }
;
lsetstmt { int var; int exp; }
: LSETSYM variable(&var) '=' expression(&exp)
{ notyetimpl(); }
;
midstmt { int exp; }
: MIDSYM '$' midparms '=' expression(&exp)
{ C_cal("_midstmt");
C_asp((arith) (2*BEMINTSIZE + 2*BEMPTRSIZE));
}
;
midparms: '(' midfirst midsec midthird ')'
;
midfirst { int exp; }
: expression(&exp) { conversion(exp,STRINGTYPE); }
;
midsec { int exp; }
: ',' expression(&exp) { conversion(exp,INTTYPE); }
;
midthird { int exp; }
: ',' expression(&exp) { conversion(exp,INTTYPE); }
| /* empty */ { C_loc((arith) -1); }
;
onstmt : ONSYM
[ exceptionstmt
| ongotostmt
]
;
exceptionstmt: ERRORSYM GOTOSYM INTVALUE { exceptstmt(ival); }
;
ongotostmt { int exp; }
: expression(&exp)
[ GOSUBSYM constantlist { ongosubstmt(exp); }
| GOTOSYM constantlist { ongotostmt(exp); }
]
;
constantlist: INTVALUE { jumpelm(ival); }
[ ',' INTVALUE { jumpelm(ival); }
]*
;
openstmt { int exp; }
: OPENSYM mode openchannel expression(&exp)
{ conversion(exp,STRINGTYPE); }
[ /* empty */ { openstmt(0); }
| INTVALUE { openstmt(ival); }
]
;
openchannel: cross INTVALUE ',' { setchannel(ival); }
;
mode { int exp; }
: expression(&exp) ',' { conversion(exp,STRINGTYPE); }
| ',' { C_lae_dnam("_iomode",(arith)0); }
;
optionstmt { int intv; }
: OPTIONSYM BASESYM intvalue(&intv) { optionbase(ival); }
;
printstmt { int plist; }
: PRINTSYM
[ /* empty */ { setchannel(-1);
C_cal("_nl");
}
| file format printlist(&plist)
{ if(plist)
C_cal("_nl");
}
]
;
file { int intv; }
: '#' intvalue(&intv) ',' { setchannel(ival); }
| /* empty */ { setchannel(-1); }
;
format { int var ; }
: USINGSYM
[ STRVALUE { loadstr(yylval.integer); } ';'
| variable(&var) ';'
{ if(var!=STRINGTYPE)
error("string variable expected");
}
]
| /* empty */ { formatstring=0; }
;
printlist(int *ip;) { int exp; }
: [ expression(&exp) { printstmt(exp); *ip=1; }
| ',' { zone(1); *ip=0; }
| ';' { zone(0); *ip=0; }
]+
;
pokestmt { int exp1; int exp2 ; }
: POKESYM
expression(&exp1)
','
expression(&exp2) { pokestmt(exp1,exp2); }
;
randomizestmt { int exp; }
: RANDOMIZESYM
[ /* empty */ { C_cal("_randomi"); }
| expression(&exp)
{ conversion(exp,INTTYPE);
C_cal("_setrand");
C_asp((arith) BEMINTSIZE);
}
]
;
readstmt { int var; }
: READSYM { setchannel(0); }
variable(&var) { readelm(var); }
[ ',' variable(&var) { readelm(var); }
]*
;
restorestmt : RESTORESYM
[ INTVALUE { restore(ival); }
| /* empty */ { restore(0); }
]
;
swapstmt { int var1; int var2; }
: SWAPSYM
variable(&var1)
','
variable(&var2) { swapstmt(var1,var2); }
;
whilestmt { int exp; }
: WHILESYM { whilestart(); }
expression(&exp) { whiletst(exp); }
;
wendstmt : WENDSYM { wend(); }
;
writestmt: WRITESYM
[ /* empty */ { setchannel(-1);
C_cal("_wrnl");
}
| file writelist { C_cal("_wrnl"); }
]
;
writelist { int exp; }
: expression(&exp) { writestmt(exp,0); }
[ ',' expression(&exp) { writestmt(exp,1); }
]*
;
cross: '#' | /* empty */ ;
intvalue(int *ip;)
: INTVALUE { *ip = yylval.integer; }
;
variable(int *ip;) { Symbol *symp; int exp; }
: identifier(&symp)
[ %avoid /* empty */ { *ip = loadaddr(symp); }
| '(' { newarrayload(symp); }
expression(&exp) { loadarray(exp); }
[ ',' expression(&exp) { loadarray(exp); } ]*
')' { *ip = endarrayload(); }
]
| ERRSYM { C_lae_dnam("_errsym",(arith) 0);
*ip = INTTYPE;
}
| ERLSYM { C_lae_dnam("_erlsym",(arith) 0);
*ip = INTTYPE;
}
;
expression(int *ip;) { int neg; } /* NIEUW */
: expression1(&neg) { *ip = neg; }
[
IMPSYM
expression(&neg) { *ip = boolop(*ip,neg,IMPSYM); }
]?
;
expression1(int *ip;) { int neg; }
: expression2(&neg) { *ip = neg; }
[ EQVSYM
expression2(&neg) { *ip = boolop(*ip,neg,EQVSYM); }
]*
;
expression2(int *ip;) { int neg; }
: expression3(&neg) { *ip = neg; }
[ XORSYM
expression3(&neg) { *ip = boolop(*ip,neg,XORSYM); }
]*
;
expression3(int *ip;) { int neg; }
: expression4(&neg) { *ip = neg; }
[ ORSYM
expression4(&neg) { *ip = boolop(*ip,neg,ORSYM); }
]*
;
expression4(int *ip;) { int neg; }
: negation(&neg) { *ip = neg; }
[ ANDSYM
negation(&neg) { *ip = boolop(*ip,neg,ANDSYM); }
]*
;
negation(int *ip;) { int comp; }
: NOTSYM compare(&comp) { *ip=boolop(comp,0,NOTSYM); }
| compare(ip)
;
compare(int *ip;) { int sum1,sum2,rel; }
: sum(&sum1)
[ /* empty */ { *ip = sum1; }
| RELOP { rel=yylval.integer; }
sum(&sum2) { *ip=relop(sum1,sum2,rel); }
| '=' sum(&sum2) { *ip=relop(sum1,sum2,'='); }
]
;
sum(int *ip;) { int term1; }
: term(&term1) { *ip = term1; }
[ %while(1)
'-' term(&term1) { *ip=plusmin(*ip,term1,'-'); }
| '+' term(&term1) { *ip=plusmin(*ip,term1,'+'); }
]*
;
term(int *ip;) { int fac1; }
: factor(&fac1) { *ip = fac1; }
[ '*' factor(&fac1) { *ip=muldiv(*ip,fac1,'*'); }
| '\\' factor(&fac1) { *ip=muldiv(*ip,fac1,'\\'); }
| '/' factor(&fac1) { *ip=muldiv(*ip,fac1,'/'); }
| MODSYM factor(&fac1) { *ip=muldiv(*ip,fac1,MODSYM); }
]*
;
factor(int *ip;)
: '-' factor(ip) { *ip=negate(*ip); }
| factor1(ip)
;
factor1(int *ip;) { int mant,exp; }
: factor2(&mant)
[ /* empty */ { *ip = mant; }
| '^' factor1(&exp) { *ip = power(mant,exp); }
]
;
factor2(int *ip;)
{ int var,func,expl,funcc,exp,intv,funcn,inpt; int typetable[10]; }
: INTVALUE { *ip=loadint(ival); }
| '(' expression(&exp) ')' { *ip=exp; }
| FLTVALUE { *ip=loaddbl(dval); }
| STRVALUE
{ *ip= STRINGTYPE;
loadstr(yylval.integer);
}
| variable(&var)
{ *ip=var;
loadvar(var);
}
| INKEYSYM '$' { C_cal("_inkey");
C_lfr((arith) BEMPTRSIZE);
*ip= STRINGTYPE;
}
| VARPTR '(' '#' intvalue(&intv) ')'
{ warning("Not supported");
*ip=INTTYPE;
}
| FUNCTION { func=yylval.integer; }
[ %avoid /* empty */ { *ip= callfcn(yylval.integer,0, typetable); }
| '(' cross exprlist(&expl, typetable) ')'
{ *ip=callfcn(func,expl, typetable); }
]
| funcname(&funcn)
[ %avoid /* empty */ { *ip=fcnend(0); }
| funccall(&funcc) ')' { *ip=fcnend(funcc); }
]
| MIDSYM '$' midparms
{
C_cal("_mid");
C_asp((arith) (2*BEMINTSIZE+BEMPTRSIZE));
C_lfr((arith) BEMPTRSIZE);
*ip= STRINGTYPE;
}
| INPUTSYM '$' '(' expression(&exp) inputtail(&inpt)
{ /*waar worden inpt en exp gebruikt?*/
C_cal("_inpfcn");
C_asp((arith) (2*BEMINTSIZE+BEMPTRSIZE));
*ip= STRINGTYPE;
}
;
inputtail(int *ip;) { int exp; }
: ',' cross expression(&exp) ')'
{ conversion(exp,INTTYPE);
*ip= INTTYPE;
}
| ')'
{ C_loc((arith) -1);
*ip= INTTYPE;
}
;
funcname(int *ip;)
: FUNCTID { *ip=fcncall(yylval.Sptr); }
;
funccall(int *ip;) { int exp; }
: '(' expression(&exp) { callparm(0,exp);*ip=1; }
[ ',' expression(&exp) { callparm(*ip,exp);
*ip = *ip+1;
}
]*
;
identifier(Symbol **ident;)
: IDENTIFIER { dcltype(yylval.Sptr);
*ident=yylval.Sptr;
}
;
exprlist(int *ip; int *typetable;) { int exp; }
: expression(&exp) { typetable[0]=exp;
*ip=1;
}
[ ',' expression(&exp) { typetable[*ip]=exp;
*ip = *ip+1;
}
]*
;
{
#ifndef NORCSID
static char rcs_id[] = "$Header$" ;
#endif
}