/* bobcom.c - the bytecode compiler */
/*
        Copyright (c) 1991, by David Michael Betz
        All rights reserved.

        Alterations and additions, 1994, by G.C.Wraith
*/

#include <setjmp.h>
#include <string.h>
#include <stdlib.h>
#include "bob.h"
#include "bobcom.h"

/* partial value structure */
typedef struct pvalue {
#ifdef __STDC__
  int (*fcn)(int,int);
#else
  int (*fcn)();
#endif
  int val;
} PVAL;

/* variable access function codes */
#define LOAD    1
#define STORE   2
#define PUSH    3
#define DUP     4

/* global variables */
int decode=0;           /* flag for decoding functions */
int trace=0;

/* local variables */
static ARGUMENT *arguments;     /* argument list */
static ARGUMENT *temporaries;   /* temporary variable list */
static LITERAL *literals;       /* literal list */
static VALUE methodclass;       /* class of the current method */
static unsigned char *cbuff;    /* code buffer */
static int cptr;                /* code pointer */

/* break/continue stacks */
#define SSIZE   10
static int bstack[SSIZE],*bsp;
static int cstack[SSIZE],*csp;

/* external variables */
extern jmp_buf error_trap;      /* trap for compile errors */
extern VALUE symbols;   /* symbol table */
extern VALUE classes;   /* class table */
extern VALUE *sp;       /* stack pointer */
extern int t_value;     /* token value */
extern float r_value;   /* real token value */
extern char t_token[];  /* token string */

/* forward declarations */
#ifdef __STDC__
static void do_class(void);
static DICT_ENTRY *findmember(CLASS *class,char *name);
static DICT_ENTRY *rfindmember(CLASS *class,char *name);
static void do_function(char *name);
static void do_regular_function(char *name);
static void do_member_function(VALUE *class);
static VECTOR *do_code(char *name,VALUE *class);
static CLASS *get_class(char *name);
static void do_statement(void);
static void do_if(void);
static void do_switch(void);                  /* RISC OS */
static void do_in();                          /* RISC OS */
static int *addbreak(int lbl);
static int rembreak(int *old,int lbl);
static int *addcontinue(int lbl);
static int remcontinue(int *old);
static void do_while(void);
static void do_dowhile(void);
static void do_for(void);
static void do_break(void);
static void do_continue(void);
static void do_block(void);
static void do_return(void);
static void do_test(void);
static void do_expr(void);
static int rvalue(PVAL *pv);
static int chklvalue(PVAL *pv);
static void do_expr1(PVAL *pv);
static void do_expr2(PVAL *pv);
static void do_assignment(PVAL *pv,int op);
static void do_expr3(PVAL *pv);
static void do_expr4(PVAL *pv);
static void do_expr5(PVAL *pv);
static void do_expr6(PVAL *pv);
static void do_expr7(PVAL *pv);
static void do_expr8(PVAL *pv);
static void do_expr9(PVAL *pv);
static void do_expr10(PVAL *pv);
static void do_expr11(PVAL *pv);
static void do_expr12(PVAL *pv);
static void do_expr13(PVAL *pv);
static void do_expr14(PVAL *pv);
static void do_preincrement(PVAL *pv,int op);
static void do_postincrement(PVAL *pv,int op);
static void do_new(PVAL *pv);
static void do_expr15(PVAL *pv);
static void do_primary(PVAL *pv);
static int do_enum(void);
static void do_vect(void);
static void do_call(PVAL *pv);
static void do_send(char *selector,PVAL *pv);
static void do_index(PVAL *pv);
static int get_id_list(ARGUMENT **list,char *term);
static int addargument(ARGUMENT **list,char *name);
static int freelist(ARGUMENT **plist);
static int findarg(char *name);
static int findtmp(char *name);
/* static DICT_ENTRY *finddatamember(char *name); */
static int addliteral(LITERAL **list,LITERAL **pval);
static int freeliterals(LITERAL **plist);
static int frequire(int rtkn);
static int require(int tkn,int rtkn);
static void do_lit_integer(long n);
static void do_lit_real(float x);
static void do_lit_string(char *str);
static int make_lit_string(char *str);
static int make_lit_variable(DICT_ENTRY *sym);
static int findvariable(char *id,PVAL *pv);
static int findclassvariable(CLASS *class,char *name,PVAL *pv);
/* static int code_argument(int fcn,int n); */
/* static int code_temporary(int fcn,int n); */
/* static int code_member(int fcn,int n);  */
/* static int code_variable(int fcn,int n); */
/* static int code_index(int fcn,int n); */
static int code_literal(int n);
static int putcbyte(int b);
static int putcword(int w);
static int fixup(int chn,int val);
static char *copystring(char *str);
/* static char *getmemory(int size); */
#else
CLASS *get_class();
VECTOR *do_code();
char *copystring();
char *getmemory();
#endif

/* init_compiler - initialize the compiler */
int init_compiler(void)
{
    char *calloc();
    literals = NULL;
    set_nil(&methodclass);
    bsp = &bstack[-1];
    csp = &cstack[-1];
    return ((cbuff = (unsigned char *)calloc(1,CMAX)) != NULL);
}

/* mark_compiler - mark compiler variables */
void mark_compiler(void)
{
    LITERAL *lit;
    if (cbuff) {
        for (lit = literals; lit != NULL; lit = lit->lit_next)
            mark(&lit->lit_value);
        mark(&methodclass);
    }
}

