/* ------------------------------------------------------------------------- */
/*   "express" :  The expression evaluator                                   */
/*                                                                           */
/*   Part of Inform release 5                                                */
/*                                                                           */
/* ------------------------------------------------------------------------- */

#include "header.h"

int sys_functions[16];

extern int replace_sf(char *b)
{   int x=-1;
    word(b,2);
    On_("parent")  x=0;
    On_("sibling") x=1;
    On_("younger") x=2;
    On_("child")   x=3;
    On_("eldest")  x=4;
    On_("random")  x=5;
    On_("prop_len") x=6;
    On_("prop_addr") x=7;
    On_("prop")    x=8;
    On_("children") x=9;
    On_("youngest") x=10;
    On_("elder") x=11;
    On_("indirect") x=12;
    if (x==-1) return(0);
    sys_functions[x]=1;
    return(1);
}

/* ------------------------------------------------------------------------- */
/*   Definition of expression tree branch                                    */
/* ------------------------------------------------------------------------- */

typedef struct treenode {
    int up;                     /* Node above                                */
    int word;                   /* Token number in source line               */
    int type;                   /* Type of node (there are eight: see above) */
    int priority;               /* Eg, + has a low priority, * a higher one  */
    int label_number;           /* For code blocks in && and || expressions  */
    int yes_label;              /* Condition true                            */
    int no_label;               /* Condition false                           */
    int arity;                  /* Number of branches expected               */
    int b[MAX_ARITY];           /* Nodes below (the branches)...             */
    int branches_made;          /* ...from 0 up to this-1                    */
    char *op;                   /* Name of opcode to achieve this operation  */
} treenode;

#ifndef ALLOCATE_BIG_ARRAYS
  static treenode   tree[MAX_EXPRESSION_NODES];
#else
  static treenode   *tree;
#endif

extern void express_allocate_arrays(void)
{
#ifdef ALLOCATE_BIG_ARRAYS
    tree      = my_calloc(sizeof(treenode),   MAX_EXPRESSION_NODES,
                "expression tree");
#endif
}

extern void express_free_arrays(void)
{   
#ifdef ALLOCATE_BIG_ARRAYS
    my_free(&tree, "expression tree");
#endif
}

/* ------------------------------------------------------------------------- */
/*   Compiler expression and assignment evaluator                            */
/* ------------------------------------------------------------------------- */
/*                                                                           */
/*   This is easily the most complicated algorithm in Inform, for two        */
/*   reasons - firstly, because I invented it in a hurry and know absolutely */
/*   nothing about compiler theory, and second, because it tries to avoid    */
/*   recursion which uses the C stack.  (Some machines to which Inform has   */
/*   been ported have had problems with the size of the C stack.)            */
/*                                                                           */
/*   The code generator is also complicated by some awkward features of the  */
/*   Z-machine: for instance, the safe way to extract property lengths is    */
/*   tricky to get right.  Anyway, enough excuses:                           */
/*                                                                           */
/*   The algorithm first makes a tree out of the expression and then         */
/*   clears it off again by clipping off nodes and stacking up corresponding */
/*   assembly lines.  This needs to be in the right order, since the stack   */
/*   can't very conveniently be re-ordered.                                  */
/*                                                                           */
/*   The algorithm is iterative rather than recursive.  In the first phase,  */
/*   we imagine a tree gradually growing as a dryad scampers over it.  She   */
/*   is either resting on a leaf already grown, or else hovering in midair   */
/*   over the space where one will grow.  Every so often she casts an easy   */
/*   spell to grow a leaf where she is, or a more powerful one to grow her   */
/*   leaf into a branch, and she then clambers along or down.                */
/*                                                                           */
/*   The dryad is also sometimes awaiting a comma, since she knows that the  */
/*   line 45+1, ... ends with the comma, whereas i=fn(j,k) does not.  Sadly  */
/*   she can get distracted while waiting, for instance in the expression    */
/*   (after reading j) i=fn(j+5*(l+1),2), but being conscientious she ties   */
/*   her veil where she was so as to be able to find the place again later.  */
/*                                                                           */
/*   To follow her movements, try Informing with full expression tracing on  */
/*   (using "etrace full"): to look simply at the tree she grows, and the    */
/*   code it results in, try just "etrace".                                  */
/*                                                                           */
/*   The main data structure (treenode) is commented at the top of the file. */
/*   (Most of the variables have been more sensibly named since early        */
/*   releases: in particular now you can't see the woods[] for the tree[].)  */
/* ------------------------------------------------------------------------- */

#define ROOT_NODE    -4
#define BLANK_NODE   -3
#define CDONE_NODE   -2
#define SP_NODE      -1
#define LEAF_NODE     0
#define STORE_NODE    1
#define ARITH_NODE    2
#define FCALL_NODE    3
#define COND_NODE     4
#define NCOND_NODE    5
#define LOGICAND_NODE 6
#define LOGICOR_NODE  7
#define OR_NODE       8
#define ALTERA_NODE   9
#define ALTERB_NODE  10

static int tree_size, dryad, resting, comma_mode, dryad_veil=-1,
           sofar_empty;

/* ------------------------------------------------------------------------- */
/*   Pretty printing (for diagnostics)                                       */
/* ------------------------------------------------------------------------- */

