/*  Pawn compiler - Recursive descend expresion parser

  *

  *  Copyright (c) ITB CompuPhase, 1997-2005

  *

  *  This software is provided "as-is", without any express or implied warranty.

  *  In no event will the authors be held liable for any damages arising from

  *  the use of this software.

  *

  *  Permission is granted to anyone to use this software for any purpose,

  *  including commercial applications, and to alter it and redistribute it

  *  freely, subject to the following restrictions:

  *

  *  1.  The origin of this software must not be misrepresented; you must not

  *      claim that you wrote the original software. If you use this software in

  *      a product, an acknowledgment in the product documentation would be

  *      appreciated but is not required.

  *  2.  Altered source versions must be plainly marked as such, and must not be

  *      misrepresented as being the original software.

  *  3.  This notice may not be removed or altered from any source distribution.

  *

  *  Version: $Id: sc3.c 3635 2006-08-13 12:19:41Z thiadmer $

  */

 #include <assert.h>

 #include <stdio.h>

 #include <stdlib.h>     /* for _MAX_PATH */

 #include <string.h>

 #if defined FORTIFY

   #include <alloc/fortify.h>

 #endif

 #include "sc.h"

 static int skim(int *opstr,void (*testfunc)(int),int dropval,int endval,

                 int (*hier)(value*),value *lval);

 static void dropout(int lvalue,void (*testfunc)(int val),int exit1,value *lval);

 static int plnge(int *opstr,int opoff,int (*hier)(value *lval),value *lval,

                  char *forcetag,int chkbitwise);

 static int plnge1(int (*hier)(value *lval),value *lval);

 static void plnge2(void (*oper)(void),

                    int (*hier)(value *lval),

                    value *lval1,value *lval2);

 static cell calc(cell left,void (*oper)(),cell right,char *boolresult);

 static int hier14(value *lval);

 static int hier13(value *lval);

 static int hier12(value *lval);

 static int hier11(value *lval);

 static int hier10(value *lval);

 static int hier9(value *lval);

 static int hier8(value *lval);

 static int hier7(value *lval);

 static int hier6(value *lval);

 static int hier5(value *lval);

 static int hier4(value *lval);

 static int hier3(value *lval);

 static int hier2(value *lval);

 static int hier1(value *lval1);

 static int primary(value *lval);

 static void clear_value(value *lval);

 static void callfunction(symbol *sym,value *lval_result,int matchparanthesis);

 static int dbltest(void (*oper)(),value *lval1,value *lval2);

 static int commutative(void (*oper)());

 static int constant(value *lval);

 static char lastsymbol[sNAMEMAX+1]; /* name of last function/variable */

 static int bitwise_opercount;   /* count of bitwise operators in an expression */

 static int decl_heap=0;

 /* Function addresses of binary operators for signed operations */

 static void (*op1[17])(void) = {

   os_mult,os_div,os_mod,        /* hier3, index 0 */

   ob_add,ob_sub,                /* hier4, index 3 */

   ob_sal,os_sar,ou_sar,         /* hier5, index 5 */

   ob_and,                       /* hier6, index 8 */

   ob_xor,                       /* hier7, index 9 */

   ob_or,                        /* hier8, index 10 */

   os_le,os_ge,os_lt,os_gt,      /* hier9, index 11 */

   ob_eq,ob_ne,                  /* hier10, index 15 */

 };

 /* These two functions are defined because the functions inc() and dec() in

  * SC4.C have a different prototype than the other code generation functions.

  * The arrays for user-defined functions use the function pointers for

  * identifying what kind of operation is requested; these functions must all

  * have the same prototype. As inc() and dec() are special cases already, it

  * is simplest to add two "do-nothing" functions.

  */

 static void user_inc(void) {}

 static void user_dec(void) {}

 /*

  *  Searches for a binary operator a list of operators. The list is stored in

  *  the array "list". The last entry in the list should be set to 0.

  *

  *  The index of an operator in "list" (if found) is returned in "opidx". If

  *  no operator is found, nextop() returns 0.

  *

  *  If an operator is found in the expression, it cannot be used in a function

  *  call with omitted parantheses. Mark this...

  *

  *  Global references: sc_allowproccall   (modified)

  */

 static int nextop(int *opidx,int *list)

 {

   *opidx=0;

   while (*list){

     if (matchtoken(*list)){

       sc_allowproccall=FALSE;

       return TRUE;      /* found! */

     } else {

       list+=1;

       *opidx+=1;

     } /* if */

   } /* while */

   return FALSE;         /* entire list scanned, nothing found */

 }

 SC_FUNC int check_userop(void (*oper)(void),int tag1,int tag2,int numparam,

                          value *lval,int *resulttag)

 {

 static char *binoperstr[] = { "*", "/", "%", "+", "-", "", "", "",

                               "", "", "", "<=", ">=", "<", ">", "==", "!=" };

 static int binoper_savepri[] = { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,

                                  FALSE, FALSE, FALSE, FALSE, FALSE,

                                  TRUE, TRUE, TRUE, TRUE, FALSE, FALSE };

 static char *unoperstr[] = { "!", "-", "++", "--" };

 static void (*unopers[])(void) = { lneg, neg, user_inc, user_dec };

   char opername[4] = "", symbolname[sNAMEMAX+1];

   int i,swapparams,savepri,savealt;

   int paramspassed;

   symbol *sym;

   /* since user-defined operators on untagged operands are forbidden, we have

    * a quick exit.

    */

   assert(numparam==1 || numparam==2);

   if (tag1==0 && (numparam==1 || tag2==0))

     return FALSE;

   savepri=savealt=FALSE;

   /* find the name with the operator */

   if (numparam==2) {

     if (oper==NULL) {

       /* assignment operator: a special case */

       strcpy(opername,"=");

       if (lval!=NULL && (lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR))

         savealt=TRUE;

     } else {

       assert( (sizeof binoperstr / sizeof binoperstr[0]) == (sizeof op1 / sizeof op1[0]) );

       for (i=0; i<sizeof op1 / sizeof op1[0]; i++) {

         if (oper==op1[i]) {

           strcpy(opername,binoperstr[i]);

           savepri=binoper_savepri[i];

           break;

         } /* if */

       } /* for */

     } /* if */

   } else {

     assert(oper!=NULL);

     assert(numparam==1);

     /* try a select group of unary operators */

     assert( (sizeof unoperstr / sizeof unoperstr[0]) == (sizeof unopers / sizeof unopers[0]) );

     if (opername[0]=='\0') {

       for (i=0; i<sizeof unopers / sizeof unopers[0]; i++) {

         if (oper==unopers[i]) {

           strcpy(opername,unoperstr[i]);

           break;

         } /* if */

       } /* for */

     } /* if */

   } /* if */

   /* if not found, quit */

   if (opername[0]=='\0')

     return FALSE;

   /* create a symbol name from the tags and the operator name */

   assert(numparam==1 || numparam==2);

   operator_symname(symbolname,opername,tag1,tag2,numparam,tag2);

   swapparams=FALSE;

   sym=findglb(symbolname,sGLOBAL);

   if (sym==NULL /*|| (sym->usage & uDEFINE)==0*/) {  /* ??? should not check uDEFINE; first pass clears these bits */

     /* check for commutative operators */

     if (tag1==tag2 || oper==NULL || !commutative(oper))

       return FALSE;             /* not commutative, cannot swap operands */

     /* if arrived here, the operator is commutative and the tags are different,

      * swap tags and try again

      */

     assert(numparam==2);        /* commutative operator must be a binary operator */

     operator_symname(symbolname,opername,tag2,tag1,numparam,tag1);

     swapparams=TRUE;

     sym=findglb(symbolname,sGLOBAL);

     if (sym==NULL /*|| (sym->usage & uDEFINE)==0*/)

       return FALSE;

   } /* if */

   /* check existance and the proper declaration of this function */

   if ((sym->usage & uMISSING)!=0 || (sym->usage & uPROTOTYPED)==0) {

     char symname[2*sNAMEMAX+16];  /* allow space for user defined operators */

     funcdisplayname(symname,sym->name);

     if ((sym->usage & uMISSING)!=0)

       error(4,symname);           /* function not defined */

     if ((sym->usage & uPROTOTYPED)==0)

       error(71,symname);          /* operator must be declared before use */

   } /* if */

   /* we don't want to use the redefined operator in the function that

    * redefines the operator itself, otherwise the snippet below gives

    * an unexpected recursion:

    *    fixed:operator+(fixed:a, fixed:b)

    *        return a + b

    */

   if (sym==curfunc)

     return FALSE;

   /* for increment and decrement operators, the symbol must first be loaded

    * (and stored back afterwards)

    */

   if (oper==user_inc || oper==user_dec) {

     assert(!savepri);

     assert(lval!=NULL);

     if (lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR)

       pushreg(sPRI);            /* save current address in PRI */

     rvalue(lval);               /* get the symbol's value in PRI */

   } /* if */

   assert(!savepri || !savealt); /* either one MAY be set, but not both */

   if (savepri) {

     /* the chained comparison operators require that the ALT register is

      * unmodified, so we save it here; actually, we save PRI because the normal

      * instruction sequence (without user operator) swaps PRI and ALT

      */

     pushreg(sPRI);              /* right-hand operand is in PRI */

   } else if (savealt) {

     /* for the assignment operator, ALT may contain an address at which the

      * result must be stored; this address must be preserved accross the

      * call

      */

     assert(lval!=NULL);         /* this was checked earlier */

     assert(lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR); /* checked earlier */

     pushreg(sALT);

   } /* if */

   /* push parameters, call the function */

   paramspassed= (oper==NULL) ? 1 : numparam;

   switch (paramspassed) {

   case 1:

     pushreg(sPRI);

     break;

   case 2:

     /* note that 1) a function expects that the parameters are pushed

      * in reversed order, and 2) the left operand is in the secondary register

      * and the right operand is in the primary register */

     if (swapparams) {

       pushreg(sALT);

       pushreg(sPRI);

     } else {

       pushreg(sPRI);

       pushreg(sALT);

     } /* if */

     break;

   default:

     assert(0);

   } /* switch */

   markexpr(sPARM,NULL,0);       /* mark the end of a sub-expression */

   pushval((cell)paramspassed*sizeof(cell));

   assert(sym->ident==iFUNCTN);

   ffcall(sym,NULL,paramspassed);

   if (sc_status!=statSKIP)

     markusage(sym,uREAD);       /* do not mark as "used" when this call itself is skipped */

   if ((sym->usage & uNATIVE)!=0 && sym->x.lib!=NULL)

     sym->x.lib->value += 1;     /* increment "usage count" of the library */

   sideeffect=TRUE;              /* assume functions carry out a side-effect */

   assert(resulttag!=NULL);

   *resulttag=sym->tag;          /* save tag of the called function */

   if (savepri || savealt)

     popreg(sALT);               /* restore the saved PRI/ALT that into ALT */

   if (oper==user_inc || oper==user_dec) {

     assert(lval!=NULL);

     if (lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR)

       popreg(sALT);             /* restore address (in ALT) */

     store(lval);                /* store PRI in the symbol */

     moveto1();                  /* make sure PRI is restored on exit */

   } /* if */

   return TRUE;

 }

 SC_FUNC int matchtag(int formaltag,int actualtag,int allowcoerce)

 {

   if (formaltag!=actualtag) {

     /* if the formal tag is zero and the actual tag is not "fixed", the actual

      * tag is "coerced" to zero

      */

     if (!allowcoerce || formaltag!=0 || (actualtag & FIXEDTAG)!=0)

       return FALSE;

   } /* if */

   return TRUE;

 }

 /*

  *  The AMX pseudo-processor has no direct support for logical (boolean)

  *  operations. These have to be done via comparing and jumping. Since we are

  *  already jumping through the code, we might as well implement an "early

  *  drop-out" evaluation (also called "short-circuit"). This conforms to

  *  standard C:

  *

  *  expr1 || expr2           expr2 will only be evaluated if expr1 is false.

  *  expr1 && expr2           expr2 will only be evaluated if expr1 is true.

  *

  *  expr1 || expr2 && expr3  expr2 will only be evaluated if expr1 is false

  *                           and expr3 will only be evaluated if expr1 is

  *                           false and expr2 is true.

  *

  *  Code generation for the last example proceeds thus:

  *

  *      evaluate expr1

  *      operator || found

  *      jump to "l1" if result of expr1 not equal to 0

  *      evaluate expr2

  *      ->  operator && found; skip to higher level in hierarchy diagram

  *          jump to "l2" if result of expr2 equal to 0

  *          evaluate expr3

  *          jump to "l2" if result of expr3 equal to 0

  *          set expression result to 1 (true)

  *          jump to "l3"

  *      l2: set expression result to 0 (false)

  *      l3:

  *      <-  drop back to previous hierarchy level

  *      jump to "l1" if result of expr2 && expr3 not equal to 0

  *      set expression result to 0 (false)

  *      jump to "l4"

  *  l1: set expression result to 1 (true)

  *  l4:

  *

  */

 /*  Skim over terms adjoining || and && operators

  *  dropval   The value of the expression after "dropping out". An "or" drops

  *            out when the left hand is TRUE, so dropval must be 1 on "or"

  *            expressions.

  *  endval    The value of the expression when no expression drops out. In an

  *            "or" expression, this happens when both the left hand and the

  *            right hand are FALSE, so endval must be 0 for "or" expressions.

  */

 static int skim(int *opstr,void (*testfunc)(int),int dropval,int endval,

                 int (*hier)(value*),value *lval)

 {

   int lvalue,hits,droplab,endlab,opidx;

   int allconst,foundop;

   cell constval;

   int index;

   cell cidx;

   stgget(&index,&cidx);         /* mark position in code generator */

   hits=FALSE;                   /* no logical operators "hit" yet */

   allconst=TRUE;                /* assume all values "const" */

   constval=0;

   droplab=0;                    /* to avoid a compiler warning */

   for ( ;; ) {

     lvalue=plnge1(hier,lval);   /* evaluate left expression */

     allconst= allconst && (lval->ident==iCONSTEXPR);

     if (allconst) {

       if (hits) {

         /* one operator was already found */

         if (testfunc==jmp_ne0)

           lval->constval= lval->constval || constval;

         else

           lval->constval= lval->constval && constval;

       } /* if */

       constval=lval->constval;  /* save result accumulated so far */

     } /* if */

     foundop=nextop(&opidx,opstr);

     if ((foundop || hits) && (lval->ident==iARRAY || lval->ident==iREFARRAY))

       error(33, lval->sym ? (lval->sym->name ? lval->sym->name : "-unknown") : "-unknown-");  /* array was not indexed in an expression */

     if (foundop) {

       if (!hits) {

         /* this is the first operator in the list */

         hits=TRUE;

         droplab=getlabel();

       } /* if */

       dropout(lvalue,testfunc,droplab,lval);

     } else if (hits) {                       /* no (more) identical operators */

       dropout(lvalue,testfunc,droplab,lval); /* found at least one operator! */

       ldconst(endval,sPRI);

       jumplabel(endlab=getlabel());

       setlabel(droplab);

       ldconst(dropval,sPRI);

       setlabel(endlab);

       lval->sym=NULL;

       lval->tag=pc_addtag("bool");  /* force tag to be "bool" */

       if (allconst) {

         lval->ident=iCONSTEXPR;

         lval->constval=constval;

         stgdel(index,cidx);         /* scratch generated code and calculate */

       } else {

         lval->ident=iEXPRESSION;

         lval->constval=0;

       } /* if */

       return FALSE;

     } else {

       return lvalue;            /* none of the operators in "opstr" were found */

     } /* if */

   } /* while */

 }

 /*

  *  Reads into the primary register the variable pointed to by lval if

  *  plunging through the hierarchy levels detected an lvalue. Otherwise

  *  if a constant was detected, it is loaded. If there is no constant and

  *  no lvalue, the primary register must already contain the expression

  *  result.

  *

  *  After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which

  *  compare the primary register against 0, and jump to the "early drop-out"

  *  label "exit1" if the condition is true.

  */

 static void dropout(int lvalue,void (*testfunc)(int val),int exit1,value *lval)

 {

   if (lvalue)

     rvalue(lval);

   else if (lval->ident==iCONSTEXPR)

     ldconst(lval->constval,sPRI);

   (*testfunc)(exit1);

 }

 static void checkfunction(value *lval)

 {

   symbol *sym=lval->sym;

   if (sym==NULL || (sym->ident!=iFUNCTN && sym->ident!=iREFFUNC))

     return;             /* no known symbol, or not a function result */

   if ((sym->usage & uDEFINE)!=0) {

     /* function is defined, can now check the return value (but make an

      * exception for directly recursive functions)

      */

     if (sym!=curfunc && (sym->usage & uRETVALUE)==0) {

       char symname[2*sNAMEMAX+16];  /* allow space for user defined operators */

       funcdisplayname(symname,sym->name);

       error(209,symname);       /* function should return a value */

     } /* if */

   } else {

     /* function not yet defined, set */

     sym->usage|=uRETVALUE;      /* make sure that a future implementation of

                                  * the function uses "return <value>" */

   } /* if */

 }

 /*

  *  Plunge to a lower level

  */

 static int plnge(int *opstr,int opoff,int (*hier)(value *lval),value *lval,

                  char *forcetag,int chkbitwise)

 {

   int lvalue,opidx;

   int count;

   value lval2 = {0};

   lvalue=plnge1(hier,lval);

   if (nextop(&opidx,opstr)==0)

     return lvalue;              /* no operator in "opstr" found */

   if (lvalue)

     rvalue(lval);

   count=0;

   do {

     if (chkbitwise && count++>0 && bitwise_opercount!=0)

       error(212);

     opidx+=opoff;               /* add offset to index returned by nextop() */

     plnge2(op1[opidx],hier,lval,&lval2);

     if (op1[opidx]==ob_and || op1[opidx]==ob_or)

       bitwise_opercount++;

     if (forcetag!=NULL)

       lval->tag=pc_addtag(forcetag);

   } while (nextop(&opidx,opstr)); /* do */

   return FALSE;         /* result of expression is not an lvalue */

 }

 /*  plnge_rel

  *

  *  Binary plunge to lower level; this is very simular to plnge, but

  *  it has special code generation sequences for chained operations.

  */

 static int plnge_rel(int *opstr,int opoff,int (*hier)(value *lval),value *lval)

 {

   int lvalue,opidx;

   value lval2={0};

   int count;

   /* this function should only be called for relational operators */

   assert(op1[opoff]==os_le);

   lvalue=plnge1(hier,lval);

   if (nextop(&opidx,opstr)==0)

     return lvalue;              /* no operator in "opstr" found */

   if (lvalue)

     rvalue(lval);

   count=0;

   lval->boolresult=TRUE;

   do {

     /* same check as in plnge(), but "chkbitwise" is always TRUE */

     if (count>0 && bitwise_opercount!=0)

       error(212);

     if (count>0) {

       relop_prefix();

       *lval=lval2;      /* copy right hand expression of the previous iteration */

     } /* if */

     opidx+=opoff;

     plnge2(op1[opidx],hier,lval,&lval2);

     if (count++>0)

       relop_suffix();

   } while (nextop(&opidx,opstr)); /* enddo */

   lval->constval=lval->boolresult;

   lval->tag=pc_addtag("bool");    /* force tag to be "bool" */

   return FALSE;         /* result of expression is not an lvalue */

 }

 /*  plnge1

  *

  *  Unary plunge to lower level

  *  Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13()

  */

 static int plnge1(int (*hier)(value *lval),value *lval)

 {

   int lvalue,index;

   cell cidx;

   stgget(&index,&cidx); /* mark position in code generator */

   lvalue=(*hier)(lval);

   if (lval->ident==iCONSTEXPR)

     stgdel(index,cidx); /* load constant later */

   return lvalue;

 }

 /*  plnge2

  *

  *  Binary plunge to lower level

  *  Called by: plnge(), plnge_rel(), hier14() and hier1()

  */

 static void plnge2(void (*oper)(void),

                    int (*hier)(value *lval),

                    value *lval1,value *lval2)

 {

   int index;

   cell cidx;

   stgget(&index,&cidx);             /* mark position in code generator */

   if (lval1->ident==iCONSTEXPR) {   /* constant on left side; it is not yet loaded */

     if (plnge1(hier,lval2))

       rvalue(lval2);                /* load lvalue now */

     else if (lval2->ident==iCONSTEXPR)

       ldconst(lval2->constval<<dbltest(oper,lval2,lval1),sPRI);

     ldconst(lval1->constval<<dbltest(oper,lval2,lval1),sALT);

                    /* ^ doubling of constants operating on integer addresses */

                    /*   is restricted to "add" and "subtract" operators */

   } else {                          /* non-constant on left side */

     pushreg(sPRI);

     if (plnge1(hier,lval2))

       rvalue(lval2);

     if (lval2->ident==iCONSTEXPR) { /* constant on right side */

       if (commutative(oper)) {      /* test for commutative operators */

         value lvaltmp = {0};

         stgdel(index,cidx);         /* scratch pushreg() and constant fetch (then

                                      * fetch the constant again */

         ldconst(lval2->constval<<dbltest(oper,lval1,lval2),sALT);

         /* now, the primary register has the left operand and the secondary

          * register the right operand; swap the "lval" variables so that lval1

          * is associated with the secondary register and lval2 with the

          * primary register, as is the "normal" case.

          */

         lvaltmp=*lval1;

         *lval1=*lval2;

         *lval2=lvaltmp;

       } else {

         ldconst(lval2->constval<<dbltest(oper,lval1,lval2),sPRI);

         popreg(sALT);   /* pop result of left operand into secondary register */

       } /* if */

     } else {            /* non-constants on both sides */

       popreg(sALT);

       if (dbltest(oper,lval1,lval2))

         cell2addr();                    /* double primary register */

       if (dbltest(oper,lval2,lval1))

         cell2addr_alt();                /* double secondary register */

     } /* if */

   } /* if */

   if (oper) {

     /* If used in an expression, a function should return a value.

      * If the function has been defined, we can check this. If the

      * function was not defined, we can set this requirement (so that

      * a future function definition can check this bit.

      */

     checkfunction(lval1);

     checkfunction(lval2);

     if (lval1->ident==iARRAY || lval1->ident==iREFARRAY) {

       char *ptr=(lval1->sym!=NULL) ? lval1->sym->name : "-unknown-";

       error(33,ptr);                    /* array must be indexed */

     } else if (lval2->ident==iARRAY || lval2->ident==iREFARRAY) {

       char *ptr=(lval2->sym!=NULL) ? lval2->sym->name : "-unknown-";

       error(33,ptr);                    /* array must be indexed */

     } /* if */

     /* ??? ^^^ should do same kind of error checking with functions */

     /* check whether an "operator" function is defined for the tag names

      * (a constant expression cannot be optimized in that case)

      */

     if (check_userop(oper,lval1->tag,lval2->tag,2,NULL,&lval1->tag)) {

       lval1->ident=iEXPRESSION;

       lval1->constval=0;

     } else if (lval1->ident==iCONSTEXPR && lval2->ident==iCONSTEXPR) {

       /* only constant expression if both constant */

       stgdel(index,cidx);       /* scratch generated code and calculate */

       if (!matchtag(lval1->tag,lval2->tag,FALSE))

         error(213);             /* tagname mismatch */

       lval1->constval=calc(lval1->constval,oper,lval2->constval,&lval1->boolresult);

     } else {

       if (!matchtag(lval1->tag,lval2->tag,FALSE))

         error(213);             /* tagname mismatch */

       (*oper)();                /* do the (signed) operation */

       lval1->ident=iEXPRESSION;

     } /* if */

   } /* if */

 }

 static cell flooreddiv(cell a,cell b,int return_remainder)

 {

   cell q,r;

   if (b==0) {

     error(29);

     return 0;

   } /* if */

   /* first implement truncated division in a portable way */

   #define IABS(a)       ((a)>=0 ? (a) : (-a))

   q=IABS(a)/IABS(b);

   if ((cell)(a ^ b)<0)

     q=-q;               /* swap sign if either "a" or "b" is negative (but not both) */

   r=a-q*b;              /* calculate the matching remainder */

   /* now "fiddle" with the values to get floored division */

   if (r!=0 && (cell)(r ^ b)<0) {

     q--;

     r+=b;

   } /* if */

   return return_remainder ? r : q;

 }

 static cell calc(cell left,void (*oper)(),cell right,char *boolresult)

 {

   if (oper==ob_or)

     return (left | right);

   else if (oper==ob_xor)

     return (left ^ right);

   else if (oper==ob_and)

     return (left & right);

   else if (oper==ob_eq)

     return (left == right);

   else if (oper==ob_ne)

     return (left != right);

   else if (oper==os_le)

     return *boolresult &= (char)(left <= right), right;

   else if (oper==os_ge)

     return *boolresult &= (char)(left >= right), right;

   else if (oper==os_lt)

     return *boolresult &= (char)(left < right), right;

   else if (oper==os_gt)

     return *boolresult &= (char)(left > right), right;

   else if (oper==os_sar)

     return (left >> (int)right);

   else if (oper==ou_sar)

     return ((ucell)left >> (ucell)right);

   else if (oper==ob_sal)

     return ((ucell)left << (int)right);

   else if (oper==ob_add)

     return (left + right);

   else if (oper==ob_sub)

     return (left - right);

   else if (oper==os_mult)

     return (left * right);

   else if (oper==os_div)

     return flooreddiv(left,right,0);

   else if (oper==os_mod)

     return flooreddiv(left,right,1);

   else

     error(29);  /* invalid expression, assumed 0 (this should never occur) */

   return 0;

 }

 SC_FUNC int expression(cell *val,int *tag,symbol **symptr,int chkfuncresult)

 {

   int locheap=decl_heap;

   value lval={0};

   if (hier14(&lval))

     rvalue(&lval);

   /* scrap any arrays left on the heap */

   assert(decl_heap>=locheap);

   modheap((locheap-decl_heap)*sizeof(cell));  /* remove heap space, so negative delta */

   decl_heap=locheap;

   if (lval.ident==iCONSTEXPR && val!=NULL)    /* constant expression */

     *val=lval.constval;

   if (tag!=NULL)

     *tag=lval.tag;

   if (symptr!=NULL)

     *symptr=lval.sym;

   if (chkfuncresult)

     checkfunction(&lval);

   return lval.ident;

 }

 SC_FUNC int sc_getstateid(constvalue **automaton,constvalue **state)

 {

   char name[sNAMEMAX+1];

   cell val;

   char *str;

   int fsa,islabel;

   assert(automaton!=NULL);

   assert(state!=NULL);

   if (!(islabel=matchtoken(tLABEL)) && !needtoken(tSYMBOL))

     return 0;

   tokeninfo(&val,&str);

   assert(strlen(str)<sizeof name);

   strcpy(name,str);

   if (islabel || matchtoken(':')) {

     /* token is an automaton name, add the name and get a new token */

     *automaton=automaton_find(name);

     /* read in the state name before checking the automaton, to keep the parser

      * going (an "unknown automaton" error may occur when the "state" instruction

      * precedes any state definition)

      */

     if (!needtoken(tSYMBOL))

       return 0;

     tokeninfo(&val,&str);        /* do not copy the name yet, must check automaton first */

     if (*automaton==NULL) {

       error(86,name);            /* unknown automaton */

       return 0;

     } /* if */

     assert((*automaton)->index>0);

     assert(strlen(str)<sizeof name);

     strcpy(name,str);

   } else {

     *automaton=automaton_find("");

     assert(*automaton!=NULL);

     assert((*automaton)->index==0);

   } /* if */

   assert(*automaton!=NULL);

   fsa=(*automaton)->index;

   assert(*automaton!=NULL);

   *state=state_find(name,fsa);

   if (*state==NULL) {

     char *fsaname=(*automaton)->name;

     if (*fsaname=='\0')

       fsaname="<main>";

     error(87,name,fsaname);   /* unknown state for automaton */

     return 0;

   } /* if */

   return 1;

 }

 SC_FUNC cell array_totalsize(symbol *sym)

 {

   cell length;

   assert(sym!=NULL);

   assert(sym->ident==iARRAY || sym->ident==iREFARRAY);

   length=sym->dim.array.length;

   if (sym->dim.array.level > 0) {

     cell sublength=array_totalsize(finddepend(sym));

     if (sublength>0)

       length=length+length*sublength;

     else

       length=0;

   } /* if */

   return length;

 }

 static cell array_levelsize(symbol *sym,int level)

 {

   assert(sym!=NULL);

   assert(sym->ident==iARRAY || sym->ident==iREFARRAY);

   assert(level <= sym->dim.array.level);

   while (level-- > 0) {

     sym=finddepend(sym);

     assert(sym!=NULL);

   } /* if */

   return sym->dim.array.length;

 }

 /*  hier14

  *

  *  Lowest hierarchy level (except for the , operator).

  *

  *  Global references: sc_intest        (reffered to only)

  *                     sc_allowproccall (modified)

  */

 static int hier14(value *lval1)

 {

   int lvalue;

   value lval2={0},lval3={0};

   void (*oper)(void);

   int tok,level,i;