/* compile_definitions - compile class or function definitions */
int compile_definitions(int (*getcf)(),void *getcd)
{
    char name[TKNSIZE+1];
    int tkn;

    /* trap errors */
    if (setjmp(error_trap))
        return (FALSE);

    /* initialize */
    init_scanner(getcf,getcd);

    /* process statements until end of file */
    while ((tkn = token()) != T_EOF) {
        switch (tkn) {
        case T_IDENTIFIER:
            strcpy(name,t_token);
            do_function(name);
            break;
        case T_CLASS:
            do_class();
            break;
        default:
            parse_error("Expecting a declaration");
            break;
        }
    }
    return (TRUE);
}

/* do_class - handle class declarations */
static void do_class(void)
{
    ARGUMENT *mvars,*smvars,*fargs,**table,*p;
    char cname[TKNSIZE+1],id[TKNSIZE+1];
    DICT_ENTRY *entry;
    int type,tkn,i;

    /* initialize */
    mvars = smvars = fargs = NULL;
    check(1);
    
    /* get the class name */
    frequire(T_IDENTIFIER);
    strcpy(cname,t_token);
    
    /* get the optional base class */
    if ((tkn = token()) == ':') {
        frequire(T_IDENTIFIER);
        push_class(get_class(t_token));
        if (decode || trace)
          info2("Class '%s', Base class '%s'",
          cname,getcstring(id,sizeof(id),clgetname(sp)));
    }
    else {
        push_nil();
        stoken(tkn);
        if (decode || trace)
            info1("Class '%s'",cname);
    }
    frequire('{');

    /* create the new class object */
    set_class(sp,newclass(cname,sp));
    addentry(&classes,cname,ST_CLASS)->de_value = *sp;

    /* handle each variable declaration */
    while ((tkn = token()) != '}') {

        /* check for static members */
        if ((type = tkn) == T_STATIC)
            tkn = token();

        /* get the first identifier */
        if (tkn != T_IDENTIFIER)
            parse_error("Expecting a member declaration");
        strcpy(id,t_token);

        /* check for a member function declaration */
        if ((tkn = token()) == '(') {
            get_id_list(&fargs,")");
            frequire(')');
            addentry(clgetfunctions(sp),id,
                     type == T_STATIC ? ST_SFUNCTION : ST_FUNCTION);
            freelist(&fargs);
        }

        /* handle data members */
        else {
            table = (type == T_STATIC ? &smvars : &mvars);
            addargument(table,id);
            if (tkn == ',')
                get_id_list(table,";");
            else
                stoken(tkn);
        }           
        frequire(';');
    }

    /* store the member variable names */
    i = (isnil(clgetbase(sp)) ? 0 : clgetsize(clgetbase(sp)));
    for (p = mvars; p != NULL; p = p->arg_next) {
        entry = addentry(clgetmembers(sp),p->arg_name,ST_DATA);
        set_integer(&entry->de_value,i++);
    }
    sp->v.v_class->cl_size = i;
    freelist(&mvars);

    /* store the static member variable names */
    for (p = smvars; p != NULL; p = p->arg_next)
        addentry(clgetmembers(sp),p->arg_name,ST_SDATA);
    freelist(&smvars);
    ++sp;
}

/* findmember - find a class member */
static DICT_ENTRY *findmember(CLASS *class,char *name)
{
    DICT_ENTRY *entry;
    if ((entry = findentry(&class->cl_members,name)) != NULL)
        return (entry);
    return (findentry(&class->cl_functions,name));
}

/* rfindmember - recursive findmember */
static DICT_ENTRY *rfindmember(CLASS *class,char *name)
{
    DICT_ENTRY *entry;
    if ((entry = findmember(class,name)) != NULL)
        return (entry);
    else if (!isnil(&class->cl_base))
        return (rfindmember(claddr(&class->cl_base),name));
    return (NULL);
}

/* do_function - handle function declarations */
static void do_function(char *name)
{
    switch (token()) {
    case '(':
        do_regular_function(name);
        break;
    case T_CC:
        check(1);
        push_class(get_class(name));
        do_member_function(sp);
        ++sp;
        break;
    default:
        parse_error("Expecting a function declaration");
        break;
    }
}

/* do_regular_function - parse a regular function definition */
static void do_regular_function(char *name)
{
    /* enter the function name */
    if (decode || trace) info1("Function '%s'",name);
    check(1);
    push_var(addentry(&symbols,name,ST_SFUNCTION));

    /* compile the body of the function */
    set_bytecode(&sp->v.v_var->de_value,do_code(name,&nil));
    ++sp;

    /* free the argument and temporary symbol lists */
    freelist(&arguments); freelist(&temporaries);
}

/* do_member_function - parse a member function definition */
static void do_member_function(VALUE *class)
{
    char name[TKNSIZE+1],selector[TKNSIZE+1];
    DICT_ENTRY *entry;
    
    /* get the selector */
    frequire(T_IDENTIFIER);
    strcpy(selector,t_token);
    frequire('(');
    getcstring(name,sizeof(name),clgetname(class));
    if (decode || trace) 
        info2("Member function '%s::%s'",name,selector);

    /* make sure the type matches the declaration */
    if ((entry = findmember(claddr(class),selector)) != NULL
    &&  entry->de_type != ST_FUNCTION
    &&  entry->de_type != ST_SFUNCTION)
        parse_error("Illegal redefinition");

    /* compile the code */
    check(1);
    push_var(addentry(clgetfunctions(class),selector,ST_FUNCTION));
    set_bytecode(&sp->v.v_var->de_value,do_code(selector,class));
    ++sp;

    /* free the argument and temporary symbol lists */
    freelist(&arguments); freelist(&temporaries);
}