static void show_leaf(int ln, int depth)
{   char sl_buffer[100];
    int j;
    for (j=0; j<2*depth+2; j++) printf(" ");
    if (ln==-1) { printf("..\n"); return; }
    else if (etrace_mode==1) printf("%02d ",ln);
    switch(tree[ln].type)
    {   case ROOT_NODE:  printf("<root>"); break;
        case BLANK_NODE: printf("<blank>"); break;
        case CDONE_NODE: printf("<condition done>"); break;
        case SP_NODE:    printf("<sp>"); break;
        case LEAF_NODE:  word(sl_buffer,tree[ln].word);
                         printf("%s",sl_buffer); break;
        default:         printf("%s",tree[ln].op); break;
    }
    if (etrace_mode==1)
    {   if (tree[ln].priority!=0)
        { printf(" (%d)",tree[ln].priority); }
        if (tree[ln].type>=STORE_NODE)
        {   switch(tree[ln].type)
            {   case STORE_NODE:    printf(" [assignment] ");        break;
                case ARITH_NODE:    printf(" [arithmetic] ");        break;
                case FCALL_NODE:    printf(" [function call] ");     break;
                case COND_NODE:     printf(" [condition] ");         break;
                case NCOND_NODE:    printf(" [negated condition] "); break;
                case LOGICAND_NODE: printf(" [conjunction] ");       break;
                case LOGICOR_NODE:  printf(" [disjunction] ");       break;
                case OR_NODE:       printf(" [or] ");                break;
                case ALTERA_NODE:    printf(" [read then alter] ");  break;
                case ALTERB_NODE:    printf(" [alter then read] ");  break;
            }
        }
        printf(" ^%d ",tree[ln].up);
        if (ln==dryad) printf("(dryad here) ");
    }
    if ((tree[ln].type==LOGICAND_NODE)
        ||(tree[ln].type==LOGICOR_NODE))
        printf(" {%d/%d/%d} ",tree[ln].label_number,
            tree[ln].yes_label, tree[ln].no_label);
    printf("\n");
    for (j=0; j<tree[ln].arity; j++)
    {   if (j<tree[ln].branches_made) show_leaf(tree[ln].b[j],depth+1);
        else show_leaf(-1,depth+1);
    }
}

static void show_tree(char *c)
{   printf("%s\n",c); show_leaf(tree[0].b[0],0);
    if (etrace_mode==1)
    {   printf("The dryad is at %d and is %s%s\n",
            dryad,(resting==1)?"resting":"hovering in midair",
            (comma_mode==0)?"":"\nwhile waiting for a comma");
        if (dryad_veil!=-1)
            printf("with her veil tied to %d\n",dryad_veil);
    }
}

/* ------------------------------------------------------------------------- */
/*   Growing the tree                                                        */
/* ------------------------------------------------------------------------- */

static void grow_branch(int a, int wn, int type, char *opcde, int prio)
{   int i, above_dryad, rflag=0, prefix=0, postfix=0;

    if ((a>=5)&&(actual_version==3))
    {   error("A function may be called with at most 3 arguments");
        return;
    }
    if ((a>=9)&&(actual_version>3))
    {   error("A function may be called with at most 7 arguments");
        return;
    }

    above_dryad=tree[dryad].up;

    if ((a==1)&&(type!=FCALL_NODE)&&(sofar_empty==1))
    {   prefix=1;
        if (type==ALTERA_NODE) type=ALTERB_NODE;
    }
    if (type==ALTERA_NODE) postfix=1;
    if ((a==1)&&(type==FCALL_NODE)) postfix=1;

    if (etrace_mode==1) printf("%s%s%s operator '%s'\n",
        (prefix==1)?"prefix":"",(postfix==1)?"postfix":"",
        ((prefix==0)&&(postfix==0))?"infix":"",opcde);
    sofar_empty=1;

    if ((resting==0)&&(comma_mode==0)&&(prefix==0))
    {   error("Operator has too few arguments"); return;
    }

    if (type==OR_NODE)
    {   if ((strcmp(tree[above_dryad].op,"je")==0)
            || (strcmp(tree[above_dryad].op,"vje")==0))
        {   if (tree[above_dryad].arity < 5)
            {   tree[above_dryad].arity++; rflag=1; }
            tree[above_dryad].op="vje";
            if (tree[above_dryad].arity==5)
            {   error("At most three values can be separated by 'or'");
                rflag=0;
            }
            if (rflag==1)
            {   if (tree_size==MAX_EXPRESSION_NODES) goto TooComplex;
                dryad=tree_size++;
                tree[dryad].up=above_dryad;
                tree[dryad].type=BLANK_NODE;
                tree[above_dryad].b[tree[above_dryad].arity-1]=dryad;
                resting=0;
                return;
            }
        }
        else
            error("'or' can only be used with the conditions '==' and '~='");
    }

    if (comma_mode==1)
    {   comma_mode=0;
        if (prefix==0) dryad_veil=dryad;
    }

    while ((tree[above_dryad].priority>prio)
           || ((tree[above_dryad].priority==prio)
               && (type==ARITH_NODE)
               && (tree[above_dryad].type==ARITH_NODE)))
    {   dryad=above_dryad; above_dryad=tree[dryad].up;
    }

    if (prefix==0)
    {   while (tree[dryad].type== BLANK_NODE)
        {   for (i=1; i<tree[above_dryad].arity; i++)
                if (tree[above_dryad].b[i]==dryad)
                { dryad=tree[above_dryad].b[i-1]; break; }
        }
    }

    if (prefix==1) tree[above_dryad].branches_made++;

    for (i=0; i<tree[above_dryad].arity; i++)
        if (tree[above_dryad].b[i]==dryad)
            tree[above_dryad].b[i]=tree_size;

    tree[dryad].up=tree_size;
    tree[tree_size].b[0]=dryad;
    tree[tree_size].up=above_dryad; 

    if (tree_size==MAX_EXPRESSION_NODES) goto TooComplex;
    dryad=tree_size++;

    tree[dryad].arity=a;
    tree[dryad].word=wn;
    tree[dryad].branches_made=1;
    if (prefix==1) tree[dryad].branches_made=0;
    tree[dryad].type=type;
    tree[dryad].op=opcde;
    tree[dryad].priority=prio;
    tree[dryad].no_label=-2;
    tree[dryad].yes_label=-2;
    if ((type==LOGICAND_NODE) || (type==LOGICOR_NODE))
        tree[dryad].label_number=no_dummy_labels++;

    for (i=1; i<a; i++)
    {   tree[dryad].b[i]=tree_size;
        tree[tree_size].type= BLANK_NODE;
        tree[tree_size].arity=0;
        tree[tree_size].branches_made=0;
        tree[tree_size].priority=0;
        tree[tree_size++].up=dryad;
    }
    if ((prefix==0)&&(postfix==0))
    {       if (etrace_mode==1) printf("Magic = %d\n",dryad);
        dryad=tree[dryad].b[1]; resting=0; }
    if (prefix==1)
    {   dryad=tree[dryad].b[0]; resting=0; }
    if (postfix==1)
    {   dryad=tree[dryad].b[0]; resting=1; }

    if (etrace_mode==1) show_tree("grow_branch to");
    return;

    TooComplex:
        memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
}

