1361 lines
41 KiB
C
1361 lines
41 KiB
C
/*
|
|
The main compiler. One monolithic big machine. Only expressions and instrcutions are
|
|
handled separately.
|
|
*/
|
|
|
|
#include "config.h"
|
|
#include "types.h"
|
|
#include "error.h"
|
|
#include "tokens.h"
|
|
#include "ops.h"
|
|
#include "mem.h"
|
|
#include "var.h"
|
|
#include "stack.h"
|
|
#include "reg.h"
|
|
#include "context.h"
|
|
#include "lexer.h"
|
|
#include "utils.h"
|
|
#include "code.h"
|
|
#include "printf.h"
|
|
#include "ccall.h"
|
|
#include "io.h"
|
|
#include "str.h"
|
|
#include "event.h"
|
|
#include "debug.h"
|
|
#include "str.h"
|
|
#include "context.h"
|
|
#include "log.h"
|
|
|
|
/*
|
|
is argument expression parsed? EQUAL is considered as EOX, too, here!
|
|
*/
|
|
#define termargexpr(t) (t==EOL || t==TSEPARATOR || t==TNEXTARG || t==TEQUAL || t==TELSE)
|
|
#define termsymbol(t) (t==EOL || t==TNL || t==TSEPARATOR || t==TELSE)
|
|
#define startofexpr(t) (t==TLPAR || t==TNUMBER || t==TIDENTIFIER)
|
|
/*
|
|
Operator binding
|
|
0: equal
|
|
1: next has higher binding
|
|
-1: next has lower binding
|
|
|
|
TODO and,or, lt,gt ...
|
|
*/
|
|
INLINE static int oporder(opcmd_t current, opcmd_t next) {
|
|
switch (next) {
|
|
case ADD:
|
|
case SUB:
|
|
switch (current) {
|
|
case ADD:
|
|
case SUB:
|
|
return 0;
|
|
case MOD:
|
|
case MUL:
|
|
case DIV:
|
|
return -1;
|
|
}
|
|
break;
|
|
case MOD:
|
|
case MUL:
|
|
case DIV:
|
|
switch (current) {
|
|
case ADD:
|
|
case SUB:
|
|
return 1;
|
|
case MUL:
|
|
case DIV:
|
|
return 0;
|
|
}
|
|
break;
|
|
}
|
|
return 0;
|
|
};
|
|
|
|
/*
|
|
compile expression directly to VM-Code (in M code area)
|
|
stores tokens in program memory
|
|
!expressions are parsed atomically at once!
|
|
nexttoken() compiletoken()
|
|
*/
|
|
#define MAXEXPRDEPTH 4
|
|
#define MAXOPSN 8
|
|
|
|
opcmd_t token2op(token_t t) {
|
|
switch (t) {
|
|
case TADD: return ADD;
|
|
case TAND: return AND;
|
|
case TDIV: return DIV;
|
|
case TEQUAL: return EQ;
|
|
case TGEQ: return GE;
|
|
case TGT: return GT;
|
|
case TLEQ: return LE;
|
|
case TLT: return LT;
|
|
case TMUL: return MUL;
|
|
case TMODULO: return MOD;
|
|
case TNEQ: return NEQ;
|
|
case TNOT: return NOT;
|
|
case TOR: return OR;
|
|
case TSUB: return SUB;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
// Parse a tuple of constant values and return values w. and wo ()
|
|
// string,number, number,number, string,.string
|
|
index_t ParseTuple2(lexer_t *L, reg_t *R, void *arg1, void* arg2, char types[],index_t withpars) {
|
|
int pars=0, i=0;
|
|
LookAheadToken(L);
|
|
if (L->token==TLPAR) {
|
|
SkipToken(L);
|
|
pars++;
|
|
} else if (withpars) RETURNERROR(R,ESYNTAX,0);
|
|
do {
|
|
NextToken(L);
|
|
if (L->token==TSTRING && types[i]=='S') {
|
|
L->arg[L->arglen]=0;
|
|
if (i==0) strcpy((char *)arg1,L->arg);
|
|
else strcpy((char *)arg2,L->arg);
|
|
} else if (L->token==TNUMBER && types[i]=='I') {
|
|
if (i==0) *((index_t *)(arg1))=(index_t)L->x;
|
|
else *((index_t *)(arg2))=(index_t)L->x;
|
|
} else if (L->token==TNUMBER && types[i]=='N') {
|
|
if (i==0) *((number_t *)(arg1))=L->x;
|
|
else *((number_t *)(arg2))=L->x;
|
|
} else RETURNERROR(R,ESYNTAX,0);
|
|
i++;
|
|
LookAheadToken(L);
|
|
if (L->token==TNEXTARG) SkipToken(L);
|
|
} while (L->token==TNEXTARG);
|
|
if (pars) {
|
|
if (L->token!=TRPAR) RETURNERROR(R,ESYNTAX,0);
|
|
SkipToken(L);
|
|
}
|
|
return i;
|
|
}
|
|
/*
|
|
Returns prediction of number of pushed values
|
|
*/
|
|
index_t CompileExpr(lexer_t *L, mem_t *M, reg_t *R) {
|
|
token_t current,_uptoken;
|
|
address_t addr;
|
|
var_t *var;
|
|
index_t i,j,stackN;
|
|
char op;
|
|
char ops[MAXEXPRDEPTH][MAXOPSN]; // operation stack
|
|
char opsT[MAXEXPRDEPTH][MAXOPSN]; // expression type stack
|
|
int opsI[MAXEXPRDEPTH]; // Operator counter
|
|
int expN = 0; // Expression depth counter ((..))
|
|
int opN[MAXEXPRDEPTH]; // Operand counter
|
|
int checkOpFlush = 0;
|
|
opsI[0]=0;opN[0]=0;
|
|
index_t ps,ix,argn,npar;
|
|
ccall_t *ccall;
|
|
|
|
L->type=TNUMBER; stackN=0;
|
|
|
|
do {
|
|
|
|
#if DEBUG > 0
|
|
log(LOGDEBUG1,"CompileExpr (error=%d,expN=%d,opN[expN]=%d,ps=%d) ",R->error,expN,opN[expN],L->ps);
|
|
if (log_level<=LOGDEBUG1) PrintLexerToken(L);
|
|
#endif
|
|
|
|
switch (L->token) {
|
|
// Expression, delay op
|
|
case TADD:
|
|
case TAND:
|
|
case TDIV:
|
|
case TEQUAL:
|
|
case TGEQ:
|
|
case TGT:
|
|
case TLEQ:
|
|
case TLT:
|
|
case TMODULO:
|
|
case TMUL:
|
|
case TNEQ:
|
|
case TNOT:
|
|
case TOR:
|
|
case TSUB:
|
|
opsT[expN][opsI[expN]]=L->type; op=token2op(L->token); ops[expN][opsI[expN]++]=op;
|
|
// some sanity checks; prevent accidental sequence of operators, e.g. 2++2, which would result in ADD ADD
|
|
// with stack underflow
|
|
LookAheadToken(L);
|
|
// TSUB can follow as negative sign
|
|
if (L->token==TSUB) {
|
|
switch (op) {
|
|
case EQ:
|
|
case NEQ:
|
|
case LT:
|
|
case GT:
|
|
case LE:
|
|
case GE:
|
|
case AND:
|
|
case OR:
|
|
expN++;
|
|
opN[expN]=opsI[expN]=0;
|
|
break;
|
|
default:
|
|
RETURNERROR(R,ESYNTAX,0);
|
|
}
|
|
} else if (token2op(L->token)) RETURNERROR(R,ESYNTAX,0);
|
|
break;
|
|
|
|
case TLPAR:
|
|
expN++;
|
|
opN[expN]=opsI[expN]=0;
|
|
break;
|
|
case TRPAR:
|
|
if (expN==0 && L->ps==PARGS) {
|
|
// closing RPAR of argument list, ignored here
|
|
L->next=L->input;
|
|
L->input=L->last;
|
|
L->argN++; // argument counter
|
|
goto flushopsandreturn;
|
|
}
|
|
if (expN==0) RETURNERROR(R,ESYNTAX,0);
|
|
// flush the operator stack
|
|
while(opsI[expN]) {
|
|
opsI[expN]--;
|
|
if (opsT[expN][opsI[expN]]==TSTRING) {
|
|
switch (ops[expN][opsI[expN]]) {
|
|
case EQ: CODEADD0(M,CMPS); break;
|
|
case NEQ: CODEADD0(M,CMPS); CODEADD0(M,NOT); break;
|
|
default: RETURNERROR(R,EOP,0);
|
|
}
|
|
} else CODEADD0(M,ops[expN][opsI[expN]]);
|
|
}
|
|
opN[expN]=0;
|
|
expN--;
|
|
// () is an operand!
|
|
opN[expN]++;
|
|
break;
|
|
|
|
#if HAS_FUNC > 0
|
|
case TCALL:
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) RETURNERROR(R,ESYNTAX,0);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var); // function symbol
|
|
if (!addr || var->type!=MFUNC) RETURNERROR(R,EPROC,0);
|
|
NextToken(L);
|
|
argn=0;
|
|
if (L->token != TLPAR) RETURNERROR(R,ESYNTAX,0);
|
|
do {
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return 0;
|
|
argn++;
|
|
} while (L->token == TNEXTARG);
|
|
if (L->token!=TRPAR) RETURNERROR(R,ESYNTAX,0);
|
|
SkipToken(L);
|
|
CODEADD1I(M,INCSP,-argn); // correct SP (arguments)
|
|
CODEADD1A(M,CALL,var->data); // code address is stored in data field
|
|
break;
|
|
#endif
|
|
|
|
case TCCALL:
|
|
ix = L->ix;
|
|
ps = L->ps;
|
|
ccall=&ccalls[ix];
|
|
if (ccall->nret==0) RETURNERROR(R,ECALL,0);
|
|
stackN+=ccall->nret;
|
|
argn=0;
|
|
npar=0;
|
|
LookAheadToken(L);
|
|
if (L->token==TLPAR) { npar=1; SkipToken(L); }
|
|
LookAheadToken(L);
|
|
if (ccall->nargs>0) {
|
|
if (L->token==TRPAR) RETURNERROR(R,ECALL,0);
|
|
do {
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return 0;
|
|
argn++;
|
|
} while (L->token == TNEXTARG);
|
|
if (argn!=ccall->nargs) RETURNERROR(R,ECALL,0);
|
|
} else if (ccall->nargs==-1) {
|
|
// varargs
|
|
CODEADD1N(M,PUSHD,argn);
|
|
} else if (npar) LookAheadToken(L);
|
|
if (L->token==TRPAR) { if (npar) SkipToken(L); else RETURNERROR(R,ESYNTAX,0); }
|
|
else if (npar) RETURNERROR(R,ESYNTAX,0);
|
|
CODEADD1I(M,CCALL,ix);
|
|
L->ps=ps;
|
|
opN[expN]++;
|
|
break;
|
|
|
|
case TEVENT:
|
|
// get info about current event (if serviced in a handler)
|
|
CODEADD1I(M,ENV,(index_t)'E');
|
|
opN[expN]++;
|
|
stackN++;
|
|
checkOpFlush=1;
|
|
break;
|
|
|
|
case TIDENTIFIER:
|
|
// x x() x$ foo(..)
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr) {
|
|
#if HAS_FUNC > 0
|
|
if (L->level) {
|
|
string_rconcat(L->name,L->fun); // function parameter? name is "funvarname"
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
}
|
|
if (!addr) RETURNERROR(R,EVAR,0);
|
|
#else
|
|
RETURNERROR(R,EVAR,0);
|
|
#endif
|
|
}
|
|
LookAheadToken(L);
|
|
switch (L->token) {
|
|
case TLPAR:
|
|
// rhs array expression
|
|
// a(index=1,..,length)
|
|
// Should we support a(i1,i2) ?? array range
|
|
SkipToken(L);
|
|
if (var->type==MVAR) {
|
|
// push address
|
|
CODEADD1N(M,PUSHD,(number_t)(addr-number_s));
|
|
LookAheadToken(L);
|
|
if (L->token==TRPAR) RETURNERROR(R,ESYNTAX,0);
|
|
{
|
|
L->ps=PARGS; NextToken(L);
|
|
CompileExpr(L, M, R); if (R->error) return 0;
|
|
}
|
|
if (L->token!=TRPAR) RETURNERROR(R,ESYNTAX,0);
|
|
SkipToken(L);
|
|
CODEADD1N(M,PUSHD,number_s);
|
|
CODEADD0(M,MUL);
|
|
CODEADD0(M,ADD);
|
|
CODEADD1A(M,READ,-1); // addr is on stack -1
|
|
opN[expN]++;
|
|
checkOpFlush=1;
|
|
} else RETURNERROR(R,EVAR,0);
|
|
break;
|
|
case TDOLLAR:
|
|
NextToken(L);
|
|
if (var->type!=MSTRING && var->type!=MEVENT) RETURNERROR(R,EVAR,0);
|
|
CODEADD1N(M,PUSHD,addr);
|
|
opN[expN]++;
|
|
checkOpFlush=1;
|
|
L->type=TSTRING;
|
|
break;
|
|
default:
|
|
// simple variable
|
|
switch (var->type) {
|
|
case MVAR:
|
|
CODEADD1N(M,READ,addr);
|
|
break;
|
|
case MCONST:
|
|
CODEADD1N(M,PUSHD,var->data);
|
|
break;
|
|
#if HAS_FUNC > 0
|
|
case MVARLOC:
|
|
if (VARLOCLEVEL(var->data)!=L->level) RETURNERROR(R,EVAR,0);
|
|
CODEADD1A(M,READ,-(VARLOCINDEX(var->data))-2);
|
|
break;
|
|
#endif
|
|
case MEVENT:
|
|
// user event
|
|
CODEADD1N(M,PUSHD,(number_t)var->data);
|
|
break;
|
|
default:
|
|
RETURNERROR(R,EVAR,0);
|
|
}
|
|
opN[expN]++;
|
|
checkOpFlush=1;
|
|
break;
|
|
}
|
|
stackN++;
|
|
break;
|
|
|
|
case TCHAR:
|
|
case TNUMBER:
|
|
if (opN[expN]==0 && opsI[expN] && ops[expN][opsI[expN]-1]==SUB) {
|
|
L->x=-L->x;
|
|
opsI[expN]--;
|
|
if (opsI[expN]==0 && expN) expN--;
|
|
}
|
|
switch (L->token) {
|
|
case TCHAR: CODEADD1N(M,PUSHD,(int)(*L->arg)); L->type=TCHAR; break;
|
|
case TNUMBER: CODEADD1N(M,PUSHD,L->x); L->type=TNUMBER; break;
|
|
}
|
|
opN[expN]++;
|
|
// Todo operator bindings, next op higher binding?
|
|
// 3+4*5 => 3 4 5 * +
|
|
checkOpFlush=1;
|
|
stackN++;
|
|
break;
|
|
|
|
case TSTRING:
|
|
// constant string stored in code area
|
|
addr=M->bottom;
|
|
CODEADD1I(M,STRING,0);
|
|
j=0;
|
|
// transfer string to code area including 0 termination
|
|
for(i=0;i<L->arglen;i++) {
|
|
if (*L->arg=='\\') {
|
|
// escaped
|
|
L->arg++;i++;
|
|
switch (*L->arg) {
|
|
case 'n': M->data[M->bottom++]='\n'; break;
|
|
}
|
|
} else
|
|
M->data[M->bottom++]=*L->arg;
|
|
L->arg++;j++;
|
|
}
|
|
M->data[M->bottom++]=0;
|
|
// push address to stack
|
|
CODESTORE1I(M,addr,STRING,j);
|
|
L->type=TSTRING;
|
|
stackN++;
|
|
break;
|
|
|
|
case TDOLLAR:
|
|
// variable reference
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) RETURNERROR(R,ESYNTAX,0);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr) RETURNERROR(R,EVAR,0);
|
|
#if HAS_FUNC>0
|
|
// Heap or stack address? stack addresses are encode -addr-1 and are realtive to R->fp
|
|
CODEADD1N(M,PUSHD,VARADDRESS(var,addr));
|
|
#else
|
|
CODEADD1N(M,PUSHD,addr);
|
|
#endif
|
|
stackN++;
|
|
break;
|
|
|
|
case TBLOCK1:
|
|
case TDO:
|
|
case TELSE:
|
|
case TSEPARATOR:
|
|
case TTHEN:
|
|
case TWHILE:
|
|
case ';': // no newline
|
|
// convert NextToken to LookAhedToken call
|
|
// unconsume/rewind, next instruction
|
|
L->next=L->input; // for SkipToken
|
|
L->input=L->last; // last position
|
|
// These are consumed, but still visible via L->token
|
|
case TBLOCK2:
|
|
case TNEXTARG:
|
|
// flush pending ops
|
|
if (L->ps==PARGS) L->argN++;
|
|
L->ps=PINSTR; // leaving expression mode
|
|
goto flushopsandreturn;
|
|
|
|
#if MAXTASKS > 1
|
|
case TFORK:
|
|
CODEADD0(M,FORK);
|
|
break;
|
|
#endif
|
|
|
|
case EOL:
|
|
goto flushopsandreturn;
|
|
default:
|
|
RETURNERROR(R,ESYNTAX,0);
|
|
break;
|
|
}
|
|
|
|
if (checkOpFlush) {
|
|
#if DEBUG > 0
|
|
if (R->debug>1) print_format("checkOpFlush expN=%d opN[expN]=%d opsI[expN]=%d error=%d\n",expN,opN[expN],opsI[expN],R->error);
|
|
#endif
|
|
checkOpFlush=0;
|
|
if (opN[expN]>1 && opsI[expN]) {
|
|
LookAheadToken(L);
|
|
// check op order, flush or further delay
|
|
// special case: string type
|
|
if (oporder(ops[expN][opsI[expN]-1],token2op(L->token))<=0) {
|
|
// flush the operator stack
|
|
while(opsI[expN]) {
|
|
opsI[expN]--;
|
|
if (opsT[expN][opsI[expN]]==TSTRING) {
|
|
switch (ops[expN][opsI[expN]]) {
|
|
case EQ: CODEADD0(M,CMPS); break;
|
|
case NEQ: CODEADD0(M,CMPS); CODEADD0(M,NOT); break;
|
|
default: RETURNERROR(R,EOP,0);
|
|
}
|
|
} else CODEADD0(M,ops[expN][opsI[expN]]);
|
|
stackN--;
|
|
}
|
|
opN[expN]=0;
|
|
} // else we must delay }
|
|
} else if (opN[expN]==1 && opsI[expN] && ops[expN][opsI[expN]-1]==SUB) {
|
|
// -5? can be optimized
|
|
CODEADD0(M,NEG);
|
|
opN[expN]--;
|
|
opsI[expN]--;
|
|
} else if (opN[expN]==1 && opsI[expN] && ops[expN][opsI[expN]-1]==NOT) {
|
|
CODEADD0(M,NOT);
|
|
opN[expN]--;
|
|
opsI[expN]--;
|
|
} else if (opN[expN]>1) RETURNERROR(R,ESYNTAX,0);
|
|
}
|
|
// save input position for restore
|
|
NextToken(L);
|
|
} while (L->token != EOL && !R->error);
|
|
return stackN;
|
|
|
|
flushopsandreturn:
|
|
// flush the operator stack
|
|
while(opsI[expN]) {
|
|
opsI[expN]--;
|
|
if (opsT[expN][opsI[expN]]==TSTRING) {
|
|
switch (ops[expN][opsI[expN]]) {
|
|
case EQ: CODEADD0(M,CMPS); break;
|
|
case NEQ: CODEADD0(M,CMPS); CODEADD0(M,NOT); break;
|
|
default: RETURNERROR(R,EOP,0);
|
|
}
|
|
} else CODEADD0(M,ops[expN][opsI[expN]]);
|
|
stackN--;
|
|
}
|
|
return stackN;
|
|
}
|
|
|
|
/*
|
|
One instruction/statement: Parse next token and compile directly to PX-Code (in M code area)
|
|
-- Expressions are compiled at once --
|
|
*/
|
|
void CompileInstr(lexer_t *L, mem_t *M, reg_t *R) {
|
|
address_t addr,pc,pc2,pc3;
|
|
char inblock=0,iof,ioc[MAXNAMELEN+1],name[MAXNAMELEN+1];
|
|
index_t ioh,argn=0,npar;
|
|
token_t t;
|
|
number_t ax;
|
|
index_t ix,timeout;
|
|
ccall_t *ccall;
|
|
var_t *var;
|
|
char await;
|
|
char local;
|
|
|
|
ioc[0]=0;
|
|
|
|
compilenexttoken:
|
|
NextToken(L);
|
|
#if DEBUG > 0
|
|
log(LOGDEBUG1,"CompileInstr [MB=%d] ",M->bottom); if (log_level<=LOGDEBUG1) PrintLexerToken(L);
|
|
#endif
|
|
switch (L->token) {
|
|
case TBLOCK1:
|
|
// compile all instruction in this block
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (*L->input && L->token!=TBLOCK2);
|
|
return;
|
|
break;
|
|
case TBLOCK2:
|
|
// consumed, but still visisble via L->token
|
|
return;
|
|
break;
|
|
|
|
case TBREAK:
|
|
// best hope, assuming loop frame, TODO CHECK
|
|
CODEADD1A(M,JMP,-2);
|
|
break;
|
|
|
|
case TCALL:
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var); // function symbol
|
|
if (!addr || var->type != MPROC) return error(R,EPROC);
|
|
CODEADD1A(M,CALL,var->data); // code address is stored in data field
|
|
break;
|
|
|
|
case TCCALL:
|
|
ix = L->ix;
|
|
ccall=&ccalls[ix];
|
|
if (ccall->nret>0) return error(R,ECALL);
|
|
argn=0;
|
|
npar=0;
|
|
LookAheadToken(L);
|
|
if (L->token==TLPAR) { npar=1; SkipToken(L); }
|
|
LookAheadToken(L);
|
|
if (ccall->nargs>0) {
|
|
if (L->token==TRPAR) RETURNERROR0(R,ECALL);
|
|
do {
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
argn++;
|
|
} while (L->token == TNEXTARG);
|
|
if (argn!=ccall->nargs) return error(R,ECALL);
|
|
} else if (ccall->nargs==-1) {
|
|
// varargs
|
|
CODEADD1N(M,PUSHD,argn);
|
|
} else if (npar) LookAheadToken(L);
|
|
if (L->token==TRPAR) { if (npar) SkipToken(L); else return error(R,ESYNTAX); }
|
|
else if (npar) return error(R,ESYNTAX);
|
|
CODEADD1I(M,CCALL,ix);
|
|
break;
|
|
|
|
case TCONST:
|
|
// TODO
|
|
// const x=v,x=v,..
|
|
do {
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
string_copy(name,L->name,0);
|
|
NextToken(L);
|
|
if (L->token!=TEQUAL) return error(R,ESYNTAX);
|
|
NextToken(L);
|
|
if (L->token!=TNUMBER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, name, MCONST, 1, &var);
|
|
if (!addr) return error(R,EVAR);
|
|
var->data=L->x;
|
|
LookAheadToken(L);
|
|
if (L->token == TNEXTARG) NextToken(L);
|
|
} while (L->token == TNEXTARG);
|
|
break;
|
|
|
|
case TCONTINUE:
|
|
// best hope, assuming loop frame TODO check
|
|
CODEADD1A(M,JMP,-3);
|
|
break;
|
|
|
|
case TDATA:
|
|
// DATA 1,2,3,4,"text"
|
|
// DATA 1,2,
|
|
// 3,4,"text"
|
|
// DATA?...
|
|
LookAheadToken(L);
|
|
if (L->token==TINPUT) {
|
|
// channel operation
|
|
ioc[0]='$';
|
|
goto compilenexttoken;
|
|
}
|
|
pc=M->bottom;
|
|
CODEADD1A(M,DATA,0);
|
|
pc2=M->bottom;
|
|
|
|
do {
|
|
NextToken(L);
|
|
switch (L->token) {
|
|
case TNUMBER:
|
|
CODEADD1N(M,'N',L->x);
|
|
break;
|
|
case TSTRING:
|
|
CODEADD1I(M,'S',L->arglen+1);
|
|
for(ix=0;ix<L->arglen;ix++) {
|
|
CODEADD0(M,L->arg[ix]);
|
|
}
|
|
CODEADD0(M,0);
|
|
break;
|
|
case TNEXTARG:
|
|
LookAheadToken(L);
|
|
if (L->token==EOL) {
|
|
SkipToken(L);
|
|
continue;
|
|
}
|
|
break;
|
|
default:
|
|
break;
|
|
}
|
|
} while (L->token!=EOL && L->token!=TSEPARATOR);
|
|
CODESTORE1A(M,pc,DATA,M->bottom-pc2);
|
|
|
|
break;
|
|
|
|
case TDELAY:
|
|
LookAheadToken(L);
|
|
if (L->token==TLPAR) SkipToken(L);
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1I(M,INTERRUPT,-1);
|
|
break;
|
|
|
|
case TDO:
|
|
// F-Stack frame [start address,end address, 'D']
|
|
pc=M->bottom+3+3*number_s;
|
|
CODEADD1A(M,PUSHF,(number_t)pc); // address of loop start
|
|
pc=M->bottom;
|
|
CODEADD1A(M,PUSHF,0); // address of loop end, filled below
|
|
CODEADD1A(M,PUSHF,(number_t)'D'); // DO frame marker
|
|
|
|
do {
|
|
LookAheadToken(L);
|
|
if (L->token==TWHILE) break;
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=EOL && L->token!=TBLOCK2);
|
|
NextToken(L);
|
|
|
|
if (L->token!=TWHILE) return error(R,ESYNTAX);
|
|
// loop expression
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1A(M,JNZ,-3);
|
|
pc2=M->bottom; // end of loop body
|
|
CODESTORE1A(M,pc,PUSHF,pc2);
|
|
|
|
// clean-up
|
|
CODEADD1I(M,DROPF,3);
|
|
break;
|
|
|
|
case TEVENT:
|
|
// user event definition
|
|
// event "myev1", "myev2", ..
|
|
// event sysev1=("event",index)
|
|
do {
|
|
NextToken(L);
|
|
if (L->token==TSTRING) {
|
|
L->arg[L->arglen]=0;
|
|
addr=Allocate(M, R, L->arg, MEVENT, 0, &var);
|
|
} else if (L->token==TIDENTIFIER) {
|
|
// we loose case sensitivity!! bad idea, identifier are always upper-case
|
|
addr=Allocate(M, R, L->name, MEVENT, 0, &var);
|
|
} else return error(R,ESYNTAX);
|
|
LookAheadToken(L);
|
|
if (L->token==TEQUAL) {
|
|
// event sysev1=(string,number)?
|
|
SkipToken(L);
|
|
if (ParseTuple2(L,R,&name,&ix,"SI",1)<0) return error(R,ESYNTAX);
|
|
if ((ix=FindEvent(L->arg,L->x))<0) return error(R,EEVENT);
|
|
var->data=(number_t)ix;
|
|
LookAheadToken(L);
|
|
} else {
|
|
if ((ix=AddEvent(var->name,0,EVUSER))<0) return error(R,EEVENT);
|
|
var->data=(number_t)ix;
|
|
}
|
|
if (L->token==TNEXTARG) NextToken(L);
|
|
} while (L->token == TNEXTARG);
|
|
break;
|
|
|
|
case TEND:
|
|
CODEADD0(M,END);
|
|
break;
|
|
|
|
case TFOR:
|
|
// for i=a,b[,s] [do] [:] {...}
|
|
// FOR loops create a loop frame on the F-Stack
|
|
// [b,control address,end address,'F']
|
|
// [b,step,control address,end address,'F']
|
|
argn=0;
|
|
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, L->name, MVAR, 1, &var); // loop variable i
|
|
if (addr==0) return error(R,EVAR);
|
|
NextToken(L);
|
|
if (L->token!=TEQUAL) return error(R,ESYNTAX);
|
|
// = a,b[,step]
|
|
// a
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
#if HAS_FUNC > 0
|
|
CODEADD1A(M,WRITE,VARADDRESS(var,addr)); // i
|
|
#else
|
|
CODEADD1A(M,WRITE,addr); // i
|
|
#endif
|
|
argn++;
|
|
if (L->token!=TNEXTARG) return error(R,ESYNTAX);
|
|
// b
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1I(M,TOF,1);
|
|
argn++;
|
|
if (L->token==TNEXTARG) {
|
|
// step
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1I(M,TOF,1);
|
|
argn++;
|
|
}
|
|
if (L->token==TDO) NextToken(L); // syntactic suggar only
|
|
pc=M->bottom+3+3*number_s;
|
|
CODEADD1A(M,PUSHF,(number_t)pc); // address for loop control
|
|
pc=M->bottom;
|
|
CODEADD1A(M,PUSHF,0); // address of end of loop body, filled below
|
|
CODEADD1A(M,PUSHF,(number_t)'F'); // FOR frame marker
|
|
// control block
|
|
#if HAS_FUNC > 0
|
|
CODEADD1A(M,READ,VARADDRESS(var,addr)); // i
|
|
#else
|
|
CODEADD1A(M,READ,addr); // i
|
|
#endif
|
|
CODEADD1I(M,NTHF,argn+2); // b
|
|
CODEADD0(M,LE);
|
|
CODEADD1A(M,JZ,-2);
|
|
// compile loop body
|
|
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=EOL && L->token!=TBLOCK2);
|
|
// increment loop counter and jump back to control block via F-Stack loop frame
|
|
#if HAS_FUNC > 0
|
|
CODEADD1A(M,READ,VARADDRESS(var,addr)); // i
|
|
#else
|
|
CODEADD1A(M,READ,addr); // i
|
|
#endif
|
|
if (argn==3) CODEADD1I(M,NTHF,argn+1) else CODEADD1N(M,PUSHD,1); // step
|
|
CODEADD0(M,ADD);
|
|
#if HAS_FUNC > 0
|
|
CODEADD1A(M,WRITE,VARADDRESS(var,addr)); // i
|
|
#else
|
|
CODEADD1A(M,WRITE,addr); // i
|
|
#endif
|
|
CODEADD1I(M,JMP,-3); // jump back to loop control block via F-Stack frame
|
|
|
|
pc2=M->bottom; // end of loop body
|
|
CODESTORE1A(M,pc,PUSHF,pc2);
|
|
// clean-up
|
|
CODEADD1I(M,DROPF,argn+2);
|
|
|
|
break;
|
|
|
|
#if MAXTASKS > 1
|
|
case TFORK:
|
|
CODEADD0(M,FORK);
|
|
CODEADD1I(M,DROPD,1);
|
|
break;
|
|
#endif
|
|
|
|
case TIDENTIFIER:
|
|
// x=expr
|
|
// x(i)=expr
|
|
// x$="..."
|
|
// ch!...
|
|
// ch?..
|
|
// proc(args)
|
|
// printf("CompileToken: Identifier(%s)\n",L->name);
|
|
LookAheadToken(L);
|
|
switch (L->token) {
|
|
case TOUTPUT:
|
|
case TINPUT:
|
|
// check channel var, is it existing, or an event?
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr) return error(R,EVAR);
|
|
if (var->type==MEVENT) {
|
|
t=L->token;
|
|
ix=1;
|
|
SkipToken(L);
|
|
LookAheadToken(L);
|
|
if (L->token==TGT) {
|
|
ix=-1;
|
|
SkipToken(L);
|
|
}
|
|
// >0: RaiseEvent, <0: SendEvent
|
|
if (t==TOUTPUT) {
|
|
CODEADD1I(M,EMIT,ix*((index_t)var->data+1));
|
|
} else {
|
|
CODEADD1I(M,PUSHD,(index_t)var->data); // evindex
|
|
CODEADD1A(M,EVENT,0); // OnEvent
|
|
CODEADD1A(M,INTERRUPT,0 /*timeout*/); // OnEvent
|
|
}
|
|
goto compilenexttoken;
|
|
} else return error(R,EVAR);
|
|
// prepare channel operation
|
|
string_copy(ioc,L->name,0);
|
|
goto compilenexttoken;
|
|
break;
|
|
case TLPAR:
|
|
// lhs array expression
|
|
// a(index=1,..,length)
|
|
// Should we support a(i1,i2) ?? array range
|
|
SkipToken(L);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr) return error(R,EVAR);
|
|
if (var->type==MVAR) {
|
|
// push address
|
|
// TODO: MVARLOC
|
|
CODEADD1N(M,PUSHD,(number_t)(addr-number_s));
|
|
LookAheadToken(L);
|
|
if (L->token==TRPAR) return error(R,ESYNTAX);
|
|
{
|
|
L->ps=PARGS; NextToken(L);
|
|
CompileExpr(L, M, R); if (R->error) return;
|
|
}
|
|
if (L->token!=TRPAR) return error(R,ESYNTAX);
|
|
SkipToken(L);
|
|
CODEADD1N(M,PUSHD,number_s);
|
|
CODEADD0(M,MUL);
|
|
CODEADD0(M,ADD);
|
|
NextToken(L);
|
|
if (L->token!=TEQUAL) return error(R,ESYNTAX);
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1A(M,WRITE,-1); // addr is on stack -2
|
|
} else return error(R,EVAR);
|
|
break;
|
|
case TEQUAL:
|
|
// simple assignment with expression
|
|
SkipToken(L);
|
|
addr=Allocate(M,R, L->name, MVAR, 1, &var);
|
|
if (addr==0) {
|
|
return error(R,EVAR); // Var Error
|
|
}
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
#if HAS_FUNC > 0
|
|
CODEADD1A(M,WRITE,VARADDRESS(var,addr));
|
|
#else
|
|
CODEADD1A(M,WRITE,addr);
|
|
#endif
|
|
break;
|
|
case TDOLLAR:
|
|
// string variable
|
|
SkipToken(L);
|
|
NextToken(L);
|
|
if (L->token!=TEQUAL) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, L->name, MSTRING, 0, &var);
|
|
if (addr==0) return error(R,EVAR); // Error
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
if (L->type!=TSTRING) return error(R,ETYPE);
|
|
CODEADD1N(M,PUSHD,L->arglen);
|
|
CODEADD1A(M,WRITES,addr);
|
|
break;
|
|
default:
|
|
return error(R,ESYNTAX);
|
|
}
|
|
break;
|
|
|
|
case TIF:
|
|
L->ps=PEXPR; NextToken(L); argn=CompileExpr(L, M, R);
|
|
if (argn==0) return error(R,ESYNTAX);
|
|
LookAheadToken(L);
|
|
if (L->token==TTHEN || L->token==TSEPARATOR) SkipToken(L);
|
|
pc=M->bottom; CODEADD1A(M,JZ,0); // jump to end of if block, address is resolved later
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=EOL && L->token!=TBLOCK2 && L->token!=TELSE);
|
|
|
|
if (L->token==EOL || L->token==TBLOCK2) {
|
|
LookAheadToken(L);
|
|
}
|
|
if (L->token==TELSE) {
|
|
SkipToken(L);
|
|
pc2=M->bottom; CODEADD1A(M,JMP,0); // jump to end of else block, address is resolved later
|
|
CODESTORE1A(M,pc,JZ,M->bottom); // update jump to end of if block
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=EOL && L->token!=TBLOCK2);
|
|
|
|
CODESTORE1A(M,pc2,JMP,M->bottom); // update jump to end of else block
|
|
} else CODESTORE1A(M,pc,JZ,M->bottom); // update jump to end of if block
|
|
break;
|
|
case TELSE:
|
|
// consumed
|
|
// handled by corresp. IF case above
|
|
return;
|
|
break;
|
|
|
|
case TINPUT:
|
|
ioh = 0; // stdin
|
|
if (ioc[0]=='$') {
|
|
// DATA
|
|
ioh=-1;
|
|
ioc[0]=0;
|
|
}
|
|
CompileInput(L,R,M,ioh,ioc);
|
|
ioc[0]=0;
|
|
break;
|
|
|
|
case TAWAIT:
|
|
// await event(...)
|
|
// await event(...) delay ..
|
|
// await <ccall>()
|
|
LookAheadToken(L);
|
|
if (L->token != TEVENT) return error(R,ESYNTAX);
|
|
timeout=0;
|
|
case TON:
|
|
await=L->lasttoken==TAWAIT;
|
|
// printf("%d\n",await);
|
|
// await ...
|
|
// on event(..) call xx
|
|
// on error call xx
|
|
|
|
// nothing to do here, work is done in TEVENT case
|
|
|
|
NextToken(L);
|
|
switch (L->token) {
|
|
case TEVENT:
|
|
// in-line await? await event("adc",..)?
|
|
LookAheadToken(L);
|
|
argn=0;
|
|
// 1. get event args
|
|
// parse (string,number) tuple and resolve event here, only storing the event index,
|
|
// the event table is already filled
|
|
#if 0
|
|
if (L->token==TLPAR) { npar=1; SkipToken(L); } else npar=0;
|
|
do {
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
if (argn==0 && L->type!=TSTRING) return error(R,ESYNTAX);
|
|
if (argn==1 && L->type!=TNUMBER) return error(R,ESYNTAX);
|
|
argn++;
|
|
} while (L->token == TNEXTARG);
|
|
if (argn!=2) return error(R,ESYNTAX);
|
|
if (npar && L->token!=TRPAR) return error(R,ESYNTAX);
|
|
else if (L->token==TRPAR) SkipToken(L);
|
|
#endif
|
|
if (ParseTuple2(L,R,&name,&ix,"SI",0)<0) return error(R,ESYNTAX);
|
|
|
|
ix=FindEvent(name,ix);
|
|
if (ix<0) return error(R,EEVENT);
|
|
CODEADD1I(M,PUSHD,ix); // evindex
|
|
// 2. get event action (except for await w/o timeout delay)
|
|
LookAheadToken(L);
|
|
switch (L->token) {
|
|
case TCALL:
|
|
SkipToken(L);
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr || var->type != MPROC) return error(R,EPROC);
|
|
CODEADD1A(M,EVENT,var->data); // OnEvent
|
|
break;
|
|
case TSTOP:
|
|
SkipToken(L);
|
|
CODEADD1A(M,EVENT,-1); // OffEvent
|
|
break;
|
|
case TDELAY:
|
|
// Consume a delay and bind to event
|
|
if (await) {
|
|
CODEADD1A(M,EVENT,0); // OnEvent
|
|
SkipToken(L);
|
|
timeout=-1; // millis on stack
|
|
if (L->token==TLPAR) { npar=1; SkipToken(L); } else npar=0;
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
}
|
|
default:
|
|
if (await) {
|
|
// in-line waiting for event blocking main program
|
|
if (!timeout) CODEADD1A(M,EVENT,0); // OnEvent
|
|
CODEADD1A(M,INTERRUPT,timeout); // OnEvent
|
|
} else return error(R,ESYNTAX);
|
|
}
|
|
break;
|
|
case TERROR:
|
|
break;
|
|
case TIDENTIFIER:
|
|
// user or system alias event?
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (var->type==MEVENT) {
|
|
//CODEADD1N(M,PUSHD,(number_t)addr);
|
|
//CODEADD1N(M,PUSHD,(number_t)0); // device id not used
|
|
CODEADD1I(M,PUSHD,(index_t)var->data); // evindex
|
|
SkipToken(L);
|
|
LookAheadToken(L);
|
|
switch (L->token) {
|
|
case TCALL:
|
|
SkipToken(L);
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr || var->type != MPROC) return error(R,EPROC);
|
|
CODEADD1A(M,EVENT,var->data); // OnEvent
|
|
break;
|
|
case TSTOP:
|
|
SkipToken(L);
|
|
CODEADD1A(M,EVENT,-1); // OffEvent
|
|
break;
|
|
default:
|
|
if (await) {
|
|
|
|
} else return error(R,EEVENT);
|
|
}
|
|
} else return error(R,ESYNTAX);
|
|
break;
|
|
default: return error(R,ESYNTAX);
|
|
}
|
|
break;
|
|
|
|
case TGO:
|
|
// GO GO(context)
|
|
ix=-1; // self context, ix=-2: context idnex is on stack, ix>=0 is constant context index
|
|
LookAheadToken(L);
|
|
if (L->token==TLPAR) {
|
|
SkipToken(L);
|
|
L->ps=PARGS;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
ix=-2; // context index is on stack
|
|
}
|
|
CODEADD1I(M,RESUME,ix);
|
|
break;
|
|
|
|
case TOUTPUT:
|
|
ioh = 1; // stdout
|
|
CompileOutput(L,R,M,ioh,ioc);
|
|
ioc[0]=0;
|
|
break;
|
|
|
|
#if HAS_FUNC > 0
|
|
case TFUNC:
|
|
#endif
|
|
case TPROC:
|
|
t=L->token;
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
#if HAS_FUNC > 0
|
|
L->level++;
|
|
argn=0;
|
|
string_copy(L->fun,L->name,0);
|
|
if (t==TFUNC) {
|
|
// get arguments
|
|
NextToken(L);
|
|
if (L->token!=TLPAR) return error(R,ESYNTAX);
|
|
do {
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
string_rconcat(L->name,L->fun);
|
|
addr=Allocate(M,R, L->name, MVARLOC , 1, &var); // parameter is stored on stack
|
|
var->data=(number_t)(L->level+(L->fp[L->level]++)*2); // local variable, save level and var index
|
|
NextToken(L);
|
|
argn++;
|
|
} while (L->token==TNEXTARG);
|
|
if (L->token!=TRPAR) return error(R,ESYNTAX);
|
|
// store function parameter symbols on the heap. prefix with function name
|
|
}
|
|
addr=Allocate(M,R, L->fun, t==TFUNC?MFUNC:MPROC, t==TFUNC?2:1, &var); // procedure/function heap entry, store name
|
|
if (!addr) return error(R,EPROC);
|
|
if (t==TFUNC) { VARDATA(var,1)=argn; }
|
|
#else
|
|
addr=Allocate(M,R, L->name, MPROC , 1, &var); // procedure heap entry, store name
|
|
if (!addr) return error(R,EPROC);
|
|
#endif
|
|
|
|
pc=M->bottom; CODEADD1I(M,PROC,0); // code address is stored in var data field
|
|
pc2=M->bottom;
|
|
#if HAS_FUNC > 0
|
|
CODEADD1I(M,INCSP,0); // allocate space for local variables, if any
|
|
#endif
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=TBLOCK2 && L->token!=EOL);
|
|
if (M->data[M->bottom-1-ops_s[RETURN]]!=RETURN) CODEADD1I(M,RETURN,0);
|
|
var->length=M->bottom-pc2;
|
|
var->data=pc2;
|
|
CODESTORE1I(M,pc,PROC,var->length);
|
|
M->segment->refcount++; // code referenced by heap entry
|
|
#if HAS_FUNC > 0
|
|
// stack layout [p1,p2,p3,vl1,vl2,..]
|
|
// but on function enter the arguments are already pushed on stack, so only var* must be allocated additionally
|
|
CODESTORE1I(M,pc+ops_s[PROC]+1,INCSP,L->fp[L->level]);
|
|
L->level--;
|
|
#endif
|
|
break;
|
|
|
|
case TREPEAT:
|
|
// Endless service loop (but breakable)
|
|
// similar to DO, but without WHILE expression
|
|
// F-Stack frame [start address,end address, 'D']
|
|
pc=M->bottom+3+3*number_s;
|
|
CODEADD1A(M,PUSHF,(number_t)pc); // address of loop start
|
|
pc=M->bottom;
|
|
CODEADD1A(M,PUSHF,0); // address of loop end, filled below
|
|
CODEADD1A(M,PUSHF,(number_t)'D'); // Do/Repeat frame marker
|
|
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=EOL && L->token!=TBLOCK2);
|
|
NextToken(L);
|
|
|
|
CODEADD1A(M,JMP,-3);
|
|
pc2=M->bottom; // end of loop body
|
|
CODESTORE1A(M,pc,PUSHF,pc2);
|
|
|
|
// clean-up
|
|
CODEADD1I(M,DROPF,3);
|
|
break;
|
|
|
|
case TRETURN:
|
|
#if HAS_FUNC>0
|
|
LookAheadToken(L);
|
|
if (startofexpr(L->token)) {
|
|
// return expr
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1I(M,RETURN,1);
|
|
} else
|
|
#endif
|
|
CODEADD1I(M,RETURN,0);
|
|
break;
|
|
|
|
case TSEPARATOR:
|
|
// next instruction
|
|
return;
|
|
break;
|
|
|
|
case TSTOP:
|
|
CODEADD1A(M,INTERRUPT,0);
|
|
break;
|
|
|
|
case TVARDEF:
|
|
// var x
|
|
// var x,y
|
|
// var v(n),..
|
|
// var s$, s$(n)
|
|
// var* a,b,c local vars on stack
|
|
#if HAS_FUNC>0
|
|
local=0;
|
|
LookAheadToken(L);
|
|
if (L->token=='*') {
|
|
SkipToken(L);
|
|
local=1;
|
|
}
|
|
#endif
|
|
do {
|
|
NextToken(L);
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
string_copy(name,L->name,0);
|
|
LookAheadToken(L);
|
|
|
|
switch (L->token) {
|
|
case TLPAR:
|
|
// array
|
|
SkipToken(L);
|
|
NextToken(L);
|
|
if (L->token!=TNUMBER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, name, MVAR, (index_t)L->x, &var);
|
|
if (!addr) return error(R,EVAR);
|
|
NextToken(L);
|
|
if (L->token!=TRPAR) return error(R,ESYNTAX);
|
|
NextToken(L);
|
|
break;
|
|
case TDOLLAR:
|
|
// string variable
|
|
SkipToken(L);
|
|
LookAheadToken(L);
|
|
if (L->token==TLPAR) {
|
|
SkipToken(L);
|
|
NextToken(L);
|
|
if (L->token!=TNUMBER) return error(R,ESYNTAX);
|
|
ix=L->x+1;
|
|
NextToken(L);
|
|
if (L->token!=TRPAR) return error(R,ESYNTAX);
|
|
} else {
|
|
ix=DEFSTRINGLEN+1;
|
|
}
|
|
addr=Allocate(M,R, name, MSTRING, ix, &var);
|
|
CHAR(M,addr)=0;
|
|
if (!addr) return error(R,EVAR);
|
|
NextToken(L);
|
|
break;
|
|
default:
|
|
SkipToken(L);
|
|
#if HAS_FUNC > 0
|
|
addr=Allocate(M,R, name, local?MVARLOC:MVAR, 1, &var);
|
|
#else
|
|
addr=Allocate(M,R, name, MVAR, 1, &var);
|
|
#endif
|
|
if (!addr) return error(R,EVAR);
|
|
#if HAS_FUNC > 0
|
|
if (local) var->data=(number_t)(L->level+(L->fp[L->level]++)*2); // store level and current Lexer fp
|
|
#endif
|
|
break;
|
|
}
|
|
} while (L->token==TNEXTARG);
|
|
break;
|
|
|
|
case TWHILE:
|
|
// F-Stack frame [start address,end address, 'W']
|
|
pc=M->bottom+3+3*number_s;
|
|
CODEADD1A(M,PUSHF,(number_t)pc); // address of loop start (control block)
|
|
pc=M->bottom;
|
|
CODEADD1A(M,PUSHF,0); // address of loop end, filled below
|
|
CODEADD1A(M,PUSHF,(number_t)'W'); // DO frame marker
|
|
|
|
// loop expression
|
|
L->ps=PEXPR;
|
|
NextToken(L); CompileExpr(L, M, R); if (R->error) return;
|
|
CODEADD1A(M,JZ,-2);
|
|
|
|
LookAheadToken(L);
|
|
if (L->token==TDO) SkipToken(L); // syntactic sugar
|
|
|
|
do {
|
|
CompileInstr(L, M, R);
|
|
if (R->error) return;
|
|
} while (L->token!=EOL && L->token!=TBLOCK2);
|
|
if (L->token==TDO) SkipToken(L);
|
|
CODEADD1A(M,JMP,-3);
|
|
|
|
|
|
pc2=M->bottom; // end of loop body
|
|
CODESTORE1A(M,pc,PUSHF,pc2);
|
|
|
|
// clean-up
|
|
CODEADD1I(M,DROPF,3);
|
|
break;
|
|
|
|
case TYIELD:
|
|
CODEADD0(M,YIELD);
|
|
break;
|
|
|
|
#if HAS_LOCK > 0
|
|
case TLOCK:
|
|
case TUNLOCK:
|
|
t=L->token;
|
|
NextToken(L);
|
|
if (L->token==TLPAR) { npar=1; NextToken(L); } else npar=0;
|
|
if (L->token!=TIDENTIFIER) return error(R,ESYNTAX);
|
|
addr=Allocate(M,R, L->name, MANY, 1, &var);
|
|
if (!addr) return error(R,EVAR);
|
|
if (t==TLOCK)
|
|
CODEADD1A(M,LOCK,addr-sizeof(var_t)+number_s+MAXNAMELEN+1)
|
|
else
|
|
CODEADD1A(M,UNLOCK,addr-sizeof(var_t)+number_s+MAXNAMELEN+1);
|
|
if (npar) { NextToken(L); if (L->token==TLPAR) return error(R,ESYNTAX); }
|
|
break;
|
|
#endif
|
|
|
|
case EOL:
|
|
return;
|
|
break;
|
|
default:
|
|
error(R,ESYNTAX);
|
|
break;
|
|
}
|
|
}
|
|
|
|
/*
|
|
Compile code from buffer. Either a chunk incrementally (but syntactically complete) or an entire program.
|
|
The C->S segment is preserved. Only one program can be compiled at one time!
|
|
Unintialized lexer structure must be provided to get lexer information after compilation (e.g., last line).
|
|
*/
|
|
int Compile(lexer_t *L, char *buffer, context_t *c, int runnable /* pstate */) {
|
|
// Setup new lexer
|
|
LexerInit(L);
|
|
LexerSetup(L,buffer);
|
|
if (!c->S) {
|
|
// allocate a dynamic segment (high water) for code compilation, initially empty
|
|
c->S=AllocSegment(c->M);
|
|
}
|
|
c->M->segment=c->S;
|
|
#if HAS_FUNC > 0
|
|
// local variables (if any) are allocated on stack, set stack pointer at the beginning (see below)
|
|
if (c->S->bottom==c->S->top) CODEADD1I(c->M,SETSP,0);
|
|
#endif
|
|
|
|
do {
|
|
CompileInstr(L,c->M,c->R);
|
|
} while (c->R->error==0 && *L->input!=EOL);
|
|
if (c->R->error) return -1;
|
|
if (runnable) {
|
|
// finalize compilation and make code ready for processing
|
|
c->R->state=runnable; // PRUNNING
|
|
if (c->M->data[c->M->bottom-1]!=END) CODEADD0(c->M,END);
|
|
#if HAS_FUNC > 0
|
|
// local variables are allocated on stack, increment stack pointer
|
|
if (L->fp[0]) CODESTORE1I(c->M,0,SETSP,L->fp[0]);
|
|
#endif
|
|
c->S->top=c->M->bottom-1; // update code segment for this task context, freeze this segment (temp. or final)
|
|
// not more needed for compilation
|
|
c->M->segment=NULL;
|
|
// set pc to start of this segment
|
|
c->R->pc=c->S->bottom;
|
|
#if DEBUG > 0
|
|
log(LOGINFO,"Compile: Finished (ntoken=%d). Starting program C[%d]\n",L->ntoken,CONTEXTID(c));
|
|
#endif
|
|
} else {
|
|
c->S->top=c->M->bottom-1; // update code segment for this task context, freeze this segment (temp. or final)
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
|