/* do_code - compile the code part of a function or method */
static VECTOR *do_code(char *name,VALUE *class)
{
    unsigned char *src,*dst;
    int tcnt=0,nlits,tkn,i;
    LITERAL *lit;

    /* initialize */
    arguments = temporaries = NULL;
    cptr = 0;

    /* add the implicit 'this' argument for member functions */
    if (!isnil(class))
        addargument(&arguments,"this");
    methodclass = *class;
    
    /* get the argument list - different syntax for
       RISC OS version
    get_id_list(&arguments,";)");  */
    get_id_list(&arguments,")");

    /* get temporary variables - different syntax for
       RISC OS version
    if ((tkn = token()) == ';') {
        tcnt = get_id_list(&temporaries,")");
        tkn = token();
    }  */
    frequire(')');
    frequire('{');
    if ((tkn = token()) == T_LOCAL ) {
      tcnt = get_id_list(&temporaries,";");
      frequire(';');
       }
    else stoken(tkn);
    /* reserve space for the temporaries */
    if (tcnt > 0) {
        putcbyte(OP_TSPACE);
        putcbyte(tcnt);
    }

    /* store the bytecodes, class and function name as the first literals */
    addliteral(&literals,&lit); /* will become the bytecode string */
    addliteral(&literals,&lit); /* class */
    lit->lit_value = *class;
    make_lit_string(name);      /* function name */

    /* compile the code */
    putcbyte(OP_PUSH);
    do_block();
    putcbyte(OP_RETURN);

    /* count the number of literals */
    for (nlits = 0, lit = literals; lit != NULL; lit = lit->lit_next)
        ++nlits;

    /* build the function */
    check(1);
    push_bytecode(newvector(nlits));
    
    /* create the code string */
    set_string(&literals->lit_value,newstring(cptr));
    src = cbuff;
    dst = (void *)strgetdata(&literals->lit_value);
    while (--cptr >= 0)
        *dst++ = *src++;
    
    /* copy the literals */
    for (i = 0, lit = literals; i < nlits; ++i, lit = lit->lit_next)
        vecsetelement(sp,i,lit->lit_value);
    freeliterals(&literals);

    /* show the generated code */
    if (decode)
        decode_procedure(sp);

    /* return the code object */
    return (vecaddr(sp++));
}

/* get_class - get the class associated with a symbol */
static CLASS *get_class(char *name)
{
    DICT_ENTRY *sym;
    sym = findentry(&classes,name);
    if (sym == NULL || sym->de_value.v_type != DT_CLASS)
        parse_error("Expecting a class name");
    return (claddr(&sym->de_value));
}

/* do_statement - compile a single statement */
static void do_statement(void)
{
    int tkn;
    switch (tkn = token()) {
    case T_IF:          do_if();        break;
    case T_SWITCH:      do_switch();    break;   /* RISC OS */
    case T_IN:          do_in();        break;   /* RISC OS */
    case T_WHILE:       do_while();     break;
    case T_DO:          do_dowhile();   break;
    case T_FOR:         do_for();       break;
    case T_BREAK:       do_break();     break;
    case T_CONTINUE:    do_continue();  break;
    case T_RETURN:      do_return();    break;
    case '{':           do_block();     break;
    case ';':           ;               break;
    default:            stoken(tkn);
                        do_expr();
                        frequire(';');  break;
    }
}

/* do_if - compile the IF/ELSE expression */
static void do_if(void)
{
    int tkn,nxt,end;

    /* compile the test expression */
    do_test();

    /* skip around the 'then' clause if the expression is false */
    putcbyte(OP_BRF);
    nxt = putcword(0);

    /* compile the 'then' clause */
    do_statement();

    /* compile the 'else' clause */
    if ((tkn = token()) == T_ELSE) {
        putcbyte(OP_BR);
        end = putcword(0);
        fixup(nxt,cptr);
        do_statement();
        nxt = end;
    }
    else
        stoken(tkn);

    /* handle the end of the statement */
    fixup(nxt,cptr);
}

/* do_switch added in RISC OS version */
static void do_switch(void)
{
 int tkn, nxt, end, leap;
 nxt = 0;
 end = 0;
 leap = 0;
 do_test();
 frequire('{');
 putcbyte(OP_PUSH);
 while ((tkn = token()) == T_CASE)
   {
    if (nxt) fixup(nxt,cptr);
    putcbyte(OP_DROP);
    putcbyte(OP_DUP);
    putcbyte(OP_PUSH);
    do_expr();
    frequire(':');
    putcbyte(OP_EQ);
    putcbyte(OP_BRF);
    nxt = putcword(0);
    tkn = token();
    while (tkn != T_CASE && tkn != T_DEFAULT && tkn != '}')
      {
       if (leap) leap = fixup(leap,cptr);
       switch (tkn)
         {
           case T_BREAK:
             putcbyte(OP_BR);
             end = putcword(end);
             frequire(';');
             break;
           default:
             stoken(tkn);
             do_statement();
             break;
         }
       tkn = token();
      }
   putcbyte(OP_BR);
   leap = putcword(leap);
   stoken(tkn);
   }
 if (nxt) nxt = fixup(nxt,cptr);
 if (tkn  == T_DEFAULT)
    {
     frequire(':');
     if (leap) leap = fixup(leap,cptr);
     while ((tkn = token()) != '}')
       switch (tkn)
         {
           case T_BREAK:
             putcbyte(OP_BR);
             end = putcword(end);
             frequire(';');
             break;
           default:
             stoken(tkn);
             do_statement();
             break;
         }
     stoken(tkn);
    }
 else
    stoken(tkn);
 if (end) fixup(end,cptr);
 if (leap) fixup(leap,cptr);
 if (nxt) fixup(nxt,cptr);
 putcbyte(OP_DROP);
 frequire('}');
}