static void grow_leaf(int wn)
{   int above_dryad;

    above_dryad=tree[dryad].up;

    tree[dryad].arity=0;
    tree[dryad].word=wn;
    tree[dryad].branches_made=0;
    tree[dryad].type=LEAF_NODE;
    tree[dryad].priority=0;

    tree[above_dryad].branches_made++;
    if (tree[above_dryad].branches_made<tree[above_dryad].arity)
    { dryad=tree[above_dryad].b[tree[above_dryad].branches_made];
      resting=0;
    }
    else resting=1;

    if (etrace_mode==1) show_tree("grow_leaf to");
    return;
}

static void fix_yesno_labels(int n, int flag)
{   int i;
    if ((tree[n].type!=LOGICOR_NODE)&&(tree[n].type!=LOGICAND_NODE))
        return;
    if (flag==1)
    {   
            tree[n].yes_label = tree[tree[n].up].yes_label;
            tree[n].no_label  = tree[tree[n].up].no_label;
    }
    else
    switch(tree[tree[n].up].type)
    {   case ROOT_NODE:
            tree[n].yes_label = no_dummy_labels-1;
            tree[n].no_label  = -1;
            break;
        case LOGICAND_NODE:
            tree[n].yes_label = tree[n].label_number;
            tree[n].no_label  = tree[tree[n].up].no_label;
            break;
        case LOGICOR_NODE:
            tree[n].yes_label = tree[tree[n].up].yes_label;
            tree[n].no_label  = tree[n].label_number;
            break;
    }
    for (i=0; i<tree[n].branches_made; i++)
        fix_yesno_labels(tree[n].b[i], (i==tree[n].branches_made-1)?1:0);
}

/* ------------------------------------------------------------------------- */
/*   Main expression (and assignment) evaluator routine:                     */
/*                                                                           */
/*   expression(from) compiles code to evaluate the expression starting at   */
/*     token from, leaves next_token at the first not part of the expression */
/*     (or -1 if the line was all used up); and returns                      */
/*                                                                           */
/*     -3  if the result was thrown away (eg. a void context function call)  */
/*     -2  if there is no result (eg, from "i=4" there is none)              */
/*     -1  if the result is on the stack                                     */
/*     n   if the result is the constant term in token n                     */
/* ------------------------------------------------------------------------- */

static void eword(char *b, int bn)
{   if (tree[bn].type==SP_NODE) strcpy(b,"sp");
    else word(b,tree[bn].word);
    /* printf("Eword %d -> %d <%s>\n",bn,tree[bn].word,b);  */
}

#define Op_(type,name,priority) grow_branch(2,token-1,type,name,\
priority+current_priority)
#define Op1_(type,name,priority) grow_branch(1,token-1,type,name,\
priority+current_priority)
#define OnCS_(x) if ((condition_context==1)&&(strcmp(sub_buffer,x)==0))
#define OnBS_(x) if ((bracket_level>0)&&(strcmp(sub_buffer,x)==0))

int next_token, void_context, condition_context=0,
           assign_context=0, lines_compiled;
char condition_label[64];
static int brackets[MAX_EXPRESSION_BRACKETS], bracket_level;

static void estack_line(char *rewrite)
{   if (etrace_mode>=1) printf("%2d  %s\n",++lines_compiled,rewrite+1);
    stack_line(rewrite);
}

