sourcemod-central: sourcepawn/compiler/sc3.c@492a8d0d5f59

     1 /*  Pawn compiler - Recursive descend expresion parser

     2  *

     3  *  Copyright (c) ITB CompuPhase, 1997-2005

     4  *

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

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

     7  *  the use of this software.

     8  *

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

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

    11  *  freely, subject to the following restrictions:

    12  *

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

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

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

    16  *      appreciated but is not reeq;quired.

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

    18  *      misrepresented as being the original software.

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

    20  *

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

    22  */

    23 #include <assert.h>

    24 #include <stdio.h>

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

    26 #include <string.h>

    27 #if defined FORTIFY

    28   #include <alloc/fortify.h>

    29 #endif

    30 #include "sc.h"

    31 #include "sctracker.h"

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

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

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

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

    37                  char *forcetag,int chkbitwise);

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

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

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

    41                    value *lval1,value *lval2);

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

    43 static int hier14(value *lval);

    44 static int hier13(value *lval);

    45 static int hier12(value *lval);

    46 static int hier11(value *lval);

    47 static int hier10(value *lval);

    48 static int hier9(value *lval);

    49 static int hier8(value *lval);

    50 static int hier7(value *lval);

    51 static int hier6(value *lval);

    52 static int hier5(value *lval);

    53 static int hier4(value *lval);

    54 static int hier3(value *lval);

    55 static int hier2(value *lval);

    56 static int hier1(value *lval1);

    57 static int primary(value *lval);

    58 static void clear_value(value *lval);

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

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

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

    62 static int constant(value *lval);

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

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

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

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

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

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

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

    72   ob_and,                       /* hier6, index 8 */

    73   ob_xor,                       /* hier7, index 9 */

    74   ob_or,                        /* hier8, index 10 */

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

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

    77 };

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

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

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

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

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

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

    84  */

    85 static void user_inc(void) {}

    86 static void user_dec(void) {}

    88 /*

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

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

    91  *

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

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

    94  *

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

    96  *  call with omitted parantheses. Mark this...

    97  *

    98  *  Global references: sc_allowproccall   (modified)

    99  */

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

   101 {

   102   *opidx=0;

   103   while (*list){

   104     if (matchtoken(*list)){

   105       sc_allowproccall=FALSE;

   106       return TRUE;      /* found! */

   107     } else {

   108       list+=1;

   109       *opidx+=1;

   110     } /* if */

   111   } /* while */

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

   113 }

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

   116                          value *lval,int *resulttag)

   117 {

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

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

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

   121                                  FALSE, FALSE, FALSE, FALSE, FALSE,

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

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

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

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

   126   int i,swapparams,savepri,savealt;

   127   int paramspassed;

   128   symbol *sym;

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

   131    * a quick exit.

   132    */

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

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

   135     return FALSE;

   137   savepri=savealt=FALSE;

   138   /* find the name with the operator */

   139   if (numparam==2) {

   140     if (oper==NULL) {

   141       /* assignment operator: a special case */

   142       strcpy(opername,"=");

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

   144         savealt=TRUE;

   145     } else {

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

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

   148         if (oper==op1[i]) {

   149           strcpy(opername,binoperstr[i]);

   150           savepri=binoper_savepri[i];

   151           break;

   152         } /* if */

   153       } /* for */

   154     } /* if */

   155   } else {

   156     assert(oper!=NULL);

   157     assert(numparam==1);

   158     /* try a select group of unary operators */

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

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

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

   162         if (oper==unopers[i]) {

   163           strcpy(opername,unoperstr[i]);

   164           break;

   165         } /* if */

   166       } /* for */

   167     } /* if */

   168   } /* if */

   169   /* if not found, quit */

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

   171     return FALSE;

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

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

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

   176   swapparams=FALSE;

   177   sym=findglb(symbolname,sGLOBAL);

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

   179     /* check for commutative operators */

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

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

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

   183      * swap tags and try again

   184      */

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

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

   187     swapparams=TRUE;

   188     sym=findglb(symbolname,sGLOBAL);

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

   190       return FALSE;

   191   } /* if */

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

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

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

   196     funcdisplayname(symname,sym->name);

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

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

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

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

   201   } /* if */

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

   204    * redefines the operator itself, otherwise the snippet below gives

   205    * an unexpected recursion:

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

   207    *        return a + b

   208    */

   209   if (sym==curfunc)

   210     return FALSE;

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

   213    * (and stored back afterwards)

   214    */

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

   216     assert(!savepri);

   217     assert(lval!=NULL);

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

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

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

   221   } /* if */

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

   224   if (savepri) {

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

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

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

   228      */

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

   230   } else if (savealt) {

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

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

   233      * call

   234      */

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

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

   237     pushreg(sALT);

   238   } /* if */

   240   /* push parameters, call the function */

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

   242   switch (paramspassed) {

   243   case 1:

   244     pushreg(sPRI);

   245     break;

   246   case 2:

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

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

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

   250     if (swapparams) {

   251       pushreg(sALT);

   252       pushreg(sPRI);

   253     } else {

   254       pushreg(sPRI);

   255       pushreg(sALT);

   256     } /* if */

   257     break;

   258   default:

   259     assert(0);

   260   } /* switch */

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

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

   263   assert(sym->ident==iFUNCTN);

   264   ffcall(sym,NULL,paramspassed);

   265   if (sc_status!=statSKIP)

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

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

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

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

   270   assert(resulttag!=NULL);

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

   273   if (savepri || savealt)

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

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

   276     assert(lval!=NULL);

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

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

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

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

   281   } /* if */

   282   return TRUE;

   283 }

   285 SC_FUNC int checktags_string(int tags[], int numtags, value *sym1)

   286 {

   287   int i;

   288   if (sym1->ident == iARRAY || sym1->ident == iREFARRAY)

   289   {

   290     return FALSE;

   291   }

   292   for (i=0; i<numtags; i++) {

   293     if ((sym1->tag == pc_tag_string && tags[i] == 0) ||

   294 		(sym1->tag == 0 && tags[i] == pc_tag_string))

   295       return TRUE;

   296   }

   297   return FALSE;

   298 }

   300 SC_FUNC int checktag_string(value *sym1, value *sym2)

   301 {

   302   if (sym1->ident == iARRAY || sym2->ident == iARRAY

   303 	  || sym1->ident == iREFARRAY || sym2->ident == iREFARRAY)

   304   {

   305     return FALSE;

   306   }

   307   if ((sym1->tag == pc_tag_string && sym2->tag == 0)

   308 	  || (sym1->tag == 0 && sym2->tag == pc_tag_string))

   309   {

   310     return TRUE;

   311   }

   313   return FALSE;

   314 }

   316 SC_FUNC int matchtag_string(int ident, int tag)

   317 {

   318   if (ident == iARRAY || ident == iREFARRAY)

   319     return FALSE;

   320   return (tag == pc_tag_string) ? TRUE : FALSE;

   321 }

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

   324 {

   325   if (formaltag!=actualtag) {

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

   327      * tag is "coerced" to zero

   328      */

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

   330 		if (formaltag & FUNCTAG)

   331 		{

   332 			if (actualtag == pc_functag || (formaltag == pc_functag && actualtag & FUNCTAG))

   333 			{

   334 				return TRUE;

   335 			} else if (actualtag & FUNCTAG) {

   336 				constvalue *v = find_tag_byval(actualtag);

   337 				int index;

   338 				short usage = uPUBLIC;

   339 				symbol *sym, *found = NULL;

   340 				funcenum_t *e;

   341 				functag_t *t;

   343 				if (strncmp(v->name, "$Func", 5) != 0)

   344 				{

   345 					return FALSE;

   346 				}

   348 				/* Now we have to go about looking up each function in this enum.  WHICH IS IT. */

   349 				e = funcenums_find_byval(formaltag);

   350 				if (!e)

   351 				{

   352 					return FALSE;

   353 				}

   355 				assert(v->name[5] == '@' || v->name[5] == '!');

   357 				/* Deduce which function type this is */

   358 				if (v->name[5] == '@')

   359 				{

   360 					usage = uPUBLIC;

   361 				} else if (v->name[5] = '!') {

   362 					usage = uSTOCK;

   363 				}

   365 				index = atoi(&v->name[6]);

   367 				assert(index >= 0);

   369 				/* Find the function, either by public idx or code addr */

   370 				if (usage == uPUBLIC)

   371 				{

   372 					for (sym=glbtab.next; sym!=NULL; sym=sym->next) {

   373 						if (sym->ident==iFUNCTN && (sym->usage & uPUBLIC)!=0 && (sym->vclass == sGLOBAL))

   374 						{

   375 							if (index-- == 0)

   376 							{

   377 								found = sym;

   378 								break;

   379 							}

   380 						}

   381 					}

   382 				} else if (usage == uSTOCK) {

   383 					for (sym=glbtab.next; sym!=NULL; sym=sym->next) {

   384 						if (sym->ident==iFUNCTN && (sym->vclass == sGLOBAL))

   385 						{

   386 							if (sym->codeaddr == index)

   387 							{

   388 								found = sym;

   389 								break;

   390 							}

   391 						}

   392 					}

   393 				}

   395 				if (!found)

   396 				{

   397 					assert(found);

   398 					return FALSE;

   399 				}

   401 				/* Wow, we now have:

   402 				 * 1) The functional enum deduced from formaltag

   403 				 * 2) The function trying to be shoved in deduced from actualtag

   404 				 * Now we have to check if it matches any one of the functags inside the enum.

   405 				 */

   406 				t = e->first;

   407 				while (t)

   408 				{

   409 					int curarg,skip=0,i;

   410 					arginfo *func_arg;

   411 					funcarg_t *enum_arg;

   412 					/* Check return type first. */

   413 					if (t->ret_tag != sym->tag)

   414 					{

   415 						t = t->next;

   416 						continue;

   417 					}

   418 					/* Check usage */

   419 					if (t->type != usage)

   420 					{

   421 						t = t->next;

   422 						continue;

   423 					}

   424 					/* Begin iterating arguments */

   425 					for (curarg=0; curarg<t->argcount; curarg++)

   426 					{

   427 						enum_arg = &t->args[curarg];

   428 						/* Check whether we've exhausted our arguments */

   429 						if (sym->dim.arglist[curarg].ident == 0)

   430 						{

   431 							/* Can we bail out early? */

   432 							if (!enum_arg->ommittable)

   433 							{

   434 								/* No! */

   435 								skip = 1;

   436 							}

   437 							break;

   438 						}

   439 						func_arg = &sym->dim.arglist[curarg];

   440 						/* First check the ident type */

   441 						if (enum_arg->ident != func_arg->ident)

   442 						{

   443 							skip = 1;

   444 							break;

   445 						}

   446 						/* Next check arrayness */

   447 						if (enum_arg->dimcount != func_arg->numdim)

   448 						{

   449 							skip = 1;

   450 							break;

   451 						}

   452 						if (enum_arg->dimcount > 0)

   453 						{

   454 							for (i=0; i<enum_arg->dimcount; i++)

   455 							{

   456 								if (enum_arg->dims[i] != func_arg->dim[i])

   457 								{

   458 									skip = 1;

   459 									break;

   460 								}

   461 							}

   462 							if (skip)

   463 							{

   464 								break;

   465 							}

   466 						}

   467 						/* Lastly, check the tags */

   468 						if (enum_arg->tagcount != func_arg->numtags)

   469 						{

   470 							skip = 1;

   471 							break;

   472 						}

   473 						/* They should all be in the same order just for clarity... */

   474 						for (i=0; i<enum_arg->tagcount; i++)

   475 						{

   476 							if (enum_arg->tags[i] != func_arg->tags[i])

   477 							{

   478 								skip = 1;

   479 								break;

   480 							}

   481 						}

   482 						if (skip)

   483 						{

   484 							break;

   485 						}

   486 					}

   487 					if (!skip)

   488 					{

   489 						/* Make sure there are no trailing arguments */

   490 						if (sym->dim.arglist[curarg].ident == 0)

   491 						{

   492 							return TRUE;

   493 						}

   494 					}

   495 					t = t->next;

   496 				}

   497 			}

   498 		}

   499 		return FALSE;

   500 	}

   501   } /* if */

   502   return TRUE;

   503 }

   505 /*

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

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

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

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

   510  *  standard C:

   511  *

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

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

   514  *

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

   516  *                           and expr3 will only be evaluated if expr1 is

   517  *                           false and expr2 is true.

   518  *

   519  *  Code generation for the last example proceeds thus:

   520  *

   521  *      evaluate expr1

   522  *      operator || found

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

   524  *      evaluate expr2

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

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

   527  *          evaluate expr3

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

   529  *          set expression result to 1 (true)

   530  *          jump to "l3"

   531  *      l2: set expression result to 0 (false)

   532  *      l3:

   533  *      <-  drop back to previous hierarchy level

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

   535  *      set expression result to 0 (false)

   536  *      jump to "l4"

   537  *  l1: set expression result to 1 (true)

   538  *  l4:

   539  *

   540  */

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

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

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

   545  *            expressions.

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

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

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

   549  */

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

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

   552 {

   553   int lvalue,hits,droplab,endlab,opidx;

   554   int allconst,foundop;

   555   cell constval;

   556   int index;

   557   cell cidx;

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

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

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

   562   constval=0;

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

   564   for ( ;; ) {

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

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

   568     if (allconst) {

   569       if (hits) {

   570         /* one operator was already found */

   571         if (testfunc==jmp_ne0)

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

   573         else

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

   575       } /* if */

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

   577     } /* if */

   579     foundop=nextop(&opidx,opstr);

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

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

   582     if (foundop) {

   583       if (!hits) {

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

   585         hits=TRUE;

   586         droplab=getlabel();

   587       } /* if */

   588       dropout(lvalue,testfunc,droplab,lval);

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

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

   591       ldconst(endval,sPRI);

   592       jumplabel(endlab=getlabel());

   593       setlabel(droplab);

   594       ldconst(dropval,sPRI);

   595       setlabel(endlab);

   596       lval->sym=NULL;

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

   598       if (allconst) {

   599         lval->ident=iCONSTEXPR;

   600         lval->constval=constval;

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

   602       } else {

   603         lval->ident=iEXPRESSION;

   604         lval->constval=0;

   605       } /* if */

   606       return FALSE;

   607     } else {

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

   609     } /* if */

   611   } /* while */

   612 }

   614 /*

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

   616  *  plunging through the hierarchy levels detected an lvalue. Otherwise

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

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

   619  *  result.

   620  *

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

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

   623  *  label "exit1" if the condition is true.

   624  */

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

   626 {

   627   if (lvalue)

   628     rvalue(lval);

   629   else if (lval->ident==iCONSTEXPR)

   630     ldconst(lval->constval,sPRI);

   631   (*testfunc)(exit1);

   632 }

   634 static void checkfunction(value *lval)

   635 {

   636   symbol *sym=lval->sym;

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

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

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

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

   643      * exception for directly recursive functions)

   644      */

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

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

   647       funcdisplayname(symname,sym->name);

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

   649     } /* if */

   650   } else {

   651     /* function not yet defined, set */

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

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

   654   } /* if */

   655 }

   657 /*

   658  *  Plunge to a lower level

   659  */

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

   661                  char *forcetag,int chkbitwise)

   662 {

   663   int lvalue,opidx;

   664   int count;

   665   value lval2 = {0};

   667   lvalue=plnge1(hier,lval);

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

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

   670   if (lvalue)

   671     rvalue(lval);

   672   count=0;

   673   do {

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

   675       error(212);

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

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

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

   679       bitwise_opercount++;

   680     if (forcetag!=NULL)

   681       lval->tag=pc_addtag(forcetag);

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

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

   684 }

   686 /*  plnge_rel

   687  *

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

   689  *  it has special code generation sequences for chained operations.

   690  */

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

   692 {

   693   int lvalue,opidx;

   694   value lval2={0};

   695   int count;

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

   698   assert(op1[opoff]==os_le);

   699   lvalue=plnge1(hier,lval);

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

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

   702   if (lvalue)

   703     rvalue(lval);

   704   count=0;

   705   lval->boolresult=TRUE;

   706   do {

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

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

   709       error(212);

   710     if (count>0) {

   711       relop_prefix();

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

   713     } /* if */

   714     opidx+=opoff;

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

   716     if (count++>0)

   717       relop_suffix();

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

   719   lval->constval=lval->boolresult;

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

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

   722 }

   724 /*  plnge1

   725  *

   726  *  Unary plunge to lower level

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

   728  */

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

   730 {

   731   int lvalue,index;

   732   cell cidx;

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

   735   lvalue=(*hier)(lval);

   736   if (lval->ident==iCONSTEXPR)

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

   738   return lvalue;

   739 }

   741 /*  plnge2

   742  *

   743  *  Binary plunge to lower level

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

   745  */

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

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

   748                    value *lval1,value *lval2)

   749 {

   750   int index;

   751   cell cidx;

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

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

   755     if (plnge1(hier,lval2))

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

   757     else if (lval2->ident==iCONSTEXPR)

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

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

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

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

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

   763     pushreg(sPRI);

   764     if (plnge1(hier,lval2))

   765       rvalue(lval2);

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

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

   768         value lvaltmp = {0};

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

   770                                      * fetch the constant again */

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

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

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

   774          * is associated with the secondary register and lval2 with the

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

   776          */

   777         lvaltmp=*lval1;

   778         *lval1=*lval2;

   779         *lval2=lvaltmp;

   780       } else {

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

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

   783       } /* if */

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

   785       popreg(sALT);

   786       if (dbltest(oper,lval1,lval2))

   787         cell2addr();                    /* double primary register */

   788       if (dbltest(oper,lval2,lval1))

   789         cell2addr_alt();                /* double secondary register */

   790     } /* if */

   791   } /* if */

   792   if (oper) {

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

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

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

   796      * a future function definition can check this bit.

   797      */

   798     checkfunction(lval1);

   799     checkfunction(lval2);

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

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

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

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

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

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

   806     } /* if */

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

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

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

   811      */

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

   813       lval1->ident=iEXPRESSION;

   814       lval1->constval=0;

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

   816       /* only constant expression if both constant */

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

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

   819         error(213);             /* tagname mismatch */

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

   821     } else {

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

   823         error(213);             /* tagname mismatch */

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

   825       lval1->ident=iEXPRESSION;

   826     } /* if */

   827   } /* if */

   828 }

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

   831 {

   832   cell q,r;

   834   if (b==0) {

   835     error(29);

   836     return 0;

   837   } /* if */

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

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

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

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

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

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

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

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

   846     q--;

   847     r+=b;

   848   } /* if */

   849   return return_remainder ? r : q;

   850 }

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

   853 {

   854   if (oper==ob_or)

   855     return (left | right);

   856   else if (oper==ob_xor)

   857     return (left ^ right);

   858   else if (oper==ob_and)

   859     return (left & right);

   860   else if (oper==ob_eq)

   861     return (left == right);

   862   else if (oper==ob_ne)

   863     return (left != right);

   864   else if (oper==os_le)

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

   866   else if (oper==os_ge)

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

   868   else if (oper==os_lt)

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

   870   else if (oper==os_gt)

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

   872   else if (oper==os_sar)

   873     return (left >> (int)right);

   874   else if (oper==ou_sar)

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

   876   else if (oper==ob_sal)

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

   878   else if (oper==ob_add)

   879     return (left + right);

   880   else if (oper==ob_sub)

   881     return (left - right);

   882   else if (oper==os_mult)

   883     return (left * right);

   884   else if (oper==os_div)

   885     return flooreddiv(left,right,0);

   886   else if (oper==os_mod)

   887     return flooreddiv(left,right,1);

   888   else

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

   890   return 0;

   891 }

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

   894 {

   895   value lval={0};

   896   pushheaplist();

   898   if (hier14(&lval))

   899     rvalue(&lval);

   900   /* scrap any arrays left on the heap */

   901   popheaplist();

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

   904     *val=lval.constval;

   905   if (tag!=NULL)

   906     *tag=lval.tag;

   907   if (symptr!=NULL)

   908     *symptr=lval.sym;

   909   if (chkfuncresult)

   910     checkfunction(&lval);

   911   if (_lval)

   912     *_lval=lval;

   913   return lval.ident;

   914 }

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

   917 {

   918   char name[sNAMEMAX+1];

   919   cell val;

   920   char *str;

   921   int fsa,islabel;

   923   assert(automaton!=NULL);

   924   assert(state!=NULL);

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

   926     return 0;

   928   tokeninfo(&val,&str);

   929   assert(strlen(str)<sizeof name);

   930   strcpy(name,str);

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

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

   933     *automaton=automaton_find(name);

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

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

   936      * precedes any state definition)

   937      */

   938     if (!needtoken(tSYMBOL))

   939       return 0;

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

   941     if (*automaton==NULL) {

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

   943       return 0;

   944     } /* if */

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

   946     assert(strlen(str)<sizeof name);

   947     strcpy(name,str);

   948   } else {

   949     *automaton=automaton_find("");

   950     assert(*automaton!=NULL);

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

   952   } /* if */

   953   assert(*automaton!=NULL);

   954   fsa=(*automaton)->index;

   956   assert(*automaton!=NULL);

   957   *state=state_find(name,fsa);

   958   if (*state==NULL) {

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

   960     if (*fsaname=='\0')

   961       fsaname="<main>";

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

   963     return 0;

   964   } /* if */

   966   return 1;

   967 }

   969 SC_FUNC cell array_totalsize(symbol *sym)

   970 {

   971   cell length;

   973   assert(sym!=NULL);

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

   975   length=sym->dim.array.length;

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

   977     cell sublength=array_totalsize(finddepend(sym));

   978     if (sublength>0)

   979       length=length+length*sublength;

   980     else

   981       length=0;

   982   } /* if */

   983   return length;

   984 }

   986 static cell array_levelsize(symbol *sym,int level)

   987 {

   988   assert(sym!=NULL);

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

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

   991   while (level-- > 0) {

   992     sym=finddepend(sym);

   993     assert(sym!=NULL);

   994   } /* if */

   995   return (sym->dim.array.slength ? sym->dim.array.slength : sym->dim.array.length);

   996 }

   998 /*  hier14

   999  *

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

  1001  *

  1002  *  Global references: sc_intest        (reffered to only)

  1003  *                     sc_allowproccall (modified)

  1004  */

  1005 static int hier14(value *lval1)

  1006 {

  1007   int lvalue;

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

  1009   void (*oper)(void);

  1010   int tok,level,i;

  1011   cell val;

  1012   char *st;

  1013   int bwcount,leftarray;

  1014   cell arrayidx1[sDIMEN_MAX],arrayidx2[sDIMEN_MAX];  /* last used array indices */

  1015   cell *org_arrayidx;

  1017   bwcount=bitwise_opercount;

  1018   bitwise_opercount=0;

  1019   /* initialize the index arrays with unlikely constant indices; note that

  1020    * these indices will only be changed when the array is indexed with a

  1021    * constant, and that negative array indices are invalid (so actually, any

  1022    * negative value would do).

  1023    */

  1024   for (i=0; i<sDIMEN_MAX; i++)

  1025     arrayidx1[i]=arrayidx2[i]=(cell)(-1L << (sizeof(cell)*8-1));

  1026   org_arrayidx=lval1->arrayidx; /* save current pointer, to reset later */

  1027   if (lval1->arrayidx==NULL)

  1028     lval1->arrayidx=arrayidx1;

  1029   lvalue=plnge1(hier13,lval1);

  1030   if (lval1->ident!=iARRAYCELL && lval1->ident!=iARRAYCHAR)

  1031     lval1->arrayidx=NULL;

  1032   if (lval1->ident==iCONSTEXPR) /* load constant here */

  1033     ldconst(lval1->constval,sPRI);

  1034   tok=lex(&val,&st);

  1035   switch (tok) {

  1036     case taOR:

  1037       oper=ob_or;

  1038       break;

  1039     case taXOR:

  1040       oper=ob_xor;

  1041       break;

  1042     case taAND:

  1043       oper=ob_and;

  1044       break;

  1045     case taADD:

  1046       oper=ob_add;

  1047       break;

  1048     case taSUB:

  1049       oper=ob_sub;

  1050       break;

  1051     case taMULT:

  1052       oper=os_mult;

  1053       break;

  1054     case taDIV:

  1055       oper=os_div;

  1056       break;

  1057     case taMOD:

  1058       oper=os_mod;

  1059       break;

  1060     case taSHRU:

  1061       oper=ou_sar;

  1062       break;

  1063     case taSHR:

  1064       oper=os_sar;

  1065       break;

  1066     case taSHL:

  1067       oper=ob_sal;

  1068       break;

  1069     case '=':           /* simple assignment */

  1070       oper=NULL;

  1071       if (sc_intest)

  1072         error(211);     /* possibly unintended assignment */

  1073       break;

  1074     default:

  1075       lexpush();

  1076       bitwise_opercount=bwcount;

  1077       lval1->arrayidx=org_arrayidx; /* restore array index pointer */

  1078       return lvalue;

  1079   } /* switch */

  1081   /* if we get here, it was an assignment; first check a few special cases

  1082    * and then the general */

  1083   if (lval1->ident==iARRAYCHAR) {

  1084     /* special case, assignment to packed character in a cell is permitted */

  1085     lvalue=TRUE;

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

  1087     /* array assignment is permitted too (with restrictions) */

  1088     if (oper)

  1089       return error(23); /* array assignment must be simple assigment */

  1090     assert(lval1->sym!=NULL);

  1091     if (array_totalsize(lval1->sym)==0)

  1092       return error(46,lval1->sym->name);        /* unknown array size */

  1093     lvalue=TRUE;

  1094   } /* if */

  1096   /* operand on left side of assignment must be lvalue */

  1097   if (!lvalue)

  1098     return error(22);                   /* must be lvalue */

  1099   /* may not change "constant" parameters */

  1100   assert(lval1->sym!=NULL);

  1101   if ((lval1->sym->usage & uCONST)!=0)

  1102     return error(22);           /* assignment to const argument */

  1103   sc_allowproccall=FALSE;       /* may no longer use "procedure call" syntax */

  1105   lval3=*lval1;         /* save symbol to enable storage of expresion result */

  1106   lval1->arrayidx=org_arrayidx; /* restore array index pointer */

  1107   if (lval1->ident==iARRAYCELL || lval1->ident==iARRAYCHAR

  1108       || lval1->ident==iARRAY || lval1->ident==iREFARRAY)

  1109   {

  1110     /* if indirect fetch: save PRI (cell address) */

  1111     if (oper) {

  1112       pushreg(sPRI);

  1113       rvalue(lval1);

  1114     } /* if */

  1115     lval2.arrayidx=arrayidx2;

  1116     plnge2(oper,hier14,lval1,&lval2);

  1117     if (lval2.ident!=iARRAYCELL && lval2.ident!=iARRAYCHAR)

  1118       lval2.arrayidx=NULL;

  1119     if (oper)

  1120       popreg(sALT);

  1121     if (!oper && lval3.arrayidx!=NULL && lval2.arrayidx!=NULL

  1122         && lval3.ident==lval2.ident && lval3.sym==lval2.sym)

  1123     {

  1124       int same=TRUE;

  1125       assert(lval2.arrayidx==arrayidx2);

  1126       for (i=0; i<sDIMEN_MAX; i++)

  1127         same=same && (lval3.arrayidx[i]==lval2.arrayidx[i]);

  1128         if (same)

  1129           error(226,lval3.sym->name);   /* self-assignment */

  1130     } /* if */

  1131   } else {

  1132     if (oper){

  1133       rvalue(lval1);

  1134       plnge2(oper,hier14,lval1,&lval2);

  1135     } else {

  1136       /* if direct fetch and simple assignment: no "push"

  1137        * and "pop" needed -> call hier14() directly, */

  1138       if (hier14(&lval2))

  1139         rvalue(&lval2);         /* instead of plnge2(). */

  1140       else if (lval2.ident==iVARIABLE)

  1141         lval2.ident=iEXPRESSION;/* mark as "rvalue" if it is not an "lvalue" */

  1142       checkfunction(&lval2);

  1143       /* check whether lval2 and lval3 (old lval1) refer to the same variable */

  1144       if (lval2.ident==iVARIABLE && lval3.ident==lval2.ident && lval3.sym==lval2.sym) {

  1145         assert(lval3.sym!=NULL);

  1146         error(226,lval3.sym->name);     /* self-assignment */

  1147       } /* if */

  1148     } /* if */

  1149   } /* if */

  1150   /* Array elements are sometimes considered as sub-arrays --when the

  1151    * array index is an enumeration field and the enumeration size is greater

  1152    * than 1. If the expression on the right side of the assignment is a cell,

  1153    * or if an operation is in effect, this does not apply.

  1154    */

  1155   leftarray= lval3.ident==iARRAY || lval3.ident==iREFARRAY

  1156              || ((lval3.ident==iARRAYCELL || lval3.ident==iARRAYCHAR)

  1157                  && lval3.constval>1 && lval3.sym->dim.array.level==0

  1158                  && !oper && (lval2.ident==iARRAY || lval2.ident==iREFARRAY));

  1159   if (leftarray) {

  1160     /* Left operand is an array, right operand should be an array variable

  1161      * of the same size and the same dimension, an array literal (of the

  1162      * same size) or a literal string. For single-dimensional arrays without

  1163      * tag for the index, it is permitted to assign a smaller array into a

  1164      * larger one (without warning). This is to make it easier to work with

  1165      * strings.

  1166      */

  1167     int exactmatch=TRUE;

  1168     int idxtag=0;

  1169     int ltlength=(int)lval3.sym->dim.array.length;

  1170     if ((lval3.ident==iARRAYCELL || lval3.ident==iARRAYCHAR)

  1171         && lval3.constval>0 && lval3.sym->dim.array.level==0)

  1172     {

  1173       ltlength=(int)lval3.constval;

  1174     } /* if */

  1175     if (lval2.ident!=iARRAY && lval2.ident!=iREFARRAY

  1176         && (lval2.sym==NULL || lval2.constval<=0))

  1177       error(33,lval3.sym->name);        /* array must be indexed */

  1178     if (lval2.sym!=NULL) {

  1179       if (lval2.constval==0) {

  1180         val=lval2.sym->dim.array.length;/* array variable */

  1181       } else {

  1182         val=lval2.constval;

  1183         if (lval2.sym->dim.array.level!=0)

  1184           error(28,lval2.sym->name);

  1185       } /* if */

  1186       level=lval2.sym->dim.array.level;

  1187       idxtag=lval2.sym->x.tags.index;

  1188       if (level==0 && idxtag==0 && lval3.sym->x.tags.index==0)

  1189         exactmatch=FALSE;

  1190     } else {

  1191       val=lval2.constval;               /* literal array */

  1192       level=0;

  1193       /* If val is negative, it means that lval2 is a literal string.

  1194        * The string array size may be smaller than the destination

  1195        * array, provided that the destination array does not have an

  1196        * index tag.

  1197        */

  1198       if (val<0) {

  1199         val=-val;

  1200         if (lval3.sym->x.tags.index==0)

  1201           exactmatch=FALSE;

  1202       } /* if */

  1203     } /* if */

  1204     if (lval3.sym->dim.array.level!=level)

  1205       return error(48); /* array dimensions must match */

  1206     else if (ltlength<val || exactmatch && ltlength>val || val==0)

  1207       return error(47); /* array sizes must match */

  1208     else if (lval3.ident!=iARRAYCELL && !matchtag(lval3.sym->x.tags.index,idxtag,TRUE))

  1209       error(229,(lval2.sym!=NULL) ? lval2.sym->name : lval3.sym->name); /* index tag mismatch */

  1210     if (level>0) {

  1211       /* check the sizes of all sublevels too */

  1212       symbol *sym1 = lval3.sym;

  1213       symbol *sym2 = lval2.sym;

  1214       int i;

  1215       assert(sym1!=NULL && sym2!=NULL);

  1216       /* ^^^ sym2 must be valid, because only variables can be

  1217        *     multi-dimensional (there are no multi-dimensional literals),

  1218        *     sym1 must be valid because it must be an lvalue

  1219        */

  1220       assert(exactmatch);

  1221       for (i=0; i<level; i++) {

  1222         sym1=finddepend(sym1);

  1223         sym2=finddepend(sym2);

  1224         assert(sym1!=NULL && sym2!=NULL);

  1225         /* ^^^ both arrays have the same dimensions (this was checked

  1226          *     earlier) so the dependend should always be found

  1227          */

  1228         if (sym1->dim.array.length!=sym2->dim.array.length)

  1229           error(47);    /* array sizes must match */

  1230         else if (!matchtag(sym1->x.tags.index,sym2->x.tags.index,TRUE))

  1231           error(229,sym2->name);  /* index tag mismatch */

  1232       } /* for */

  1233       /* get the total size in cells of the multi-dimensional array */

  1234       val=array_totalsize(lval3.sym);

  1235       assert(val>0);    /* already checked */

  1236     } /* if */

  1237   } else {

  1238     /* left operand is not an array, right operand should then not be either */

  1239     if (lval2.ident==iARRAY || lval2.ident==iREFARRAY)

  1240       error(6);         /* must be assigned to an array */

  1241   } /* if */

  1242   if (leftarray) {

  1243     memcopy(val*sizeof(cell));

  1244   } else {

  1245     check_userop(NULL,lval2.tag,lval3.tag,2,&lval3,&lval2.tag);

  1246     store(&lval3);      /* now, store the expression result */

  1247   } /* if */

  1248   if (!oper && !checktag_string(&lval3, &lval2) && !matchtag(lval3.tag,lval2.tag,TRUE))

  1249     error(213);         /* tagname mismatch (if "oper", warning already given in plunge2()) */

  1250   if (lval3.sym)

  1251     markusage(lval3.sym,uWRITTEN);

  1252   sideeffect=TRUE;

  1253   bitwise_opercount=bwcount;

  1254   lval1->ident=iEXPRESSION;

  1255   return FALSE;         /* expression result is never an lvalue */

  1256 }

  1258 /**

  1259  * Sums up array usage in the current heap tracer and convert it into a dynamic array.

  1260  * This is used for the ternary operator, which needs to convert its array usage into

  1261  * something dynamically managed.

  1262  * !Note:

  1263  * This might break if expressions can ever return dynamic arrays.

  1264  * Thus, we assert() if something is non-static here.

  1265  * Right now, this poses no problem because this type of expression is impossible:

  1266  *   (a() ? return_array() : return_array()) ? return_array() : return_array()

  1267  */

  1269 void dynarray_from_heaplist(memuse_list_t *heap)

  1270 {

  1271   memuse_t *use=heap->head;

  1272   memuse_t *tmp;

  1273   long total=0;

  1274   while (use) {

  1275     assert(use->type==MEMUSE_STATIC);

  1276     total+=use->size;

  1277     tmp=use->prev;

  1278     free(use);

  1279     use=tmp;

  1280   }

  1281   free(heap);

  1282   if (total)

  1283     setheap_save(-total*sizeof(cell));

  1284 }

  1286 static int hier13(value *lval)

  1287 {

  1288   int lvalue=plnge1(hier12,lval);

  1289   if (matchtoken('?')) {

  1290     int flab1=getlabel();

  1291     int flab2=getlabel();

  1292     value lval2={0};

  1293     int array1,array2;

  1294     memuse_list_t *heap;

  1296     pushheaplist();

  1297     if (lvalue) {

  1298       rvalue(lval);

  1299     } else if (lval->ident==iCONSTEXPR) {

  1300       ldconst(lval->constval,sPRI);

  1301       error(lval->constval ? 206 : 205);        /* redundant test */

  1302     } /* if */

  1303     jmp_eq0(flab1);             /* go to second expression if primary register==0 */

  1304     PUSHSTK_I(sc_allowtags);

  1305     sc_allowtags=FALSE;         /* do not allow tagnames here (colon is a special token) */

  1306     if (hier13(lval))

  1307       rvalue(lval);

  1308     if (lval->ident==iCONSTEXPR)        /* load constant here */

  1309       ldconst(lval->constval,sPRI);

  1310     sc_allowtags=(short)POPSTK_I();     /* restore */

  1311     heap=popsaveheaplist();

  1312     dynarray_from_heaplist(heap);

  1313     pushheaplist();

  1314     jumplabel(flab2);

  1315     setlabel(flab1);

  1316     needtoken(':');

  1317     if (hier13(&lval2))

  1318       rvalue(&lval2);

  1319     if (lval2.ident==iCONSTEXPR)        /* load constant here */

  1320       ldconst(lval2.constval,sPRI);

  1321     array1= (lval->ident==iARRAY || lval->ident==iREFARRAY);

  1322     array2= (lval2.ident==iARRAY || lval2.ident==iREFARRAY);

  1323     if (array1 && !array2) {

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

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

  1326     } else if (!array1 && array2) {

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

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

  1329     } /* if */

  1330     /* ??? if both are arrays, should check dimensions */

  1331     if (!matchtag(lval->tag,lval2.tag,FALSE))

  1332       error(213);               /* tagname mismatch ('true' and 'false' expressions) */

  1333     heap=popsaveheaplist();

  1334     dynarray_from_heaplist(heap);

  1335     setlabel(flab2);

  1336     if (array1 && array2) {

  1337       markheap(MEMUSE_DYNAMIC, 0);

  1338     }

  1339     if (lval->ident==iARRAY)

  1340       lval->ident=iREFARRAY;    /* iARRAY becomes iREFARRAY */

  1341     else if (lval->ident!=iREFARRAY)

  1342       lval->ident=iEXPRESSION;  /* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */

  1343     return FALSE;               /* conditional expression is no lvalue */

  1344   } else {

  1345     return lvalue;

  1346   } /* if */

  1347 }

  1349 /* the order of the operators in these lists is important and must be

  1350  * the same as the order of the operators in the array "op1"

  1351  */

  1352 static int list3[]  = {'*','/','%',0};

  1353 static int list4[]  = {'+','-',0};

  1354 static int list5[]  = {tSHL,tSHR,tSHRU,0};

  1355 static int list6[]  = {'&',0};

  1356 static int list7[]  = {'^',0};

  1357 static int list8[]  = {'|',0};

  1358 static int list9[]  = {tlLE,tlGE,'<','>',0};

  1359 static int list10[] = {tlEQ,tlNE,0};

  1360 static int list11[] = {tlAND,0};

  1361 static int list12[] = {tlOR,0};

  1363 static int hier12(value *lval)

  1364 {

  1365   return skim(list12,jmp_ne0,1,0,hier11,lval);

  1366 }

  1368 static int hier11(value *lval)

  1369 {

  1370   return skim(list11,jmp_eq0,0,1,hier10,lval);

  1371 }

  1373 static int hier10(value *lval)

  1374 { /* ==, != */

  1375   return plnge(list10,15,hier9,lval,"bool",TRUE);

  1376 }                  /* ^ this variable is the starting index in the op1[]

  1377                     *   array of the operators of this hierarchy level */

  1379 static int hier9(value *lval)

  1380 { /* <=, >=, <, > */

  1381   return plnge_rel(list9,11,hier8,lval);

  1382 }

  1384 static int hier8(value *lval)

  1385 { /* | */

  1386   return plnge(list8,10,hier7,lval,NULL,FALSE);

  1387 }

  1389 static int hier7(value *lval)

  1390 { /* ^ */

  1391   return plnge(list7,9,hier6,lval,NULL,FALSE);

  1392 }

  1394 static int hier6(value *lval)

  1395 { /* & */

  1396   return plnge(list6,8,hier5,lval,NULL,FALSE);

  1397 }

  1399 static int hier5(value *lval)

  1400 { /* <<, >>, >>> */

  1401   return plnge(list5,5,hier4,lval,NULL,FALSE);

  1402 }

  1404 static int hier4(value *lval)

  1405 { /* +, - */

  1406   return plnge(list4,3,hier3,lval,NULL,FALSE);

  1407 }

  1409 static int hier3(value *lval)

  1410 { /* *, /, % */

  1411   return plnge(list3,0,hier2,lval,NULL,FALSE);

  1412 }

  1414 static int hier2(value *lval)

  1415 {

  1416   int lvalue,tok;

  1417   int tag,paranthese;

  1418   cell val;

  1419   char *st;

  1420   symbol *sym;

  1421   int saveresult;

  1423   tok=lex(&val,&st);

  1424   switch (tok) {

  1425   case tINC:                    /* ++lval */

  1426     if (!hier2(lval))

  1427       return error(22);         /* must be lvalue */

  1428     assert(lval->sym!=NULL);

  1429     if ((lval->sym->usage & uCONST)!=0)

  1430       return error(22);         /* assignment to const argument */

  1431     if (!check_userop(user_inc,lval->tag,0,1,lval,&lval->tag))

  1432       inc(lval);                /* increase variable first */

  1433     rvalue(lval);               /* and read the result into PRI */

  1434     sideeffect=TRUE;

  1435     return FALSE;               /* result is no longer lvalue */

  1436   case tDEC:                    /* --lval */

  1437     if (!hier2(lval))

  1438       return error(22);         /* must be lvalue */

  1439     assert(lval->sym!=NULL);

  1440     if ((lval->sym->usage & uCONST)!=0)

  1441       return error(22);         /* assignment to const argument */

  1442     if (!check_userop(user_dec,lval->tag,0,1,lval,&lval->tag))

  1443       dec(lval);                /* decrease variable first */

  1444     rvalue(lval);               /* and read the result into PRI */

  1445     sideeffect=TRUE;

  1446     return FALSE;               /* result is no longer lvalue */

  1447   case '~':                     /* ~ (one's complement) */

  1448     if (hier2(lval))

  1449       rvalue(lval);

  1450     invert();                   /* bitwise NOT */

  1451     lval->constval=~lval->constval;

  1452     return FALSE;

  1453   case '!':                     /* ! (logical negate) */

  1454     if (hier2(lval))

  1455       rvalue(lval);

  1456     if (check_userop(lneg,lval->tag,0,1,NULL,&lval->tag)) {

  1457       lval->ident=iEXPRESSION;

  1458       lval->constval=0;

  1459     } else {

  1460       lneg();                   /* 0 -> 1,  !0 -> 0 */

  1461       lval->constval=!lval->constval;

  1462       lval->tag=pc_addtag("bool");

  1463     } /* if */

  1464     return FALSE;

  1465   case '-':                     /* unary - (two's complement) */

  1466     if (hier2(lval))

  1467       rvalue(lval);

  1468     /* make a special check for a constant expression with the tag of a

  1469      * rational number, so that we can simple swap the sign of that constant.

  1470      */

  1471     if (lval->ident==iCONSTEXPR && lval->tag==sc_rationaltag && sc_rationaltag!=0) {

  1472       if (rational_digits==0) {

  1473         #if PAWN_CELL_SIZE==32

  1474           float *f = (float *)&lval->constval;

  1475         #elif PAWN_CELL_SIZE==64

  1476           double *f = (double *)&lval->constval;

  1477         #else

  1478           #error Unsupported cell size

  1479         #endif

  1480         *f= - *f; /* this modifies lval->constval */

  1481       } else {

  1482         /* the negation of a fixed point number is just an integer negation */

  1483         lval->constval=-lval->constval;

  1484       } /* if */

  1485     } else if (check_userop(neg,lval->tag,0,1,NULL,&lval->tag)) {

  1486       lval->ident=iEXPRESSION;

  1487       lval->constval=0;

  1488     } else {

  1489       neg();                    /* arithmic negation */

  1490       lval->constval=-lval->constval;

  1491     } /* if */

  1492     return FALSE;

  1493   case tLABEL:                  /* tagname override */

  1494     tag=pc_addtag(st);

  1495     lval->cmptag=tag;

  1496     lvalue=hier2(lval);

  1497     lval->tag=tag;

  1498     return lvalue;

  1499   case tDEFINED:

  1500     paranthese=0;

  1501     while (matchtoken('('))

  1502       paranthese++;

  1503     tok=lex(&val,&st);

  1504     if (tok!=tSYMBOL)

  1505       return error(20,st);      /* illegal symbol name */

  1506     sym=findloc(st);

  1507     if (sym==NULL)

  1508       sym=findglb(st,sSTATEVAR);

  1509     if (sym!=NULL && sym->ident!=iFUNCTN && sym->ident!=iREFFUNC && (sym->usage & uDEFINE)==0)

  1510       sym=NULL;                 /* symbol is not a function, it is in the table, but not "defined" */

  1511     val= (sym!=NULL);

  1512     if (!val && find_subst(st,strlen(st))!=NULL)

  1513       val=1;

  1514     clear_value(lval);

  1515     lval->ident=iCONSTEXPR;

  1516     lval->constval= val;

  1517     lval->tag=pc_addtag("bool");

  1518     ldconst(lval->constval,sPRI);

  1519     while (paranthese--)

  1520       needtoken(')');

  1521     return FALSE;

  1522   case tSIZEOF:

  1523     paranthese=0;

  1524     while (matchtoken('('))

  1525       paranthese++;

  1526     tok=lex(&val,&st);

  1527     if (tok!=tSYMBOL)

  1528       return error(20,st);      /* illegal symbol name */

  1529     sym=findloc(st);

  1530     if (sym==NULL)

  1531       sym=findglb(st,sSTATEVAR);

  1532     if (sym==NULL)

  1533       return error(17,st);      /* undefined symbol */

  1534     if (sym->ident==iCONSTEXPR)

  1535       error(39);                /* constant symbol has no size */

  1536     else if (sym->ident==iFUNCTN || sym->ident==iREFFUNC)

  1537       error(72);                /* "function" symbol has no size */

  1538     else if ((sym->usage & uDEFINE)==0)

  1539       return error(17,st);      /* undefined symbol (symbol is in the table, but it is "used" only) */

  1540     clear_value(lval);

  1541     lval->ident=iCONSTEXPR;

  1542     lval->constval=1;           /* preset */

  1543     if (sym->ident==iARRAY || sym->ident==iREFARRAY) {

  1544       int level;

  1545       symbol *idxsym=NULL;

  1546       symbol *subsym=sym;

  1547       for (level=0; matchtoken('['); level++) {

  1548         idxsym=NULL;

  1549         if (subsym!=NULL && level==subsym->dim.array.level && matchtoken(tSYMBOL)) {

  1550           char *idxname;

  1551           int cmptag=subsym->x.tags.index;

  1552           tokeninfo(&val,&idxname);

  1553           if ((idxsym=findconst(idxname,&cmptag))==NULL)

  1554             error(80,idxname);  /* unknown symbol, or non-constant */

  1555           else if (cmptag>1)

  1556             error(91,idxname);  /* ambiguous constant */

  1557         } /* if */

  1558         needtoken(']');

  1559         if (subsym!=NULL)

  1560           subsym=finddepend(subsym);

  1561       } /* for */

  1562 	  if (level>sym->dim.array.level+1) {

  1563         error(28,sym->name);  /* invalid subscript */

  1564       } else if (level==sym->dim.array.level+1) {

  1565         lval->constval= (idxsym!=NULL && idxsym->dim.array.length>0) ? idxsym->dim.array.length : 1;

  1566       } else {

  1567         lval->constval=array_levelsize(sym,level);

  1568       }

  1569       if (lval->constval==0 && strchr((char *)lptr,PREPROC_TERM)==NULL)

  1570         error(224,st);          /* indeterminate array size in "sizeof" expression */

  1571     } /* if */

  1572     ldconst(lval->constval,sPRI);

  1573     while (paranthese--)

  1574       needtoken(')');

  1575     return FALSE;

  1576   case tCELLSOF:

  1577     paranthese=0;

  1578     while (matchtoken('('))

  1579       paranthese++;

  1580     tok=lex(&val,&st);

  1581     if (tok!=tSYMBOL)

  1582       return error(20,st);      /* illegal symbol name */

  1583     sym=findloc(st);

  1584     if (sym==NULL)

  1585       sym=findglb(st,sSTATEVAR);

  1586     if (sym==NULL)

  1587       return error(17,st);      /* undefined symbol */

  1588     if (sym->ident==iCONSTEXPR)

  1589       error(39);                /* constant symbol has no size */

  1590     else if (sym->ident==iFUNCTN || sym->ident==iREFFUNC)

  1591       error(72);                /* "function" symbol has no size */

  1592     else if ((sym->usage & uDEFINE)==0)

  1593       return error(17,st);      /* undefined symbol (symbol is in the table, but it is "used" only) */

  1594     clear_value(lval);

  1595     lval->ident=iCONSTEXPR;

  1596     lval->constval=1;           /* preset */

  1597     if (sym->ident==iARRAY || sym->ident==iREFARRAY) {

  1598       int level;

  1599       symbol *idxsym=NULL;

  1600       symbol *subsym=sym;

  1601       for (level=0; matchtoken('['); level++) {

  1602         idxsym=NULL;

  1603         if (subsym!=NULL && level==subsym->dim.array.level && matchtoken(tSYMBOL)) {

  1604           char *idxname;

  1605           int cmptag=subsym->x.tags.index;

  1606           tokeninfo(&val,&idxname);

  1607           if ((idxsym=findconst(idxname,&cmptag))==NULL)

  1608             error(80,idxname);  /* unknown symbol, or non-constant */

  1609           else if (cmptag>1)

  1610             error(91,idxname);  /* ambiguous constant */

  1611         } /* if */

  1612         needtoken(']');

  1613         if (subsym!=NULL)

  1614           subsym=finddepend(subsym);

  1615       } /* for */

  1616 	  if (level>sym->dim.array.level+1) {

  1617         error(28,sym->name);  /* invalid subscript */

  1618       } else if (level==sym->dim.array.level+1) {

  1619         lval->constval= (idxsym!=NULL && idxsym->dim.array.length>0) ? idxsym->dim.array.length : 1;

  1620       } else {

  1621         lval->constval=array_levelsize(sym,level);

  1622       }

  1623       if (lval->constval==0 && strchr((char *)lptr,PREPROC_TERM)==NULL)

  1624         error(224,st);          /* indeterminate array size in "sizeof" expression */

  1625     } /* if */

  1626     ldconst(lval->constval,sPRI);

  1627     while (paranthese--)

  1628       needtoken(')');

  1629     return FALSE;

  1630   case tTAGOF:

  1631     paranthese=0;

  1632     while (matchtoken('('))

  1633       paranthese++;

  1634     tok=lex(&val,&st);

  1635     if (tok!=tSYMBOL && tok!=tLABEL)

  1636       return error(20,st);      /* illegal symbol name */

  1637     if (tok==tLABEL) {

  1638       constvalue *tagsym=find_constval(&tagname_tab,st,0);

  1639       tag=(int)((tagsym!=NULL) ? tagsym->value : 0);

  1640     } else {

  1641       sym=findloc(st);

  1642       if (sym==NULL)

  1643         sym=findglb(st,sSTATEVAR);

  1644       if (sym==NULL)

  1645         return error(17,st);      /* undefined symbol */

  1646       if ((sym->usage & uDEFINE)==0)

  1647         return error(17,st);      /* undefined symbol (symbol is in the table, but it is "used" only) */

  1648       tag=sym->tag;

  1649     } /* if */

  1650     if (sym->ident==iARRAY || sym->ident==iREFARRAY) {

  1651       int level;

  1652       symbol *idxsym=NULL;

  1653       symbol *subsym=sym;

  1654       for (level=0; matchtoken('['); level++) {

  1655         idxsym=NULL;

  1656         if (subsym!=NULL && level==subsym->dim.array.level && matchtoken(tSYMBOL)) {

  1657           char *idxname;

  1658           int cmptag=subsym->x.tags.index;

  1659           tokeninfo(&val,&idxname);

  1660           if ((idxsym=findconst(idxname,&cmptag))==NULL)

  1661             error(80,idxname);  /* unknown symbol, or non-constant */

  1662           else if (cmptag>1)

  1663             error(91,idxname);  /* ambiguous constant */

  1664         } /* if */

  1665         needtoken(']');

  1666         if (subsym!=NULL)

  1667           subsym=finddepend(subsym);

  1668       } /* for */

  1669       if (level>sym->dim.array.level+1)

  1670         error(28,sym->name);  /* invalid subscript */

  1671       else if (level==sym->dim.array.level+1 && idxsym!=NULL)

  1672         tag= idxsym->x.tags.index;

  1673     } /* if */

  1674     exporttag(tag);

  1675     clear_value(lval);

  1676     lval->ident=iCONSTEXPR;

  1677     lval->constval=tag | PUBLICTAG;

  1678     ldconst(lval->constval,sPRI);

  1679     while (paranthese--)

  1680       needtoken(')');

  1681     return FALSE;

  1682   case tSTATE: {

  1683     constvalue *automaton;

  1684     constvalue *state;

  1685     if (sc_getstateid(&automaton,&state)) {

  1686       assert(automaton!=NULL);

  1687       assert(automaton->index==0 && automaton->name[0]=='\0' || automaton->index>0);

  1688       loadreg(automaton->value,sALT);

  1689       assert(state!=NULL);

  1690       ldconst(state->value,sPRI);

  1691       ob_eq();

  1692       clear_value(lval);

  1693       lval->ident=iEXPRESSION;

  1694       lval->tag=pc_addtag("bool");

  1695     } /* if */

  1696     return FALSE;

  1697   } /* case */

  1698   default:

  1699     lexpush();

  1700     lvalue=hier1(lval);

  1701     /* check for postfix operators */

  1702     if (matchtoken(';')) {

  1703       /* Found a ';', do not look further for postfix operators */

  1704       lexpush();                /* push ';' back after successful match */

  1705       return lvalue;

  1706     } else if (matchtoken(tTERM)) {

  1707       /* Found a newline that ends a statement (this is the case when

  1708        * semicolons are optional). Note that an explicit semicolon was

  1709        * handled above. This case is similar, except that the token must

  1710        * not be pushed back.

  1711        */

  1712       return lvalue;

  1713     } else {

  1714       tok=lex(&val,&st);

  1715       switch (tok) {

  1716       case tINC:                /* lval++ */

  1717         if (!lvalue)

  1718           return error(22);     /* must be lvalue */

  1719         assert(lval->sym!=NULL);

  1720         if ((lval->sym->usage & uCONST)!=0)

  1721           return error(22);     /* assignment to const argument */

  1722         /* on incrementing array cells, the address in PRI must be saved for

  1723          * incremening the value, whereas the current value must be in PRI

  1724          * on exit.

  1725          */

  1726         saveresult= (lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR);

  1727         if (saveresult)

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

  1729         rvalue(lval);           /* read current value into PRI */

  1730         if (saveresult)

  1731           swap1();              /* save PRI on the stack, restore address in PRI */

  1732         if (!check_userop(user_inc,lval->tag,0,1,lval,&lval->tag))

  1733           inc(lval);            /* increase variable afterwards */

  1734         if (saveresult)

  1735           popreg(sPRI);         /* restore PRI (result of rvalue()) */

  1736         sideeffect=TRUE;

  1737         return FALSE;           /* result is no longer lvalue */

  1738       case tDEC:                /* lval-- */

  1739         if (!lvalue)

  1740           return error(22);     /* must be lvalue */

  1741         assert(lval->sym!=NULL);

  1742         if ((lval->sym->usage & uCONST)!=0)

  1743           return error(22);     /* assignment to const argument */

  1744         saveresult= (lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR);

  1745         if (saveresult)

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

  1747         rvalue(lval);           /* read current value into PRI */

  1748         if (saveresult)

  1749           swap1();              /* save PRI on the stack, restore address in PRI */

  1750         if (!check_userop(user_dec,lval->tag,0,1,lval,&lval->tag))

  1751           dec(lval);            /* decrease variable afterwards */

  1752         if (saveresult)

  1753           popreg(sPRI);         /* restore PRI (result of rvalue()) */

  1754         sideeffect=TRUE;

  1755         return FALSE;

  1756 /* This is temporarily disabled because we detect it automatically.

  1757  * Thus, it could be weird if both were used at once

  1758  */

  1759 #if 0

  1760       case tCHAR:               /* char (compute required # of cells */

  1761         if (lval->ident==iCONSTEXPR) {

  1762           lval->constval *= sCHARBITS/8;  /* from char to bytes */

  1763           lval->constval = (lval->constval + sizeof(cell)-1) / sizeof(cell);

  1764         } else {

  1765           if (lvalue)

  1766             rvalue(lval);       /* fetch value if not already in PRI */

  1767           char2addr();          /* from characters to bytes */

  1768           addconst(sizeof(cell)-1);     /* make sure the value is rounded up */

  1769           addr2cell();          /* truncate to number of cells */

  1770         } /* if */

  1771         return FALSE;

  1772 #endif

  1773       default:

  1774         lexpush();

  1775         return lvalue;

  1776       } /* switch */

  1777     } /* if */

  1778   } /* switch */

  1779 }

  1781 /*  hier1

  1782  *

  1783  *  The highest hierarchy level: it looks for pointer and array indices

  1784  *  and function calls.

  1785  *  Generates code to fetch a pointer value if it is indexed and code to

  1786  *  add to the pointer value or the array address (the address is already

  1787  *  read at primary()). It also generates code to fetch a function address

  1788  *  if that hasn't already been done at primary() (check lval[4]) and calls

  1789  *  callfunction() to call the function.

  1790  */

  1791 static int hier1(value *lval1)

  1792 {

  1793   int lvalue,index,tok,symtok;

  1794   cell val,cidx;

  1795   value lval2={0};

  1796   char *st;

  1797   char close;

  1798   symbol *sym;

  1799   int magic_string=0;

  1800   symbol dummysymbol,*cursym;   /* for changing the index tags in case of enumerated pseudo-arrays */

  1802   lvalue=primary(lval1);

  1803   symtok=tokeninfo(&val,&st);   /* get token read by primary() */

  1804   cursym=lval1->sym;

  1805 restart:

  1806   sym=cursym;

  1807   if (matchtoken('[') || matchtoken('{') || matchtoken('(')) {

  1808     tok=tokeninfo(&val,&st);    /* get token read by matchtoken() */

  1809     magic_string = (sym && (sym->tag == pc_tag_string && sym->dim.array.level == 0));

  1810     if (sym==NULL && symtok!=tSYMBOL) {

  1811       /* we do not have a valid symbol and we appear not to have read a valid

  1812        * symbol name (so it is unlikely that we would have read a name of an

  1813        * undefined symbol) */

  1814       error(29);                /* expression error, assumed 0 */

  1815       lexpush();                /* analyse '(', '{' or '[' again later */

  1816       return FALSE;

  1817     } /* if */

  1818     if (tok=='[' || tok=='{') { /* subscript */

  1819       close = (char)((tok=='[') ? ']' : '}');

  1820       if (sym==NULL) {  /* sym==NULL if lval is a constant or a literal */

  1821         error(28,"<no variable>");  /* cannot subscript */

  1822         needtoken(close);

  1823         return FALSE;

  1824       } else if (sym->ident!=iARRAY && sym->ident!=iREFARRAY){

  1825         error(28,sym->name);    /* cannot subscript, variable is not an array */

  1826         needtoken(close);

  1827         return FALSE;

  1828       } else if (sym->dim.array.level>0 && close!=']') {

  1829         error(51);      /* invalid subscript, must use [ ] */

  1830         needtoken(close);

  1831         return FALSE;

  1832       } /* if */

  1833       /* set the tag to match (enumeration fields as indices) */

  1834       lval2.cmptag=sym->x.tags.index;

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

  1836       pushreg(sPRI);            /* save base address of the array */

  1837       if (hier14(&lval2))       /* create expression for the array index */

  1838         rvalue(&lval2);

  1839       if (lval2.ident==iARRAY || lval2.ident==iREFARRAY)

  1840         error(33,lval2.sym->name);      /* array must be indexed */

  1841       needtoken(close);

  1842       if ((sym->usage & uENUMROOT) && !matchtag(sym->x.tags.index,lval2.tag,TRUE))

  1843         error(213);

  1844       if (lval2.ident==iCONSTEXPR) {    /* constant expression */

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

  1846         if (lval1->arrayidx!=NULL) {    /* keep constant index, for checking */

  1847           assert(sym->dim.array.level>=0 && sym->dim.array.level<sDIMEN_MAX);

  1848           lval1->arrayidx[sym->dim.array.level]=lval2.constval;

  1849         } /* if */

  1850         if (close==']' && !(sym->tag == pc_tag_string && sym->dim.array.level == 0)) {

  1851           /* normal array index */

  1852           if (lval2.constval<0 || sym->dim.array.length!=0 && sym->dim.array.length<=lval2.constval)

  1853             error(32,sym->name);        /* array index out of bounds */

  1854           if (lval2.constval!=0) {

  1855             /* don't add offsets for zero subscripts */

  1856             #if PAWN_CELL_SIZE==16

  1857               ldconst(lval2.constval<<1,sALT);

  1858             #elif PAWN_CELL_SIZE==32

  1859               ldconst(lval2.constval<<2,sALT);

  1860             #elif PAWN_CELL_SIZE==64

  1861               ldconst(lval2.constval<<3,sALT);

  1862             #else

  1863               #error Unsupported cell size

  1864             #endif

  1865             ob_add();

  1866           } /* if */

  1867         } else {

  1868           /* character index */

  1869           if (lval2.constval<0 || sym->dim.array.length!=0

  1870               && sym->dim.array.length*((8*sizeof(cell))/sCHARBITS)<=(ucell)lval2.constval)

  1871             error(32,sym->name);        /* array index out of bounds */

  1872           if (lval2.constval!=0) {

  1873             /* don't add offsets for zero subscripts */

  1874             #if sCHARBITS==16

  1875               ldconst(lval2.constval<<1,sALT);/* 16-bit character */

  1876             #else

  1877               ldconst(lval2.constval,sALT);   /* 8-bit character */

  1878             #endif

  1879             ob_add();

  1880           } /* if */

  1881           charalign();                  /* align character index into array */

  1882         } /* if */

  1883         /* if the array index is a field from an enumeration, get the tag name

  1884          * from the field and save the size of the field too.

  1885          */

  1886         assert(lval2.sym==NULL || lval2.sym->dim.array.level==0);

  1887         if (lval2.sym!=NULL && lval2.sym->dim.array.length>0 && sym->dim.array.level==0) {

  1888           lval1->tag=lval2.sym->x.tags.index;

  1889           lval1->constval=lval2.sym->dim.array.length;

  1890         } /* if */

  1891       } else {

  1892         /* array index is not constant */

  1893         lval1->arrayidx=NULL;           /* reset, so won't be checked */

  1894         if (close==']' && !magic_string) {

  1895           if (sym->dim.array.length!=0)

  1896             ffbounds(sym->dim.array.length-1);  /* run time check for array bounds */

  1897           cell2addr();  /* normal array index */

  1898         } else {

  1899           if (sym->dim.array.length!=0)

  1900             ffbounds(sym->dim.array.length*(32/sCHARBITS)-1);

  1901           char2addr();  /* character array index */

  1902         } /* if */

  1903         popreg(sALT);

  1904         ob_add();       /* base address was popped into secondary register */

  1905         if (close!=']' || magic_string)

  1906           charalign();  /* align character index into array */

  1907       } /* if */

  1908       /* the indexed item may be another array (multi-dimensional arrays) */

  1909       assert(cursym==sym && sym!=NULL); /* should still be set */

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

  1911         assert(close==']');     /* checked earlier */

  1912         assert(cursym==lval1->sym);

  1913         /* read the offset to the subarray and add it to the current address */

  1914         lval1->ident=iARRAYCELL;

  1915         pushreg(sPRI);          /* the optimizer makes this to a MOVE.alt */

  1916         rvalue(lval1);

  1917         popreg(sALT);

  1918         ob_add();

  1919         /* adjust the "value" structure and find the referenced array */

  1920         lval1->ident=iREFARRAY;

  1921         lval1->sym=finddepend(sym);

  1922         assert(lval1->sym!=NULL);

  1923         assert(lval1->sym->dim.array.level==sym->dim.array.level-1);

  1924         cursym=lval1->sym;

  1925         /* try to parse subsequent array indices */

  1926         lvalue=FALSE;   /* for now, a iREFARRAY is no lvalue */

  1927         goto restart;

  1928       } /* if */

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

  1930       /* set type to fetch... INDIRECTLY */

  1931       if (sym->tag == pc_tag_string) {

  1932         lval1->ident = iARRAYCHAR;

  1933       } else {

  1934         lval1->ident= (char)((close==']') ? iARRAYCELL : iARRAYCHAR);

  1935       }

  1936       /* if the array index is a field from an enumeration, get the tag name

  1937        * from the field and save the size of the field too. Otherwise, the

  1938        * tag is the one from the array symbol.

  1939        */

  1940       if (lval2.ident==iCONSTEXPR && lval2.sym!=NULL

  1941           && lval2.sym->dim.array.length>0 && sym->dim.array.level==0)

  1942       {

  1943         lval1->tag=lval2.sym->x.tags.index;

  1944         lval1->constval=lval2.sym->dim.array.length;

  1945         if (lval2.tag==sym->x.tags.index && lval1->constval>1 && matchtoken('[')) {

  1946           /* an array indexed with an enumeration field may be considered a sub-array */

  1947           lexpush();

  1948           lvalue=FALSE;   /* for now, a iREFARRAY is no lvalue */

  1949           lval1->ident=iREFARRAY;

  1950           /* initialize a dummy symbol, which is a copy of the current symbol,

  1951            * but with an adjusted index tag

  1952            */

  1953           assert(sym!=NULL);

  1954           dummysymbol=*sym;

  1955           /* get the tag of the root of the enumeration */

  1956           assert(lval2.sym!=NULL);

  1957           dummysymbol.x.tags.index=lval2.sym->x.tags.field;

  1958           dummysymbol.dim.array.length=lval2.sym->dim.array.length;

  1959           cursym=&dummysymbol;

  1960           /* recurse */

  1961           goto restart;

  1962         } /* if */

  1963       } else {

  1964         assert(sym!=NULL);

  1965         if (cursym!=&dummysymbol)

  1966           lval1->tag=sym->tag;

  1967         lval1->constval=0;

  1968       } /* if */

  1969       /* a cell in an array is an lvalue, a character in an array is not

  1970        * always a *valid* lvalue */

  1971       return TRUE;

  1972     } else {            /* tok=='(' -> function(...) */

  1973       assert(tok=='(');

  1974       if (sym==NULL

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

  1976       {

  1977         if (sym==NULL && sc_status==statFIRST) {

  1978           /* could be a "use before declaration"; in that case, create a stub

  1979            * function so that the usage can be marked.

  1980            */

  1981           sym=fetchfunc(lastsymbol,0);

  1982           if (sym==NULL)

  1983             error(103); /* insufficient memory */

  1984           markusage(sym,uREAD);

  1985         } else {

  1986           return error(12);           /* invalid function call */

  1987         } /* if */

  1988       } else if ((sym->usage & uMISSING)!=0) {

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

  1990         funcdisplayname(symname,sym->name);

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

  1992       } /* if */

  1993       callfunction(sym,lval1,TRUE);

  1994       return FALSE;             /* result of function call is no lvalue */

  1995     } /* if */

  1996   } /* if */

  1997   if (sym!=NULL && lval1->ident==iFUNCTN) {

  1998     assert(sym->ident==iFUNCTN);

  1999     if (sc_allowproccall) {

  2000       callfunction(sym,lval1,FALSE);

  2001     } else {

  2002       symbol *oldsym=sym;

  2003       int n=-1,iter=0;

  2004       int usage = ((sym->usage & uPUBLIC) == uPUBLIC) ? uPUBLIC : 0;

  2005       cell code_addr=0;

  2006       for (sym=glbtab.next; sym!=NULL; sym=sym->next) {

  2007         if (sym->ident==iFUNCTN && sym->vclass == sGLOBAL && (!usage || (sym->usage & usage)))

  2008         {

  2009           if (strcmp(sym->name, lval1->sym->name)==0) {

  2010             n = iter;

  2011             code_addr = sym->codeaddr;

  2012             break;

  2013           }

  2014           iter++;

  2015         }

  2016       }

  2017       if (n!=-1) {

  2018         char faketag[sNAMEMAX+1];

  2019         lval1->sym=NULL;

  2020         lval1->ident=iCONSTEXPR;

  2021         /* Generate a quick pseudo-tag! */

  2022         if (usage == uPUBLIC) {

  2023           lval1->constval=(n<<1)|1;

  2024           snprintf(faketag, sizeof(faketag)-1, "$Func@%d", n);

  2025         } else {

  2026           lval1->constval=(code_addr<<1)|0;

  2027           snprintf(faketag, sizeof(faketag)-1, "$Func!%d", code_addr);

  2028         }

  2029         lval1->tag=pc_addfunctag(faketag);

  2030         oldsym->usage |= uREAD;

  2031 		sym->usage |= uREAD;

  2032       } else {

  2033         error(76);                /* invalid function call, or syntax error */

  2034       } /* if */

  2035       return FALSE;

  2036     }

  2037   } /* if */

  2038   return lvalue;

  2039 }

  2041 /*  primary

  2042  *

  2043  *  Returns 1 if the operand is an lvalue (everything except arrays, functions

  2044  *  constants and -of course- errors).

  2045  *  Generates code to fetch the address of arrays. Code for constants is

  2046  *  already generated by constant().

  2047  *  This routine first clears the entire lval array (all fields are set to 0).

  2048  *

  2049  *  Global references: sc_intest  (may be altered, but restored upon termination)

  2050  */

  2051 static int primary(value *lval)

  2052 {

  2053   char *st;

  2054   int lvalue,tok;

  2055   cell val;

  2056   symbol *sym;

  2058   if (matchtoken('(')){         /* sub-expression - (expression,...) */

  2059     PUSHSTK_I(sc_intest);

  2060     PUSHSTK_I(sc_allowtags);

  2062     sc_intest=FALSE;            /* no longer in "test" expression */

  2063     sc_allowtags=TRUE;          /* allow tagnames to be used in parenthesized expressions */

  2064     sc_allowproccall=FALSE;

  2065     do

  2066       lvalue=hier14(lval);

  2067     while (matchtoken(','));

  2068     needtoken(')');

  2069     lexclr(FALSE);              /* clear lex() push-back, it should have been

  2070                                  * cleared already by needtoken() */

  2071     sc_allowtags=(short)POPSTK_I();

  2072     sc_intest=(short)POPSTK_I();

  2073     return lvalue;

  2074   } /* if */

  2076   clear_value(lval);    /* clear lval */

  2077   tok=lex(&val,&st);

  2078   if (tok==tSYMBOL) {

  2079     /* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol

  2080      * to sNAMEMAX significant characters */

  2081     assert(strlen(st)<sizeof lastsymbol);

  2082     strcpy(lastsymbol,st);

  2083   } /* if */

  2084   if (tok==tSYMBOL && !findconst(st,NULL)) {

  2085     /* first look for a local variable */

  2086     if ((sym=findloc(st))!=0) {

  2087       if (sym->ident==iLABEL) {

  2088         error(29);          /* expression error, assumed 0 */

  2089         ldconst(0,sPRI);    /* load 0 */

  2090         return FALSE;       /* return 0 for labels (expression error) */

  2091       } /* if */

  2092       lval->sym=sym;

  2093       lval->ident=sym->ident;

  2094       lval->tag=sym->tag;

  2095       if (sym->ident==iARRAY || sym->ident==iREFARRAY) {

  2096         address(sym,sPRI);  /* get starting address in primary register */

  2097         return FALSE;       /* return 0 for array (not lvalue) */

  2098       } else {

  2099         return TRUE;        /* return 1 if lvalue (not label or array) */

  2100       } /* if */

  2101     } /* if */

  2102     /* now try a global variable */

  2103     if ((sym=findglb(st,sSTATEVAR))!=0) {

  2104       if (sym->ident==iFUNCTN || sym->ident==iREFFUNC) {

  2105         /* if the function is only in the table because it was inserted as a

  2106          * stub in the first pass (i.e. it was "used" but never declared or

  2107          * implemented, issue an error

  2108          */

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

  2110           error(17,st);

  2111       } else {

  2112         if ((sym->usage & uDEFINE)==0)

  2113           error(17,st);

  2114         lval->sym=sym;

  2115         lval->ident=sym->ident;

  2116         lval->tag=sym->tag;

  2117         if (sym->ident==iARRAY || sym->ident==iREFARRAY) {

  2118           address(sym,sPRI);    /* get starting address in primary register */

  2119           return FALSE;         /* return 0 for array (not lvalue) */

  2120         } else {

  2121           return TRUE;          /* return 1 if lvalue (not function or array) */

  2122         } /* if */

  2123       } /* if */

  2124     } else {

  2125       if (!sc_allowproccall)

  2126         return error(17,st);    /* undefined symbol */

  2127       /* an unknown symbol, but used in a way compatible with the "procedure

  2128        * call" syntax. So assume that the symbol refers to a function.

  2129        */

  2130       assert(sc_status==statFIRST);

  2131       sym=fetchfunc(st,0);

  2132       if (sym==NULL)

  2133         error(103);     /* insufficient memory */

  2134     } /* if */

  2135     assert(sym!=NULL);

  2136     assert(sym->ident==iFUNCTN || sym->ident==iREFFUNC);

  2137     lval->sym=sym;

  2138     lval->ident=sym->ident;

  2139     lval->tag=sym->tag;

  2140     return FALSE;       /* return 0 for function (not an lvalue) */

  2141   } /* if */

  2142   lexpush();            /* push the token, it is analyzed by constant() */

  2143   if (constant(lval)==0) {

  2144     error(29);          /* expression error, assumed 0 */

  2145     ldconst(0,sPRI);    /* load 0 */

  2146   } /* if */

  2147   return FALSE;         /* return 0 for constants (or errors) */

  2148 }

  2150 static void clear_value(value *lval)

  2151 {

  2152   lval->sym=NULL;

  2153   lval->constval=0L;

  2154   lval->tag=0;

  2155   lval->ident=0;

  2156   lval->boolresult=FALSE;

  2157   /* do not clear lval->arrayidx, it is preset in hier14() */

  2158   /* do not clear lval->cmptag */

  2159 }

  2161 static void setdefarray(cell *string,cell size,cell array_sz,cell *dataaddr,int fconst)

  2162 {

  2163   /* The routine must copy the default array data onto the heap, as to avoid

  2164    * that a function can change the default value. An optimization is that

  2165    * the default array data is "dumped" into the data segment only once (on the

  2166    * first use).

  2167    */

  2168   assert(string!=NULL);

  2169   assert(size>0);

  2170   /* check whether to dump the default array */

  2171   assert(dataaddr!=NULL);

  2172   if (sc_status==statWRITE && *dataaddr<0) {

  2173     int i;

  2174     *dataaddr=(litidx+glb_declared)*sizeof(cell);

  2175     for (i=0; i<size; i++)

  2176       litadd(*string++);

  2177   } /* if */

  2179   /* if the function is known not to modify the array (meaning that it also

  2180    * does not modify the default value), directly pass the address of the

  2181    * array in the data segment.

  2182    */

  2183   if (fconst) {

  2184     ldconst(*dataaddr,sPRI);

  2185   } else {

  2186     /* Generate the code:

  2187      *  CONST.pri dataaddr                ;address of the default array data

  2188      *  HEAP      array_sz*sizeof(cell)   ;heap address in ALT

  2189      *  MOVS      size*sizeof(cell)       ;copy data from PRI to ALT

  2190      *  MOVE.PRI                          ;PRI = address on the heap

  2191      */

  2192     ldconst(*dataaddr,sPRI);

  2193     /* "array_sz" is the size of the argument (the value between the brackets

  2194      * in the declaration), "size" is the size of the default array data.

  2195      */

  2196     assert(array_sz>=size);

  2197     modheap((int)array_sz*sizeof(cell));

  2198     markheap(MEMUSE_STATIC, array_sz);

  2199     /* ??? should perhaps fill with zeros first */

  2200     memcopy(size*sizeof(cell));

  2201     moveto1();

  2202   } /* if */

  2203 }

  2205 static int findnamedarg(arginfo *arg,char *name)

  2206 {

  2207   int i;

  2209   for (i=0; arg[i].ident!=0 && arg[i].ident!=iVARARGS; i++)

  2210     if (strcmp(arg[i].name,name)==0)

  2211       return i;

  2212   return -1;

  2213 }

  2215 int checktag(int tags[],int numtags,int exprtag)

  2216 {

  2217   int i;

  2219   assert(tags!=0);

  2220   assert(numtags>0);

  2221   for (i=0; i<numtags; i++)

  2222     if (matchtag(tags[i],exprtag,TRUE))

  2223       return TRUE;    /* matching tag */

  2224   return FALSE;       /* no tag matched */

  2225 }

  2227 enum {

  2228   ARG_UNHANDLED,

  2229   ARG_IGNORED,

  2230   ARG_DONE,

  2231 };

  2233 /*  callfunction

  2234  *

  2235  *  Generates code to call a function. This routine handles default arguments

  2236  *  and positional as well as named parameters.

  2237  */

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

  2239 {

  2240 static long nest_stkusage=0L;

  2241 static int nesting=0;

  2242   int close,lvalue;

  2243   int argpos;       /* index in the output stream (argpos==nargs if positional parameters) */

  2244   int argidx=0;     /* index in "arginfo" list */

  2245   int nargs=0;      /* number of arguments */

  2246   int heapalloc=0;

  2247   int namedparams=FALSE;

  2248   value lval = {0};

  2249   arginfo *arg;

  2250   char arglist[sMAXARGS];

  2251   constvalue arrayszlst = { NULL, "", 0, 0};/* array size list starts empty */

  2252   constvalue taglst = { NULL, "", 0, 0};    /* tag list starts empty */

  2253   symbol *symret;

  2254   cell lexval;

  2255   char *lexstr;

  2257   assert(sym!=NULL);

  2258   lval_result->ident=iEXPRESSION; /* preset, may be changed later */

  2259   lval_result->constval=0;

  2260   lval_result->tag=sym->tag;

  2261   /* check whether this is a function that returns an array */

  2262   symret=finddepend(sym);

  2263   assert(symret==NULL || symret->ident==iREFARRAY);

  2264   if (symret!=NULL) {

  2265     int retsize;

  2266     /* allocate space on the heap for the array, and pass the pointer to the

  2267      * reserved memory block as a hidden parameter

  2268      */

  2269     retsize=(int)array_totalsize(symret);

  2270     assert(retsize>0);

  2271     modheap(retsize*sizeof(cell));/* address is in ALT */

  2272     pushreg(sALT);                /* pass ALT as the last (hidden) parameter */

  2273     markheap(MEMUSE_STATIC, retsize);

  2274     /* also mark the ident of the result as "array" */

  2275     lval_result->ident=iREFARRAY;

  2276     lval_result->sym=symret;

  2277   } /* if */

  2278   pushheaplist();

  2280   nesting++;

  2281   assert(nest_stkusage>=0);

  2282   #if !defined NDEBUG

  2283     if (nesting==1)

  2284       assert(nest_stkusage==0);

  2285   #endif

  2286   sc_allowproccall=FALSE;       /* parameters may not use procedure call syntax */

  2288   if ((sym->flags & flgDEPRECATED)!=0) {

  2289     char *ptr= (sym->documentation!=NULL) ? sym->documentation : "";

  2290     error(234,sym->name,ptr);   /* deprecated (probably a native function) */

  2291   } /* if */

  2293   /* run through the arguments */

  2294   arg=sym->dim.arglist;

  2295   assert(arg!=NULL);

  2296   stgmark(sSTARTREORDER);

  2297   memset(arglist,ARG_UNHANDLED,sizeof arglist);

  2298   if (matchparanthesis) {

  2299     /* Opening brace was already parsed, if closing brace follows, this

  2300      * call passes no parameters.

  2301      */

  2302     close=matchtoken(')');

  2303   } else {

  2304     /* When we find an end of line here, it may be a function call passing

  2305      * no parameters, or it may be that the first parameter is on a line

  2306      * below. But as a parameter can be anything, this is difficult to check.

  2307      * The only simple check that we have is the use of "named parameters".

  2308      */

  2309     close=matchtoken(tTERM);

  2310     if (close) {

  2311       close=!matchtoken('.');

  2312       if (!close)

  2313         lexpush();                /* reset the '.' */

  2314     } /* if */

  2315   } /* if */

  2316   if (!close) {

  2317     do {

  2318       if (matchtoken('.')) {

  2319         namedparams=TRUE;

  2320         if (needtoken(tSYMBOL))

  2321           tokeninfo(&lexval,&lexstr);

  2322         else

  2323           lexstr="";

  2324         argpos=findnamedarg(arg,lexstr);

  2325         if (argpos<0) {

  2326           error(17,lexstr);       /* undefined symbol */

  2327           break;                  /* exit loop, argpos is invalid */

  2328         } /* if */

  2329         needtoken('=');

  2330         argidx=argpos;

  2331       } else {

  2332         if (namedparams)

  2333           error(44);   /* positional parameters must precede named parameters */

  2334         argpos=nargs;

  2335       } /* if */

  2336       /* the number of arguments this was already checked at the declaration

  2337        * of the function; check it again for functions with a variable

  2338        * argument list

  2339        */

  2340       if (argpos>=sMAXARGS)

  2341         error(45);                /* too many function arguments */

  2342       stgmark((char)(sEXPRSTART+argpos));/* mark beginning of new expression in stage */

  2343       if (arglist[argpos]!=ARG_UNHANDLED)

  2344         error(58);                /* argument already set */

  2345       if (matchtoken('_')) {

  2346         arglist[argpos]=ARG_IGNORED;  /* flag argument as "present, but ignored" */

  2347         if (arg[argidx].ident==0 || arg[argidx].ident==iVARARGS) {

  2348           error(92);             /* argument count mismatch */

  2349         } else if (!arg[argidx].hasdefault) {

  2350           error(34,nargs+1);      /* argument has no default value */

  2351         } /* if */

  2352         if (arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS)

  2353           argidx++;

  2354         /* The rest of the code to handle default values is at the bottom

  2355          * of this routine where default values for unspecified parameters

  2356          * are (also) handled. Note that above, the argument is flagged as

  2357          * ARG_IGNORED.

  2358          */

  2359       } else {

  2360         arglist[argpos]=ARG_DONE; /* flag argument as "present" */

  2361         if (arg[argidx].numtags==1)     /* set the expected tag, if any */

  2362           lval.cmptag=arg[argidx].tags[0];

  2363         lvalue=hier14(&lval);

  2364         assert(sc_status==statFIRST || arg[argidx].tags!=NULL);

  2365         switch (arg[argidx].ident) {

  2366         case 0:

  2367           error(92);             /* argument count mismatch */

  2368           break;

  2369         case iVARARGS:

  2370           /* always pass by reference */

  2371           if (lval.ident==iVARIABLE || lval.ident==iREFERENCE) {

  2372             assert(lval.sym!=NULL);

  2373             if ((lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0) {

  2374               /* treat a "const" variable passed to a function with a non-const

  2375                * "variable argument list" as a constant here */

  2376               if (!lvalue) {

  2377                 error(22);        /* need lvalue */

  2378               } else {

  2379                 rvalue(&lval);    /* get value in PRI */

  2380                 setheap_pri();    /* address of the value on the heap in PRI */

  2381                 heapalloc+=markheap(MEMUSE_STATIC, 1);

  2382                 nest_stkusage++;

  2383               } /* if */

  2384             } else if (lvalue) {

  2385               address(lval.sym,sPRI);

  2386             } else {

  2387               setheap_pri();      /* address of the value on the heap in PRI */

  2388               heapalloc+=markheap(MEMUSE_STATIC, 1);

  2389               nest_stkusage++;

  2390             } /* if */

  2391           } else if (lval.ident==iCONSTEXPR || lval.ident==iEXPRESSION)

  2392           {

  2393             /* allocate a cell on the heap and store the

  2394              * value (already in PRI) there */

  2395             setheap_pri();        /* address of the value on the heap in PRI */

  2396             heapalloc+=markheap(MEMUSE_STATIC, 1);

  2397             nest_stkusage++;

  2398           } /* if */

  2399           /* ??? handle const array passed by reference */

  2400           /* otherwise, the address is already in PRI */

  2401           if (lval.sym!=NULL)

  2402             markusage(lval.sym,uWRITTEN);

  2403           if (!checktags_string(arg[argidx].tags, arg[argidx].numtags, &lval)

  2404               && !checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2405             error(213);

  2406           if (lval.tag!=0)

  2407             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2408           break;

  2409         case iVARIABLE:

  2410           if (lval.ident==iLABEL || lval.ident==iFUNCTN || lval.ident==iREFFUNC

  2411               || lval.ident==iARRAY || lval.ident==iREFARRAY)

  2412             error(35,argidx+1);   /* argument type mismatch */

  2413           if (lvalue)

  2414             rvalue(&lval);        /* get value (direct or indirect) */

  2415           /* otherwise, the expression result is already in PRI */

  2416           assert(arg[argidx].numtags>0);

  2417           check_userop(NULL,lval.tag,arg[argidx].tags[0],2,NULL,&lval.tag);

  2418           if (!checktags_string(arg[argidx].tags, arg[argidx].numtags, &lval)

  2419               && !checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2420             error(213);

  2421           if (lval.tag!=0)

  2422             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2423           argidx++;               /* argument done */

  2424           break;

  2425         case iREFERENCE:

  2426           if (!lvalue)

  2427             error(35,argidx+1);   /* argument type mismatch */

  2428           if (lval.sym!=NULL && (lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0)

  2429             error(35,argidx+1);   /* argument type mismatch */

  2430           if (lval.ident==iVARIABLE || lval.ident==iREFERENCE) {

  2431             if (lvalue) {

  2432               assert(lval.sym!=NULL);

  2433               address(lval.sym,sPRI);

  2434             } else {

  2435               setheap_pri();      /* address of the value on the heap in PRI */

  2436               heapalloc+=markheap(MEMUSE_STATIC, 1);

  2437               nest_stkusage++;

  2438             } /* if */

  2439           } /* if */

  2440           /* otherwise, the address is already in PRI */

  2441           if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2442             error(213);

  2443           if (lval.tag!=0)

  2444             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2445           argidx++;               /* argument done */

  2446           if (lval.sym!=NULL)

  2447             markusage(lval.sym,uWRITTEN);

  2448           break;

  2449         case iREFARRAY:

  2450           if (lval.ident!=iARRAY && lval.ident!=iREFARRAY

  2451               && lval.ident!=iARRAYCELL && lval.ident!=iARRAYCHAR)

  2452           {

  2453             error(35,argidx+1);   /* argument type mismatch */

  2454             break;

  2455           } /* if */

  2456           if (lval.sym!=NULL && (lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0)

  2457             error(35,argidx+1); /* argument type mismatch */

  2458           /* Verify that the dimensions match with those in arg[argidx].

  2459            * A literal array always has a single dimension.

  2460            * An iARRAYCELL parameter is also assumed to have a single dimension.

  2461            */

  2462           if (lval.sym==NULL || lval.ident==iARRAYCELL || lval.ident==iARRAYCHAR) {

  2463             if (arg[argidx].numdim!=1) {

  2464               error(48);        /* array dimensions must match */

  2465             } else if (arg[argidx].dim[0]!=0) {

  2466               assert(arg[argidx].dim[0]>0);

  2467               if (lval.ident==iARRAYCELL) {

  2468                 error(47);        /* array sizes must match */

  2469               } else {

  2470                 assert(lval.constval!=0); /* literal array must have a size */

  2471                 /* A literal array must have exactly the same size as the

  2472                  * function argument; a literal string may be smaller than

  2473                  * the function argument.

  2474                  */

  2475                 if (lval.constval>0 && arg[argidx].dim[0]!=lval.constval

  2476                     || lval.constval<0 && arg[argidx].dim[0] < -lval.constval)

  2477                   error(47);      /* array sizes must match */

  2478               } /* if */

  2479             } /* if */

  2480             if (lval.ident!=iARRAYCELL && lval.ident!=iARRAYCHAR) {

  2481               /* save array size, for default values with uSIZEOF flag */

  2482               cell array_sz=lval.constval;

  2483               assert(array_sz!=0);/* literal array must have a size */

  2484               if (array_sz<0)

  2485                 array_sz= -array_sz;

  2486               append_constval(&arrayszlst,arg[argidx].name,array_sz,0);

  2487             }/* if */

  2488           } else {

  2489             symbol *sym=lval.sym;

  2490             short level=0;

  2491             assert(sym!=NULL);

  2492             if (sym->dim.array.level+1!=arg[argidx].numdim)

  2493               error(48);          /* array dimensions must match */

  2494             /* the lengths for all dimensions must match, unless the dimension

  2495              * length was defined at zero (which means "undefined")

  2496              */

  2497             while (sym->dim.array.level>0) {

  2498               assert(level<sDIMEN_MAX);

  2499               if (arg[argidx].dim[level]!=0 && sym->dim.array.length!=arg[argidx].dim[level])

  2500                 error(47);        /* array sizes must match */

  2501               else if (!matchtag(arg[argidx].idxtag[level],sym->x.tags.index,TRUE))

  2502                 error(229,sym->name);   /* index tag mismatch */

  2503               append_constval(&arrayszlst,arg[argidx].name,sym->dim.array.length,level);

  2504               sym=finddepend(sym);

  2505               assert(sym!=NULL);

  2506               level++;

  2507             } /* if */

  2508             /* the last dimension is checked too, again, unless it is zero */

  2509             assert(level<sDIMEN_MAX);

  2510             assert(sym!=NULL);

  2511             if (arg[argidx].dim[level]!=0 && sym->dim.array.length!=arg[argidx].dim[level])

  2512               error(47);          /* array sizes must match */

  2513             else if (!matchtag(arg[argidx].idxtag[level],sym->x.tags.index,TRUE))

  2514               error(229,sym->name);   /* index tag mismatch */

  2515             append_constval(&arrayszlst,arg[argidx].name,sym->dim.array.length,level);

  2516           } /* if */

  2517           /* address already in PRI */

  2518           if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2519             error(213);

  2520           if (lval.tag!=0)

  2521             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2522           // ??? set uWRITTEN?

  2523           argidx++;               /* argument done */

  2524           break;

  2525         } /* switch */

  2526         pushreg(sPRI);            /* store the function argument on the stack */

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

  2528         nest_stkusage++;

  2529       } /* if */

  2530       assert(arglist[argpos]!=ARG_UNHANDLED);

  2531       nargs++;

  2532       if (matchparanthesis) {

  2533         close=matchtoken(')');

  2534         if (!close)               /* if not paranthese... */

  2535           if (!needtoken(','))    /* ...should be comma... */

  2536             break;                /* ...but abort loop if neither */

  2537       } else {

  2538         close=!matchtoken(',');

  2539         if (close) {              /* if not comma... */

  2540           if (needtoken(tTERM)==1)/* ...must be end of statement */

  2541             lexpush();            /* push again, because end of statement is analised later */

  2542         } /* if */

  2543       } /* if */

  2544     } while (!close && freading && !matchtoken(tENDEXPR)); /* do */

  2545   } /* if */

  2546   /* check remaining function arguments (they may have default values) */

  2547   for (argidx=0; arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS; argidx++) {

  2548     if (arglist[argidx]==ARG_DONE)

  2549       continue;                 /* already seen and handled this argument */

  2550     /* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;

  2551      * these are handled last

  2552      */

  2553     if ((arg[argidx].hasdefault & uSIZEOF)!=0 || (arg[argidx].hasdefault & uTAGOF)!=0) {

  2554       assert(arg[argidx].ident==iVARIABLE);

  2555       continue;

  2556     } /* if */

  2557     stgmark((char)(sEXPRSTART+argidx));/* mark beginning of new expression in stage */

  2558     if (arg[argidx].hasdefault) {

  2559       if (arg[argidx].ident==iREFARRAY) {

  2560         short level;

  2561         setdefarray(arg[argidx].defvalue.array.data,

  2562                     arg[argidx].defvalue.array.size,

  2563                     arg[argidx].defvalue.array.arraysize,

  2564                     &arg[argidx].defvalue.array.addr,

  2565                     (arg[argidx].usage & uCONST)!=0);

  2566         if ((arg[argidx].usage & uCONST)==0) {

  2567           heapalloc+=arg[argidx].defvalue.array.arraysize;

  2568           nest_stkusage+=arg[argidx].defvalue.array.arraysize;

  2569         } /* if */

  2570         /* keep the lengths of all dimensions of a multi-dimensional default array */

  2571         assert(arg[argidx].numdim>0);

  2572         if (arg[argidx].numdim==1) {

  2573           append_constval(&arrayszlst,arg[argidx].name,arg[argidx].defvalue.array.arraysize,0);

  2574         } else {

  2575           for (level=0; level<arg[argidx].numdim; level++) {

  2576             assert(level<sDIMEN_MAX);

  2577             append_constval(&arrayszlst,arg[argidx].name,arg[argidx].dim[level],level);

  2578           } /* for */

  2579         } /* if */

  2580       } else if (arg[argidx].ident==iREFERENCE) {

  2581         setheap(arg[argidx].defvalue.val);

  2582         /* address of the value on the heap in PRI */

  2583         heapalloc+=markheap(MEMUSE_STATIC, 1);

  2584         nest_stkusage++;

  2585       } else {

  2586         int dummytag=arg[argidx].tags[0];

  2587         ldconst(arg[argidx].defvalue.val,sPRI);

  2588         assert(arg[argidx].numtags>0);

  2589         check_userop(NULL,arg[argidx].defvalue_tag,arg[argidx].tags[0],2,NULL,&dummytag);

  2590         assert(dummytag==arg[argidx].tags[0]);

  2591       } /* if */

  2592       pushreg(sPRI);            /* store the function argument on the stack */

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

  2594       nest_stkusage++;

  2595     } else {

  2596       error(92,argidx);        /* argument count mismatch */

  2597     } /* if */

  2598     if (arglist[argidx]==ARG_UNHANDLED)

  2599       nargs++;

  2600     arglist[argidx]=ARG_DONE;

  2601   } /* for */

  2602   /* now a second loop to catch the arguments with default values that are

  2603    * the "sizeof" or "tagof" of other arguments

  2604    */

  2605   for (argidx=0; arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS; argidx++) {

  2606     constvalue *asz;

  2607     cell array_sz;

  2608     if (arglist[argidx]==ARG_DONE)

  2609       continue;                 /* already seen and handled this argument */

  2610     stgmark((char)(sEXPRSTART+argidx));/* mark beginning of new expression in stage */

  2611     assert(arg[argidx].ident==iVARIABLE);           /* if "sizeof", must be single cell */

  2612     /* if unseen, must be "sizeof" or "tagof" */

  2613     assert((arg[argidx].hasdefault & uSIZEOF)!=0 || (arg[argidx].hasdefault & uTAGOF)!=0);

  2614     if ((arg[argidx].hasdefault & uSIZEOF)!=0) {

  2615       /* find the argument; if it isn't found, the argument's default value

  2616        * was a "sizeof" of a non-array (a warning for this was already given

  2617        * when declaring the function)

  2618        */

  2619       asz=find_constval(&arrayszlst,arg[argidx].defvalue.size.symname,

  2620                         arg[argidx].defvalue.size.level);

  2621       if (asz!=NULL) {

  2622         array_sz=asz->value;

  2623         if (array_sz==0)

  2624           error(224,arg[argidx].name);    /* indeterminate array size in "sizeof" expression */

  2625       } else {

  2626         array_sz=1;

  2627       } /* if */

  2628     } else {

  2629       asz=find_constval(&taglst,arg[argidx].defvalue.size.symname,

  2630                         arg[argidx].defvalue.size.level);

  2631       if (asz != NULL) {

  2632         exporttag(asz->value);

  2633         array_sz=asz->value | PUBLICTAG;  /* must be set, because it just was exported */

  2634       } else {

  2635         array_sz=0;

  2636       } /* if */

  2637     } /* if */

  2638     ldconst(array_sz,sPRI);

  2639     pushreg(sPRI);              /* store the function argument on the stack */

  2640     markexpr(sPARM,NULL,0);

  2641     nest_stkusage++;

  2642     if (arglist[argidx]==ARG_UNHANDLED)

  2643       nargs++;

  2644     arglist[argidx]=ARG_DONE;

  2645   } /* for */

  2646   stgmark(sENDREORDER);         /* mark end of reversed evaluation */

  2647   pushval((cell)nargs /* *sizeof(cell)*/ );

  2648   nest_stkusage++;

  2649   ffcall(sym,NULL,nargs);

  2650   if (sc_status!=statSKIP)

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

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

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

  2654   if (symret!=NULL)

  2655     popreg(sPRI);               /* pop hidden parameter as function result */

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

  2657   delete_consttable(&arrayszlst);     /* clear list of array sizes */

  2658   delete_consttable(&taglst);   /* clear list of parameter tags */

  2660   /* maintain max. amount of memory used */

  2661   {

  2662     long totalsize;

  2663     totalsize=declared+heapalloc+1;   /* local variables & return value size,

  2664                                        * +1 for PROC opcode */

  2665     if (lval_result->ident==iREFARRAY)

  2666       totalsize++;                    /* add hidden parameter (on the stack) */

  2667     if ((sym->usage & uNATIVE)==0)

  2668       totalsize++;                    /* add "call" opcode */

  2669     totalsize+=nest_stkusage;

  2670     assert(curfunc!=NULL);

  2671     if (curfunc->x.stacksize<totalsize)

  2672       curfunc->x.stacksize=totalsize;

  2673     nest_stkusage-=nargs+heapalloc+1; /* stack/heap space, +1 for argcount param */

  2674     /* if there is a syntax error in the script, the stack calculation is

  2675      * probably incorrect; but we may not allow it to drop below zero

  2676      */

  2677     if (nest_stkusage<0)

  2678       nest_stkusage=0;

  2679   }

  2681   /* scrap any arrays left on the heap, with the exception of the array that

  2682    * this function has as a result (in other words, scrap all arrays on the

  2683    * heap that caused by expressions in the function arguments)

  2684    */

  2685   popheaplist();

  2686   nesting--;

  2687 }

  2689 /*  dbltest

  2690  *

  2691  *  Returns a non-zero value if lval1 an array and lval2 is not an array and

  2692  *  the operation is addition or subtraction.

  2693  *

  2694  *  Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell

  2695  *  to an array offset.

  2696  */

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

  2698 {

  2699   if ((oper!=ob_add) && (oper!=ob_sub))

  2700     return 0;

  2701   if (lval1->ident!=iARRAY)

  2702     return 0;

  2703   if (lval2->ident==iARRAY)

  2704     return 0;

  2705   return sizeof(cell)/2;        /* 1 for 16-bit, 2 for 32-bit */

  2706 }

  2708 /*  commutative

  2709  *

  2710  *  Test whether an operator is commutative, i.e. x oper y == y oper x.

  2711  *  Commutative operators are: +  (addition)

  2712  *                             *  (multiplication)

  2713  *                             == (equality)

  2714  *                             != (inequality)

  2715  *                             &  (bitwise and)

  2716  *                             ^  (bitwise xor)

  2717  *                             |  (bitwise or)

  2718  *

  2719  *  If in an expression, code for the left operand has been generated and

  2720  *  the right operand is a constant and the operator is commutative, the

  2721  *  precautionary "push" of the primary register is scrapped and the constant

  2722  *  is read into the secondary register immediately.

  2723  */

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

  2725 {

  2726   return oper==ob_add || oper==os_mult

  2727          || oper==ob_eq || oper==ob_ne

  2728          || oper==ob_and || oper==ob_xor || oper==ob_or;

  2729 }

  2731 /*  constant

  2732  *

  2733  *  Generates code to fetch a number, a literal character (which is returned

  2734  *  by lex() as a number as well) or a literal string (lex() stores the

  2735  *  strings in the literal queue). If the operand was a number, it is stored

  2736  *  in lval->constval.

  2737  *

  2738  *  The function returns 1 if the token was a constant or a string, 0

  2739  *  otherwise.

  2740  */

  2741 static int constant(value *lval)

  2742 {

  2743   int tok,index,ident;

  2744   cell val,item,cidx;

  2745   char *st;

  2746   symbol *sym;

  2747   int cmptag=lval->cmptag;

  2749   tok=lex(&val,&st);

  2750   if (tok==tSYMBOL && (sym=findconst(st,&cmptag))!=0) {

  2751     if (cmptag>1)

  2752       error(91,sym->name);  /* ambiguity: multiple matching constants (different tags) */

  2753     lval->constval=sym->addr;

  2754     ldconst(lval->constval,sPRI);

  2755     lval->ident=iCONSTEXPR;

  2756     lval->tag=sym->tag;

  2757     lval->sym=sym;

  2758     markusage(sym,uREAD);

  2759   } else if (tok==tNUMBER) {

  2760     lval->constval=val;

  2761     ldconst(lval->constval,sPRI);

  2762     lval->ident=iCONSTEXPR;

  2763   } else if (tok==tRATIONAL) {

  2764     lval->constval=val;

  2765     ldconst(lval->constval,sPRI);

  2766     lval->ident=iCONSTEXPR;

  2767     lval->tag=sc_rationaltag;

  2768   } else if (tok==tSTRING) {

  2769     /* lex() stores starting index of string in the literal table in 'val' */

  2770     ldconst((val+glb_declared)*sizeof(cell),sPRI);

  2771     lval->ident=iARRAY;         /* pretend this is a global array */

  2772     lval->constval=val-litidx;  /* constval == the negative value of the

  2773                                  * size of the literal array; using a negative

  2774                                  * value distinguishes between literal arrays

  2775                                  * and literal strings (this was done for

  2776                                  * array assignment). */

  2777 	lval->tag=pc_tag_string;

  2778   } else if (tok=='{') {

  2779     int tag,lasttag=-1;

  2780     val=litidx;

  2781     do {

  2782       /* cannot call constexpr() here, because "staging" is already turned

  2783        * on at this point */

  2784       assert(staging);

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

  2786       ident=expression(&item,&tag,NULL,FALSE,NULL);

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

  2788       if (ident!=iCONSTEXPR)

  2789         error(8);               /* must be constant expression */

  2790       if (lasttag<0)

  2791         lasttag=tag;

  2792       else if (!matchtag(lasttag,tag,FALSE))

  2793         error(213);             /* tagname mismatch */

  2794       litadd(item);             /* store expression result in literal table */

  2795     } while (matchtoken(','));

  2796     if (!needtoken('}'))

  2797       lexclr(FALSE);

  2798     ldconst((val+glb_declared)*sizeof(cell),sPRI);

  2799     lval->ident=iARRAY;         /* pretend this is a global array */

  2800     lval->constval=litidx-val;  /* constval == the size of the literal array */

  2801   } else {

  2802     return FALSE;               /* no, it cannot be interpreted as a constant */

  2803   } /* if */

  2804   return TRUE;                  /* yes, it was a constant value */

  2805 }

author	David Anderson <dvander@alliedmods.net>
	Thu Jan 25 20:08:00 2007 +0000 (2007-01-25)
changeset 353	492a8d0d5f59
parent 343	9f6532016ce1
child 365	d830b2b0414f
permissions	-rw-r--r--