/* do_in - do in (..) put { .... } RISC OS version */
static void do_in(void)
{
 int tkn;
 do_expr();
 frequire(T_PUT);
 frequire('{');
 putcbyte(OP_DUP);
 putcbyte(OP_ADR);
 putcbyte(OP_PUSH);
 while ((tkn = token()) != '}')
   {
    stoken(tkn);
    do_expr();
    putcbyte(OP_PUTNEXT);
    frequire(';');
   }
 putcbyte(OP_DROP);
 putcbyte(OP_DROP);
}

/* addbreak - add a break level to the stack */
static int *addbreak(int lbl)
{
    int *old=bsp;
    if (++bsp < &bstack[SSIZE])
        *bsp = lbl;
    else
        parse_error("Too many nested loops");
    return (old);
}

/* rembreak - remove a break level from the stack */
static int rembreak(int *old,int lbl)
{
   return (bsp > old ? *bsp-- : lbl);
}

/* addcontinue - add a continue level to the stack */
static int *addcontinue(int lbl)
{
    int *old=csp;
    if (++csp < &cstack[SSIZE])
        *csp = lbl;
    else
        parse_error("Too many nested loops");
    return (old);
}

/* remcontinue - remove a continue level from the stack */
static int remcontinue(int *old)
{
    csp = old;
    return(0);
}

/* do_while - compile the WHILE expression */
static void do_while(void)
{
    int nxt,end,*ob,*oc;

    /* compile the test expression */
    nxt = cptr;
    do_test();

    /* skip around the loop body if the expression is false */
    putcbyte(OP_BRF);
    end = putcword(0);

    /* compile the loop body */
    ob = addbreak(end);
    oc = addcontinue(nxt);
    do_statement();
    end = rembreak(ob,end);
    remcontinue(oc);

    /* branch back to the start of the loop */
    putcbyte(OP_BR);
    putcword(nxt);

    /* handle the end of the statement */
    fixup(end,cptr);
}

/* do_dowhile - compile the DO/WHILE expression */
static void do_dowhile(void)
{
    int nxt,end=0,*ob,*oc, endtok;

    /* remember the start of the loop */
    nxt = cptr;

    /* compile the loop body */
    ob = addbreak(0);
    oc = addcontinue(nxt);
    do_statement();
    end = rembreak(ob,end);
    remcontinue(oc);

    /* compile the test expression -- RISCOS version
    frequire(T_WHILE); */
    if ((endtok = token())!=T_WHILE && endtok != T_UNTIL)
       error0("Expecting while or until\n");
    do_test();
    frequire(';');

    /* branch to the top */
    switch (endtok)
    {
     case T_WHILE :
        putcbyte(OP_BRT);
        break;
     case T_UNTIL :
        putcbyte(OP_BRF);
        break;
    }
    putcword(nxt);

    /* handle the end of the statement */
    fixup(end,cptr);
}

/* do_for - compile the FOR statement */
static void do_for(void)
{
    int tkn,nxt,end,body,update,*ob,*oc;

    /* compile the initialization expression */
    frequire('(');
    if ((tkn = token()) != ';') {
        stoken(tkn);
        do_expr();
        frequire(';');
    }

    /* compile the test expression */
    nxt = cptr;
    if ((tkn = token()) != ';') {
        stoken(tkn);
        do_expr();
        frequire(';');
    }

    /* branch to the loop body if the expression is true */
    putcbyte(OP_BRT);
    body = putcword(0);

    /* branch to the end if the expression is false */
    putcbyte(OP_BR);
    end = putcword(0);

    /* compile the update expression */
    update = cptr;
    if ((tkn = token()) != ')') {
        stoken(tkn);
        do_expr();
        frequire(')');
    }

    /* branch back to the test code */
    putcbyte(OP_BR);
    putcword(nxt);

    /* compile the loop body */
    fixup(body,cptr);
    ob = addbreak(end);
    oc = addcontinue(update);
    do_statement();
    end = rembreak(ob,end);
    remcontinue(oc);

    /* branch back to the update code */
    putcbyte(OP_BR);
    putcword(update);

    /* handle the end of the statement */
    fixup(end,cptr);
}

/* do_break - compile the BREAK statement */
static void do_break(void)
{
    if (bsp >= bstack) {
        putcbyte(OP_BR);
        *bsp = putcword(*bsp);
    }
    else
        parse_error("Break outside of loop");
}

/* do_continue - compile the CONTINUE statement */
static void do_continue(void)
{
    if (csp >= cstack) {
        putcbyte(OP_BR);
        putcword(*csp);
    }
    else
        parse_error("Continue outside of loop");
}

/* do_block - compile the {} expression */
static void do_block(void)
{
    int tkn;
    if ((tkn = token()) != '}') {
        do {
            stoken(tkn);
            do_statement();
        } while ((tkn = token()) != '}');
    }
    else
        putcbyte(OP_NIL);
}

/* do_return - handle the RETURN expression */
static void do_return(void)
{
    do_expr();
    frequire(';');
    putcbyte(OP_RETURN);
}

/* do_test - compile a test expression */
static void do_test(void)
{
    frequire('(');
    do_expr();
    frequire(')');
}

/* do_expr - parse an expression */
static void do_expr(void)
{
    PVAL pv;
    do_expr1(&pv);
    rvalue(&pv);
}

/* rvalue - get the rvalue of a partial expression */
static int rvalue(PVAL *pv)
{
    if (pv->fcn) {
        (*pv->fcn)(LOAD,pv->val);
        pv->fcn = NULL;
    }
 return(0);
}

/* chklvalue - make sure we've got an lvalue */
static int chklvalue(PVAL *pv)
{
    if (pv->fcn == NULL)
        parse_error("Expecting an lvalue");
    return(0);
}