extern int expression(int fromword)
{   int c, i, j, k, t, token, current_priority=0, wd_tk,
        sysfun_arity, dummy_branch_flag,
        call_level, call_flag, call_args, call_i, tosp_flag,
        revise_flag, last_was_leaf,
        its_void=0, thrown_away_flag=0, indirect_flag=0,
        last_was_comma=0, last_was_openb=0;

    /* --------------------------------------------------------------------- */
    /*  1. A little optimisation: can we tell at once this will not be a     */
    /*     full-blown expression, but just a single constant term?           */
    /* --------------------------------------------------------------------- */

    t=word_token(fromword);
    if ((t!=OPENB_SEP) && (t!=MINUS_SEP) && (condition_context==0)
        && (t!=DEC_SEP) && (t!=INC_SEP))
    {   word(sub_buffer,fromword+1); c=sub_buffer[0];
        if ((c==0) || (isalpha(c)) || (isdigit(c)) ||
            (c=='#') || (c==',') || (c==':'))
        {   next_token=fromword+1; if (c==0) next_token=-1;
            return(fromword);
        }
    }

    /* --------------------------------------------------------------------- */
    /*  2. Initially the tree is just a root node plus one blank branch      */
    /* --------------------------------------------------------------------- */

    tree[0].up= -1;  tree[0].type= ROOT_NODE;   tree[0].b[0]=1;
    tree[0].arity=1; tree[0].branches_made=0;   tree[0].priority=0;

    tree[1].up=0;    tree[1].type= BLANK_NODE;  tree[1].priority=0;

    tree_size=2; comma_mode=0;
    dryad=1; resting=0; sofar_empty=1; last_was_leaf=0;

    bracket_level=0;
    token=fromword;
    revise_flag=0;

    if (etrace_mode==1) printf("\n++++++++++++++++++++++++++++++\n");
    if (etrace_mode>=1)
    {   printf("\nEvaluating expression %s%s%sat:\n  ",
            (void_context==1)?"(in void context) ":"",
            (condition_context==1)?"(in condition context) ":"",
            (assign_context==1)?"(in assignment context) ":"");
        for (i=0; (i==0)||(sub_buffer[0]!=0); i++)
        {   word(sub_buffer,fromword+i); printf("%s ",sub_buffer);
        }
        printf("\n");
    }

    lines_compiled=0;

    /* --------------------------------------------------------------------- */
    /*  3. Grow the tree                                                     */
    /* --------------------------------------------------------------------- */

    do
    {   token++;
        wd_tk = word_token(token-1); sub_buffer[0]=0;
        if (wd_tk==-1) { word(sub_buffer,token-1);
                         if (sub_buffer[0]==0) break;
                       }

        if (last_was_comma>0) last_was_comma--;
        if (last_was_openb>0) last_was_openb--;

        if (etrace_mode==1)
          printf("Dryad reads '%s'\nSofar_empty=%d\n",sub_buffer,sofar_empty);

        switch(wd_tk)
        {
             case SETEQUALS_SEP:
                                   Op_(STORE_NODE,  "store",         3);
                 revise_flag=1; its_void=1; last_was_openb=2; break;

             case PLUS_SEP:        Op_(ARITH_NODE,  "add",           4); break;

             case MINUS_SEP:
                 if (sofar_empty==0)
                                   Op_(ARITH_NODE,  "sub",           4);
                 else
                                  Op1_(ARITH_NODE,  "sub 0",         8);
                 break;

             case TIMES_SEP:       Op_(ARITH_NODE,  "mul",           5); break;

             case DIVIDE_SEP:      Op_(ARITH_NODE,  "div",           5); break;

             case REMAINDER_SEP:   Op_(ARITH_NODE,  "mod",           5); break;

             case ARTAND_SEP:      Op_(ARITH_NODE,  "and",           5); break;

             case ARTOR_SEP:       Op_(ARITH_NODE,  "or",            5); break;

             case ARROW_SEP:       Op_(ARITH_NODE,  "loadb",         6); break;

             case DARROW_SEP:      Op_(ARITH_NODE,  "loadw",         6); break;

             case PROPERTY_SEP:    Op_(ARITH_NODE,  "get_prop",      7); break;

             case PROPADD_SEP:     Op_(ARITH_NODE,  "get_prop_addr", 7); break;

             case PROPNUM_SEP:     Op_(ARITH_NODE,  "_get_prop_len", 7);
                 revise_flag=1; break;

             case INC_SEP:        Op1_(ALTERA_NODE, "inc",           9); break;

             case DEC_SEP:        Op1_(ALTERA_NODE, "dec",           9); break;

             case OPENB_SEP:
                 current_priority+=10;
                 last_was_openb=2;
                 if (last_was_leaf==0)
                 {   if (bracket_level==MAX_EXPRESSION_BRACKETS)
                     {   error("Brackets '(' too deeply nested");
                         goto BigBreak; }
                     brackets[bracket_level++]=1;
                 }
                 else
                 {   sofar_empty=1; brackets[bracket_level++]=0;
                     j=token; call_args=2; call_level=bracket_level;
                     word(sub_buffer,token);
                     OnS_(")") call_args=1;
                     else
                     do { word(sub_buffer,j++);
                          if (sub_buffer[0]==0)
                          {   error("Missing bracket ')' in function call");
                              goto BigBreak;
                          }
                          if ((strcmp(sub_buffer,",")==0)
                              &&(bracket_level==call_level))
                              call_args++;
                          OnS_("(") call_level++;
                          OnS_(")") call_level--;
                        } while (call_level>=bracket_level);
                     grow_branch(call_args,token-1,FCALL_NODE,"call",
                                 1+current_priority);
                     comma_mode=1;
                 }
                 sofar_empty=1;
                 break;

             case CLOSEB_SEP:
                 if (bracket_level--==0) goto BigBreak;
                 current_priority-=10;
                 break;

             case COMMA_SEP:
                 if (bracket_level<=0) goto DefaultCase;
                 if (brackets[bracket_level-1]==1)
                     error("Spurious comma ','");
                 comma_mode=1; sofar_empty=1; last_was_comma=2;
                 if (tree[dryad].type!=BLANK_NODE)
                 {   while (tree[dryad].type!=ROOT_NODE)
                     {   while (tree[dryad].type!=FCALL_NODE)
                             dryad=tree[dryad].up;
                         if (tree[dryad].branches_made<tree[dryad].arity)
                         {   dryad=tree[dryad].b[tree[dryad].branches_made];
                             goto FoundNewPlace;
                         }
                         dryad=tree[dryad].up;
                     }
                     error("Misplaced comma ','"); return(-2);
                     FoundNewPlace: resting=0;
                 }
                 if (etrace_mode==1) show_tree("Comma to");
                 break;

             default:
                 DefaultCase:
                     goto TryFurther;
        }
        goto AtomDone;

        TryFurther:

        if (condition_context==1)
        {   switch(wd_tk)
            {   case GREATER_SEP:  Op_(COND_NODE,   "jg",            3); break;
                case LESS_SEP:     Op_(COND_NODE,   "jl",            3); break;
                case CONDEQUALS_SEP:
                                   Op_(COND_NODE,   "je",            3); break;
                case NOTEQUAL_SEP: Op_(NCOND_NODE,  "je",            3); break;
                case GE_SEP:       Op_(NCOND_NODE,  "jl",            3); break;
                case LE_SEP:       Op_(NCOND_NODE,  "jg",            3); break;
                case LOGAND_SEP:   Op_(LOGICAND_NODE, "&&",          2); break;
                case LOGOR_SEP:    Op_(LOGICOR_NODE, "||",           2); break;
                default:

                     OnS_("or")    Op_(OR_NODE,     "or",            2);
                else OnS_("in")    Op_(COND_NODE,   "jin",           3);
                else OnS_("notin") Op_(NCOND_NODE,  "jin",           3);
                else OnS_("has")   Op_(COND_NODE,   "test_attr",     3);
                else OnS_("hasnt") Op_(NCOND_NODE,  "test_attr",     3);
                else OnS_("far")   error("'far' is obselete and withdrawn");
                else OnS_("near")  error("'near' is obselete and withdrawn");
                else goto TryYetFurther;
            }
            last_was_openb=2;
            goto AtomDone;
        }

        TryYetFurther:

        if (resting==1)
        {   if (sub_buffer[0]=='-')
            {   Op_(ARITH_NODE,"add",4);
                grow_leaf(token-1); sofar_empty=0;
            }
            else
            {   if (bracket_level>0)
                error("Operator has too many arguments");
                goto BigBreak;
            }
        }
        else if (tree[dryad].type==BLANK_NODE)
             {   
                 if ((sub_buffer[0]=='-')
                     &&(last_was_openb==0)&&(last_was_comma==0))
                 {   Op_(ARITH_NODE,"add",4);
                     grow_leaf(token-1); sofar_empty=0;
                     goto AtomDone;
                 }

                 sofar_empty=0; grow_leaf(token-1); last_was_leaf=1;
                 goto UnlessItWas;
             }
             else
             if (sub_buffer[0]=='-')
                  {   Op_(ARITH_NODE,"add",4);
                      grow_leaf(token-1); sofar_empty=0;
                  }
                  else goto BigBreak;


        AtomDone:
        last_was_leaf=0;
        UnlessItWas: ;
    } while (1==1);
 
    BigBreak:
    if ((wd_tk==-1)&&(sub_buffer[0]==0)) next_token= -1;
    else next_token=token-1;

    if (bracket_level>0) error("Too many brackets '(' in expression");

    /* --------------------------------------------------------------------- */
    /*  4. If necessary, revise the tree to allow for get_prop_len and the   */
    /*     different contexts of the "=" assignment                          */
    /* --------------------------------------------------------------------- */

    if (revise_flag==1)
    {
        for (i=0; i<tree_size; i++)
        {   j=tree[i].b[0];
            if ((tree[i].type==STORE_NODE)&&(tree[j].type==ARITH_NODE)
                &&(tree[i].op!=NULL)&&(strcmp(tree[i].op,"store")==0))
            {   k=0;
                if (tree[j].op!=NULL)
                {   if (strcmp(tree[j].op,"get_prop")==0) k=1;
                    if (strcmp(tree[j].op,"loadb")==0) k=2;
                    if (strcmp(tree[j].op,"loadw")==0) k=3;
                }
                if (k!=0)
                {   
                    if (etrace_mode==1)
                        printf("Sub type %d nodes %d and %d\n",k,i,j);
                    if (etrace_mode==1) show_tree("Substituting from");
                    tree[j].b[tree[j].arity++] = tree[i].b[1];
                    tree[j].branches_made++;
                    tree[j].type=STORE_NODE;
                    tree[j].up=tree[i].up;
                    tree[i]=tree[j];
                    switch(k)
                    {   case 1: tree[i].op="put_prop"; break;
                        case 2: tree[i].op="storeb"; break;
                        case 3: tree[i].op="storew"; break;
                    }
                    if (etrace_mode==1) show_tree("Substituting to");
                }
            }
            if ((tree[i].op!=NULL)&&(strcmp(tree[i].op,"_get_prop_len")==0))
            {
                tree[i].op="get_prop_addr";
                tree[tree_size]=tree[i];
                tree[tree_size].up=i;
                tree[i].b[0]=tree_size;
                tree[i].arity=1;
                tree[i].branches_made=1;
                tree[i].op="get_prop_len";
                if (tree_size==MAX_EXPRESSION_NODES) goto TooComplexToo;
                tree_size++;
                if (etrace_mode==1) show_tree("Fixing a _get_prop_len to");
            }

            if (((tree[i].type==COND_NODE)||(tree[i].type==NCOND_NODE))
                &&(tree[i].op!=NULL)&&(strcmp(tree[i].op,"in")==0))
            {   if (etrace_mode==1) show_tree("Substituting 'in' from");
                j=tree[i].b[0];
                tree[i].op="je";
                tree[tree_size]=tree[j];
                tree[tree_size].up=j;
                tree[j].b[0]=tree_size;
                tree[j].arity=1;
                tree[j].type=ARITH_NODE;
                tree[j].branches_made=1;
                tree[j].op="get_parent";
                if (tree_size==MAX_EXPRESSION_NODES) goto TooComplexToo;
                tree_size++;
                if (etrace_mode==1) show_tree("Substituting to");
            }
        }
    }

    if (condition_context==1)
    {   fix_yesno_labels(tree[0].b[0],0);
    }

    if (etrace_mode>=1) show_tree("Made the tree:");

    /* --------------------------------------------------------------------- */
    /*  5. Recursively cut off branches into assembly language               */
    /* --------------------------------------------------------------------- */

    if (etrace_mode==2) printf("Compiling code:\n");

    do
    {   i=0;
        DownDown:
        if ((tree[i].type!=LOGICAND_NODE)&&(tree[i].type!=LOGICOR_NODE))
        {   for (j=tree[i].branches_made-1; j>=0; j--)
            {   t=tree[tree[i].b[j]].type;
                if ((t!=LEAF_NODE)&&(t!=SP_NODE)&&(t!=CDONE_NODE))
                {   i=tree[i].b[j]; goto DownDown;
                }
            }
        }
        else
        {   for (j=0; j<tree[i].branches_made; j++)
            {   t=tree[tree[i].b[j]].type;
                if ((t!=LEAF_NODE)&&(t!=SP_NODE)&&(t!=CDONE_NODE))
                {   i=tree[i].b[j]; goto DownDown;
                }
            }
        }

        if (etrace_mode==1) printf("Detaching %d\n",i);

        if (i==0)
        {   if (tree[tree[0].b[0]].type==SP_NODE) j=-1;
            else if (tree[tree[0].b[0]].type==CDONE_NODE) j=-3;
            else j=tree[tree[0].b[0]].word;
            if (its_void==1) j=-2;

            if ((condition_context==0)&&(j==-3))
            {   error("Unexpected condition"); return(-2); }

            if ((condition_context==1)&&(j!=-3))
            {   error("Expected condition but found expression");
                return(-2);
            }

            if (etrace_mode>=1)
            {   if (next_token==-1) printf("Completed: line used up: ");
                else
                {   word(sub_buffer,next_token);
                    printf("Completed: next word '%s': ",sub_buffer);
                }
                if (j>=0) word(sub_buffer,j);
                if (thrown_away_flag==1) printf("result thrown away\n");
                else if (j==-1) printf("result on stack\n");
                else if (j==-2) printf("no resulting value\n");
                else if (j==-3) printf("a condition\n");
                else printf("result in %s\n",sub_buffer);
            }
            if (thrown_away_flag==1) return(-3);
            return(j);
        }

        if (tree[i].branches_made<tree[i].arity)
            error("Operator has too few arguments");

        sysfun_arity=0; dummy_branch_flag=0;
        if (tree[i].type==FCALL_NODE)
        {   indirect_flag=0;
            InV5
            {   tree[i].op="call_***";
                call_args=tree[i].branches_made-1;
            }
            call_i=i; call_flag=1;
            eword(sub_buffer,tree[i].b[0]);

#define SysF_(x,n) if ((strcmp(sub_buffer,x)==0)&&(sys_functions[n]==0))

            SysF_("parent",0)    { sysfun_arity=1; tree[i].op="get_parent";    }
            SysF_("sibling",1)   { sysfun_arity=1; tree[i].op="get_sibling";
                                    dummy_branch_flag=1; }
            SysF_("younger",2)   { sysfun_arity=1; tree[i].op="get_sibling";
                                    dummy_branch_flag=1; }
            SysF_("child",3)     { sysfun_arity=1; tree[i].op="get_child";
                                    dummy_branch_flag=1; }
            SysF_("eldest",4)    { sysfun_arity=1; tree[i].op="get_child";
                                    dummy_branch_flag=1; }
            SysF_("random",5)    { sysfun_arity=1; tree[i].op="random";        }
            SysF_("prop_len",6)  { sysfun_arity=1; tree[i].op="get_prop_len";  }
            SysF_("prop_addr",7) { sysfun_arity=2; tree[i].op="get_prop_addr"; }
            SysF_("prop",8)      { sysfun_arity=2; tree[i].op="get_prop";      }
            SysF_("children",9)
            {   if (2!=tree[i].branches_made)
                    error("'children' takes a single argument");
                estack_line(         "@store temp_global 0");
                eword(sub_buffer,
                  tree[i].b[1]);
                sprintf(rewrite,     "@get_child %s sp ~_x%d",
                  sub_buffer,
                  no_dummy_labels+1);
                estack_line(rewrite);
                sprintf(rewrite,     "@._x%d",
                  no_dummy_labels++);
                estack_line(rewrite);
                estack_line(         "@inc temp_global");
                sprintf(rewrite,     "@get_sibling sp sp _x%d",
                  no_dummy_labels-1);
                estack_line(rewrite);
                sprintf(rewrite,     "@._x%d",
                  no_dummy_labels++);
                estack_line(rewrite);
                sprintf(rewrite,     "@add sp temp_global sp");
                estack_line(rewrite);
                tree[i].type=SP_NODE;
                tree[i].word=-1;
                goto Detached;
            }
            SysF_("youngest",10)
            {   if (2!=tree[i].branches_made)
                    error("'youngest' takes a single argument");
                eword(sub_buffer,tree[i].b[1]);
                sprintf(rewrite,     "@get_child %s temp_global ~_x%d",
                  sub_buffer,
                  no_dummy_labels+1);
                estack_line(rewrite);
                estack_line(         "@push temp_global");
                sprintf(rewrite,     "@._x%d",
                  no_dummy_labels++);
                estack_line(rewrite);
                estack_line(         "@store temp_global sp");
                sprintf(rewrite,     "@get_sibling temp_global sp _x%d",
                    no_dummy_labels-1);
                estack_line(rewrite);
                sprintf(rewrite,     "@._x%d",no_dummy_labels++);
                estack_line(rewrite);
                sprintf(rewrite,     "@push temp_global");
                estack_line(rewrite);
                tree[i].type=SP_NODE;
                tree[i].word=-1;
                goto Detached;
            }
            SysF_("elder",11)
            {   if (2!=tree[i].branches_made)
                    error("'elder' takes a single argument");
                eword(sub_buffer,tree[i].b[1]);
                sprintf(rewrite,     "@store temp_global %s",
                  sub_buffer);
                estack_line(rewrite);
                estack_line(         "@store temp_global3 0");
                estack_line(         "@get_parent temp_global sp");
                sprintf(rewrite,     "@get_child sp temp_global2 _x%d",
                  no_dummy_labels);
                estack_line(rewrite);
                sprintf(rewrite,     "@._x%d",no_dummy_labels++);
                estack_line(rewrite);
                sprintf(rewrite,     "@je temp_global temp_global2 _x%d",
                  no_dummy_labels);
                estack_line(rewrite);
                estack_line(         "@store temp_global3 temp_global2");
                sprintf(rewrite, "@get_sibling temp_global2 temp_global2 _x%d",
                  no_dummy_labels-1);
                estack_line(rewrite);
                sprintf(rewrite,     "@._x%d",
                  no_dummy_labels++);
                estack_line(rewrite);
                sprintf(rewrite,     "@push temp_global3");
                estack_line(rewrite);
                tree[i].type=SP_NODE;
                tree[i].word=-1;
                goto Detached;
            }

            SysF_("indirect",12)
            {   if (tree[i].branches_made<2)
                { error("'indirect' takes at least one argument"); }
                sysfun_arity=1; tree[i].op="icall"; indirect_flag=1;
            }
            else
            if (sysfun_arity!=0)
            {   if (sysfun_arity+1!=tree[i].branches_made)
                {   error("Wrong number of arguments to system function");
                }
            }
        }
        else call_flag=0;

        t=tree[i].type;

        if ((t==LOGICAND_NODE)||(t==LOGICOR_NODE))
        {   for (j=0; j<tree[i].branches_made; j++)
            {   if (tree[tree[i].b[j]].type != CDONE_NODE)
                {   error("Expected condition but found expression");
                    return(-2);
                }
            }
            sprintf(rewrite,"@._x%d",tree[i].label_number);
            estack_line(rewrite);
            tree[i].type=CDONE_NODE;
            goto Detached;
        }

        if (t==ALTERB_NODE)
        {   if (tree[tree[i].b[0]].type!=LEAF_NODE)
            {   error("'++' and '--' can only apply directly to variables");
                return(-2);
            }
            eword(sub_buffer,tree[i].b[0]);
            sprintf(rewrite,"@%s %s",tree[i].op,sub_buffer);
            estack_line(rewrite);
            tree[i].type=LEAF_NODE;
            tree[i].word=tree[tree[i].b[0]].word;
            tree[i].arity=0;
            tree[i].branches_made=0;
            if (tree[i].up==0)
                if (assign_context==1) its_void=1;
            goto Detached;
        }
        if (t==ALTERA_NODE)
        {   if (tree[tree[i].b[0]].type!=LEAF_NODE)
            {   error("'++' and '--' can only apply directly to variables");
                return(-2);
            }
            if ((tree[i].up==0)&&(assign_context==1))
            {   eword(sub_buffer,tree[i].b[0]);
                sprintf(rewrite,"@%s %s",tree[i].op,sub_buffer);
                estack_line(rewrite);
                tree[i].type=LEAF_NODE;
                tree[i].word=tree[tree[i].b[0]].word;
                tree[i].arity=0;
                tree[i].branches_made=0;
                if (assign_context==1) its_void=1;
                goto Detached;
            }
            eword(sub_buffer,tree[i].b[0]);
            sprintf(rewrite,"@push %s",sub_buffer);
            estack_line(rewrite);
            sprintf(rewrite,"@%s %s",tree[i].op,sub_buffer);
            estack_line(rewrite);
            tree[i].type=SP_NODE;
            tree[i].arity=0;
            tree[i].branches_made=0;
            goto Detached;
        }

        if (strcmp(tree[i].op,"get_prop_len")==0)
        {   eword(sub_buffer,tree[i].b[0]);
            sprintf(rewrite,"@store temp_global %s",sub_buffer);
            estack_line(rewrite);
            sprintf(rewrite,"@jz temp_global _x%d",no_dummy_labels);
            estack_line(rewrite);
            sprintf(rewrite,"@get_prop_len temp_global temp_global");
            estack_line(rewrite);
            sprintf(rewrite,"@._x%d",no_dummy_labels++);
            estack_line(rewrite);

            if ((tree[tree[i].up].op!=NULL) &&
                (strcmp(tree[tree[i].up].op,"store")==0))
            {   word(sub_buffer,tree[tree[tree[i].up].b[0]].word);
                i=tree[i].up; t=STORE_NODE;
                sprintf(rewrite,"@store %s temp_global",sub_buffer);
            }
            else sprintf(rewrite,"@push temp_global");

        }
        else
        {
            sprintf(rewrite,"@%s ",tree[i].op);

            for (j=(sysfun_arity>0)?1:0; j<tree[i].branches_made; j++)
            {   eword(sub_buffer,tree[i].b[j]);
                sprintf(rewrite+strlen(rewrite),"%s ",sub_buffer);
            }

            if ((sub_buffer[0]=='-') && (tree[i].op!=NULL)
                && (strcmp(tree[i].op,"add")==0))
            {   eword(sub_buffer,tree[i].b[0]);
                sprintf(rewrite,"@sub %s ",sub_buffer);
                eword(sub_buffer,tree[i].b[1]);
                sprintf(rewrite+strlen(rewrite),"%s ",sub_buffer+1);
            }

            if ((t==ARITH_NODE)||(t==FCALL_NODE))
            {   if ((tree[tree[i].up].op!=NULL) &&
                    (strcmp(tree[tree[i].up].op,"store")==0))
                {   word(sub_buffer,tree[tree[tree[i].up].b[0]].word);
                    i=tree[i].up; t=STORE_NODE;
                }
                else sprintf(sub_buffer,"sp");
                sprintf(rewrite+strlen(rewrite),"%s",sub_buffer);
            }
        }

        if (dummy_branch_flag==1)
        {   sprintf(rewrite+strlen(rewrite)," _x%d",no_dummy_labels);
        }
        if ((t==COND_NODE)||(t==NCOND_NODE))
        {   int pflag, lnumber, lat, tup;
            tup=tree[i].up; lat=tree[tup].label_number;
            switch(tree[tup].type)
            {   case ROOT_NODE: lnumber=-1; pflag=0; break;
                case LOGICAND_NODE:
                         if (tree[tup].b[tree[tup].branches_made-1]!=i)
                         {   lnumber=tree[tup].no_label; pflag=0;  }
                         else
                         {   if (lat==tree[tup].yes_label)
                             {   lnumber=tree[tup].no_label; pflag=0;  }
                             else
                             {   lnumber=tree[tup].yes_label; pflag=1; }
                         }
                         break;
                case LOGICOR_NODE:
                         if (tree[tup].b[tree[tup].branches_made-1]!=i)
                         {   lnumber=tree[tup].yes_label; pflag=1;  }
                         else
                         {   if (lat==tree[tup].no_label)
                             {   lnumber=tree[tup].yes_label; pflag=1;  }
                             else
                             {   lnumber=tree[tup].no_label; pflag=0; }
                         }
                         break;
                default:
                    error("Attempt to use a condition as a value");
                    return(-2);
            }
            if (pflag==0)
                sprintf(rewrite+strlen(rewrite),"?%s",
                    (t==COND_NODE)?"~":"");
            else
                sprintf(rewrite+strlen(rewrite),"?%s",
                    (t!=COND_NODE)?"~":"");
            if (lnumber==-1)
                sprintf(rewrite+strlen(rewrite),"%s",
                    condition_label);
            else
                sprintf(rewrite+strlen(rewrite),"_x%d",
                    lnumber);
        }

        if (call_flag==1)
        {   tosp_flag=0;
            if (strcmp(sub_buffer,"sp")==0) tosp_flag=1;

            InV3
            {
                if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
                {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
                    thrown_away_flag=1;
                }
            }

            if (actual_version == 4)
            {
                if (sysfun_arity==0)
                {   rewrite[7]='s';
                    switch(call_args)
                    {   case 0: rewrite[6]='1'; break;
                        case 1: rewrite[6]='2'; break;
                        default: rewrite[6]='v'; break;
                    }
                    if (call_args>3) rewrite[8]='2'; else rewrite[8]=' ';
                    if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
                    {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
                        thrown_away_flag=1;
                    }
                }
                if (indirect_flag==1)
                    if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
                    {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
                        thrown_away_flag=1;
                    }
            }

            if (actual_version >= 5)
            {
                if (sysfun_arity==0)
                {   rewrite[7]='s';
                    switch(call_args)
                    {   case 0: rewrite[6]='1'; break;
                        case 1: rewrite[6]='2'; break;
                        default: rewrite[6]='v'; break;
                    }
                    if (call_args>3) rewrite[8]='2'; else rewrite[8]=' ';
                    if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
                    {   rewrite[7]='n';
                        rewrite[strlen(rewrite)-3]=0;
                        thrown_away_flag=1;
                    }
                }
                if (indirect_flag==1)
                    if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
                    {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
                        thrown_away_flag=1;
                    }
            }
        }

        estack_line(rewrite);

        if (dummy_branch_flag==1)
        {   sprintf(rewrite,"@._x%d",no_dummy_labels++);
            estack_line(rewrite);
        }

        if (t==STORE_NODE) tree[i]=tree[tree[i].b[0]];
        else
        {   tree[i].arity=0;
            tree[i].type= SP_NODE;
            tree[i].branches_made=0;
        }
        switch(t)
        {   default: tree[i].type = SP_NODE; break;
            case COND_NODE:
            case NCOND_NODE:
            case LOGICOR_NODE:
            case LOGICAND_NODE: tree[i].type = CDONE_NODE; break;
        }

        Detached:
        if (etrace_mode==1) show_tree("to");
    } while (1==1);
    return(1);

    TooComplexToo:
        memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
    return(1);
}

extern void assignment(int from, int flag)
{   int i;
    next_token=from;
    do
    {   assign_context=1; i=expression(next_token); assign_context=0;
        if ((i!=-2)&&(i!=from))
        {   error("Expected an assignment but found an expression");
            return;
        }
        if (i==from)
        {   word(sub_buffer,from);
            if (flag==1)
                error_named("Expected an assignment, command, directive \
or opcode but found",sub_buffer);
            else
                error_named("Expected an assignment but found",sub_buffer);
            return;
        }
        if (next_token==-1) return;
        word(sub_buffer,next_token);
        if (strcmp(sub_buffer,",")!=0) return;
        next_token++;
    } while (1==1);
}

extern void init_express_vars(void)
{   int i;
    dryad_veil = -1;
    condition_context = 0;
    assign_context = 0;
    for (i=0;i<16;i++) sys_functions[i]=0;
#ifdef ALLOCATE_BIG_ARRAYS
    tree = NULL;
#endif
}