sourcemod-central: sourcepawn/compiler/sc3.c@568f4497ef4a

     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$

    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 == pc_anytag || actualtag == pc_anytag)

   331 		{

   332 			return TRUE;

   333 		}

   335 		if (formaltag & FUNCTAG)

   336 		{

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

   338 			{

   339 				return TRUE;

   340 			} else if (actualtag & FUNCTAG) {

   341 				constvalue *v = find_tag_byval(actualtag);

   342 				int index;

   343 				short usage = uPUBLIC;

   344 				symbol *sym, *found = NULL;

   345 				funcenum_t *e;

   346 				functag_t *t;

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

   349 				{

   350 					return FALSE;

   351 				}

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

   354 				e = funcenums_find_byval(formaltag);

   355 				if (!e)

   356 				{

   357 					return FALSE;

   358 				}

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

   362 				/* Deduce which function type this is */

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

   364 				{

   365 					usage = uPUBLIC;

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

   367 					usage = uSTOCK;

   368 				}

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

   372 				assert(index >= 0);

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

   375 				if (usage == uPUBLIC)

   376 				{

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

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

   379 						{

   380 							if (index-- == 0)

   381 							{

   382 								found = sym;

   383 								break;

   384 							}

   385 						}

   386 					}

   387 				} else if (usage == uSTOCK) {

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

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

   390 						{

   391 							if (sym->codeaddr == index)

   392 							{

   393 								found = sym;

   394 								break;

   395 							}

   396 						}

   397 					}

   398 				}

   400 				if (!found)

   401 				{

   402 					assert(found);

   403 					return FALSE;

   404 				}

   406 				/* Wow, we now have:

   407 				 * 1) The functional enum deduced from formaltag

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

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

   410 				 */

   411 				t = e->first;

   412 				while (t)

   413 				{

   414 					int curarg,skip=0,i;

   415 					arginfo *func_arg;

   416 					funcarg_t *enum_arg;

   417 					/* Check return type first. */

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

   419 					{

   420 						t = t->next;

   421 						continue;

   422 					}

   423 					/* Check usage */

   424 					if (t->type != usage)

   425 					{

   426 						t = t->next;

   427 						continue;

   428 					}

   429 					/* Begin iterating arguments */

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

   431 					{

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

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

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

   435 						{

   436 							/* Can we bail out early? */

   437 							if (!enum_arg->ommittable)

   438 							{

   439 								/* No! */

   440 								skip = 1;

   441 							}

   442 							break;

   443 						}

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

   445 						/* First check the ident type */

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

   447 						{

   448 							skip = 1;

   449 							break;

   450 						}

   451 						/* Next check arrayness */

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

   453 						{

   454 							skip = 1;

   455 							break;

   456 						}

   457 						if (enum_arg->dimcount > 0)

   458 						{

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

   460 							{

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

   462 								{

   463 									skip = 1;

   464 									break;

   465 								}

   466 							}

   467 							if (skip)

   468 							{

   469 								break;

   470 							}

   471 						}

   472 						/* Lastly, check the tags */

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

   474 						{

   475 							skip = 1;

   476 							break;

   477 						}

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

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

   480 						{

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

   482 							{

   483 								skip = 1;

   484 								break;

   485 							}

   486 						}

   487 						if (skip)

   488 						{

   489 							break;

   490 						}

   491 					}

   492 					if (!skip)

   493 					{

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

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

   496 						{

   497 							return TRUE;

   498 						}

   499 					}

   500 					t = t->next;

   501 				}

   502 			}

   503 		}

   504 		return FALSE;

   505 	}

   506   } /* if */

   507   return TRUE;

   508 }

   510 /*

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

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

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

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

   515  *  standard C:

   516  *

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

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

   519  *

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

   521  *                           and expr3 will only be evaluated if expr1 is

   522  *                           false and expr2 is true.

   523  *

   524  *  Code generation for the last example proceeds thus:

   525  *

   526  *      evaluate expr1

   527  *      operator || found

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

   529  *      evaluate expr2

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

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

   532  *          evaluate expr3

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

   534  *          set expression result to 1 (true)

   535  *          jump to "l3"

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

   537  *      l3:

   538  *      <-  drop back to previous hierarchy level

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

   540  *      set expression result to 0 (false)

   541  *      jump to "l4"

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

   543  *  l4:

   544  *

   545  */

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

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

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

   550  *            expressions.

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

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

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

   554  */

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

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

   557 {

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

   559   int allconst,foundop;

   560   cell constval;

   561   int index;

   562   cell cidx;

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

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

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

   567   constval=0;

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

   569   for ( ;; ) {

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

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

   573     if (allconst) {

   574       if (hits) {

   575         /* one operator was already found */

   576         if (testfunc==jmp_ne0)

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

   578         else

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

   580       } /* if */

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

   582     } /* if */

   584     foundop=nextop(&opidx,opstr);

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

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

   587     if (foundop) {

   588       if (!hits) {

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

   590         hits=TRUE;

   591         droplab=getlabel();

   592       } /* if */

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

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

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

   596       ldconst(endval,sPRI);

   597       jumplabel(endlab=getlabel());

   598       setlabel(droplab);

   599       ldconst(dropval,sPRI);

   600       setlabel(endlab);

   601       lval->sym=NULL;

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

   603       if (allconst) {

   604         lval->ident=iCONSTEXPR;

   605         lval->constval=constval;

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

   607       } else {

   608         lval->ident=iEXPRESSION;

   609         lval->constval=0;

   610       } /* if */

   611       return FALSE;

   612     } else {

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

   614     } /* if */

   616   } /* while */

   617 }

   619 /*

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

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

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

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

   624  *  result.

   625  *

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

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

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

   629  */

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

   631 {

   632   if (lvalue)

   633     rvalue(lval);

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

   635     ldconst(lval->constval,sPRI);

   636   (*testfunc)(exit1);

   637 }

   639 static void checkfunction(value *lval)

   640 {

   641   symbol *sym=lval->sym;

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

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

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

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

   648      * exception for directly recursive functions)

   649      */

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

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

   652       funcdisplayname(symname,sym->name);

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

   654     } /* if */

   655   } else {

   656     /* function not yet defined, set */

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

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

   659   } /* if */

   660 }

   662 /*

   663  *  Plunge to a lower level

   664  */

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

   666                  char *forcetag,int chkbitwise)

   667 {

   668   int lvalue,opidx;

   669   int count;

   670   value lval2 = {0};

   672   lvalue=plnge1(hier,lval);

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

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

   675   if (lvalue)

   676     rvalue(lval);

   677   count=0;

   678   do {

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

   680       error(212);

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

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

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

   684       bitwise_opercount++;

   685     if (forcetag!=NULL)

   686       lval->tag=pc_addtag(forcetag);

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

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

   689 }

   691 /*  plnge_rel

   692  *

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

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

   695  */

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

   697 {

   698   int lvalue,opidx;

   699   value lval2={0};

   700   int count;

   701   char boolresult;

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

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

   705   lvalue=plnge1(hier,lval);

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

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

   708   if (lvalue)

   709     rvalue(lval);

   710   count=0;

   711   lval->boolresult=TRUE;

   712   do {

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

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

   715       error(212);

   716     if (count>0) {

   717       relop_prefix();

   718       boolresult=lval->boolresult;

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

   720       lval->boolresult=boolresult;

   721     } /* if */

   722     opidx+=opoff;

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

   724     if (count++>0)

   725       relop_suffix();

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

   727   lval->constval=lval->boolresult;

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

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

   730 }

   732 /*  plnge1

   733  *

   734  *  Unary plunge to lower level

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

   736  */

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

   738 {

   739   int lvalue,index;

   740   cell cidx;

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

   743   lvalue=(*hier)(lval);

   744   if (lval->ident==iCONSTEXPR)

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

   746   return lvalue;

   747 }

   749 /*  plnge2

   750  *

   751  *  Binary plunge to lower level

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

   753  */

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

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

   756                    value *lval1,value *lval2)

   757 {

   758   int index;

   759   cell cidx;

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

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

   763     if (plnge1(hier,lval2))

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

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

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

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

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

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

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

   771     pushreg(sPRI);

   772     if (plnge1(hier,lval2))

   773       rvalue(lval2);

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

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

   776         value lvaltmp = {0};

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

   778                                      * fetch the constant again */

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

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

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

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

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

   784          */

   785         lvaltmp=*lval1;

   786         *lval1=*lval2;

   787         *lval2=lvaltmp;

   788       } else {

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

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

   791       } /* if */

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

   793       popreg(sALT);

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

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

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

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

   798     } /* if */

   799   } /* if */

   800   if (oper) {

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

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

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

   804      * a future function definition can check this bit.

   805      */

   806     checkfunction(lval1);

   807     checkfunction(lval2);

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

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

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

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

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

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

   814     } /* if */

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

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

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

   819      */

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

   821       lval1->ident=iEXPRESSION;

   822       lval1->constval=0;

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

   824       /* only constant expression if both constant */

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

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

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

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

   829     } else {

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

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

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

   833       lval1->ident=iEXPRESSION;

   834     } /* if */

   835   } /* if */

   836 }

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

   839 {

   840   cell q,r;

   842   if (b==0) {

   843     error(29);

   844     return 0;

   845   } /* if */

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

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

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

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

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

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

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

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

   854     q--;

   855     r+=b;

   856   } /* if */

   857   return return_remainder ? r : q;

   858 }

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

   861 {

   862   if (oper==ob_or)

   863     return (left | right);

   864   else if (oper==ob_xor)

   865     return (left ^ right);

   866   else if (oper==ob_and)

   867     return (left & right);

   868   else if (oper==ob_eq)

   869     return (left == right);

   870   else if (oper==ob_ne)

   871     return (left != right);

   872   else if (oper==os_le)

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

   874   else if (oper==os_ge)

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

   876   else if (oper==os_lt)

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

   878   else if (oper==os_gt)

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

   880   else if (oper==os_sar)

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

   882   else if (oper==ou_sar)

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

   884   else if (oper==ob_sal)

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

   886   else if (oper==ob_add)

   887     return (left + right);

   888   else if (oper==ob_sub)

   889     return (left - right);

   890   else if (oper==os_mult)

   891     return (left * right);

   892   else if (oper==os_div)

   893     return flooreddiv(left,right,0);

   894   else if (oper==os_mod)

   895     return flooreddiv(left,right,1);

   896   else

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

   898   return 0;

   899 }

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

   902 {

   903   value lval={0};

   904   pushheaplist();

   906   if (hier14(&lval))

   907     rvalue(&lval);

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

   909   popheaplist();

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

   912     *val=lval.constval;

   913   if (tag!=NULL)

   914     *tag=lval.tag;

   915   if (symptr!=NULL)

   916     *symptr=lval.sym;

   917   if (chkfuncresult)

   918     checkfunction(&lval);

   919   if (_lval)

   920     *_lval=lval;

   921   return lval.ident;

   922 }

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

   925 {

   926   char name[sNAMEMAX+1];

   927   cell val;

   928   char *str;

   929   int fsa,islabel;

   931   assert(automaton!=NULL);

   932   assert(state!=NULL);

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

   934     return 0;

   936   tokeninfo(&val,&str);

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

   938   strcpy(name,str);

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

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

   941     *automaton=automaton_find(name);

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

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

   944      * precedes any state definition)

   945      */

   946     if (!needtoken(tSYMBOL))

   947       return 0;

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

   949     if (*automaton==NULL) {

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

   951       return 0;

   952     } /* if */

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

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

   955     strcpy(name,str);

   956   } else {

   957     *automaton=automaton_find("");

   958     assert(*automaton!=NULL);

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

   960   } /* if */

   961   assert(*automaton!=NULL);

   962   fsa=(*automaton)->index;

   964   assert(*automaton!=NULL);

   965   *state=state_find(name,fsa);

   966   if (*state==NULL) {

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

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

   969       fsaname="<main>";

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

   971     return 0;

   972   } /* if */

   974   return 1;

   975 }

   977 SC_FUNC cell array_totalsize(symbol *sym)

   978 {

   979   cell length;

   981   assert(sym!=NULL);

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

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

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

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

   986     if (sublength>0)

   987       length=length+length*sublength;

   988     else

   989       length=0;

   990   } /* if */

   991   return length;

   992 }

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

   995 {

   996   assert(sym!=NULL);

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

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

   999   while (level-- > 0) {

  1000     sym=finddepend(sym);

  1001     assert(sym!=NULL);

  1002   } /* if */

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

  1004 }

  1006 /*  hier14

  1007  *

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

  1009  *

  1010  *  Global references: sc_intest        (reffered to only)

  1011  *                     sc_allowproccall (modified)

  1012  */

  1013 static int hier14(value *lval1)

  1014 {

  1015   int lvalue;

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

  1017   void (*oper)(void);

  1018   int tok,level,i;

  1019   cell val;

  1020   char *st;

  1021   int bwcount,leftarray;

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

  1023   cell *org_arrayidx;

  1025   bwcount=bitwise_opercount;

  1026   bitwise_opercount=0;

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

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

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

  1030    * negative value would do).

  1031    */

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

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

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

  1035   if (lval1->arrayidx==NULL)

  1036     lval1->arrayidx=arrayidx1;

  1037   lvalue=plnge1(hier13,lval1);

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

  1039     lval1->arrayidx=NULL;

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

  1041     ldconst(lval1->constval,sPRI);

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

  1043   switch (tok) {

  1044     case taOR:

  1045       oper=ob_or;

  1046       break;

  1047     case taXOR:

  1048       oper=ob_xor;

  1049       break;

  1050     case taAND:

  1051       oper=ob_and;

  1052       break;

  1053     case taADD:

  1054       oper=ob_add;

  1055       break;

  1056     case taSUB:

  1057       oper=ob_sub;

  1058       break;

  1059     case taMULT:

  1060       oper=os_mult;

  1061       break;

  1062     case taDIV:

  1063       oper=os_div;

  1064       break;

  1065     case taMOD:

  1066       oper=os_mod;

  1067       break;

  1068     case taSHRU:

  1069       oper=ou_sar;

  1070       break;

  1071     case taSHR:

  1072       oper=os_sar;

  1073       break;

  1074     case taSHL:

  1075       oper=ob_sal;

  1076       break;

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

  1078       oper=NULL;

  1079       if (sc_intest)

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

  1081       break;

  1082     default:

  1083       lexpush();

  1084       bitwise_opercount=bwcount;

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

  1086       return lvalue;

  1087   } /* switch */

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

  1090    * and then the general */

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

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

  1093     lvalue=TRUE;

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

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

  1096     if (oper)

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

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

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

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

  1101     lvalue=TRUE;

  1102   } /* if */

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

  1105   if (!lvalue)

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

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

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

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

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

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

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

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

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

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

  1117   {

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

  1119     if (oper) {

  1120       pushreg(sPRI);

  1121       rvalue(lval1);

  1122     } /* if */

  1123     lval2.arrayidx=arrayidx2;

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

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

  1126       lval2.arrayidx=NULL;

  1127     if (oper)

  1128       popreg(sALT);

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

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

  1131     {

  1132       int same=TRUE;

  1133       assert(lval2.arrayidx==arrayidx2);

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

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

  1136         if (same)

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

  1138     } /* if */

  1139   } else {

  1140     if (oper){

  1141       rvalue(lval1);

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

  1143     } else {

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

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

  1146       if (hier14(&lval2))

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

  1148       else if (lval2.ident==iVARIABLE)

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

  1150       checkfunction(&lval2);

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

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

  1153         assert(lval3.sym!=NULL);

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

  1155       } /* if */

  1156     } /* if */

  1157   } /* if */

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

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

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

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

  1162    */

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

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

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

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

  1167   if (leftarray) {

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

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

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

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

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

  1173      * strings.

  1174      */

  1175     int exactmatch=TRUE;

  1176     int idxtag=0;

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

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

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

  1180     {

  1181       ltlength=(int)lval3.constval;

  1182     } /* if */

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

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

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

  1186     if (lval2.sym!=NULL) {

  1187       if (lval2.constval==0) {

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

  1189       } else {

  1190         val=lval2.constval;

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

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

  1193       } /* if */

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

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

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

  1197         exactmatch=FALSE;

  1198     } else {

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

  1200       level=0;

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

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

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

  1204        * index tag.

  1205        */

  1206       if (val<0) {

  1207         val=-val;

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

  1209           exactmatch=FALSE;

  1210       } /* if */

  1211     } /* if */

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

  1213       return error(47); /* array dimensions must match */

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

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

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

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

  1218     if (level>0) {

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

  1220       symbol *sym1 = lval3.sym;

  1221       symbol *sym2 = lval2.sym;

  1222       int i;

  1223       error(23);

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

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

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

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

  1228        */

  1229       assert(exactmatch);

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

  1231         sym1=finddepend(sym1);

  1232         sym2=finddepend(sym2);

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

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

  1235          *     earlier) so the dependend should always be found

  1236          */

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

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

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

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

  1241       } /* for */

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

  1243       val=array_totalsize(lval3.sym);

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

  1245     } /* if */

  1246   } else {

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

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

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

  1250   } /* if */

  1251   if (leftarray) {

  1252     memcopy(val*sizeof(cell));

  1253   } else {

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

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

  1256   } /* if */

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

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

  1259   if (lval3.sym)

  1260     markusage(lval3.sym,uWRITTEN);

  1261   sideeffect=TRUE;

  1262   bitwise_opercount=bwcount;

  1263   lval1->ident=iEXPRESSION;

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

  1265 }

  1267 /**

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

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

  1270  * something dynamically managed.

  1271  * !Note:

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

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

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

  1275  *   (a() ? return_array() : return_array()) ? return_array() : return_array()

  1276  */

  1278 long dynarray_from_heaplist(memuse_list_t *heap)

  1279 {

  1280   memuse_t *use=heap->head;

  1281   memuse_t *tmp;

  1282   long total=0;

  1283   while (use) {

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

  1285     total+=use->size;

  1286     tmp=use->prev;

  1287     free(use);

  1288     use=tmp;

  1289   }

  1290   free(heap);

  1291   if (total)

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

  1293   return total;

  1294 }

  1296 static int hier13(value *lval)

  1297 {

  1298   int lvalue=plnge1(hier12,lval);

  1299   if (matchtoken('?')) {

  1300     int flab1=getlabel();

  1301     int flab2=getlabel();

  1302     value lval2={0};

  1303     int array1,array2;

  1304     long total1,total2;

  1305     memuse_list_t *heap;

  1307     pushheaplist();

  1308     if (lvalue) {

  1309       rvalue(lval);

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

  1311       ldconst(lval->constval,sPRI);

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

  1313     } /* if */

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

  1315     PUSHSTK_I(sc_allowtags);

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

  1317     if (hier13(lval))

  1318       rvalue(lval);

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

  1320       ldconst(lval->constval,sPRI);

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

  1322     heap=popsaveheaplist();

  1323     total1=dynarray_from_heaplist(heap);

  1324     pushheaplist();

  1325     jumplabel(flab2);

  1326     setlabel(flab1);

  1327     needtoken(':');

  1328     if (hier13(&lval2))

  1329       rvalue(&lval2);

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

  1331       ldconst(lval2.constval,sPRI);

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

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

  1334     if (!array1 && array2) {

  1335       const char *ptr = "-unknown-";

  1336       if (lval->sym != NULL && lval->sym->name != NULL)

  1337         ptr = lval->sym->name;

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

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

  1340       const char *ptr = "-unknown-";

  1341       if (lval2.sym != NULL && lval2.sym->name != NULL)

  1342         ptr = lval2.sym->name;

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

  1344     } /* if */

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

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

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

  1348     heap=popsaveheaplist();

  1349     total2=dynarray_from_heaplist(heap);

  1350     setlabel(flab2);

  1351     if ((array1 && array2) && (total1 && total2)) {

  1352       markheap(MEMUSE_DYNAMIC, 0);

  1353     }

  1354     /* If both sides are arrays, we should return the maximal as the lvalue.

  1355      * Otherwise we could buffer overflow and the compiler is too stupid.

  1356      * Literal strings have a constval == -(num_cells) so the cmp is flipped.

  1357      */

  1358     if (lval->ident==iARRAY && lval2.ident==iARRAY

  1359         && lval->constval < 0

  1360         && lval->constval > lval2.constval) {

  1361       *lval = lval2;

  1362     }

  1363     if (lval->ident==iARRAY)

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

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

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

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

  1368   } else {

  1369     return lvalue;

  1370   } /* if */

  1371 }

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

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

  1375  */

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

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

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

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

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

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

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

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

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

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

  1387 static int hier12(value *lval)

  1388 {

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

  1390 }

  1392 static int hier11(value *lval)

  1393 {

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

  1395 }

  1397 static int hier10(value *lval)

  1398 { /* ==, != */

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

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

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

  1403 static int hier9(value *lval)

  1404 { /* <=, >=, <, > */

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

  1406 }

  1408 static int hier8(value *lval)

  1409 { /* | */

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

  1411 }

  1413 static int hier7(value *lval)

  1414 { /* ^ */

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

  1416 }

  1418 static int hier6(value *lval)

  1419 { /* & */

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

  1421 }

  1423 static int hier5(value *lval)

  1424 { /* <<, >>, >>> */

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

  1426 }

  1428 static int hier4(value *lval)

  1429 { /* +, - */

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

  1431 }

  1433 static int hier3(value *lval)

  1434 { /* *, /, % */

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

  1436 }

  1438 static int hier2(value *lval)

  1439 {

  1440   int lvalue,tok;

  1441   int tag,paranthese;

  1442   cell val;

  1443   char *st;

  1444   symbol *sym;

  1445   int saveresult;

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

  1448   switch (tok) {

  1449   case tINC:                    /* ++lval */

  1450     if (!hier2(lval))

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

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

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

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

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

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

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

  1458     sideeffect=TRUE;

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

  1460   case tDEC:                    /* --lval */

  1461     if (!hier2(lval))

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

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

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

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

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

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

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

  1469     sideeffect=TRUE;

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

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

  1472     if (hier2(lval))

  1473       rvalue(lval);

  1474     invert();                   /* bitwise NOT */

  1475     lval->constval=~lval->constval;

  1476     return FALSE;

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

  1478     if (hier2(lval))

  1479       rvalue(lval);

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

  1481       lval->ident=iEXPRESSION;

  1482       lval->constval=0;

  1483     } else {

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

  1485       lval->constval=!lval->constval;

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

  1487     } /* if */

  1488     return FALSE;

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

  1490     if (hier2(lval))

  1491       rvalue(lval);

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

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

  1494      */

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

  1496       if (rational_digits==0) {

  1497         #if PAWN_CELL_SIZE==32

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

  1499         #elif PAWN_CELL_SIZE==64

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

  1501         #else

  1502           #error Unsupported cell size

  1503         #endif

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

  1505       } else {

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

  1507         lval->constval=-lval->constval;

  1508       } /* if */

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

  1510       lval->ident=iEXPRESSION;

  1511       lval->constval=0;

  1512     } else {

  1513       neg();                    /* arithmic negation */

  1514       lval->constval=-lval->constval;

  1515     } /* if */

  1516     return FALSE;

  1517   case tLABEL:                  /* tagname override */

  1518     tag=pc_addtag(st);

  1519     lval->cmptag=tag;

  1520     lvalue=hier2(lval);

  1521     lval->tag=tag;

  1522     return lvalue;

  1523   case tDEFINED:

  1524     paranthese=0;

  1525     while (matchtoken('('))

  1526       paranthese++;

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

  1528     if (tok!=tSYMBOL)

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

  1530     sym=findloc(st);

  1531     if (sym==NULL)

  1532       sym=findglb(st,sSTATEVAR);

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

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

  1535     val= (sym!=NULL);

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

  1537       val=1;

  1538     clear_value(lval);

  1539     lval->ident=iCONSTEXPR;

  1540     lval->constval= val;

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

  1542     ldconst(lval->constval,sPRI);

  1543     while (paranthese--)

  1544       needtoken(')');

  1545     return FALSE;

  1546   case tSIZEOF:

  1547     paranthese=0;

  1548     while (matchtoken('('))

  1549       paranthese++;

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

  1551     if (tok!=tSYMBOL)

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

  1553     sym=findloc(st);

  1554     if (sym==NULL)

  1555       sym=findglb(st,sSTATEVAR);

  1556     if (sym==NULL)

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

  1558     if (sym->ident==iCONSTEXPR)

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

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

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

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

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

  1564     clear_value(lval);

  1565     lval->ident=iCONSTEXPR;

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

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

  1568       int level;

  1569       symbol *idxsym=NULL;

  1570       symbol *subsym=sym;

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

  1572         idxsym=NULL;

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

  1574           char *idxname;

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

  1576           tokeninfo(&val,&idxname);

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

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

  1579           else if (cmptag>1)

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

  1581         } /* if */

  1582         needtoken(']');

  1583         if (subsym!=NULL)

  1584           subsym=finddepend(subsym);

  1585       } /* for */

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

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

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

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

  1590       } else {

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

  1592       }

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

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

  1595     } /* if */

  1596     ldconst(lval->constval,sPRI);

  1597     while (paranthese--)

  1598       needtoken(')');

  1599     return FALSE;

  1600   case tCELLSOF:

  1601     paranthese=0;

  1602     while (matchtoken('('))

  1603       paranthese++;

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

  1605     if (tok!=tSYMBOL)

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

  1607     sym=findloc(st);

  1608     if (sym==NULL)

  1609       sym=findglb(st,sSTATEVAR);

  1610     if (sym==NULL)

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

  1612     if (sym->ident==iCONSTEXPR)

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

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

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

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

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

  1618     clear_value(lval);

  1619     lval->ident=iCONSTEXPR;

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

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

  1622       int level;

  1623       symbol *idxsym=NULL;

  1624       symbol *subsym=sym;

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

  1626         idxsym=NULL;

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

  1628           char *idxname;

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

  1630           tokeninfo(&val,&idxname);

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

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

  1633           else if (cmptag>1)

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

  1635         } /* if */

  1636         needtoken(']');

  1637         if (subsym!=NULL)

  1638           subsym=finddepend(subsym);

  1639       } /* for */

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

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

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

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

  1644       } else {

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

  1646       }

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

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

  1649     } /* if */

  1650     ldconst(lval->constval,sPRI);

  1651     while (paranthese--)

  1652       needtoken(')');

  1653     return FALSE;

  1654   case tTAGOF:

  1655     paranthese=0;

  1656     while (matchtoken('('))

  1657       paranthese++;

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

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

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

  1661     if (tok==tLABEL) {

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

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

  1664     } else {

  1665       sym=findloc(st);

  1666       if (sym==NULL)

  1667         sym=findglb(st,sSTATEVAR);

  1668       if (sym==NULL)

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

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

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

  1672       tag=sym->tag;

  1673     } /* if */

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

  1675       int level;

  1676       symbol *idxsym=NULL;

  1677       symbol *subsym=sym;

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

  1679         idxsym=NULL;

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

  1681           char *idxname;

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

  1683           tokeninfo(&val,&idxname);

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

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

  1686           else if (cmptag>1)

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

  1688         } /* if */

  1689         needtoken(']');

  1690         if (subsym!=NULL)

  1691           subsym=finddepend(subsym);

  1692       } /* for */

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

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

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

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

  1697     } /* if */

  1698     exporttag(tag);

  1699     clear_value(lval);

  1700     lval->ident=iCONSTEXPR;

  1701     lval->constval=tag | PUBLICTAG;

  1702     ldconst(lval->constval,sPRI);

  1703     while (paranthese--)

  1704       needtoken(')');

  1705     return FALSE;

  1706   default:

  1707     lexpush();

  1708     lvalue=hier1(lval);

  1709     /* check for postfix operators */

  1710     if (matchtoken(';')) {

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

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

  1713       return lvalue;

  1714     } else if (matchtoken(tTERM)) {

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

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

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

  1718        * not be pushed back.

  1719        */

  1720       return lvalue;

  1721     } else {

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

  1723       switch (tok) {

  1724       case tINC:                /* lval++ */

  1725         if (!lvalue)

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

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

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

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

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

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

  1732          * on exit.

  1733          */

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

  1735         if (saveresult)

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

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

  1738         if (saveresult)

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

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

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

  1742         if (saveresult)

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

  1744         sideeffect=TRUE;

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

  1746       case tDEC:                /* lval-- */

  1747         if (!lvalue)

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

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

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

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

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

  1753         if (saveresult)

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

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

  1756         if (saveresult)

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

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

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

  1760         if (saveresult)

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

  1762         sideeffect=TRUE;

  1763         return FALSE;

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

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

  1766  */

  1767 #if 0

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

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

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

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

  1772         } else {

  1773           if (lvalue)

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

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

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

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

  1778         } /* if */

  1779         return FALSE;

  1780 #endif

  1781       default:

  1782         lexpush();

  1783         return lvalue;

  1784       } /* switch */

  1785     } /* if */

  1786   } /* switch */

  1787 }

  1789 /*  hier1

  1790  *

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

  1792  *  and function calls.

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

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

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

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

  1797  *  callfunction() to call the function.

  1798  */

  1799 static int hier1(value *lval1)

  1800 {

  1801   int lvalue,index,tok,symtok;

  1802   cell val,cidx;

  1803   value lval2={0};

  1804   char *st;

  1805   char close;

  1806   symbol *sym;

  1807   int magic_string=0;

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

  1810   lvalue=primary(lval1);

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

  1812   cursym=lval1->sym;

  1813 restart:

  1814   sym=cursym;

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

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

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

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

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

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

  1821        * undefined symbol) */

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

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

  1824       return FALSE;

  1825     } /* if */

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

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

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

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

  1830         needtoken(close);

  1831         return FALSE;

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

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

  1834         needtoken(close);

  1835         return FALSE;

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

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

  1838         needtoken(close);

  1839         return FALSE;

  1840       } /* if */

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

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

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

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

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

  1846         rvalue(&lval2);

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

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

  1849       needtoken(close);

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

  1851         error(213);

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

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

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

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

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

  1857         } /* if */

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

  1859           /* normal array index */

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

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

  1862           if (lval2.constval!=0) {

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

  1864             #if PAWN_CELL_SIZE==16

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

  1866             #elif PAWN_CELL_SIZE==32

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

  1868             #elif PAWN_CELL_SIZE==64

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

  1870             #else

  1871               #error Unsupported cell size

  1872             #endif

  1873             ob_add();

  1874           } /* if */

  1875         } else {

  1876           /* character index */

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

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

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

  1880           if (lval2.constval!=0) {

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

  1882             #if sCHARBITS==16

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

  1884             #else

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

  1886             #endif

  1887             ob_add();

  1888           } /* if */

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

  1890         } /* if */

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

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

  1893          */

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

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

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

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

  1898         } /* if */

  1899       } else {

  1900         /* array index is not constant */

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

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

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

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

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

  1906         } else {

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

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

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

  1910         } /* if */

  1911         popreg(sALT);

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

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

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

  1915       } /* if */

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

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

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

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

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

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

  1922         lval1->ident=iARRAYCELL;

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

  1924         rvalue(lval1);

  1925         popreg(sALT);

  1926         ob_add();

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

  1928         lval1->ident=iREFARRAY;

  1929         lval1->sym=finddepend(sym);

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

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

  1932         cursym=lval1->sym;

  1933         /* try to parse subsequent array indices */

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

  1935         goto restart;

  1936       } /* if */

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

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

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

  1940         lval1->ident = iARRAYCHAR;

  1941       } else {

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

  1943       }

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

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

  1946        * tag is the one from the array symbol.

  1947        */

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

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

  1950       {

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

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

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

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

  1955           lexpush();

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

  1957           lval1->ident=iREFARRAY;

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

  1959            * but with an adjusted index tag

  1960            */

  1961           assert(sym!=NULL);

  1962           dummysymbol=*sym;

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

  1964           assert(lval2.sym!=NULL);

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

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

  1967           cursym=&dummysymbol;

  1968           /* recurse */

  1969           goto restart;

  1970         } /* if */

  1971       } else {

  1972         assert(sym!=NULL);

  1973         if (cursym!=&dummysymbol)

  1974           lval1->tag=sym->tag;

  1975         lval1->constval=0;

  1976       } /* if */

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

  1978        * always a *valid* lvalue */

  1979       return TRUE;

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

  1981       assert(tok=='(');

  1982       if (sym==NULL

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

  1984       {

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

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

  1987            * function so that the usage can be marked.

  1988            */

  1989           sym=fetchfunc(lastsymbol,0);

  1990           if (sym==NULL)

  1991             error(123); /* insufficient memory */

  1992           markusage(sym,uREAD);

  1993         } else {

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

  1995         } /* if */

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

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

  1998         funcdisplayname(symname,sym->name);

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

  2000       } /* if */

  2001       callfunction(sym,lval1,TRUE);

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

  2003     } /* if */

  2004   } /* if */

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

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

  2007     if (sc_allowproccall) {

  2008       callfunction(sym,lval1,FALSE);

  2009     } else if ((sym->usage & uNATIVE) != uNATIVE) {

  2010       symbol *oldsym=sym;

  2011       int n=-1,iter=0;

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

  2013       cell code_addr=0;

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

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

  2016         {

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

  2018             n = iter;

  2019             code_addr = sym->codeaddr;

  2020             break;

  2021           }

  2022           iter++;

  2023         }

  2024       }

  2025       if (n!=-1) {

  2026         char faketag[sNAMEMAX+1];

  2027         lval1->sym=NULL;

  2028         lval1->ident=iCONSTEXPR;

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

  2030         if (usage == uPUBLIC) {

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

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

  2033         } else {

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

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

  2036         }

  2037         lval1->tag=pc_addfunctag(faketag);

  2038         oldsym->usage |= uREAD;

  2039 		sym->usage |= uREAD;

  2040       } else {

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

  2042       } /* if */

  2043       return FALSE;

  2044 	} else {

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

  2046 	}

  2047   } /* if */

  2048   return lvalue;

  2049 }

  2051 /*  primary

  2052  *

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

  2054  *  constants and -of course- errors).

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

  2056  *  already generated by constant().

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

  2058  *

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

  2060  */

  2061 static int primary(value *lval)

  2062 {

  2063   char *st;

  2064   int lvalue,tok;

  2065   cell val;

  2066   symbol *sym;

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

  2069     PUSHSTK_I(sc_intest);

  2070     PUSHSTK_I(sc_allowtags);

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

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

  2074     sc_allowproccall=FALSE;

  2075     do

  2076       lvalue=hier14(lval);

  2077     while (matchtoken(','));

  2078     needtoken(')');

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

  2080                                  * cleared already by needtoken() */

  2081     sc_allowtags=(short)POPSTK_I();

  2082     sc_intest=(short)POPSTK_I();

  2083     return lvalue;

  2084   } /* if */

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

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

  2088   if (tok==tSYMBOL) {

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

  2090      * to sNAMEMAX significant characters */

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

  2092     strcpy(lastsymbol,st);

  2093   } /* if */

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

  2095     /* first look for a local variable */

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

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

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

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

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

  2101       } /* if */

  2102       lval->sym=sym;

  2103       lval->ident=sym->ident;

  2104       lval->tag=sym->tag;

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

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

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

  2108       } else {

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

  2110       } /* if */

  2111     } /* if */

  2112     /* now try a global variable */

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

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

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

  2116          * stub in the first pass (i.e. it was "used" but never declared or

  2117          * implemented, issue an error

  2118          */

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

  2120           error(17,st);

  2121       } else {

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

  2123           error(17,st);

  2124         lval->sym=sym;

  2125         lval->ident=sym->ident;

  2126         lval->tag=sym->tag;

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

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

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

  2130         } else {

  2131           return TRUE;          /* return 1 if lvalue (not function or array) */

  2132         } /* if */

  2133       } /* if */

  2134     } else {

  2135       if (!sc_allowproccall)

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

  2137       /* an unknown symbol, but used in a way compatible with the "procedure

  2138        * call" syntax. So assume that the symbol refers to a function.

  2139        */

  2140       assert(sc_status==statFIRST);

  2141       sym=fetchfunc(st,0);

  2142       if (sym==NULL)

  2143         error(123);     /* insufficient memory */

  2144     } /* if */

  2145     assert(sym!=NULL);

  2146     assert(sym->ident==iFUNCTN || sym->ident==iREFFUNC);

  2147     lval->sym=sym;

  2148     lval->ident=sym->ident;

  2149     lval->tag=sym->tag;

  2150     return FALSE;       /* return 0 for function (not an lvalue) */

  2151   } /* if */

  2152   lexpush();            /* push the token, it is analyzed by constant() */

  2153   if (constant(lval)==0) {

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

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

  2156   } /* if */

  2157   return FALSE;         /* return 0 for constants (or errors) */

  2158 }

  2160 static void clear_value(value *lval)

  2161 {

  2162   lval->sym=NULL;

  2163   lval->constval=0L;

  2164   lval->tag=0;

  2165   lval->ident=0;

  2166   lval->boolresult=FALSE;

  2167   /* do not clear lval->arrayidx, it is preset in hier14() */

  2168   /* do not clear lval->cmptag */

  2169 }

  2171 static void setdefarray(cell *string,cell size,cell array_sz,cell *dataaddr,int fconst)

  2172 {

  2173   /* The routine must copy the default array data onto the heap, as to avoid

  2174    * that a function can change the default value. An optimization is that

  2175    * the default array data is "dumped" into the data segment only once (on the

  2176    * first use).

  2177    */

  2178   /* check whether to dump the default array */

  2179   assert(dataaddr!=NULL);

  2180   if (sc_status==statWRITE && *dataaddr<0) {

  2181     int i;

  2182     *dataaddr=(litidx+glb_declared)*sizeof(cell);

  2183     for (i=0; i<size; i++)

  2184       litadd(*string++);

  2185   } /* if */

  2187   /* if the function is known not to modify the array (meaning that it also

  2188    * does not modify the default value), directly pass the address of the

  2189    * array in the data segment.

  2190    */

  2191   if (fconst || !string) {

  2192     ldconst(*dataaddr,sPRI);

  2193   } else {

  2194     /* Generate the code:

  2195      *  CONST.pri dataaddr                ;address of the default array data

  2196      *  HEAP      array_sz*sizeof(cell)   ;heap address in ALT

  2197      *  MOVS      size*sizeof(cell)       ;copy data from PRI to ALT

  2198      *  MOVE.PRI                          ;PRI = address on the heap

  2199      */

  2200     ldconst(*dataaddr,sPRI);

  2201     /* "array_sz" is the size of the argument (the value between the brackets

  2202      * in the declaration), "size" is the size of the default array data.

  2203      */

  2204     assert(array_sz>=size);

  2205     modheap((int)array_sz*sizeof(cell));

  2206     markheap(MEMUSE_STATIC, array_sz);

  2207     /* ??? should perhaps fill with zeros first */

  2208     memcopy(size*sizeof(cell));

  2209     moveto1();

  2210   } /* if */

  2211 }

  2213 static int findnamedarg(arginfo *arg,char *name)

  2214 {

  2215   int i;

  2217   for (i=0; arg[i].ident!=0 && arg[i].ident!=iVARARGS; i++)

  2218     if (strcmp(arg[i].name,name)==0)

  2219       return i;

  2220   return -1;

  2221 }

  2223 int checktag(int tags[],int numtags,int exprtag)

  2224 {

  2225   int i;

  2227   assert(tags!=0);

  2228   assert(numtags>0);

  2229   for (i=0; i<numtags; i++)

  2230     if (matchtag(tags[i],exprtag,TRUE))

  2231       return TRUE;    /* matching tag */

  2232   return FALSE;       /* no tag matched */

  2233 }

  2235 enum {

  2236   ARG_UNHANDLED,

  2237   ARG_IGNORED,

  2238   ARG_DONE,

  2239 };

  2241 /*  callfunction

  2242  *

  2243  *  Generates code to call a function. This routine handles default arguments

  2244  *  and positional as well as named parameters.

  2245  */

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

  2247 {

  2248 static long nest_stkusage=0L;

  2249 static int nesting=0;

  2250   int close,lvalue;

  2251   int argpos;       /* index in the output stream (argpos==nargs if positional parameters) */

  2252   int argidx=0;     /* index in "arginfo" list */

  2253   int nargs=0;      /* number of arguments */

  2254   int heapalloc=0;

  2255   int namedparams=FALSE;

  2256   value lval = {0};

  2257   arginfo *arg;

  2258   char arglist[sMAXARGS];

  2259   constvalue arrayszlst = { NULL, "", 0, 0};/* array size list starts empty */

  2260   constvalue taglst = { NULL, "", 0, 0};    /* tag list starts empty */

  2261   symbol *symret;

  2262   cell lexval;

  2263   char *lexstr;

  2265   assert(sym!=NULL);

  2266   lval_result->ident=iEXPRESSION; /* preset, may be changed later */

  2267   lval_result->constval=0;

  2268   lval_result->tag=sym->tag;

  2269   /* check whether this is a function that returns an array */

  2270   symret=finddepend(sym);

  2271   assert(symret==NULL || symret->ident==iREFARRAY);

  2272   if (symret!=NULL) {

  2273     int retsize;

  2274     /* allocate space on the heap for the array, and pass the pointer to the

  2275      * reserved memory block as a hidden parameter

  2276      */

  2277     retsize=(int)array_totalsize(symret);

  2278     assert(retsize>0);

  2279     modheap(retsize*sizeof(cell));/* address is in ALT */

  2280     pushreg(sALT);                /* pass ALT as the last (hidden) parameter */

  2281     markheap(MEMUSE_STATIC, retsize);

  2282     /* also mark the ident of the result as "array" */

  2283     lval_result->ident=iREFARRAY;

  2284     lval_result->sym=symret;

  2285   } /* if */

  2286   pushheaplist();

  2288   nesting++;

  2289   assert(nest_stkusage>=0);

  2290   #if !defined NDEBUG

  2291     if (nesting==1)

  2292       assert(nest_stkusage==0);

  2293   #endif

  2294   sc_allowproccall=FALSE;       /* parameters may not use procedure call syntax */

  2296   if ((sym->flags & flgDEPRECATED)!=0) {

  2297     char *ptr= (sym->documentation!=NULL) ? sym->documentation : "";

  2298     error(234,sym->name,ptr);   /* deprecated (probably a native function) */

  2299   } /* if */

  2301   /* run through the arguments */

  2302   arg=sym->dim.arglist;

  2303   assert(arg!=NULL);

  2304   stgmark(sSTARTREORDER);

  2305   memset(arglist,ARG_UNHANDLED,sizeof arglist);

  2306   if (matchparanthesis) {

  2307     /* Opening brace was already parsed, if closing brace follows, this

  2308      * call passes no parameters.

  2309      */

  2310     close=matchtoken(')');

  2311   } else {

  2312     /* When we find an end of line here, it may be a function call passing

  2313      * no parameters, or it may be that the first parameter is on a line

  2314      * below. But as a parameter can be anything, this is difficult to check.

  2315      * The only simple check that we have is the use of "named parameters".

  2316      */

  2317     close=matchtoken(tTERM);

  2318     if (close) {

  2319       close=!matchtoken('.');

  2320       if (!close)

  2321         lexpush();                /* reset the '.' */

  2322     } /* if */

  2323   } /* if */

  2324   if (!close) {

  2325     do {

  2326       if (matchtoken('.')) {

  2327         namedparams=TRUE;

  2328         if (needtoken(tSYMBOL))

  2329           tokeninfo(&lexval,&lexstr);

  2330         else

  2331           lexstr="";

  2332         argpos=findnamedarg(arg,lexstr);

  2333         if (argpos<0) {

  2334           error(17,lexstr);       /* undefined symbol */

  2335           break;                  /* exit loop, argpos is invalid */

  2336         } /* if */

  2337         needtoken('=');

  2338         argidx=argpos;

  2339       } else {

  2340         if (namedparams)

  2341           error(44);   /* positional parameters must precede named parameters */

  2342         argpos=nargs;

  2343       } /* if */

  2344       /* the number of arguments this was already checked at the declaration

  2345        * of the function; check it again for functions with a variable

  2346        * argument list

  2347        */

  2348       if (argpos>=sMAXARGS)

  2349         error(45);                /* too many function arguments */

  2350       stgmark((char)(sEXPRSTART+argpos));/* mark beginning of new expression in stage */

  2351       if (arglist[argpos]!=ARG_UNHANDLED)

  2352         error(58);                /* argument already set */

  2353       if (matchtoken('_')) {

  2354         arglist[argpos]=ARG_IGNORED;  /* flag argument as "present, but ignored" */

  2355         if (arg[argidx].ident==0 || arg[argidx].ident==iVARARGS) {

  2356           error(92);             /* argument count mismatch */

  2357         } else if (!arg[argidx].hasdefault) {

  2358           error(34,nargs+1);      /* argument has no default value */

  2359         } /* if */

  2360         if (arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS)

  2361           argidx++;

  2362         /* The rest of the code to handle default values is at the bottom

  2363          * of this routine where default values for unspecified parameters

  2364          * are (also) handled. Note that above, the argument is flagged as

  2365          * ARG_IGNORED.

  2366          */

  2367       } else {

  2368         arglist[argpos]=ARG_DONE; /* flag argument as "present" */

  2369         if (arg[argidx].ident!=0 && arg[argidx].numtags==1)     /* set the expected tag, if any */

  2370           lval.cmptag=arg[argidx].tags[0];

  2371         lvalue=hier14(&lval);

  2372         assert(sc_status==statFIRST || arg[argidx].ident == 0 || arg[argidx].tags!=NULL);

  2373         switch (arg[argidx].ident) {

  2374         case 0:

  2375           /* On the first pass, we donm't have all of the parameter info.

  2376            * Hpwever, use information must be marked anyway, otherwise vars

  2377            * declared previously will be omitted in the second psas. See

  2378            * SourceMod bug 4643.

  2379            */

  2380           error(92);             /* argument count mismatch */

  2381           if (lval.sym)

  2382             markusage(lval.sym, uREAD);

  2383           break;

  2384         case iVARARGS:

  2385           /* always pass by reference */

  2386           if (lval.ident==iVARIABLE || lval.ident==iREFERENCE) {

  2387             assert(lval.sym!=NULL);

  2388             if ((lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0) {

  2389               /* treat a "const" variable passed to a function with a non-const

  2390                * "variable argument list" as a constant here */

  2391               if (!lvalue) {

  2392                 error(22);        /* need lvalue */

  2393               } else {

  2394                 rvalue(&lval);    /* get value in PRI */

  2395                 setheap_pri();    /* address of the value on the heap in PRI */

  2396                 heapalloc+=markheap(MEMUSE_STATIC, 1);

  2397                 nest_stkusage++;

  2398               } /* if */

  2399             } else if (lvalue) {

  2400               address(lval.sym,sPRI);

  2401             } else {

  2402               setheap_pri();      /* address of the value on the heap in PRI */

  2403               heapalloc+=markheap(MEMUSE_STATIC, 1);

  2404               nest_stkusage++;

  2405             } /* if */

  2406           } else if (lval.ident==iCONSTEXPR || lval.ident==iEXPRESSION)

  2407           {

  2408             /* allocate a cell on the heap and store the

  2409              * value (already in PRI) there */

  2410             setheap_pri();        /* address of the value on the heap in PRI */

  2411             heapalloc+=markheap(MEMUSE_STATIC, 1);

  2412             nest_stkusage++;

  2413           } /* if */

  2414           /* ??? handle const array passed by reference */

  2415           /* otherwise, the address is already in PRI */

  2416           if (lval.sym!=NULL)

  2417             markusage(lval.sym,uWRITTEN);

  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           break;

  2422         case iVARIABLE:

  2423           if (lval.ident==iLABEL || lval.ident==iFUNCTN || lval.ident==iREFFUNC

  2424               || lval.ident==iARRAY || lval.ident==iREFARRAY)

  2425             error(35,argidx+1);   /* argument type mismatch */

  2426           if (lvalue)

  2427             rvalue(&lval);        /* get value (direct or indirect) */

  2428           /* otherwise, the expression result is already in PRI */

  2429           assert(arg[argidx].numtags>0);

  2430           check_userop(NULL,lval.tag,arg[argidx].tags[0],2,NULL,&lval.tag);

  2431           if (!checktags_string(arg[argidx].tags, arg[argidx].numtags, &lval)

  2432               && !checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2433 		  {

  2434 			if (arg[argidx].numtags == 1 && arg[argidx].tags[0] & FUNCTAG)

  2435               error(100);         /* error - function prototypes do not match */

  2436 			else

  2437               error(213);         /* warning - tag mismatch */

  2438 		  }

  2439           if (lval.tag!=0)

  2440             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2441           argidx++;               /* argument done */

  2442           break;

  2443         case iREFERENCE:

  2444           if (!lvalue)

  2445             error(35,argidx+1);   /* argument type mismatch */

  2446           if (lval.sym!=NULL && (lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0)

  2447             error(35,argidx+1);   /* argument type mismatch */

  2448           if (lval.ident==iVARIABLE || lval.ident==iREFERENCE) {

  2449             if (lvalue) {

  2450               assert(lval.sym!=NULL);

  2451               address(lval.sym,sPRI);

  2452             } else {

  2453               setheap_pri();      /* address of the value on the heap in PRI */

  2454               heapalloc+=markheap(MEMUSE_STATIC, 1);

  2455               nest_stkusage++;

  2456             } /* if */

  2457           } /* if */

  2458           /* otherwise, the address is already in PRI */

  2459           if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2460             error(213);

  2461           if (lval.tag!=0)

  2462             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2463           argidx++;               /* argument done */

  2464           if (lval.sym!=NULL)

  2465             markusage(lval.sym,uWRITTEN);

  2466           break;

  2467         case iREFARRAY:

  2468           if (lval.ident!=iARRAY && lval.ident!=iREFARRAY

  2469               && lval.ident!=iARRAYCELL && lval.ident!=iARRAYCHAR)

  2470           {

  2471             error(35,argidx+1);   /* argument type mismatch */

  2472             break;

  2473           } /* if */

  2474           if (lval.sym!=NULL && (lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0)

  2475             error(35,argidx+1); /* argument type mismatch */

  2476           /* Verify that the dimensions match with those in arg[argidx].

  2477            * A literal array always has a single dimension.

  2478            * An iARRAYCELL parameter is also assumed to have a single dimension.

  2479            */

  2480           if (lval.sym==NULL || lval.ident==iARRAYCELL || lval.ident==iARRAYCHAR) {

  2481             if (arg[argidx].numdim!=1) {

  2482               error(48);        /* array dimensions must match */

  2483             } else if (arg[argidx].dim[0]!=0) {

  2484               assert(arg[argidx].dim[0]>0);

  2485               if (lval.ident==iARRAYCELL) {

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

  2487               } else {

  2488                 assert(lval.constval!=0); /* literal array must have a size */

  2489                 /* A literal array must have exactly the same size as the

  2490                  * function argument; a literal string may be smaller than

  2491                  * the function argument.

  2492                  */

  2493                 if ((lval.constval>0 && arg[argidx].dim[0]!=lval.constval)

  2494                     || (lval.constval<0 && arg[argidx].dim[0] < -lval.constval))

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

  2496               } /* if */

  2497             } /* if */

  2498             if (lval.ident!=iARRAYCELL && lval.ident!=iARRAYCHAR) {

  2499               /* save array size, for default values with uSIZEOF flag */

  2500               cell array_sz=lval.constval;

  2501               assert(array_sz!=0);/* literal array must have a size */

  2502               if (array_sz<0)

  2503                 array_sz= -array_sz;

  2504               append_constval(&arrayszlst,arg[argidx].name,array_sz,0);

  2505             }/* if */

  2506           } else {

  2507             symbol *sym=lval.sym;

  2508             short level=0;

  2509             assert(sym!=NULL);

  2510             if (sym->dim.array.level+1!=arg[argidx].numdim)

  2511               error(48);          /* array dimensions must match */

  2512             /* the lengths for all dimensions must match, unless the dimension

  2513              * length was defined at zero (which means "undefined")

  2514              */

  2515             while (sym->dim.array.level>0) {

  2516               assert(level<sDIMEN_MAX);

  2517               if (arg[argidx].dim[level]!=0 && sym->dim.array.length!=arg[argidx].dim[level])

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

  2519               else if (!matchtag(arg[argidx].idxtag[level],sym->x.tags.index,TRUE))

  2520                 error(229,sym->name);   /* index tag mismatch */

  2521               append_constval(&arrayszlst,arg[argidx].name,sym->dim.array.length,level);

  2522               sym=finddepend(sym);

  2523               assert(sym!=NULL);

  2524               level++;

  2525             } /* if */

  2526             /* the last dimension is checked too, again, unless it is zero */

  2527             assert(level<sDIMEN_MAX);

  2528             assert(sym!=NULL);

  2529             if (arg[argidx].dim[level]!=0 && sym->dim.array.length!=arg[argidx].dim[level])

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

  2531             else if (!matchtag(arg[argidx].idxtag[level],sym->x.tags.index,TRUE))

  2532               error(229,sym->name);   /* index tag mismatch */

  2533             append_constval(&arrayszlst,arg[argidx].name,sym->dim.array.length,level);

  2534           } /* if */

  2535           /* address already in PRI */

  2536           if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))

  2537             error(213);

  2538           if (lval.tag!=0)

  2539             append_constval(&taglst,arg[argidx].name,lval.tag,0);

  2540           // ??? set uWRITTEN?

  2541           argidx++;               /* argument done */

  2542           break;

  2543         } /* switch */

  2544         pushreg(sPRI);            /* store the function argument on the stack */

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

  2546         nest_stkusage++;

  2547       } /* if */

  2548       assert(arglist[argpos]!=ARG_UNHANDLED);

  2549       nargs++;

  2550       if (matchparanthesis) {

  2551         close=matchtoken(')');

  2552         if (!close)               /* if not paranthese... */

  2553           if (!needtoken(','))    /* ...should be comma... */

  2554             break;                /* ...but abort loop if neither */

  2555       } else {

  2556         close=!matchtoken(',');

  2557         if (close) {              /* if not comma... */

  2558           if (needtoken(tTERM)==1)/* ...must be end of statement */

  2559             lexpush();            /* push again, because end of statement is analised later */

  2560         } /* if */

  2561       } /* if */

  2562     } while (!close && freading && !matchtoken(tENDEXPR)); /* do */

  2563   } /* if */

  2564   /* check remaining function arguments (they may have default values) */

  2565   for (argidx=0; arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS; argidx++) {

  2566     if (arglist[argidx]==ARG_DONE)

  2567       continue;                 /* already seen and handled this argument */

  2568     /* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;

  2569      * these are handled last

  2570      */

  2571     if ((arg[argidx].hasdefault & uSIZEOF)!=0 || (arg[argidx].hasdefault & uTAGOF)!=0) {

  2572       assert(arg[argidx].ident==iVARIABLE);

  2573       continue;

  2574     } /* if */

  2575     stgmark((char)(sEXPRSTART+argidx));/* mark beginning of new expression in stage */

  2576     if (arg[argidx].hasdefault) {

  2577       if (arg[argidx].ident==iREFARRAY) {

  2578         short level;

  2579         setdefarray(arg[argidx].defvalue.array.data,

  2580                     arg[argidx].defvalue.array.size,

  2581                     arg[argidx].defvalue.array.arraysize,

  2582                     &arg[argidx].defvalue.array.addr,

  2583                     (arg[argidx].usage & uCONST)!=0);

  2584         if (arg[argidx].defvalue.array.data != NULL) {

  2585           if ((arg[argidx].usage & uCONST)==0) {

  2586             heapalloc+=arg[argidx].defvalue.array.arraysize;

  2587             nest_stkusage+=arg[argidx].defvalue.array.arraysize;

  2588           } /* if */

  2589           /* keep the lengths of all dimensions of a multi-dimensional default array */

  2590           assert(arg[argidx].numdim>0);

  2591           if (arg[argidx].numdim==1) {

  2592             append_constval(&arrayszlst,arg[argidx].name,arg[argidx].defvalue.array.arraysize,0);

  2593           } else {

  2594             for (level=0; level<arg[argidx].numdim; level++) {

  2595               assert(level<sDIMEN_MAX);

  2596               append_constval(&arrayszlst,arg[argidx].name,arg[argidx].dim[level],level);

  2597             } /* for */

  2598           } /* if */

  2599         }

  2600       } else if (arg[argidx].ident==iREFERENCE) {

  2601         setheap(arg[argidx].defvalue.val);

  2602         /* address of the value on the heap in PRI */

  2603         heapalloc+=markheap(MEMUSE_STATIC, 1);

  2604         nest_stkusage++;

  2605       } else {

  2606         int dummytag=arg[argidx].tags[0];

  2607         ldconst(arg[argidx].defvalue.val,sPRI);

  2608         assert(arg[argidx].numtags>0);

  2609         check_userop(NULL,arg[argidx].defvalue_tag,arg[argidx].tags[0],2,NULL,&dummytag);

  2610         assert(dummytag==arg[argidx].tags[0]);

  2611       } /* if */

  2612       pushreg(sPRI);            /* store the function argument on the stack */

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

  2614       nest_stkusage++;

  2615     } else {

  2616       error(92,argidx);        /* argument count mismatch */

  2617     } /* if */

  2618     if (arglist[argidx]==ARG_UNHANDLED)

  2619       nargs++;

  2620     arglist[argidx]=ARG_DONE;

  2621   } /* for */

  2622   /* now a second loop to catch the arguments with default values that are

  2623    * the "sizeof" or "tagof" of other arguments

  2624    */

  2625   for (argidx=0; arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS; argidx++) {

  2626     constvalue *asz;

  2627     cell array_sz;

  2628     if (arglist[argidx]==ARG_DONE)

  2629       continue;                 /* already seen and handled this argument */

  2630     stgmark((char)(sEXPRSTART+argidx));/* mark beginning of new expression in stage */

  2631     assert(arg[argidx].ident==iVARIABLE);           /* if "sizeof", must be single cell */

  2632     /* if unseen, must be "sizeof" or "tagof" */

  2633     assert((arg[argidx].hasdefault & uSIZEOF)!=0 || (arg[argidx].hasdefault & uTAGOF)!=0);

  2634     if ((arg[argidx].hasdefault & uSIZEOF)!=0) {

  2635       /* find the argument; if it isn't found, the argument's default value

  2636        * was a "sizeof" of a non-array (a warning for this was already given

  2637        * when declaring the function)

  2638        */

  2639       asz=find_constval(&arrayszlst,arg[argidx].defvalue.size.symname,

  2640                         arg[argidx].defvalue.size.level);

  2641       if (asz!=NULL) {

  2642         array_sz=asz->value;

  2643         if (array_sz==0)

  2644           error(224,arg[argidx].name);    /* indeterminate array size in "sizeof" expression */

  2645       } else {

  2646         array_sz=1;

  2647       } /* if */

  2648     } else {

  2649       asz=find_constval(&taglst,arg[argidx].defvalue.size.symname,

  2650                         arg[argidx].defvalue.size.level);

  2651       if (asz != NULL) {

  2652         exporttag(asz->value);

  2653         array_sz=asz->value | PUBLICTAG;  /* must be set, because it just was exported */

  2654       } else {

  2655         array_sz=0;

  2656       } /* if */

  2657     } /* if */

  2658     ldconst(array_sz,sPRI);

  2659     pushreg(sPRI);              /* store the function argument on the stack */

  2660     markexpr(sPARM,NULL,0);

  2661     nest_stkusage++;

  2662     if (arglist[argidx]==ARG_UNHANDLED)

  2663       nargs++;

  2664     arglist[argidx]=ARG_DONE;

  2665   } /* for */

  2666   stgmark(sENDREORDER);         /* mark end of reversed evaluation */

  2667   pushval((cell)nargs /* *sizeof(cell)*/ );

  2668   nest_stkusage++;

  2669   ffcall(sym,NULL,nargs);

  2670   if (sc_status!=statSKIP)

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

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

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

  2674   if (symret!=NULL)

  2675     popreg(sPRI);               /* pop hidden parameter as function result */

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

  2677   delete_consttable(&arrayszlst);     /* clear list of array sizes */

  2678   delete_consttable(&taglst);   /* clear list of parameter tags */

  2680   /* maintain max. amount of memory used */

  2681   {

  2682     long totalsize;

  2683     totalsize=declared+heapalloc+1;   /* local variables & return value size,

  2684                                        * +1 for PROC opcode */

  2685     if (lval_result->ident==iREFARRAY)

  2686       totalsize++;                    /* add hidden parameter (on the stack) */

  2687     if ((sym->usage & uNATIVE)==0)

  2688       totalsize++;                    /* add "call" opcode */

  2689     totalsize+=nest_stkusage;

  2690     if (curfunc != NULL) {

  2691       if (curfunc->x.stacksize<totalsize)

  2692         curfunc->x.stacksize=totalsize;

  2693     } else {

  2694       error(10);

  2695     }

  2696     nest_stkusage-=nargs+heapalloc+1; /* stack/heap space, +1 for argcount param */

  2697     /* if there is a syntax error in the script, the stack calculation is

  2698      * probably incorrect; but we may not allow it to drop below zero

  2699      */

  2700     if (nest_stkusage<0)

  2701       nest_stkusage=0;

  2702   }

  2704   /* scrap any arrays left on the heap, with the exception of the array that

  2705    * this function has as a result (in other words, scrap all arrays on the

  2706    * heap that caused by expressions in the function arguments)

  2707    */

  2708   popheaplist();

  2709   nesting--;

  2710 }

  2712 /*  dbltest

  2713  *

  2714  *  Returns a non-zero value if lval1 an array and lval2 is not an array and

  2715  *  the operation is addition or subtraction.

  2716  *

  2717  *  Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell

  2718  *  to an array offset.

  2719  */

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

  2721 {

  2722   if ((oper!=ob_add) && (oper!=ob_sub))

  2723     return 0;

  2724   if (lval1->ident!=iARRAY)

  2725     return 0;

  2726   if (lval2->ident==iARRAY)

  2727     return 0;

  2728   return sizeof(cell)/2;        /* 1 for 16-bit, 2 for 32-bit */

  2729 }

  2731 /*  commutative

  2732  *

  2733  *  Test whether an operator is commutative, i.e. x oper y == y oper x.

  2734  *  Commutative operators are: +  (addition)

  2735  *                             *  (multiplication)

  2736  *                             == (equality)

  2737  *                             != (inequality)

  2738  *                             &  (bitwise and)

  2739  *                             ^  (bitwise xor)

  2740  *                             |  (bitwise or)

  2741  *

  2742  *  If in an expression, code for the left operand has been generated and

  2743  *  the right operand is a constant and the operator is commutative, the

  2744  *  precautionary "push" of the primary register is scrapped and the constant

  2745  *  is read into the secondary register immediately.

  2746  */

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

  2748 {

  2749   return oper==ob_add || oper==os_mult

  2750          || oper==ob_eq || oper==ob_ne

  2751          || oper==ob_and || oper==ob_xor || oper==ob_or;

  2752 }

  2754 /*  constant

  2755  *

  2756  *  Generates code to fetch a number, a literal character (which is returned

  2757  *  by lex() as a number as well) or a literal string (lex() stores the

  2758  *  strings in the literal queue). If the operand was a number, it is stored

  2759  *  in lval->constval.

  2760  *

  2761  *  The function returns 1 if the token was a constant or a string, 0

  2762  *  otherwise.

  2763  */

  2764 static int constant(value *lval)

  2765 {

  2766   int tok,index,ident;

  2767   cell val,item,cidx;

  2768   char *st;

  2769   symbol *sym;

  2770   int cmptag=lval->cmptag;

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

  2773   if (tok==tSYMBOL && (sym=findconst(st,&cmptag))!=0) {

  2774     if (cmptag>1)

  2775       error(91,sym->name);  /* ambiguity: multiple matching constants (different tags) */

  2776     lval->constval=sym->addr;

  2777     ldconst(lval->constval,sPRI);

  2778     lval->ident=iCONSTEXPR;

  2779     lval->tag=sym->tag;

  2780     lval->sym=sym;

  2781     markusage(sym,uREAD);

  2782   } else if (tok==tNUMBER) {

  2783     lval->constval=val;

  2784     ldconst(lval->constval,sPRI);

  2785     lval->ident=iCONSTEXPR;

  2786   } else if (tok==tRATIONAL) {

  2787     lval->constval=val;

  2788     ldconst(lval->constval,sPRI);

  2789     lval->ident=iCONSTEXPR;

  2790     lval->tag=sc_rationaltag;

  2791   } else if (tok==tSTRING) {

  2792     /* lex() stores starting index of string in the literal table in 'val' */

  2793     ldconst((val+glb_declared)*sizeof(cell),sPRI);

  2794     lval->ident=iARRAY;         /* pretend this is a global array */

  2795     lval->constval=val-litidx;  /* constval == the negative value of the

  2796                                  * size of the literal array; using a negative

  2797                                  * value distinguishes between literal arrays

  2798                                  * and literal strings (this was done for

  2799                                  * array assignment). */

  2800 	lval->tag=pc_tag_string;

  2801   } else if (tok=='{') {

  2802     int tag,lasttag=-1;

  2803     val=litidx;

  2804     do {

  2805       /* cannot call constexpr() here, because "staging" is already turned

  2806        * on at this point */

  2807       assert(staging);

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

  2809       ident=expression(&item,&tag,NULL,FALSE,NULL);

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

  2811       if (ident!=iCONSTEXPR)

  2812         error(8);               /* must be constant expression */

  2813       if (lasttag<0)

  2814         lasttag=tag;

  2815       else if (!matchtag(lasttag,tag,FALSE))

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

  2817       litadd(item);             /* store expression result in literal table */

  2818     } while (matchtoken(','));

  2819     if (!needtoken('}'))

  2820       lexclr(FALSE);

  2821     ldconst((val+glb_declared)*sizeof(cell),sPRI);

  2822     lval->ident=iARRAY;         /* pretend this is a global array */

  2823     lval->constval=litidx-val;  /* constval == the size of the literal array */

  2824   } else {

  2825     return FALSE;               /* no, it cannot be interpreted as a constant */

  2826   } /* if */

  2827   return TRUE;                  /* yes, it was a constant value */

  2828 }

author	Ruben Gonzalez <drifter01620@gmail.com>
	Thu May 22 09:49:27 2014 -0400 (2014-05-22)
changeset 4378	568f4497ef4a
parent 4181	b81d517c5a08
permissions	-rw-r--r--