|
|
@ -1,6 +1,6 @@ |
|
|
|
%{ |
|
|
|
|
|
|
|
char *rcs_luastx = "$Id: lua.stx,v 2.2 1994/04/15 21:30:12 celes Exp celes $"; |
|
|
|
char *rcs_luastx = "$Id: lua.stx,v 2.3 1994/04/19 19:06:15 celes Exp celes $"; |
|
|
|
|
|
|
|
#include <stdio.h> |
|
|
|
#include <stdlib.h> |
|
|
@ -23,10 +23,10 @@ static Word maxcode; |
|
|
|
static Word maxmain; |
|
|
|
static Word maxcurr ; |
|
|
|
static Byte *code = NULL; |
|
|
|
static Byte *maincode; |
|
|
|
static Byte *initcode; |
|
|
|
static Byte *basepc; |
|
|
|
static Byte *pc; |
|
|
|
static Word maincode; |
|
|
|
static Word pc; |
|
|
|
|
|
|
|
#define MAXVAR 32 |
|
|
|
static long varbuffer[MAXVAR]; /* variables in an assignment list; |
|
|
@ -46,24 +46,17 @@ static int err; /* flag to indicate error */ |
|
|
|
|
|
|
|
static void code_byte (Byte c) |
|
|
|
{ |
|
|
|
if (pc-basepc>maxcurr-2) /* 1 byte free to code HALT of main code */ |
|
|
|
if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */ |
|
|
|
{ |
|
|
|
Word d = pc-basepc; |
|
|
|
Byte *new = calloc(maxcurr+GAPCODE, sizeof(Byte));; |
|
|
|
memcpy(new, basepc, maxcurr*sizeof(Byte)); |
|
|
|
maxcurr += GAPCODE; |
|
|
|
free(basepc); |
|
|
|
basepc=new; |
|
|
|
|
|
|
|
/* basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte)); */ |
|
|
|
basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte)); |
|
|
|
if (basepc == NULL) |
|
|
|
{ |
|
|
|
lua_error ("not enough memory"); |
|
|
|
err = 1; |
|
|
|
} |
|
|
|
pc = basepc+d; |
|
|
|
} |
|
|
|
*pc++ = c; |
|
|
|
basepc[pc++] = c; |
|
|
|
} |
|
|
|
|
|
|
|
static void code_word (Word n) |
|
|
@ -255,7 +248,7 @@ function : FUNCTION NAME |
|
|
|
} |
|
|
|
maxcode = GAPCODE; |
|
|
|
} |
|
|
|
pc=basepc=code; maxcurr=maxcode; |
|
|
|
pc=0; basepc=code; maxcurr=maxcode; |
|
|
|
nlocalvar=0; |
|
|
|
$<vWord>$ = lua_findsymbol($2); |
|
|
|
} |
|
|
@ -275,16 +268,16 @@ function : FUNCTION NAME |
|
|
|
if (lua_debug) code_byte(RESET); |
|
|
|
code_byte(RETCODE); code_byte(nlocalvar); |
|
|
|
s_tag($<vWord>3) = T_FUNCTION; |
|
|
|
s_bvalue($<vWord>3) = calloc (pc-basepc, sizeof(Byte)); |
|
|
|
s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte)); |
|
|
|
if (s_bvalue($<vWord>3) == NULL) |
|
|
|
{ |
|
|
|
lua_error("not enough memory"); |
|
|
|
err = 1; |
|
|
|
} |
|
|
|
memcpy (s_bvalue($<vWord>3), basepc, (pc-basepc)*sizeof(Byte)); |
|
|
|
memcpy (s_bvalue($<vWord>3), basepc, pc*sizeof(Byte)); |
|
|
|
code = basepc; maxcode=maxcurr; |
|
|
|
#if LISTING |
|
|
|
PrintCode(code,pc); |
|
|
|
PrintCode(code,code+pc); |
|
|
|
#endif |
|
|
|
} |
|
|
|
; |
|
|
@ -308,7 +301,7 @@ sc : /* empty */ | ';' ; |
|
|
|
stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END |
|
|
|
{ |
|
|
|
{ |
|
|
|
Byte *elseinit = basepc + $6 + sizeof(Word)+1; |
|
|
|
Word elseinit = $6+sizeof(Word)+1; |
|
|
|
if (pc - elseinit == 0) /* no else */ |
|
|
|
{ |
|
|
|
pc -= sizeof(Word)+1; |
|
|
@ -316,29 +309,29 @@ stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END |
|
|
|
} |
|
|
|
else |
|
|
|
{ |
|
|
|
*(basepc+$6) = JMP; |
|
|
|
basepc[$6] = JMP; |
|
|
|
code_word_at(basepc+$6+1, pc - elseinit); |
|
|
|
} |
|
|
|
*(basepc+$4) = IFFJMP; |
|
|
|
code_word_at(basepc+$4+1,elseinit-(basepc+$4+sizeof(Word)+1)); |
|
|
|
basepc[$4] = IFFJMP; |
|
|
|
code_word_at(basepc+$4+1,elseinit-($4+sizeof(Word)+1)); |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
| WHILE {$<vWord>$=pc-basepc;} expr1 DO PrepJump block PrepJump END |
|
|
|
| WHILE {$<vWord>$=pc;} expr1 DO PrepJump block PrepJump END |
|
|
|
|
|
|
|
{ |
|
|
|
*(basepc+$5) = IFFJMP; |
|
|
|
code_word_at(basepc+$5+1, pc - (basepc+$5 + sizeof(Word)+1)); |
|
|
|
basepc[$5] = IFFJMP; |
|
|
|
code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1)); |
|
|
|
|
|
|
|
*(basepc+$7) = UPJMP; |
|
|
|
code_word_at(basepc+$7+1, pc - (basepc+$<vWord>2)); |
|
|
|
basepc[$7] = UPJMP; |
|
|
|
code_word_at(basepc+$7+1, pc - ($<vWord>2)); |
|
|
|
} |
|
|
|
|
|
|
|
| REPEAT {$<vWord>$=pc-basepc;} block UNTIL expr1 PrepJump |
|
|
|
| REPEAT {$<vWord>$=pc;} block UNTIL expr1 PrepJump |
|
|
|
|
|
|
|
{ |
|
|
|
*(basepc+$6) = IFFUPJMP; |
|
|
|
code_word_at(basepc+$6+1, pc - (basepc+$<vWord>2)); |
|
|
|
basepc[$6] = IFFUPJMP; |
|
|
|
code_word_at(basepc+$6+1, pc - ($<vWord>2)); |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -364,20 +357,19 @@ elsepart : /* empty */ |
|
|
|
| ELSEIF expr1 THEN PrepJump block PrepJump elsepart |
|
|
|
{ |
|
|
|
{ |
|
|
|
Byte *elseinit = basepc + $6 + sizeof(Word)+1; |
|
|
|
Word elseinit = $6+sizeof(Word)+1; |
|
|
|
if (pc - elseinit == 0) /* no else */ |
|
|
|
{ |
|
|
|
pc -= sizeof(Word)+1; |
|
|
|
/* if (*(pc-1) == NOP) --pc; */ |
|
|
|
elseinit = pc; |
|
|
|
} |
|
|
|
else |
|
|
|
{ |
|
|
|
*(basepc+$6) = JMP; |
|
|
|
basepc[$6] = JMP; |
|
|
|
code_word_at(basepc+$6+1, pc - elseinit); |
|
|
|
} |
|
|
|
*(basepc+$4) = IFFJMP; |
|
|
|
code_word_at(basepc+$4+1, elseinit - (basepc+$4 + sizeof(Word)+1)); |
|
|
|
basepc[$4] = IFFJMP; |
|
|
|
code_word_at(basepc+$4+1, elseinit - ($4 + sizeof(Word)+1)); |
|
|
|
} |
|
|
|
} |
|
|
|
; |
|
|
@ -403,7 +395,7 @@ ret : /* empty */ |
|
|
|
|
|
|
|
PrepJump : /* empty */ |
|
|
|
{ |
|
|
|
$$ = pc-basepc; |
|
|
|
$$ = pc; |
|
|
|
code_byte(0); /* open space */ |
|
|
|
code_word (0); |
|
|
|
} |
|
|
@ -452,14 +444,14 @@ expr : '(' expr ')' { $$ = $2; } |
|
|
|
| NOT expr1 { code_byte(NOTOP); $$ = 1;} |
|
|
|
| expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1 |
|
|
|
{ |
|
|
|
*(basepc+$3) = ONFJMP; |
|
|
|
code_word_at(basepc+$3+1, pc - (basepc+$3 + sizeof(Word)+1)); |
|
|
|
basepc[$3] = ONFJMP; |
|
|
|
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1)); |
|
|
|
$$ = 1; |
|
|
|
} |
|
|
|
| expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1 |
|
|
|
{ |
|
|
|
*(basepc+$3) = ONTJMP; |
|
|
|
code_word_at(basepc+$3+1, pc - (basepc+$3 + sizeof(Word)+1)); |
|
|
|
basepc[$3] = ONTJMP; |
|
|
|
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1)); |
|
|
|
$$ = 1; |
|
|
|
} |
|
|
|
; |
|
|
@ -467,13 +459,13 @@ expr : '(' expr ')' { $$ = $2; } |
|
|
|
typeconstructor: '@' |
|
|
|
{ |
|
|
|
code_byte(PUSHBYTE); |
|
|
|
$<vWord>$ = pc-basepc; code_byte(0); |
|
|
|
$<vWord>$ = pc; code_byte(0); |
|
|
|
incr_ntemp(); |
|
|
|
code_byte(CREATEARRAY); |
|
|
|
} |
|
|
|
objectname fieldlist |
|
|
|
{ |
|
|
|
*(basepc+$<vWord>2) = $4; |
|
|
|
basepc[$<vWord>2] = $4; |
|
|
|
if ($3 < 0) /* there is no function to be called */ |
|
|
|
{ |
|
|
|
$$ = 1; |
|
|
@ -733,20 +725,20 @@ int yywrap (void) |
|
|
|
*/ |
|
|
|
int lua_parse (void) |
|
|
|
{ |
|
|
|
Byte *init = maincode = (Byte *) calloc(GAPCODE, sizeof(Byte)); |
|
|
|
if (init== NULL) |
|
|
|
Byte *init = initcode = (Byte *) calloc(GAPCODE, sizeof(Byte)); |
|
|
|
maincode = 0; |
|
|
|
maxmain = GAPCODE; |
|
|
|
if (init == NULL) |
|
|
|
{ |
|
|
|
lua_error("not enough memory"); |
|
|
|
return 1; |
|
|
|
} |
|
|
|
initcode = init; |
|
|
|
maxmain = GAPCODE; |
|
|
|
err = 0; |
|
|
|
if (yyparse () || (err==1)) return 1; |
|
|
|
*maincode++ = HALT; |
|
|
|
initcode[maincode++] = HALT; |
|
|
|
init = initcode; |
|
|
|
#if LISTING |
|
|
|
PrintCode(init,maincode); |
|
|
|
PrintCode(init,init+maincode); |
|
|
|
#endif |
|
|
|
if (lua_execute (init)) return 1; |
|
|
|
free(init); |
|
|
|