/* do_expr1 - handle the ',' operator */
static void do_expr1(PVAL *pv)
{
    int tkn;
    do_expr2(pv);
    while ((tkn = token()) == ',') {
        rvalue(pv);
        do_expr1(pv); rvalue(pv);
    }
    stoken(tkn);
}

/* do_expr2 - handle the assignment operators */
static void do_expr2(PVAL *pv)
{
    int tkn;
    PVAL rhs;
    do_expr3(pv);
    while ((tkn = token()) == '='
    ||     tkn == T_ADDEQ || tkn == T_SUBEQ
    ||     tkn == T_MULEQ || tkn == T_DIVEQ || tkn == T_REMEQ
    ||     tkn == T_ANDEQ || tkn == T_OREQ  || tkn == T_XOREQ
    ||     tkn == T_SHLEQ || tkn == T_SHREQ) {
        chklvalue(pv);
        switch (tkn) {
        case '=':
            (*pv->fcn)(PUSH,0);
            do_expr1(&rhs); rvalue(&rhs);
            (*pv->fcn)(STORE,pv->val);
            break;
        case T_ADDEQ:       do_assignment(pv,OP_ADD);       break;
        case T_SUBEQ:       do_assignment(pv,OP_SUB);       break;
        case T_MULEQ:       do_assignment(pv,OP_MUL);       break;
        case T_DIVEQ:       do_assignment(pv,OP_DIV);       break;
        case T_REMEQ:       do_assignment(pv,OP_REM);       break;
        case T_ANDEQ:       do_assignment(pv,OP_BAND);      break;
        case T_OREQ:        do_assignment(pv,OP_BOR);       break;
        case T_XOREQ:       do_assignment(pv,OP_XOR);       break;
        case T_SHLEQ:       do_assignment(pv,OP_SHL);       break;
        case T_SHREQ:       do_assignment(pv,OP_SHR);       break;
        }
        pv->fcn = NULL;
    }
    stoken(tkn);
}

/* do_assignment - handle assignment operations */
static void do_assignment(PVAL *pv,int op)
{
    PVAL rhs;
    (*pv->fcn)(DUP,0);
    (*pv->fcn)(LOAD,pv->val);
    putcbyte(OP_PUSH);
    do_expr1(&rhs); rvalue(&rhs);
    putcbyte(op);
    (*pv->fcn)(STORE,pv->val);
}

/* do_expr3 - handle the '?:' operator */
static void do_expr3(PVAL *pv)
{
    int tkn,nxt,end;
    do_expr4(pv);
    while ((tkn = token()) == '?') {
        rvalue(pv);
        putcbyte(OP_BRF);
        nxt = putcword(0);
        do_expr1(pv); rvalue(pv);
        frequire(':');
        putcbyte(OP_BR);
        end = putcword(0);
        fixup(nxt,cptr);
        do_expr1(pv); rvalue(pv);
        fixup(end,cptr);
    }
    stoken(tkn);
}

/* do_expr4 - handle the '||' operator */
static void do_expr4(PVAL *pv)
{
    int tkn,end=0;
    do_expr5(pv);
    while ((tkn = token()) == T_OR) {
        rvalue(pv);
        putcbyte(OP_BRT);
        end = putcword(end);
        do_expr5(pv); rvalue(pv);
    }
    fixup(end,cptr);
    stoken(tkn);
}

/* do_expr5 - handle the '&&' operator */
static void do_expr5(PVAL *pv)
{
    int tkn,end=0;
    do_expr6(pv);
    while ((tkn = token()) == T_AND) {
        rvalue(pv);
        putcbyte(OP_BRF);
        end = putcword(end);
        do_expr6(pv); rvalue(pv);
    }
    fixup(end,cptr);
    stoken(tkn);
}

/* do_expr6 - handle the '|' operator */
static void do_expr6(PVAL *pv)
{
    int tkn;
    do_expr7(pv);
    while ((tkn = token()) == '|') {
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr7(pv); rvalue(pv);
        putcbyte(OP_BOR);
    }
    stoken(tkn);
}

/* do_expr7 - handle the '^' operator */
static void do_expr7(PVAL *pv)
{
    int tkn;
    do_expr8(pv);
    while ((tkn = token()) == '^') {
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr8(pv); rvalue(pv);
        putcbyte(OP_XOR);
    }
    stoken(tkn);
}

/* do_expr8 - handle the '&' operator */
static void do_expr8(PVAL *pv)
{
    int tkn;
    do_expr9(pv);
    while ((tkn = token()) == '&') {
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr9(pv); rvalue(pv);
        putcbyte(OP_BAND);
    }
    stoken(tkn);
}

/* do_expr9 - handle the '==' and '!=' operators */
static void do_expr9(PVAL *pv)
{
    int tkn,op;
    do_expr10(pv);
    while ((tkn = token()) == T_EQ || tkn == T_NE) {
        switch (tkn) {
        case T_EQ: op = OP_EQ; break;
        case T_NE: op = OP_NE; break;
        }
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr10(pv); rvalue(pv);
        putcbyte(op);
    }
    stoken(tkn);
}

/* do_expr10 - handle the '<', '<=', '>=' and '>' operators */
static void do_expr10(PVAL *pv)
{
    int tkn,op;
    do_expr11(pv);
    while ((tkn = token()) == '<' || tkn == T_LE || tkn == T_GE || tkn == '>') {
        switch (tkn) {
        case '<':  op = OP_LT; break;
        case T_LE: op = OP_LE; break;
        case T_GE: op = OP_GE; break;
        case '>':  op = OP_GT; break;
        }
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr11(pv); rvalue(pv);
        putcbyte(op);
    }
    stoken(tkn);
}

