/*
  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;
}