/* do_expr11 - handle the '<<' and '>>' operators */
static void do_expr11(PVAL *pv)
{
    int tkn,op;
    do_expr12(pv);
    while ((tkn = token()) == T_SHL || tkn == T_SHR) {
        switch (tkn) {
        case T_SHL: op = OP_SHL; break;
        case T_SHR: op = OP_SHR; break;
        }
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr12(pv); rvalue(pv);
        putcbyte(op);
    }
    stoken(tkn);
}

/* do_expr12 - handle the '+' and '-' operators */
static void do_expr12(PVAL *pv)
{
    int tkn,op;
    do_expr13(pv);
    while ((tkn = token()) == '+' || tkn == '-') {
        switch (tkn) {
        case '+': op = OP_ADD; break;
        case '-': op = OP_SUB; break;
        }
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr13(pv); rvalue(pv);
        putcbyte(op);
    }
    stoken(tkn);
}

/* do_expr13 - handle the '*' and '/' operators */
static void do_expr13(PVAL *pv)
{
    int tkn,op;
    do_expr14(pv);
    while ((tkn = token()) == '*' || tkn == '/' || tkn == '%') {
        switch (tkn) {
        case '*': op = OP_MUL; break;
        case '/': op = OP_DIV; break;
        case '%': op = OP_REM; break;
        }
        rvalue(pv);
        putcbyte(OP_PUSH);
        do_expr14(pv); rvalue(pv);
        putcbyte(op);
    }
    stoken(tkn);
}

/* do_expr14 - handle unary operators */
static void do_expr14(PVAL *pv)
{
    int tkn;
    switch (tkn = token()) {
    case '-':
        do_expr15(pv); rvalue(pv);
        putcbyte(OP_NEG);
        break;
    case '!':
        do_expr15(pv); rvalue(pv);
        putcbyte(OP_NOT);
        break;
    case '~':
        do_expr15(pv); rvalue(pv);
        putcbyte(OP_BNOT);
        break;
    case T_INC:
        do_preincrement(pv,OP_INC);
        break;
    case T_DEC:
        do_preincrement(pv,OP_DEC);
        break;
    case T_NEW:
        do_new(pv);
        break;
    default:
        stoken(tkn);
        do_expr15(pv);
        return;
    }
}

/* do_preincrement - handle prefix '++' and '--' */
static void do_preincrement(PVAL *pv,int op)
{
    do_expr15(pv);
    chklvalue(pv);
    (*pv->fcn)(DUP,0);
    (*pv->fcn)(LOAD,pv->val);
    putcbyte(op);
    (*pv->fcn)(STORE,pv->val);
    pv->fcn = NULL;
}

/* do_postincrement - handle postfix '++' and '--' */
static void do_postincrement(PVAL *pv,int op)
{
    chklvalue(pv);
    (*pv->fcn)(DUP,0);
    (*pv->fcn)(LOAD,pv->val);
    putcbyte(op);
    (*pv->fcn)(STORE,pv->val);
    putcbyte(op == OP_INC ? OP_DEC : OP_INC);
    pv->fcn = NULL;
}

/* do_new - handle the 'new' operator */
static void do_new(PVAL *pv)
{
    char selector[TKNSIZE+1];
    LITERAL *lit;
    CLASS *class;

    frequire(T_IDENTIFIER);
    strcpy(selector,t_token);

    class = get_class(selector);

    code_literal(addliteral(&literals,&lit));
    set_class(&lit->lit_value,class);

    putcbyte(OP_NEW);
    pv->fcn = NULL;
    
    do_send(selector,pv);
}

/* do_expr15 - handle function calls */
static void do_expr15(PVAL *pv)
{
    char selector[TKNSIZE+1];
    int tkn;
    do_primary(pv);
    while ((tkn = token()) == '('
    ||     tkn == '['
    ||     tkn == T_MEMREF
    ||     tkn == T_INC
    ||     tkn == T_DEC
          )
        switch (tkn) {
        case '(':
            do_call(pv);
            break;
        case '[':
            do_index(pv);
            break;
        case T_MEMREF:
            frequire(T_IDENTIFIER);
            strcpy(selector,t_token);
            do_send(selector,pv);
            break;
        case T_INC:
            do_postincrement(pv,OP_INC);
            break;
        case T_DEC:
            do_postincrement(pv,OP_DEC);
            break;
        }
    stoken(tkn);
}

/* do_primary - parse a primary expression and unary operators */
static void do_primary(PVAL *pv)
{
    char id[TKNSIZE+1];
    CLASS *class;
    int tkn;
    switch (token()) {
    case '(':
        do_expr1(pv);
        frequire(')');
        break;
    case T_NUMBER:
        do_lit_integer((long)t_value);
        pv->fcn = NULL;
        break;
    case T_REAL:
        do_lit_real(r_value);
        pv->fcn = NULL;
        break;
    case T_STRING:
        do_lit_string(t_token);
        pv->fcn = NULL;
        break;
    case T_NIL:
        putcbyte(OP_NIL);
        pv->fcn = NULL;
        break;
    case T_IDENTIFIER:
        strcpy(id,t_token);
        if ((tkn = token()) == T_CC) {
            class = get_class(id);
            frequire(T_IDENTIFIER);
            if (!findclassvariable(class,t_token,pv))
                parse_error("Not a class member");
        }
        else {
            stoken(tkn);
            findvariable(id,pv);
        }
        break;
    case T_VECTOR:
        frequire('{');
        do_vect();
        pv->fcn = NULL;
        break;
    case T_ENUM:
        frequire('{');
        do_lit_integer(do_enum());
        pv->fcn = NULL;
        break;
    default:
        parse_error("Expecting a primary expression");
        break;
    }
}

/* enumerate a list of variables */
int do_enum(void)
{
 DICT_ENTRY *sym;
 int tkn,cnt=0;
 tkn = token();
 if (tkn != '}')
 {
  stoken(tkn);
  do {
      frequire(T_IDENTIFIER);
      sym = addentry(&symbols,t_token,ST_DATA);
      set_integer(&sym->de_value,cnt++);
     } while ((tkn = token()) == ',');
  stoken(tkn);
  frequire('}');
 }
 return (cnt);
}

/* get a vector */
static void do_vect(void)
{
 int n, tkn;
 n = 1;
 do_expr();
 frequire(';');
 while ((tkn = token()) != '}')
 {
  stoken(tkn);
  n++;
  putcbyte(OP_PUSH);
  do_expr();
  frequire(';');
 }
 putcbyte(OP_VECT);
 putcbyte(n);
}
 
/* do_call - compile a function call */
static void do_call(PVAL *pv)
{
    int tkn,n=0;
    
    /* get the value of the function */
    rvalue(pv);

    /* compile each argument expression */
    if ((tkn = token()) != ')') {
        stoken(tkn);
        do {
            putcbyte(OP_PUSH);
            do_expr2(pv); rvalue(pv);
            ++n;
        } while ((tkn = token()) == ',');
    }
    require(tkn,')');
    putcbyte(OP_CALL);
    putcbyte(n);

    /* we've got an rvalue now */
    pv->fcn = NULL;
}

/* do_send - compile a message sending expression */
static void do_send(char *selector,PVAL *pv)
{
    LITERAL *lit;
    int tkn,n=1;
    
    /* get the receiver value */
    rvalue(pv);

    /* generate code to push the selector */
    putcbyte(OP_PUSH);
    code_literal(addliteral(&literals,&lit));
    set_string(&lit->lit_value,makestring(selector));

    /* compile the argument list */
    frequire('(');
    if ((tkn = token()) != ')') {
        stoken(tkn);
        do {
            putcbyte(OP_PUSH);
            do_expr2(pv); rvalue(pv);
            ++n;
        } while ((tkn = token()) == ',');
    }
    require(tkn,')');

    /* send the message */
    putcbyte(OP_SEND);
    putcbyte(n);

    /* we've got an rvalue now */
    pv->fcn = NULL;
}

/* do_index - compile an indexing operation */
static void do_index(PVAL *pv)
{
    int code_index();
    rvalue(pv);
    putcbyte(OP_PUSH);
    do_expr();
    frequire(']');
    pv->fcn = code_index;
}


/* get_id_list - get a comma separated list of identifiers */
static int get_id_list(ARGUMENT **list,char *term)
{
    char *strchr();
    int tkn,cnt=0;
    tkn = token();
    if (!strchr(term,tkn)) {
        stoken(tkn);
        do {
            frequire(T_IDENTIFIER);
            addargument(list,t_token);
            ++cnt;
        } while ((tkn = token()) == ',');
    }
    stoken(tkn);
    return (cnt);
}

/* addargument - add a formal argument */
static int addargument(ARGUMENT **list,char *name)
{
    ARGUMENT *arg;
    arg = (ARGUMENT *)getmemory(sizeof(ARGUMENT));
    arg->arg_name = copystring(name);
    arg->arg_next = *list;
    *list = arg;
    return(0);
}

/* freelist - free a list of arguments or temporaries */
static int freelist(ARGUMENT **plist)
{
    ARGUMENT *this,*next;
    for (this = *plist, *plist = NULL; this != NULL; this = next) {
        next = this->arg_next;
        free(this->arg_name);
        free((char *)this);
    }
 return(0);
}

/* findarg - find an argument offset */
static int findarg(char *name)
{
    ARGUMENT *arg;
    int n;
    for (n = 0, arg = arguments; arg; n++, arg = arg->arg_next)
        if (strcmp(name,arg->arg_name) == 0)
            return (n);
    return (-1);
}

/* findtmp - find a temporary variable offset */
static int findtmp(char *name)
{
    ARGUMENT *tmp;
    int n;
    for (n = 0, tmp = temporaries; tmp; n++, tmp = tmp->arg_next)
        if (strcmp(name,tmp->arg_name) == 0)
            return (n);
    return (-1);
}

/* finddatamember - find a class data member */
static DICT_ENTRY *finddatamember(char *name)
{
    DICT_ENTRY *entry;
    VALUE *class;
    if (!isnil(class)) {
        class = &methodclass;
        do {
            if ((entry = findentry(clgetmembers(class),name)) != NULL)
                return (entry);
            class = clgetbase(class);
        } while (!isnil(class));
    }
    return (NULL);
}

/* addliteral - add a literal */
static int addliteral(LITERAL **list,LITERAL **pval)
{
    LITERAL **plit,*lit;
    int n=0;
    for (plit = list; (lit = *plit) != NULL; plit = &lit->lit_next)
        ++n;
    lit = (LITERAL *)getmemory(sizeof(LITERAL));
    set_nil(&lit->lit_value);
    lit->lit_next = NULL;
    *pval = *plit = lit;
    return (n);
}

/* freeliterals - free a list of literals */
static int freeliterals(LITERAL **plist)
{
    LITERAL *this,*next;
    for (this = *plist, *plist = NULL; this != NULL; this = next) {
        next = this->lit_next;
        free((char *)this);
    }
 return(0);
}

/* frequire - fetch a token and check it */
static int frequire(int rtkn)
{
    require(token(),rtkn);
    return(0);
}

/* require - check for a required token */
static int require(int tkn,int rtkn)
{
    char msg[100],tknbuf[100],*tkn_name();
    if (tkn != rtkn) {
        strcpy(tknbuf,tkn_name(rtkn));
        sprintf(msg,"Expecting '%s', found '%s'",tknbuf,tkn_name(tkn));
        parse_error(msg);
    }
 return(0);
}

/* do_lit_integer - compile a literal integer */
static void do_lit_integer(long n)
{
    LITERAL *lit;
    code_literal(addliteral(&literals,&lit));
    set_integer(&lit->lit_value,n);
}

/* do_lit_real - compile a literal real */
static void do_lit_real(float x)
{
    LITERAL *lit;
    code_literal(addliteral(&literals,&lit));
    set_real(&lit->lit_value,x);
}  

/* do_lit_string - compile a literal string */
static void do_lit_string(char *str)
{
    code_literal(make_lit_string(str));
}

/* make_lit_string - make a literal string */
static int make_lit_string(char *str)
{
    LITERAL *lit;
    int n;
    n = addliteral(&literals,&lit);
    set_string(&lit->lit_value,makestring(str));
    return (n);
}

/* make_lit_variable - make a literal reference to a variable */
static int make_lit_variable(DICT_ENTRY *sym)
{
    LITERAL *lit;
    int n;
    n = addliteral(&literals,&lit);
    set_var(&lit->lit_value,sym);
    return (n);
}

/* findvariable - find a variable */
static int findvariable(char *id,PVAL *pv)
{    
    int code_argument(),code_temporary(),code_variable();
    int n;
    if ((n = findarg(id)) >= 0) {
        pv->fcn = code_argument;
        pv->val = n;
    }
    else if ((n = findtmp(id)) >= 0) {
        pv->fcn = code_temporary;
        pv->val = n;
    }
    else if (isnil(&methodclass)
          || !findclassvariable(claddr(&methodclass),id,pv)) {
        pv->fcn = code_variable;
        pv->val = make_lit_variable(addentry(&symbols,id,ST_SDATA));
    }
 return(0);
}

/* findclassvariable - find a class member variable */
static int findclassvariable(CLASS *class,char *name,PVAL *pv)
{
    int code_member(),code_variable();
    DICT_ENTRY *entry;
    if ((entry = rfindmember(class,name)) == NULL)
        return (FALSE);
    switch (entry->de_type) {
    case ST_DATA:
        pv->fcn = code_member;
        pv->val = entry->de_value.v.v_integer;
        break;
    case ST_SDATA:
        pv->fcn = code_variable;
        pv->val = make_lit_variable(entry);
        break;
    case ST_FUNCTION:
        findvariable("this",pv);
        do_send(name,pv);
        break;
    case ST_SFUNCTION:
        code_variable(LOAD,make_lit_variable(entry));
        pv->fcn = NULL;
        break;
    }
    return (TRUE);
}

/* code_argument - compile an argument reference */
static int code_argument(int fcn,int n)
{
    switch (fcn) {
    case LOAD:  putcbyte(OP_AREF); putcbyte(n); break;
    case STORE: putcbyte(OP_ASET); putcbyte(n); break;
    }
 return(0);
}

/* code_temporary - compile a temporary variable reference */
static int code_temporary(int fcn,int n)
{
    switch (fcn) {
    case LOAD:  putcbyte(OP_TREF); putcbyte(n); break;
    case STORE: putcbyte(OP_TSET); putcbyte(n); break;
    }
 return(0);
}

/* code_member - compile a data member reference */
static int code_member(int fcn,int n)
{
    switch (fcn) {
    case LOAD:  putcbyte(OP_MREF); putcbyte(n); break;
    case STORE: putcbyte(OP_MSET); putcbyte(n); break;
    }
 return(0);
}

/* code_variable - compile a variable reference */
static int code_variable(int fcn,int n)
{
    switch (fcn) {
    case LOAD:  putcbyte(OP_REF); putcbyte(n); break;
    case STORE: putcbyte(OP_SET); putcbyte(n); break;
    }
 return(0);
}

/* code_index - compile an indexed reference */
static int code_index(int fcn,int n)
{
    switch (fcn) {
    case LOAD:  putcbyte(OP_VREF); break;
    case STORE: putcbyte(OP_VSET); break;
    case PUSH:  putcbyte(OP_PUSH); break;
    case DUP:   putcbyte(OP_DUP2); break;
    }
 return(0);
}

/* code_literal - compile a literal reference */
static int code_literal(int n)
{
    putcbyte(OP_LIT);
    putcbyte(n);
    return(0);
}

/* putcbyte - put a code byte into data space */
static int putcbyte(int b)
{
    if (cptr >= CMAX)
        parse_error("Insufficient code space");
    cbuff[cptr] = b;
    return (cptr++);
}

/* putcword - put a code word into data space */
static int putcword(int w)
{
    putcbyte(w);
    putcbyte(w >> 8);
    return (cptr-2);
}

/* fixup - fixup a reference chain */
static int fixup(int chn,int val)
{
    int hval,nxt;
    for (hval = val >> 8; chn != 0; chn = nxt) {
        nxt = (cbuff[chn] & 0xFF) | (cbuff[chn+1] << 8);
        cbuff[chn] = val;
        cbuff[chn+1] = hval;
    }
 return(0);
}

/* copystring - make a copy of a string */
static char *copystring(char *str)
{
    char *val;
    val = getmemory(strlen(str)+1);
    strcpy(val,str);
    return (val);
}

/* getmemory - allocate memory and complain if there isn't enough */
char *getmemory(int size)
{
    char *calloc(),*val;
    if ((val = calloc(1,size)) == NULL)
        error0("Insufficient memory");
    return (val);
}
