sourcemod-central: sourcepawn/compiler/sc3.c@fc2bb71d0291 (annotated)

ds@1952	1	/* Pawn compiler - Recursive descend expresion parser
ds@1952	2	*
ds@1952	3	* Copyright (c) ITB CompuPhase, 1997-2005
ds@1952	4	*
ds@1952	5	* This software is provided "as-is", without any express or implied warranty.
ds@1952	6	* In no event will the authors be held liable for any damages arising from
ds@1952	7	* the use of this software.
ds@1952	8	*
ds@1952	9	* Permission is granted to anyone to use this software for any purpose,
ds@1952	10	* including commercial applications, and to alter it and redistribute it
ds@1952	11	* freely, subject to the following restrictions:
ds@1952	12	*
ds@1952	13	* 1. The origin of this software must not be misrepresented; you must not
ds@1952	14	* claim that you wrote the original software. If you use this software in
ds@1952	15	* a product, an acknowledgment in the product documentation would be
ds@1952	16	* appreciated but is not reeq;quired.
ds@1952	17	* 2. Altered source versions must be plainly marked as such, and must not be
ds@1952	18	* misrepresented as being the original software.
ds@1952	19	* 3. This notice may not be removed or altered from any source distribution.
ds@1952	20	*
ds@1952	21	* Version: $Id$
ds@1952	22	*/
ds@1952	23	#include <assert.h>
ds@1952	24	#include <stdio.h>
ds@1952	25	#include <stdlib.h> /* for _MAX_PATH */
ds@1952	26	#include <string.h>
ds@1952	27	#if defined FORTIFY
ds@1952	28	#include <alloc/fortify.h>
ds@1952	29	#endif
ds@1952	30	#include "sc.h"
ds@1952	31	#include "sctracker.h"
ds@1952	32
ds@1952	33	static int skim(int opstr,void (testfunc)(int),int dropval,int endval,
ds@1952	34	int (hier)(value),value *lval);
ds@1952	35	static void dropout(int lvalue,void (testfunc)(int val),int exit1,value lval);
ds@1952	36	static int plnge(int opstr,int opoff,int (hier)(value lval),value lval,
ds@1952	37	char *forcetag,int chkbitwise);
ds@1952	38	static int plnge1(int (hier)(value lval),value *lval);
ds@1952	39	static void plnge2(void (*oper)(void),
ds@1952	40	int (hier)(value lval),
ds@1952	41	value lval1,value lval2);
ds@1952	42	static cell calc(cell left,void (oper)(),cell right,char boolresult);
ds@1952	43	static int hier14(value *lval);
ds@1952	44	static int hier13(value *lval);
ds@1952	45	static int hier12(value *lval);
ds@1952	46	static int hier11(value *lval);
ds@1952	47	static int hier10(value *lval);
ds@1952	48	static int hier9(value *lval);
ds@1952	49	static int hier8(value *lval);
ds@1952	50	static int hier7(value *lval);
ds@1952	51	static int hier6(value *lval);
ds@1952	52	static int hier5(value *lval);
ds@1952	53	static int hier4(value *lval);
ds@1952	54	static int hier3(value *lval);
ds@1952	55	static int hier2(value *lval);
ds@1952	56	static int hier1(value *lval1);
ds@1952	57	static int primary(value *lval);
ds@1952	58	static void clear_value(value *lval);
ds@1952	59	static void callfunction(symbol sym,value lval_result,int matchparanthesis);
ds@1952	60	static int dbltest(void (oper)(),value lval1,value *lval2);
ds@1952	61	static int commutative(void (*oper)());
ds@1952	62	static int constant(value *lval);
ds@1952	63
ds@1952	64	static char lastsymbol[sNAMEMAX+1]; /* name of last function/variable */
ds@1952	65	static int bitwise_opercount; /* count of bitwise operators in an expression */
ds@1952	66
ds@1952	67	/* Function addresses of binary operators for signed operations */
ds@1952	68	static void (*op1[17])(void) = {
ds@1952	69	os_mult,os_div,os_mod, /* hier3, index 0 */
ds@1952	70	ob_add,ob_sub, /* hier4, index 3 */
ds@1952	71	ob_sal,os_sar,ou_sar, /* hier5, index 5 */
ds@1952	72	ob_and, /* hier6, index 8 */
ds@1952	73	ob_xor, /* hier7, index 9 */
ds@1952	74	ob_or, /* hier8, index 10 */
ds@1952	75	os_le,os_ge,os_lt,os_gt, /* hier9, index 11 */
ds@1952	76	ob_eq,ob_ne, /* hier10, index 15 */
ds@1952	77	};
ds@1952	78	/* These two functions are defined because the functions inc() and dec() in
ds@1952	79	* SC4.C have a different prototype than the other code generation functions.
ds@1952	80	* The arrays for user-defined functions use the function pointers for
ds@1952	81	* identifying what kind of operation is requested; these functions must all
ds@1952	82	* have the same prototype. As inc() and dec() are special cases already, it
ds@1952	83	* is simplest to add two "do-nothing" functions.
ds@1952	84	*/
ds@1952	85	static void user_inc(void) {}
ds@1952	86	static void user_dec(void) {}
ds@1952	87
ds@1952	88	/*
ds@1952	89	* Searches for a binary operator a list of operators. The list is stored in
ds@1952	90	* the array "list". The last entry in the list should be set to 0.
ds@1952	91	*
ds@1952	92	* The index of an operator in "list" (if found) is returned in "opidx". If
ds@1952	93	* no operator is found, nextop() returns 0.
ds@1952	94	*
ds@1952	95	* If an operator is found in the expression, it cannot be used in a function
ds@1952	96	* call with omitted parantheses. Mark this...
ds@1952	97	*
ds@1952	98	* Global references: sc_allowproccall (modified)
ds@1952	99	*/
ds@1952	100	static int nextop(int opidx,int list)
ds@1952	101	{
ds@1952	102	*opidx=0;
ds@1952	103	while (*list){
ds@1952	104	if (matchtoken(*list)){
ds@1952	105	sc_allowproccall=FALSE;
ds@1952	106	return TRUE; /* found! */
ds@1952	107	} else {
ds@1952	108	list+=1;
ds@1952	109	*opidx+=1;
ds@1952	110	} /* if */
ds@1952	111	} /* while */
ds@1952	112	return FALSE; /* entire list scanned, nothing found */
ds@1952	113	}
ds@1952	114
ds@1952	115	SC_FUNC int check_userop(void (*oper)(void),int tag1,int tag2,int numparam,
ds@1952	116	value lval,int resulttag)
ds@1952	117	{
ds@1952	118	static char binoperstr[] = { "", "/", "%", "+", "-", "", "", "",
ds@1952	119	"", "", "", "<=", ">=", "<", ">", "==", "!=" };
ds@1952	120	static int binoper_savepri[] = { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
ds@1952	121	FALSE, FALSE, FALSE, FALSE, FALSE,
ds@1952	122	TRUE, TRUE, TRUE, TRUE, FALSE, FALSE };
ds@1952	123	static char *unoperstr[] = { "!", "-", "++", "--" };
ds@1952	124	static void (*unopers[])(void) = { lneg, neg, user_inc, user_dec };
ds@1952	125	char opername[4] = "", symbolname[sNAMEMAX+1];
ds@1952	126	int i,swapparams,savepri,savealt;
ds@1952	127	int paramspassed;
ds@1952	128	symbol *sym;
ds@1952	129
ds@1952	130	/* since user-defined operators on untagged operands are forbidden, we have
ds@1952	131	* a quick exit.
ds@1952	132	*/
ds@1952	133	assert(numparam==1 \|\| numparam==2);
ds@1952	134	if (tag1==0 && (numparam==1 \|\| tag2==0))
ds@1952	135	return FALSE;
ds@1952	136
ds@1952	137	savepri=savealt=FALSE;
ds@1952	138	/* find the name with the operator */
ds@1952	139	if (numparam==2) {
ds@1952	140	if (oper==NULL) {
ds@1952	141	/* assignment operator: a special case */
ds@1952	142	strcpy(opername,"=");
ds@1952	143	if (lval!=NULL && (lval->ident==iARRAYCELL \|\| lval->ident==iARRAYCHAR))
ds@1952	144	savealt=TRUE;
ds@1952	145	} else {
ds@1952	146	assert( (sizeof binoperstr / sizeof binoperstr[0]) == (sizeof op1 / sizeof op1[0]) );
ds@1952	147	for (i=0; i<sizeof op1 / sizeof op1[0]; i++) {
ds@1952	148	if (oper==op1[i]) {
ds@1952	149	strcpy(opername,binoperstr[i]);
ds@1952	150	savepri=binoper_savepri[i];
ds@1952	151	break;
ds@1952	152	} /* if */
ds@1952	153	} /* for */
ds@1952	154	} /* if */
ds@1952	155	} else {
ds@1952	156	assert(oper!=NULL);
ds@1952	157	assert(numparam==1);
ds@1952	158	/* try a select group of unary operators */
ds@1952	159	assert( (sizeof unoperstr / sizeof unoperstr[0]) == (sizeof unopers / sizeof unopers[0]) );
ds@1952	160	if (opername[0]=='\0') {
ds@1952	161	for (i=0; i<sizeof unopers / sizeof unopers[0]; i++) {
ds@1952	162	if (oper==unopers[i]) {
ds@1952	163	strcpy(opername,unoperstr[i]);
ds@1952	164	break;
ds@1952	165	} /* if */
ds@1952	166	} /* for */
ds@1952	167	} /* if */
ds@1952	168	} /* if */
ds@1952	169	/* if not found, quit */
ds@1952	170	if (opername[0]=='\0')
ds@1952	171	return FALSE;
ds@1952	172
ds@1952	173	/* create a symbol name from the tags and the operator name */
ds@1952	174	assert(numparam==1 \|\| numparam==2);
ds@1952	175	operator_symname(symbolname,opername,tag1,tag2,numparam,tag2);
ds@1952	176	swapparams=FALSE;
ds@1952	177	sym=findglb(symbolname,sGLOBAL);
ds@1952	178	if (sym==NULL /\|\| (sym->usage & uDEFINE)==0/) { /* ??? should not check uDEFINE; first pass clears these bits */
ds@1952	179	/* check for commutative operators */
ds@1952	180	if (tag1==tag2 \|\| oper==NULL \|\| !commutative(oper))
ds@1952	181	return FALSE; /* not commutative, cannot swap operands */
ds@1952	182	/* if arrived here, the operator is commutative and the tags are different,
ds@1952	183	* swap tags and try again
ds@1952	184	*/
ds@1952	185	assert(numparam==2); /* commutative operator must be a binary operator */
ds@1952	186	operator_symname(symbolname,opername,tag2,tag1,numparam,tag1);
ds@1952	187	swapparams=TRUE;
ds@1952	188	sym=findglb(symbolname,sGLOBAL);
ds@1952	189	if (sym==NULL /\|\| (sym->usage & uDEFINE)==0/)
ds@1952	190	return FALSE;
ds@1952	191	} /* if */
ds@1952	192
ds@1952	193	/* check existance and the proper declaration of this function */
ds@1952	194	if ((sym->usage & uMISSING)!=0 \|\| (sym->usage & uPROTOTYPED)==0) {
ds@1952	195	char symname[2sNAMEMAX+16]; / allow space for user defined operators */
ds@1952	196	funcdisplayname(symname,sym->name);
ds@1952	197	if ((sym->usage & uMISSING)!=0)
ds@1952	198	error(4,symname); /* function not defined */
ds@1952	199	if ((sym->usage & uPROTOTYPED)==0)
ds@1952	200	error(71,symname); /* operator must be declared before use */
ds@1952	201	} /* if */
ds@1952	202
ds@1952	203	/* we don't want to use the redefined operator in the function that
ds@1952	204	* redefines the operator itself, otherwise the snippet below gives
ds@1952	205	* an unexpected recursion:
ds@1952	206	* fixed:operator+(fixed:a, fixed:b)
ds@1952	207	* return a + b
ds@1952	208	*/
ds@1952	209	if (sym==curfunc)
ds@1952	210	return FALSE;
ds@1952	211
ds@1952	212	/* for increment and decrement operators, the symbol must first be loaded
ds@1952	213	* (and stored back afterwards)
ds@1952	214	*/
ds@1952	215	if (oper==user_inc \|\| oper==user_dec) {
ds@1952	216	assert(!savepri);
ds@1952	217	assert(lval!=NULL);
ds@1952	218	if (lval->ident==iARRAYCELL \|\| lval->ident==iARRAYCHAR)
ds@1952	219	pushreg(sPRI); /* save current address in PRI */
ds@1952	220	rvalue(lval); /* get the symbol's value in PRI */
ds@1952	221	} /* if */
ds@1952	222
ds@1952	223	assert(!savepri \|\| !savealt); /* either one MAY be set, but not both */
ds@1952	224	if (savepri) {
ds@1952	225	/* the chained comparison operators require that the ALT register is
ds@1952	226	* unmodified, so we save it here; actually, we save PRI because the normal
ds@1952	227	* instruction sequence (without user operator) swaps PRI and ALT
ds@1952	228	*/
ds@1952	229	pushreg(sPRI); /* right-hand operand is in PRI */
ds@1952	230	} else if (savealt) {
ds@1952	231	/* for the assignment operator, ALT may contain an address at which the
ds@1952	232	* result must be stored; this address must be preserved accross the
ds@1952	233	* call
ds@1952	234	*/
ds@1952	235	assert(lval!=NULL); /* this was checked earlier */
ds@1952	236	assert(lval->ident==iARRAYCELL \|\| lval->ident==iARRAYCHAR); /* checked earlier */
ds@1952	237	pushreg(sALT);
ds@1952	238	} /* if */
ds@1952	239
ds@1952	240	/* push parameters, call the function */
ds@1952	241	paramspassed= (oper==NULL) ? 1 : numparam;
ds@1952	242	switch (paramspassed) {
ds@1952	243	case 1:
ds@1952	244	pushreg(sPRI);
ds@1952	245	break;
ds@1952	246	case 2:
ds@1952	247	/* note that 1) a function expects that the parameters are pushed
ds@1952	248	* in reversed order, and 2) the left operand is in the secondary register
ds@1952	249	* and the right operand is in the primary register */
ds@1952	250	if (swapparams) {
ds@1952	251	pushreg(sALT);
ds@1952	252	pushreg(sPRI);
ds@1952	253	} else {
ds@1952	254	pushreg(sPRI);
ds@1952	255	pushreg(sALT);
ds@1952	256	} /* if */
ds@1952	257	break;
ds@1952	258	default:
ds@1952	259	assert(0);
ds@1952	260	} /* switch */
ds@1952	261	markexpr(sPARM,NULL,0); /* mark the end of a sub-expression */
ds@1952	262	pushval((cell)paramspassed /* sizeof(cell)/ );
ds@1952	263	assert(sym->ident==iFUNCTN);
ds@1952	264	ffcall(sym,NULL,paramspassed);
ds@1952	265	if (sc_status!=statSKIP)
ds@1952	266	markusage(sym,uREAD); /* do not mark as "used" when this call itself is skipped */
ds@1952	267	if ((sym->usage & uNATIVE)!=0 && sym->x.lib!=NULL)
ds@1952	268	sym->x.lib->value += 1; /* increment "usage count" of the library */
ds@1952	269	sideeffect=TRUE; /* assume functions carry out a side-effect */
ds@1952	270	assert(resulttag!=NULL);
ds@1952	271	resulttag=sym->tag; / save tag of the called function */
ds@1952	272
ds@1952	273	if (savepri \|\| savealt)
ds@1952	274	popreg(sALT); /* restore the saved PRI/ALT that into ALT */
ds@1952	275	if (oper==user_inc \|\| oper==user_dec) {
ds@1952	276	assert(lval!=NULL);
ds@1952	277	if (lval->ident==iARRAYCELL \|\| lval->ident==iARRAYCHAR)
ds@1952	278	popreg(sALT); /* restore address (in ALT) */
ds@1952	279	store(lval); /* store PRI in the symbol */
ds@1952	280	moveto1(); /* make sure PRI is restored on exit */
ds@1952	281	} /* if */
ds@1952	282	return TRUE;
ds@1952	283	}
ds@1952	284
ds@1952	285	SC_FUNC int checktags_string(int tags[], int numtags, value *sym1)
ds@1952	286	{
ds@1952	287	int i;
ds@1952	288	if (sym1->ident == iARRAY \|\| sym1->ident == iREFARRAY)
ds@1952	289	{
ds@1952	290	return FALSE;
ds@1952	291	}
ds@1952	292	for (i=0; i<numtags; i++) {
ds@1952	293	if ((sym1->tag == pc_tag_string && tags[i] == 0) \|\|
ds@1952	294	(sym1->tag == 0 && tags[i] == pc_tag_string))
ds@1952	295	return TRUE;
ds@1952	296	}
ds@1952	297	return FALSE;
ds@1952	298	}
ds@1952	299
ds@1952	300	SC_FUNC int checktag_string(value sym1, value sym2)
ds@1952	301	{
ds@1952	302	if (sym1->ident == iARRAY \|\| sym2->ident == iARRAY
ds@1952	303	\|\| sym1->ident == iREFARRAY \|\| sym2->ident == iREFARRAY)
ds@1952	304	{
ds@1952	305	return FALSE;
ds@1952	306	}
ds@1952	307	if ((sym1->tag == pc_tag_string && sym2->tag == 0)
ds@1952	308	\|\| (sym1->tag == 0 && sym2->tag == pc_tag_string))
ds@1952	309	{
ds@1952	310	return TRUE;
ds@1952	311	}
ds@1952	312
ds@1952	313	return FALSE;
ds@1952	314	}
ds@1952	315
ds@1952	316	SC_FUNC int matchtag_string(int ident, int tag)
ds@1952	317	{
ds@1952	318	if (ident == iARRAY \|\| ident == iREFARRAY)
ds@1952	319	return FALSE;
ds@1952	320	return (tag == pc_tag_string) ? TRUE : FALSE;
ds@1952	321	}
ds@1952	322
ds@1952	323	SC_FUNC int matchtag(int formaltag,int actualtag,int allowcoerce)
ds@1952	324	{
ds@1952	325	if (formaltag != actualtag) {
ds@1952	326	/* if the formal tag is zero and the actual tag is not "fixed", the actual
ds@1952	327	* tag is "coerced" to zero
ds@1952	328	*/
ds@1952	329	if (!allowcoerce \|\| formaltag!=0 \|\| (actualtag & FIXEDTAG)!=0) {
ds@1952	330	if (formaltag == pc_anytag \|\| actualtag == pc_anytag)
ds@1952	331	{
ds@1952	332	return TRUE;
ds@1952	333	}
ds@1952	334
ds@1952	335	if (formaltag & FUNCTAG)
ds@1952	336	{
ds@1952	337	if (actualtag == pc_functag \|\| (formaltag == pc_functag && actualtag & FUNCTAG))
ds@1952	338	{
ds@1952	339	return TRUE;
ds@1952	340	} else if (actualtag & FUNCTAG) {
ds@1952	341	constvalue *v = find_tag_byval(actualtag);
ds@1952	342	int index;
ds@1952	343	short usage = uPUBLIC;
ds@1952	344	symbol sym, found = NULL;
ds@1952	345	funcenum_t *e;
ds@1952	346	functag_t *t;
ds@1952	347
ds@1952	348	if (strncmp(v->name, "$Func", 5) != 0)
ds@1952	349	{
ds@1952	350	return FALSE;
ds@1952	351	}
ds@1952	352
ds@1952	353	/* Now we have to go about looking up each function in this enum. WHICH IS IT. */
ds@1952	354	e = funcenums_find_byval(formaltag);
ds@1952	355	if (!e)
ds@1952	356	{
ds@1952	357	return FALSE;
ds@1952	358	}
ds@1952	359
ds@1952	360	assert(v->name[5] == '@' \|\| v->name[5] == '!');
ds@1952	361
ds@1952	362	/* Deduce which function type this is */
ds@1952	363	if (v->name[5] == '@')
ds@1952	364	{
ds@1952	365	usage = uPUBLIC;
ds@1952	366	} else if (v->name[5] = '!') {
ds@1952	367	usage = uSTOCK;
ds@1952	368	}
ds@1952	369
ds@1952	370	index = atoi(&v->name[6]);
ds@1952	371
ds@1952	372	assert(index >= 0);
ds@1952	373
ds@1952	374	/* Find the function, either by public idx or code addr */
ds@1952	375	if (usage == uPUBLIC)
ds@1952	376	{
ds@1952	377	for (sym=glbtab.next; sym!=NULL; sym=sym->next) {
ds@1952	378	if (sym->ident==iFUNCTN && (sym->usage & uPUBLIC)!=0 && (sym->vclass == sGLOBAL))
ds@1952	379	{
ds@1952	380	if (index-- == 0)
ds@1952	381	{
ds@1952	382	found = sym;
ds@1952	383	break;
ds@1952	384	}
ds@1952	385	}
ds@1952	386	}
ds@1952	387	} else if (usage == uSTOCK) {
ds@1952	388	for (sym=glbtab.next; sym!=NULL; sym=sym->next) {
ds@1952	389	if (sym->ident==iFUNCTN && (sym->vclass == sGLOBAL))
ds@1952	390	{
ds@1952	391	if (sym->codeaddr == index)
ds@1952	392	{
ds@1952	393	found = sym;
ds@1952	394	break;
ds@1952	395	}
ds@1952	396	}
ds@1952	397	}
ds@1952	398	}
ds@1952	399
ds@1952	400	if (!found)
ds@1952	401	{
ds@1952	402	assert(found);
ds@1952	403	return FALSE;
ds@1952	404	}
ds@1952	405
ds@1952	406	/* Wow, we now have:
ds@1952	407	* 1) The functional enum deduced from formaltag
ds@1952	408	* 2) The function trying to be shoved in deduced from actualtag
ds@1952	409	* Now we have to check if it matches any one of the functags inside the enum.
ds@1952	410	*/
ds@1952	411	t = e->first;
ds@1952	412	while (t)
ds@1952	413	{
ds@1952	414	int curarg,skip=0,i;
ds@1952	415	arginfo *func_arg;
ds@1952	416	funcarg_t *enum_arg;
ds@1952	417	/* Check return type first. */
ds@1952	418	if (t->ret_tag != sym->tag)
ds@1952	419	{
ds@1952	420	t = t->next;
ds@1952	421	continue;
ds@1952	422	}
ds@1952	423	/* Check usage */
ds@1952	424	if (t->type != usage)
ds@1952	425	{
ds@1952	426	t = t->next;
ds@1952	427	continue;
ds@1952	428	}
ds@1952	429	/* Begin iterating arguments */
ds@1952	430	for (curarg=0; curarg<t->argcount; curarg++)
ds@1952	431	{
ds@1952	432	enum_arg = &t->args[curarg];
ds@1952	433	/* Check whether we've exhausted our arguments */
ds@1952	434	if (sym->dim.arglist[curarg].ident == 0)
ds@1952	435	{
ds@1952	436	/* Can we bail out early? */
ds@1952	437	if (!enum_arg->ommittable)
ds@1952	438	{
ds@1952	439	/* No! */
ds@1952	440	skip = 1;
ds@1952	441	}
ds@1952	442	break;
ds@1952	443	}
ds@1952	444	func_arg = &sym->dim.arglist[curarg];
ds@1952	445	/* First check the ident type */
ds@1952	446	if (enum_arg->ident != func_arg->ident)
ds@1952	447	{
ds@1952	448	skip = 1;
ds@1952	449	break;
ds@1952	450	}
ds@1952	451	/* Next check arrayness */
ds@1952	452	if (enum_arg->dimcount != func_arg->numdim)
ds@1952	453	{
ds@1952	454	skip = 1;
ds@1952	455	break;
ds@1952	456	}
ds@1952	457	if (enum_arg->dimcount > 0)
ds@1952	458	{
ds@1952	459	for (i=0; i<enum_arg->dimcount; i++)
ds@1952	460	{
ds@1952	461	if (enum_arg->dims[i] != func_arg->dim[i])
ds@1952	462	{
ds@1952	463	skip = 1;
ds@1952	464	break;
ds@1952	465	}
ds@1952	466	}
ds@1952	467	if (skip)
ds@1952	468	{
ds@1952	469	break;
ds@1952	470	}
ds@1952	471	}
ds@1952	472	/* Lastly, check the tags */
ds@1952	473	if (enum_arg->tagcount != func_arg->numtags)
ds@1952	474	{
ds@1952	475	skip = 1;
ds@1952	476	break;
ds@1952	477	}
ds@1952	478	/* They should all be in the same order just for clarity... */
ds@1952	479	for (i=0; i<enum_arg->tagcount; i++)
ds@1952	480	{
ds@1952	481	if (enum_arg->tags[i] != func_arg->tags[i])
ds@1952	482	{
ds@1952	483	skip = 1;
ds@1952	484	break;
ds@1952	485	}
ds@1952	486	}
ds@1952	487	if (skip)
ds@1952	488	{
ds@1952	489	break;
ds@1952	490	}
ds@1952	491	}
ds@1952	492	if (!skip)
ds@1952	493	{
ds@1952	494	/* Make sure there are no trailing arguments */
ds@1952	495	if (sym->dim.arglist[curarg].ident == 0)
ds@1952	496	{
ds@1952	497	return TRUE;
ds@1952	498	}
ds@1952	499	}
ds@1952	500	t = t->next;
ds@1952	501	}
ds@1952	502	}
ds@1952	503	}
ds@1952	504	return FALSE;
ds@1952	505	}
ds@1952	506	} /* if */
ds@1952	507	return TRUE;
ds@1952	508	}
ds@1952	509
ds@1952	510	/*
ds@1952	511	* The AMX pseudo-processor has no direct support for logical (boolean)
ds@1952	512	* operations. These have to be done via comparing and jumping. Since we are
ds@1952	513	* already jumping through the code, we might as well implement an "early
ds@1952	514	* drop-out" evaluation (also called "short-circuit"). This conforms to
ds@1952	515	* standard C:
ds@1952	516	*
ds@1952	517	* expr1 \|\| expr2 expr2 will only be evaluated if expr1 is false.
ds@1952	518	* expr1 && expr2 expr2 will only be evaluated if expr1 is true.
ds@1952	519	*
ds@1952	520	* expr1 \|\| expr2 && expr3 expr2 will only be evaluated if expr1 is false
ds@1952	521	* and expr3 will only be evaluated if expr1 is
ds@1952	522	* false and expr2 is true.
ds@1952	523	*
ds@1952	524	* Code generation for the last example proceeds thus:
ds@1952	525	*
ds@1952	526	* evaluate expr1
ds@1952	527	* operator \|\| found
ds@1952	528	* jump to "l1" if result of expr1 not equal to 0
ds@1952	529	* evaluate expr2
ds@1952	530	* -> operator && found; skip to higher level in hierarchy diagram
ds@1952	531	* jump to "l2" if result of expr2 equal to 0
ds@1952	532	* evaluate expr3
ds@1952	533	* jump to "l2" if result of expr3 equal to 0
ds@1952	534	* set expression result to 1 (true)
ds@1952	535	* jump to "l3"
ds@1952	536	* l2: set expression result to 0 (false)
ds@1952	537	* l3:
ds@1952	538	* <- drop back to previous hierarchy level
ds@1952	539	* jump to "l1" if result of expr2 && expr3 not equal to 0
ds@1952	540	* set expression result to 0 (false)
ds@1952	541	* jump to "l4"
ds@1952	542	* l1: set expression result to 1 (true)
ds@1952	543	* l4:
ds@1952	544	*
ds@1952	545	*/
ds@1952	546
ds@1952	547	/* Skim over terms adjoining \|\| and && operators
ds@1952	548	* dropval The value of the expression after "dropping out". An "or" drops
ds@1952	549	* out when the left hand is TRUE, so dropval must be 1 on "or"
ds@1952	550	* expressions.
ds@1952	551	* endval The value of the expression when no expression drops out. In an
ds@1952	552	* "or" expression, this happens when both the left hand and the
ds@1952	553	* right hand are FALSE, so endval must be 0 for "or" expressions.
ds@1952	554	*/
ds@1952	555	static int skim(int opstr,void (testfunc)(int),int dropval,int endval,
ds@1952	556	int (hier)(value),value *lval)
ds@1952	557	{
ds@1952	558	int lvalue,hits,droplab,endlab,opidx;
ds@1952	559	int allconst,foundop;
ds@1952	560	cell constval;
ds@1952	561	int index;
ds@1952	562	cell cidx;
ds@1952	563
ds@1952	564	stgget(&index,&cidx); /* mark position in code generator */
ds@1952	565	hits=FALSE; /* no logical operators "hit" yet */
ds@1952	566	allconst=TRUE; /* assume all values "const" */
ds@1952	567	constval=0;
ds@1952	568	droplab=0; /* to avoid a compiler warning */
ds@1952	569	for ( ;; ) {
ds@1952	570	lvalue=plnge1(hier,lval); /* evaluate left expression */
ds@1952	571
ds@1952	572	allconst= allconst && (lval->ident==iCONSTEXPR);
ds@1952	573	if (allconst) {
ds@1952	574	if (hits) {
ds@1952	575	/* one operator was already found */
ds@1952	576	if (testfunc==jmp_ne0)
ds@1952	577	lval->constval= lval->constval \|\| constval;
ds@1952	578	else
ds@1952	579	lval->constval= lval->constval && constval;
ds@1952	580	} /* if */
ds@1952	581	constval=lval->constval; /* save result accumulated so far */
ds@1952	582	} /* if */
ds@1952	583
ds@1952	584	foundop=nextop(&opidx,opstr);
ds@1952	585	if ((foundop \|\| hits) && (lval->ident==iARRAY \|\| lval->ident==iREFARRAY))
ds@1952	586	error(33, lval->sym ? (lval->sym->name ? lval->sym->name : "-unknown") : "-unknown-"); /* array was not indexed in an expression */
ds@1952	587	if (foundop) {
ds@1952	588	if (!hits) {
ds@1952	589	/* this is the first operator in the list */
ds@1952	590	hits=TRUE;
ds@1952	591	droplab=getlabel();
ds@1952	592	} /* if */
ds@1952	593	dropout(lvalue,testfunc,droplab,lval);
ds@1952	594	} else if (hits) { /* no (more) identical operators */
ds@1952	595	dropout(lvalue,testfunc,droplab,lval); /* found at least one operator! */
ds@1952	596	ldconst(endval,sPRI);
ds@1952	597	jumplabel(endlab=getlabel());
ds@1952	598	setlabel(droplab);
ds@1952	599	ldconst(dropval,sPRI);
ds@1952	600	setlabel(endlab);
ds@1952	601	lval->sym=NULL;
ds@1952	602	lval->tag=pc_addtag("bool"); /* force tag to be "bool" */
ds@1952	603	if (allconst) {
ds@1952	604	lval->ident=iCONSTEXPR;
ds@1952	605	lval->constval=constval;
ds@1952	606	stgdel(index,cidx); /* scratch generated code and calculate */
ds@1952	607	} else {
ds@1952	608	lval->ident=iEXPRESSION;
ds@1952	609	lval->constval=0;
ds@1952	610	} /* if */
ds@1952	611	return FALSE;
ds@1952	612	} else {
ds@1952	613	return lvalue; /* none of the operators in "opstr" were found */
ds@1952	614	} /* if */
ds@1952	615
ds@1952	616	} /* while */
ds@1952	617	}
ds@1952	618
ds@1952	619	/*
ds@1952	620	* Reads into the primary register the variable pointed to by lval if
ds@1952	621	* plunging through the hierarchy levels detected an lvalue. Otherwise
ds@1952	622	* if a constant was detected, it is loaded. If there is no constant and
ds@1952	623	* no lvalue, the primary register must already contain the expression
ds@1952	624	* result.
ds@1952	625	*
ds@1952	626	* After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which
ds@1952	627	* compare the primary register against 0, and jump to the "early drop-out"
ds@1952	628	* label "exit1" if the condition is true.
ds@1952	629	*/
ds@1952	630	static void dropout(int lvalue,void (testfunc)(int val),int exit1,value lval)
ds@1952	631	{
ds@1952	632	if (lvalue)
ds@1952	633	rvalue(lval);
ds@1952	634	else if (lval->ident==iCONSTEXPR)
ds@1952	635	ldconst(lval->constval,sPRI);
ds@1952	636	(*testfunc)(exit1);
ds@1952	637	}
ds@1952	638
ds@1952	639	static void checkfunction(value *lval)
ds@1952	640	{
ds@1952	641	symbol *sym=lval->sym;
ds@1952	642
ds@1952	643	if (sym==NULL \|\| (sym->ident!=iFUNCTN && sym->ident!=iREFFUNC))
ds@1952	644	return; /* no known symbol, or not a function result */
ds@1952	645
ds@1952	646	if ((sym->usage & uDEFINE)!=0) {
ds@1952	647	/* function is defined, can now check the return value (but make an
ds@1952	648	* exception for directly recursive functions)
ds@1952	649	*/
ds@1952	650	if (sym!=curfunc && (sym->usage & uRETVALUE)==0) {
ds@1952	651	char symname[2sNAMEMAX+16]; / allow space for user defined operators */
ds@1952	652	funcdisplayname(symname,sym->name);
ds@1952	653	error(209,symname); /* function should return a value */
ds@1952	654	} /* if */
ds@1952	655	} else {
ds@1952	656	/* function not yet defined, set */
ds@1952	657	sym->usage\|=uRETVALUE; /* make sure that a future implementation of
ds@1952	658	* the function uses "return <value>" */
ds@1952	659	} /* if */
ds@1952	660	}
ds@1952	661
ds@1952	662	/*
ds@1952	663	* Plunge to a lower level
ds@1952	664	*/
ds@1952	665	static int plnge(int opstr,int opoff,int (hier)(value lval),value lval,
ds@1952	666	char *forcetag,int chkbitwise)
ds@1952	667	{
ds@1952	668	int lvalue,opidx;
ds@1952	669	int count;
ds@1952	670	value lval2 = {0};
ds@1952	671
ds@1952	672	lvalue=plnge1(hier,lval);
ds@1952	673	if (nextop(&opidx,opstr)==0)
ds@1952	674	return lvalue; /* no operator in "opstr" found */
ds@1952	675	if (lvalue)
ds@1952	676	rvalue(lval);
ds@1952	677	count=0;
ds@1952	678	do {
ds@1952	679	if (chkbitwise && count++>0 && bitwise_opercount!=0)
ds@1952	680	error(212);
ds@1952	681	opidx+=opoff; /* add offset to index returned by nextop() */
ds@1952	682	plnge2(op1[opidx],hier,lval,&lval2);
ds@1952	683	if (op1[opidx]==ob_and \|\| op1[opidx]==ob_or)
ds@1952	684	bitwise_opercount++;
ds@1952	685	if (forcetag!=NULL)
ds@1952	686	lval->tag=pc_addtag(forcetag);
ds@1952	687	} while (nextop(&opidx,opstr)); /* do */
ds@1952	688	return FALSE; /* result of expression is not an lvalue */
ds@1952	689	}
ds@1952	690
ds@1952	691	/* plnge_rel
ds@1952	692	*
ds@1952	693	* Binary plunge to lower level; this is very simular to plnge, but
ds@1952	694	* it has special code generation sequences for chained operations.
ds@1952	695	*/
ds@1952	696	static int plnge_rel(int opstr,int opoff,int (hier)(value lval),value lval)
ds@1952	697	{
ds@1952	698	int lvalue,opidx;
ds@1952	699	value lval2={0};
ds@1952	700	int count;
ds@1952	701
ds@1952	702	/* this function should only be called for relational operators */
ds@1952	703	assert(op1[opoff]==os_le);
ds@1952	704	lvalue=plnge1(hier,lval);
ds@1952	705	if (nextop(&opidx,opstr)==0)
ds@1952	706	return lvalue; /* no operator in "opstr" found */
ds@1952	707	if (lvalue)
ds@1952	708	rvalue(lval);
ds@1952	709	count=0;
ds@1952	710	lval->boolresult=TRUE;
ds@1952	711	do {
ds@1952	712	/* same check as in plnge(), but "chkbitwise" is always TRUE */
ds@1952	713	if (count>0 && bitwise_opercount!=0)
ds@1952	714	error(212);
ds@1952	715	if (count>0) {
ds@1952	716	relop_prefix();
ds@1952	717	lval=lval2; / copy right hand expression of the previous iteration */
ds@1952	718	} /* if */
ds@1952	719	opidx+=opoff;
ds@1952	720	plnge2(op1[opidx],hier,lval,&lval2);
ds@1952	721	if (count++>0)
ds@1952	722	relop_suffix();
ds@1952	723	} while (nextop(&opidx,opstr)); /* enddo */
ds@1952	724	lval->constval=lval->boolresult;
ds@1952	725	lval->tag=pc_addtag("bool"); /* force tag to be "bool" */
ds@1952	726	return FALSE; /* result of expression is not an lvalue */
ds@1952	727	}
ds@1952	728
ds@1952	729	/* plnge1
ds@1952	730	*
ds@1952	731	* Unary plunge to lower level
ds@1952	732	* Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13()
ds@1952	733	*/
ds@1952	734	static int plnge1(int (hier)(value lval),value *lval)
ds@1952	735	{
ds@1952	736	int lvalue,index;
ds@1952	737	cell cidx;
ds@1952	738
ds@1952	739	stgget(&index,&cidx); /* mark position in code generator */
ds@1952	740	lvalue=(*hier)(lval);
ds@1952	741	if (lval->ident==iCONSTEXPR)
ds@1952	742	stgdel(index,cidx); /* load constant later */
ds@1952	743	return lvalue;
ds@1952	744	}
ds@1952	745
ds@1952	746	/* plnge2
ds@1952	747	*
ds@1952	748	* Binary plunge to lower level
ds@1952	749	* Called by: plnge(), plnge_rel(), hier14() and hier1()
ds@1952	750	*/
ds@1952	751	static void plnge2(void (*oper)(void),
ds@1952	752	int (hier)(value lval),
ds@1952	753	value lval1,value lval2)
ds@1952	754	{
ds@1952	755	int index;
ds@1952	756	cell cidx;
ds@1952	757
ds@1952	758	stgget(&index,&cidx); /* mark position in code generator */
ds@1952	759	if (lval1->ident==iCONSTEXPR) { /* constant on left side; it is not yet loaded */
ds@1952	760	if (plnge1(hier,lval2))
ds@1952	761	rvalue(lval2); /* load lvalue now */
ds@1952	762	else if (lval2->ident==iCONSTEXPR)
ds@1952	763	ldconst(lval2->constval<<dbltest(oper,lval2,lval1),sPRI);
ds@1952	764	ldconst(lval1->constval<<dbltest(oper,lval2,lval1),sALT);
ds@1952	765	/* ^ doubling of constants operating on integer addresses */
ds@1952	766	/* is restricted to "add" and "subtract" operators */
ds@1952	767	} else { /* non-constant on left side */
ds@1952	768	pushreg(sPRI);
ds@1952	769	if (plnge1(hier,lval2))
ds@1952	770	rvalue(lval2);
ds@1952	771	if (lval2->ident==iCONSTEXPR) { /* constant on right side */
ds@1952	772	if (commutative(oper)) { /* test for commutative operators */
ds@1952	773	value lvaltmp = {0};
ds@1952	774	stgdel(index,cidx); /* scratch pushreg() and constant fetch (then
ds@1952	775	* fetch the constant again */
ds@1952	776	ldconst(lval2->constval<<dbltest(oper,lval1,lval2),sALT);
ds@1952	777	/* now, the primary register has the left operand and the secondary
ds@1952	778	* register the right operand; swap the "lval" variables so that lval1
ds@1952	779	* is associated with the secondary register and lval2 with the
ds@1952	780	* primary register, as is the "normal" case.
ds@1952	781	*/
ds@1952	782	lvaltmp=*lval1;
ds@1952	783	lval1=lval2;
ds@1952	784	*lval2=lvaltmp;
ds@1952	785	} else {
ds@1952	786	ldconst(lval2->constval<<dbltest(oper,lval1,lval2),sPRI);
ds@1952	787	popreg(sALT); /* pop result of left operand into secondary register */
ds@1952	788	} /* if */
ds@1952	789	} else { /* non-constants on both sides */
ds@1952	790	popreg(sALT);
ds@1952	791	if (dbltest(oper,lval1,lval2))
ds@1952	792	cell2addr(); /* double primary register */
ds@1952	793	if (dbltest(oper,lval2,lval1))
ds@1952	794	cell2addr_alt(); /* double secondary register */
ds@1952	795	} /* if */
ds@1952	796	} /* if */
ds@1952	797	if (oper) {
ds@1952	798	/* If used in an expression, a function should return a value.
ds@1952	799	* If the function has been defined, we can check this. If the
ds@1952	800	* function was not defined, we can set this requirement (so that
ds@1952	801	* a future function definition can check this bit.
ds@1952	802	*/
ds@1952	803	checkfunction(lval1);
ds@1952	804	checkfunction(lval2);
ds@1952	805	if (lval1->ident==iARRAY \|\| lval1->ident==iREFARRAY) {
ds@1952	806	char *ptr=(lval1->sym!=NULL) ? lval1->sym->name : "-unknown-";
ds@1952	807	error(33,ptr); /* array must be indexed */
ds@1952	808	} else if (lval2->ident==iARRAY \|\| lval2->ident==iREFARRAY) {
ds@1952	809	char *ptr=(lval2->sym!=NULL) ? lval2->sym->name : "-unknown-";
ds@1952	810	error(33,ptr); /* array must be indexed */
ds@1952	811	} /* if */
ds@1952	812	/* ??? ^^^ should do same kind of error checking with functions */
ds@1952	813
ds@1952	814	/* check whether an "operator" function is defined for the tag names
ds@1952	815	* (a constant expression cannot be optimized in that case)
ds@1952	816	*/
ds@1952	817	if (check_userop(oper,lval1->tag,lval2->tag,2,NULL,&lval1->tag)) {
ds@1952	818	lval1->ident=iEXPRESSION;
ds@1952	819	lval1->constval=0;
ds@1952	820	} else if (lval1->ident==iCONSTEXPR && lval2->ident==iCONSTEXPR) {
ds@1952	821	/* only constant expression if both constant */
ds@1952	822	stgdel(index,cidx); /* scratch generated code and calculate */
ds@1952	823	if (!matchtag(lval1->tag,lval2->tag,FALSE))
ds@1952	824	error(213); /* tagname mismatch */
ds@1952	825	lval1->constval=calc(lval1->constval,oper,lval2->constval,&lval1->boolresult);
ds@1952	826	} else {
ds@1952	827	if (!checktag_string(lval1, lval2) && !matchtag(lval1->tag,lval2->tag,FALSE))
ds@1952	828	error(213); /* tagname mismatch */
ds@1952	829	(oper)(); / do the (signed) operation */
ds@1952	830	lval1->ident=iEXPRESSION;
ds@1952	831	} /* if */
ds@1952	832	} /* if */
ds@1952	833	}
ds@1952	834
ds@1952	835	static cell flooreddiv(cell a,cell b,int return_remainder)
ds@1952	836	{
ds@1952	837	cell q,r;
ds@1952	838
ds@1952	839	if (b==0) {
ds@1952	840	error(29);
ds@1952	841	return 0;
ds@1952	842	} /* if */
ds@1952	843	/* first implement truncated division in a portable way */
ds@1952	844	#define IABS(a) ((a)>=0 ? (a) : (-a))
ds@1952	845	q=IABS(a)/IABS(b);
ds@1952	846	if ((cell)(a ^ b)<0)
ds@1952	847	q=-q; /* swap sign if either "a" or "b" is negative (but not both) */
ds@1952	848	r=a-qb; / calculate the matching remainder */
ds@1952	849	/* now "fiddle" with the values to get floored division */
ds@1952	850	if (r!=0 && (cell)(r ^ b)<0) {
ds@1952	851	q--;
ds@1952	852	r+=b;
ds@1952	853	} /* if */
ds@1952	854	return return_remainder ? r : q;
ds@1952	855	}
ds@1952	856
ds@1952	857	static cell calc(cell left,void (oper)(),cell right,char boolresult)
ds@1952	858	{
ds@1952	859	if (oper==ob_or)
ds@1952	860	return (left \| right);
ds@1952	861	else if (oper==ob_xor)
ds@1952	862	return (left ^ right);
ds@1952	863	else if (oper==ob_and)
ds@1952	864	return (left & right);
ds@1952	865	else if (oper==ob_eq)
ds@1952	866	return (left == right);
ds@1952	867	else if (oper==ob_ne)
ds@1952	868	return (left != right);
ds@1952	869	else if (oper==os_le)
ds@1952	870	return *boolresult &= (char)(left <= right), right;
ds@1952	871	else if (oper==os_ge)
ds@1952	872	return *boolresult &= (char)(left >= right), right;
ds@1952	873	else if (oper==os_lt)
ds@1952	874	return *boolresult &= (char)(left < right), right;
ds@1952	875	else if (oper==os_gt)
ds@1952	876	return *boolresult &= (char)(left > right), right;
ds@1952	877	else if (oper==os_sar)
ds@1952	878	return (left >> (int)right);
ds@1952	879	else if (oper==ou_sar)
ds@1952	880	return ((ucell)left >> (ucell)right);
ds@1952	881	else if (oper==ob_sal)
ds@1952	882	return ((ucell)left << (int)right);
ds@1952	883	else if (oper==ob_add)
ds@1952	884	return (left + right);
ds@1952	885	else if (oper==ob_sub)
ds@1952	886	return (left - right);
ds@1952	887	else if (oper==os_mult)
ds@1952	888	return (left * right);
ds@1952	889	else if (oper==os_div)
ds@1952	890	return flooreddiv(left,right,0);
ds@1952	891	else if (oper==os_mod)
ds@1952	892	return flooreddiv(left,right,1);
ds@1952	893	else
ds@1952	894	error(29); /* invalid expression, assumed 0 (this should never occur) */
ds@1952	895	return 0;
ds@1952	896	}
ds@1952	897
ds@1952	898	SC_FUNC int expression(cell val,int tag,symbol *symptr,int chkfuncresult,value _lval)
ds@1952	899	{
ds@1952	900	value lval={0};
ds@1952	901	pushheaplist();
ds@1952	902
ds@1952	903	if (hier14(&lval))
ds@1952	904	rvalue(&lval);
ds@1952	905	/* scrap any arrays left on the heap */
ds@1952	906	popheaplist();
ds@1952	907
ds@1952	908	if (lval.ident==iCONSTEXPR && val!=NULL) /* constant expression */
ds@1952	909	*val=lval.constval;
ds@1952	910	if (tag!=NULL)
ds@1952	911	*tag=lval.tag;
ds@1952	912	if (symptr!=NULL)
ds@1952	913	*symptr=lval.sym;
ds@1952	914	if (chkfuncresult)
ds@1952	915	checkfunction(&lval);
ds@1952	916	if (_lval)
ds@1952	917	*_lval=lval;
ds@1952	918	return lval.ident;
ds@1952	919	}
ds@1952	920
ds@1952	921	SC_FUNC int sc_getstateid(constvalue automaton,constvalue state)
ds@1952	922	{
ds@1952	923	char name[sNAMEMAX+1];
ds@1952	924	cell val;
ds@1952	925	char *str;
ds@1952	926	int fsa,islabel;
ds@1952	927
ds@1952	928	assert(automaton!=NULL);
ds@1952	929	assert(state!=NULL);
ds@1952	930	if (!(islabel=matchtoken(tLABEL)) && !needtoken(tSYMBOL))
ds@1952	931	return 0;
ds@1952	932
ds@1952	933	tokeninfo(&val,&str);
ds@1952	934	assert(strlen(str)<sizeof name);
ds@1952	935	strcpy(name,str);
ds@1952	936	if (islabel \|\| matchtoken(':')) {
ds@1952	937	/* token is an automaton name, add the name and get a new token */
ds@1952	938	*automaton=automaton_find(name);
ds@1952	939	/* read in the state name before checking the automaton, to keep the parser
ds@1952	940	* going (an "unknown automaton" error may occur when the "state" instruction
ds@1952	941	* precedes any state definition)
ds@1952	942	*/
ds@1952	943	if (!needtoken(tSYMBOL))
ds@1952	944	return 0;
ds@1952	945	tokeninfo(&val,&str); /* do not copy the name yet, must check automaton first */
ds@1952	946	if (*automaton==NULL) {
ds@1952	947	error(86,name); /* unknown automaton */
ds@1952	948	return 0;
ds@1952	949	} /* if */
ds@1952	950	assert((*automaton)->index>0);
ds@1952	951	assert(strlen(str)<sizeof name);
ds@1952	952	strcpy(name,str);
ds@1952	953	} else {
ds@1952	954	*automaton=automaton_find("");
ds@1952	955	assert(*automaton!=NULL);
ds@1952	956	assert((*automaton)->index==0);
ds@1952	957	} /* if */
ds@1952	958	assert(*automaton!=NULL);
ds@1952	959	fsa=(*automaton)->index;
ds@1952	960
ds@1952	961	assert(*automaton!=NULL);
ds@1952	962	*state=state_find(name,fsa);
ds@1952	963	if (*state==NULL) {
ds@1952	964	char fsaname=(automaton)->name;
ds@1952	965	if (*fsaname=='\0')
ds@1952	966	fsaname="<main>";
ds@1952	967	error(87,name,fsaname); /* unknown state for automaton */
ds@1952	968	return 0;
ds@1952	969	} /* if */
ds@1952	970
ds@1952	971	return 1;
ds@1952	972	}
ds@1952	973
ds@1952	974	SC_FUNC cell array_totalsize(symbol *sym)
ds@1952	975	{
ds@1952	976	cell length;
ds@1952	977
ds@1952	978	assert(sym!=NULL);
ds@1952	979	assert(sym->ident==iARRAY \|\| sym->ident==iREFARRAY);
ds@1952	980	length=sym->dim.array.length;
ds@1952	981	if (sym->dim.array.level > 0) {
ds@1952	982	cell sublength=array_totalsize(finddepend(sym));
ds@1952	983	if (sublength>0)
ds@1952	984	length=length+length*sublength;
ds@1952	985	else
ds@1952	986	length=0;
ds@1952	987	} /* if */
ds@1952	988	return length;
ds@1952	989	}
ds@1952	990
ds@1952	991	static cell array_levelsize(symbol *sym,int level)
ds@1952	992	{
ds@1952	993	assert(sym!=NULL);
ds@1952	994	assert(sym->ident==iARRAY \|\| sym->ident==iREFARRAY);
ds@1952	995	assert(level <= sym->dim.array.level);
ds@1952	996	while (level-- > 0) {
ds@1952	997	sym=finddepend(sym);
ds@1952	998	assert(sym!=NULL);
ds@1952	999	} /* if */
ds@1952	1000	return (sym->dim.array.slength ? sym->dim.array.slength : sym->dim.array.length);
ds@1952	1001	}
ds@1952	1002
ds@1952	1003	/* hier14
ds@1952	1004	*
ds@1952	1005	* Lowest hierarchy level (except for the , operator).
ds@1952	1006	*
ds@1952	1007	* Global references: sc_intest (reffered to only)
ds@1952	1008	* sc_allowproccall (modified)
ds@1952	1009	*/
ds@1952	1010	static int hier14(value *lval1)
ds@1952	1011	{
ds@1952	1012	int lvalue;
ds@1952	1013	value lval2={0},lval3={0};
ds@1952	1014	void (*oper)(void);
ds@1952	1015	int tok,level,i;
ds@1952	1016	cell val;
ds@1952	1017	char *st;
ds@1952	1018	int bwcount,leftarray;
ds@1952	1019	cell arrayidx1[sDIMEN_MAX],arrayidx2[sDIMEN_MAX]; /* last used array indices */
ds@1952	1020	cell *org_arrayidx;
ds@1952	1021
ds@1952	1022	bwcount=bitwise_opercount;
ds@1952	1023	bitwise_opercount=0;
ds@1952	1024	/* initialize the index arrays with unlikely constant indices; note that
ds@1952	1025	* these indices will only be changed when the array is indexed with a
ds@1952	1026	* constant, and that negative array indices are invalid (so actually, any
ds@1952	1027	* negative value would do).
ds@1952	1028	*/
ds@1952	1029	for (i=0; i<sDIMEN_MAX; i++)
ds@1952	1030	arrayidx1[i]=arrayidx2[i]=(cell)(-1L << (sizeof(cell)*8-1));
ds@1952	1031	org_arrayidx=lval1->arrayidx; /* save current pointer, to reset later */
ds@1952	1032	if (lval1->arrayidx==NULL)
ds@1952	1033	lval1->arrayidx=arrayidx1;
ds@1952	1034	lvalue=plnge1(hier13,lval1);
ds@1952	1035	if (lval1->ident!=iARRAYCELL && lval1->ident!=iARRAYCHAR)
ds@1952	1036	lval1->arrayidx=NULL;
ds@1952	1037	if (lval1->ident==iCONSTEXPR) /* load constant here */
ds@1952	1038	ldconst(lval1->constval,sPRI);
ds@1952	1039	tok=lex(&val,&st);
ds@1952	1040	switch (tok) {
ds@1952	1041	case taOR:
ds@1952	1042	oper=ob_or;
ds@1952	1043	break;
ds@1952	1044	case taXOR:
ds@1952	1045	oper=ob_xor;
ds@1952	1046	break;
ds@1952	1047	case taAND:
ds@1952	1048	oper=ob_and;
ds@1952	1049	break;
ds@1952	1050	case taADD:
ds@1952	1051	oper=ob_add;
ds@1952	1052	break;
ds@1952	1053	case taSUB:
ds@1952	1054	oper=ob_sub;
ds@1952	1055	break;
ds@1952	1056	case taMULT:
ds@1952	1057	oper=os_mult;
ds@1952	1058	break;
ds@1952	1059	case taDIV:
ds@1952	1060	oper=os_div;
ds@1952	1061	break;
ds@1952	1062	case taMOD:
ds@1952	1063	oper=os_mod;
ds@1952	1064	break;
ds@1952	1065	case taSHRU:
ds@1952	1066	oper=ou_sar;
ds@1952	1067	break;
ds@1952	1068	case taSHR:
ds@1952	1069	oper=os_sar;
ds@1952	1070	break;
ds@1952	1071	case taSHL:
ds@1952	1072	oper=ob_sal;
ds@1952	1073	break;
ds@1952	1074	case '=': /* simple assignment */
ds@1952	1075	oper=NULL;
ds@1952	1076	if (sc_intest)
ds@1952	1077	error(211); /* possibly unintended assignment */
ds@1952	1078	break;
ds@1952	1079	default:
ds@1952	1080	lexpush();
ds@1952	1081	bitwise_opercount=bwcount;
ds@1952	1082	lval1->arrayidx=org_arrayidx; /* restore array index pointer */
ds@1952	1083	return lvalue;
ds@1952	1084	} /* switch */
ds@1952	1085
ds@1952	1086	/* if we get here, it was an assignment; first check a few special cases
ds@1952	1087	* and then the general */
ds@1952	1088	if (lval1->ident==iARRAYCHAR) {
ds@1952	1089	/* special case, assignment to packed character in a cell is permitted */
ds@1952	1090	lvalue=TRUE;
ds@1952	1091	} else if (lval1->ident==iARRAY \|\| lval1->ident==iREFARRAY) {
ds@1952	1092	/* array assignment is permitted too (with restrictions) */
ds@1952	1093	if (oper)
ds@1952	1094	return error(23); /* array assignment must be simple assigment */
ds@1952	1095	assert(lval1->sym!=NULL);
ds@1952	1096	if (array_totalsize(lval1->sym)==0)
ds@1952	1097	return error(46,lval1->sym->name); /* unknown array size */
ds@1952	1098	lvalue=TRUE;
ds@1952	1099	} /* if */
ds@1952	1100
ds@1952	1101	/* operand on left side of assignment must be lvalue */
ds@1952	1102	if (!lvalue)
ds@1952	1103	return error(22); /* must be lvalue */
ds@1952	1104	/* may not change "constant" parameters */
ds@1952	1105	assert(lval1->sym!=NULL);
ds@1952	1106	if ((lval1->sym->usage & uCONST)!=0)
ds@1952	1107	return error(22); /* assignment to const argument */
ds@1952	1108	sc_allowproccall=FALSE; /* may no longer use "procedure call" syntax */
ds@1952	1109
ds@1952	1110	lval3=lval1; / save symbol to enable storage of expresion result */
ds@1952	1111	lval1->arrayidx=org_arrayidx; /* restore array index pointer */
ds@1952	1112	if (lval1->ident==iARRAYCELL \|\| lval1->ident==iARRAYCHAR
ds@1952	1113	\|\| lval1->ident==iARRAY \|\| lval1->ident==iREFARRAY)
ds@1952	1114	{
ds@1952	1115	/* if indirect fetch: save PRI (cell address) */
ds@1952	1116	if (oper) {
ds@1952	1117	pushreg(sPRI);
ds@1952	1118	rvalue(lval1);
ds@1952	1119	} /* if */
ds@1952	1120	lval2.arrayidx=arrayidx2;
ds@1952	1121	plnge2(oper,hier14,lval1,&lval2);
ds@1952	1122	if (lval2.ident!=iARRAYCELL && lval2.ident!=iARRAYCHAR)
ds@1952	1123	lval2.arrayidx=NULL;
ds@1952	1124	if (oper)
ds@1952	1125	popreg(sALT);
ds@1952	1126	if (!oper && lval3.arrayidx!=NULL && lval2.arrayidx!=NULL
ds@1952	1127	&& lval3.ident==lval2.ident && lval3.sym==lval2.sym)
ds@1952	1128	{
ds@1952	1129	int same=TRUE;
ds@1952	1130	assert(lval2.arrayidx==arrayidx2);
ds@1952	1131	for (i=0; i<sDIMEN_MAX; i++)
ds@1952	1132	same=same && (lval3.arrayidx[i]==lval2.arrayidx[i]);
ds@1952	1133	if (same)
ds@1952	1134	error(226,lval3.sym->name); /* self-assignment */
ds@1952	1135	} /* if */
ds@1952	1136	} else {
ds@1952	1137	if (oper){
ds@1952	1138	rvalue(lval1);
ds@1952	1139	plnge2(oper,hier14,lval1,&lval2);
ds@1952	1140	} else {
ds@1952	1141	/* if direct fetch and simple assignment: no "push"
ds@1952	1142	* and "pop" needed -> call hier14() directly, */
ds@1952	1143	if (hier14(&lval2))
ds@1952	1144	rvalue(&lval2); /* instead of plnge2(). */
ds@1952	1145	else if (lval2.ident==iVARIABLE)
ds@1952	1146	lval2.ident=iEXPRESSION;/* mark as "rvalue" if it is not an "lvalue" */
ds@1952	1147	checkfunction(&lval2);
ds@1952	1148	/* check whether lval2 and lval3 (old lval1) refer to the same variable */
ds@1952	1149	if (lval2.ident==iVARIABLE && lval3.ident==lval2.ident && lval3.sym==lval2.sym) {
ds@1952	1150	assert(lval3.sym!=NULL);
ds@1952	1151	error(226,lval3.sym->name); /* self-assignment */
ds@1952	1152	} /* if */
ds@1952	1153	} /* if */
ds@1952	1154	} /* if */
ds@1952	1155	/* Array elements are sometimes considered as sub-arrays --when the
ds@1952	1156	* array index is an enumeration field and the enumeration size is greater
ds@1952	1157	* than 1. If the expression on the right side of the assignment is a cell,
ds@1952	1158	* or if an operation is in effect, this does not apply.
ds@1952	1159	*/
ds@1952	1160	leftarray= lval3.ident==iARRAY \|\| lval3.ident==iREFARRAY
ds@1952	1161	\|\| ((lval3.ident==iARRAYCELL \|\| lval3.ident==iARRAYCHAR)
ds@1952	1162	&& lval3.constval>1 && lval3.sym->dim.array.level==0
ds@1952	1163	&& !oper && (lval2.ident==iARRAY \|\| lval2.ident==iREFARRAY));
ds@1952	1164	if (leftarray) {
ds@1952	1165	/* Left operand is an array, right operand should be an array variable
ds@1952	1166	* of the same size and the same dimension, an array literal (of the
ds@1952	1167	* same size) or a literal string. For single-dimensional arrays without
ds@1952	1168	* tag for the index, it is permitted to assign a smaller array into a
ds@1952	1169	* larger one (without warning). This is to make it easier to work with
ds@1952	1170	* strings.
ds@1952	1171	*/
ds@1952	1172	int exactmatch=TRUE;
ds@1952	1173	int idxtag=0;
ds@1952	1174	int ltlength=(int)lval3.sym->dim.array.length;
ds@1952	1175	if ((lval3.ident==iARRAYCELL \|\| lval3.ident==iARRAYCHAR)
ds@1952	1176	&& lval3.constval>0 && lval3.sym->dim.array.level==0)
ds@1952	1177	{
ds@1952	1178	ltlength=(int)lval3.constval;
ds@1952	1179	} /* if */
ds@1952	1180	if (lval2.ident!=iARRAY && lval2.ident!=iREFARRAY
ds@1952	1181	&& (lval2.sym==NULL \|\| lval2.constval<=0))
ds@1952	1182	error(33,lval3.sym->name); /* array must be indexed */
ds@1952	1183	if (lval2.sym!=NULL) {
ds@1952	1184	if (lval2.constval==0) {
ds@1952	1185	val=lval2.sym->dim.array.length;/* array variable */
ds@1952	1186	} else {
ds@1952	1187	val=lval2.constval;
ds@1952	1188	if (lval2.sym->dim.array.level!=0)
ds@1952	1189	error(28,lval2.sym->name);
ds@1952	1190	} /* if */
ds@1952	1191	level=lval2.sym->dim.array.level;
ds@1952	1192	idxtag=lval2.sym->x.tags.index;
ds@1952	1193	if (level==0 && idxtag==0 && lval3.sym->x.tags.index==0)
ds@1952	1194	exactmatch=FALSE;
ds@1952	1195	} else {
ds@1952	1196	val=lval2.constval; /* literal array */
ds@1952	1197	level=0;
ds@1952	1198	/* If val is negative, it means that lval2 is a literal string.
ds@1952	1199	* The string array size may be smaller than the destination
ds@1952	1200	* array, provided that the destination array does not have an
ds@1952	1201	* index tag.
ds@1952	1202	*/
ds@1952	1203	if (val<0) {
ds@1952	1204	val=-val;
ds@1952	1205	if (lval3.sym->x.tags.index==0)
ds@1952	1206	exactmatch=FALSE;
ds@1952	1207	} /* if */
ds@1952	1208	} /* if */
ds@1952	1209	if (lval3.sym->dim.array.level!=level)
ds@1952	1210	return error(47); /* array dimensions must match */
ds@1952	1211	else if (ltlength<val \|\| exactmatch && ltlength>val \|\| val==0)
ds@1952	1212	return error(47); /* array sizes must match */
ds@1952	1213	else if (lval3.ident!=iARRAYCELL && !matchtag(lval3.sym->x.tags.index,idxtag,TRUE))
ds@1952	1214	error(229,(lval2.sym!=NULL) ? lval2.sym->name : lval3.sym->name); /* index tag mismatch */
ds@1952	1215	if (level>0) {
ds@1952	1216	/* check the sizes of all sublevels too */
ds@1952	1217	symbol *sym1 = lval3.sym;
ds@1952	1218	symbol *sym2 = lval2.sym;
ds@1952	1219	int i;
ds@1952	1220	error(23);
ds@1952	1221	assert(sym1!=NULL && sym2!=NULL);
ds@1952	1222	/* ^^^ sym2 must be valid, because only variables can be
ds@1952	1223	* multi-dimensional (there are no multi-dimensional literals),
ds@1952	1224	* sym1 must be valid because it must be an lvalue
ds@1952	1225	*/
ds@1952	1226	assert(exactmatch);
ds@1952	1227	for (i=0; i<level; i++) {
ds@1952	1228	sym1=finddepend(sym1);
ds@1952	1229	sym2=finddepend(sym2);
ds@1952	1230	assert(sym1!=NULL && sym2!=NULL);
ds@1952	1231	/* ^^^ both arrays have the same dimensions (this was checked
ds@1952	1232	* earlier) so the dependend should always be found
ds@1952	1233	*/
ds@1952	1234	if (sym1->dim.array.length!=sym2->dim.array.length)
ds@1952	1235	error(47); /* array sizes must match */
ds@1952	1236	else if (!matchtag(sym1->x.tags.index,sym2->x.tags.index,TRUE))
ds@1952	1237	error(229,sym2->name); /* index tag mismatch */
ds@1952	1238	} /* for */
ds@1952	1239	/* get the total size in cells of the multi-dimensional array */
ds@1952	1240	val=array_totalsize(lval3.sym);
ds@1952	1241	assert(val>0); /* already checked */
ds@1952	1242	} /* if */
ds@1952	1243	} else {
ds@1952	1244	/* left operand is not an array, right operand should then not be either */
ds@1952	1245	if (lval2.ident==iARRAY \|\| lval2.ident==iREFARRAY)
ds@1952	1246	error(6); /* must be assigned to an array */
ds@1952	1247	} /* if */
ds@1952	1248	if (leftarray) {
ds@1952	1249	memcopy(val*sizeof(cell));
ds@1952	1250	} else {
ds@1952	1251	check_userop(NULL,lval2.tag,lval3.tag,2,&lval3,&lval2.tag);
ds@1952	1252	store(&lval3); /* now, store the expression result */
ds@1952	1253	} /* if */
ds@1952	1254	if (!oper && !checktag_string(&lval3, &lval2) && !matchtag(lval3.tag,lval2.tag,TRUE))
ds@1952	1255	error(213); /* tagname mismatch (if "oper", warning already given in plunge2()) */
ds@1952	1256	if (lval3.sym)
ds@1952	1257	markusage(lval3.sym,uWRITTEN);
ds@1952	1258	sideeffect=TRUE;
ds@1952	1259	bitwise_opercount=bwcount;
ds@1952	1260	lval1->ident=iEXPRESSION;
ds@1952	1261	return FALSE; /* expression result is never an lvalue */
ds@1952	1262	}
ds@1952	1263
ds@1952	1264	/**
ds@1952	1265	* Sums up array usage in the current heap tracer and convert it into a dynamic array.
ds@1952	1266	* This is used for the ternary operator, which needs to convert its array usage into
ds@1952	1267	* something dynamically managed.
ds@1952	1268	* !Note:
ds@1952	1269	* This might break if expressions can ever return dynamic arrays.
ds@1952	1270	* Thus, we assert() if something is non-static here.
ds@1952	1271	* Right now, this poses no problem because this type of expression is impossible:
ds@1952	1272	* (a() ? return_array() : return_array()) ? return_array() : return_array()
ds@1952	1273	*/
ds@1952	1274
ds@1952	1275	long dynarray_from_heaplist(memuse_list_t *heap)
ds@1952	1276	{
ds@1952	1277	memuse_t *use=heap->head;
ds@1952	1278	memuse_t *tmp;
ds@1952	1279	long total=0;
ds@1952	1280	while (use) {
ds@1952	1281	assert(use->type==MEMUSE_STATIC);
ds@1952	1282	total+=use->size;
ds@1952	1283	tmp=use->prev;
ds@1952	1284	free(use);
ds@1952	1285	use=tmp;
ds@1952	1286	}
ds@1952	1287	free(heap);
ds@1952	1288	if (total)
ds@1952	1289	setheap_save(-total*sizeof(cell));
ds@1952	1290	return total;
ds@1952	1291	}
ds@1952	1292
ds@1952	1293	static int hier13(value *lval)
ds@1952	1294	{
ds@1952	1295	int lvalue=plnge1(hier12,lval);
ds@1952	1296	if (matchtoken('?')) {
ds@1952	1297	int flab1=getlabel();
ds@1952	1298	int flab2=getlabel();
ds@1952	1299	value lval2={0};
ds@1952	1300	int array1,array2;
ds@1952	1301	long total1,total2;
ds@1952	1302	memuse_list_t *heap;
ds@1952	1303
ds@1952	1304	pushheaplist();
ds@1952	1305	if (lvalue) {
ds@1952	1306	rvalue(lval);
ds@1952	1307	} else if (lval->ident==iCONSTEXPR) {
ds@1952	1308	ldconst(lval->constval,sPRI);
ds@1952	1309	error(lval->constval ? 206 : 205); /* redundant test */
ds@1952	1310	} /* if */
ds@1952	1311	jmp_eq0(flab1); /* go to second expression if primary register==0 */
ds@1952	1312	PUSHSTK_I(sc_allowtags);
ds@1952	1313	sc_allowtags=FALSE; /* do not allow tagnames here (colon is a special token) */
ds@1952	1314	if (hier13(lval))
ds@1952	1315	rvalue(lval);
ds@1952	1316	if (lval->ident==iCONSTEXPR) /* load constant here */
ds@1952	1317	ldconst(lval->constval,sPRI);
ds@1952	1318	sc_allowtags=(short)POPSTK_I(); /* restore */
ds@1952	1319	heap=popsaveheaplist();
ds@1952	1320	total1=dynarray_from_heaplist(heap);
ds@1952	1321	pushheaplist();
ds@1952	1322	jumplabel(flab2);
ds@1952	1323	setlabel(flab1);
ds@1952	1324	needtoken(':');
ds@1952	1325	if (hier13(&lval2))
ds@1952	1326	rvalue(&lval2);
ds@1952	1327	if (lval2.ident==iCONSTEXPR) /* load constant here */
ds@1952	1328	ldconst(lval2.constval,sPRI);
ds@1952	1329	array1= (lval->ident==iARRAY \|\| lval->ident==iREFARRAY);
ds@1952	1330	array2= (lval2.ident==iARRAY \|\| lval2.ident==iREFARRAY);
ds@1952	1331	if (array1 && !array2) {
ds@1952	1332	const char *ptr = "-unknown-";
ds@1952	1333	if (lval->sym != NULL && lval->sym->name != NULL)
ds@1952	1334	ptr = lval->sym->name;
ds@1952	1335	error(33,ptr); /* array must be indexed */
ds@1952	1336	} else if (!array1 && array2) {
ds@1952	1337	char *ptr=(lval2.sym->name!=NULL) ? lval2.sym->name : "-unknown-";
ds@1952	1338	error(33,ptr); /* array must be indexed */
ds@1952	1339	} /* if */
ds@1952	1340	/* ??? if both are arrays, should check dimensions */
ds@1952	1341	if (!matchtag(lval->tag,lval2.tag,FALSE))
ds@1952	1342	error(213); /* tagname mismatch ('true' and 'false' expressions) */
ds@1952	1343	heap=popsaveheaplist();
ds@1952	1344	total2=dynarray_from_heaplist(heap);
ds@1952	1345	setlabel(flab2);
ds@1952	1346	if ((array1 && array2) && (total1 && total2)) {
ds@1952	1347	markheap(MEMUSE_DYNAMIC, 0);
ds@1952	1348	}
dvander@2273	1349	/* If both sides are arrays, we should return the maximal as the lvalue.
dvander@2273	1350	* Otherwise we could buffer overflow and the compiler is too stupid.
dvander@2273	1351	* Literal strings have a constval == -(num_cells) so the cmp is flipped.
dvander@2273	1352	*/
dvander@2273	1353	if (lval->ident==iARRAY && lval2.ident==iARRAY
dvander@2273	1354	&& lval->constval < 0
dvander@2273	1355	&& lval->constval > lval2.constval) {
dvander@2273	1356	*lval = lval2;
dvander@2273	1357	}
ds@1952	1358	if (lval->ident==iARRAY)
ds@1952	1359	lval->ident=iREFARRAY; /* iARRAY becomes iREFARRAY */
ds@1952	1360	else if (lval->ident!=iREFARRAY)
ds@1952	1361	lval->ident=iEXPRESSION; /* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */
ds@1952	1362	return FALSE; /* conditional expression is no lvalue */
ds@1952	1363	} else {
ds@1952	1364	return lvalue;
ds@1952	1365	} /* if */
ds@1952	1366	}
ds@1952	1367
ds@1952	1368	/* the order of the operators in these lists is important and must be
ds@1952	1369	* the same as the order of the operators in the array "op1"
ds@1952	1370	*/
ds@1952	1371	static int list3[] = {'*','/','%',0};
ds@1952	1372	static int list4[] = {'+','-',0};
ds@1952	1373	static int list5[] = {tSHL,tSHR,tSHRU,0};
ds@1952	1374	static int list6[] = {'&',0};
ds@1952	1375	static int list7[] = {'^',0};
ds@1952	1376	static int list8[] = {'\|',0};
ds@1952	1377	static int list9[] = {tlLE,tlGE,'<','>',0};
ds@1952	1378	static int list10[] = {tlEQ,tlNE,0};
ds@1952	1379	static int list11[] = {tlAND,0};
ds@1952	1380	static int list12[] = {tlOR,0};
ds@1952	1381
ds@1952	1382	static int hier12(value *lval)
ds@1952	1383	{
ds@1952	1384	return skim(list12,jmp_ne0,1,0,hier11,lval);
ds@1952	1385	}
ds@1952	1386
ds@1952	1387	static int hier11(value *lval)
ds@1952	1388	{
ds@1952	1389	return skim(list11,jmp_eq0,0,1,hier10,lval);
ds@1952	1390	}
ds@1952	1391
ds@1952	1392	static int hier10(value *lval)
ds@1952	1393	{ /* ==, != */
ds@1952	1394	return plnge(list10,15,hier9,lval,"bool",TRUE);
ds@1952	1395	} /* ^ this variable is the starting index in the op1[]
ds@1952	1396	* array of the operators of this hierarchy level */
ds@1952	1397
ds@1952	1398	static int hier9(value *lval)
ds@1952	1399	{ /* <=, >=, <, > */
ds@1952	1400	return plnge_rel(list9,11,hier8,lval);
ds@1952	1401	}
ds@1952	1402
ds@1952	1403	static int hier8(value *lval)
ds@1952	1404	{ /* \| */
ds@1952	1405	return plnge(list8,10,hier7,lval,NULL,FALSE);
ds@1952	1406	}
ds@1952	1407
ds@1952	1408	static int hier7(value *lval)
ds@1952	1409	{ /* ^ */
ds@1952	1410	return plnge(list7,9,hier6,lval,NULL,FALSE);
ds@1952	1411	}
ds@1952	1412
ds@1952	1413	static int hier6(value *lval)
ds@1952	1414	{ /* & */
ds@1952	1415	return plnge(list6,8,hier5,lval,NULL,FALSE);
ds@1952	1416	}
ds@1952	1417
ds@1952	1418	static int hier5(value *lval)
ds@1952	1419	{ /* <<, >>, >>> */
ds@1952	1420	return plnge(list5,5,hier4,lval,NULL,FALSE);
ds@1952	1421	}
ds@1952	1422
ds@1952	1423	static int hier4(value *lval)
ds@1952	1424	{ /* +, - */
ds@1952	1425	return plnge(list4,3,hier3,lval,NULL,FALSE);
ds@1952	1426	}
ds@1952	1427
ds@1952	1428	static int hier3(value *lval)
ds@1952	1429	{ /* , /, % /
ds@1952	1430	return plnge(list3,0,hier2,lval,NULL,FALSE);
ds@1952	1431	}
ds@1952	1432
ds@1952	1433	static int hier2(value *lval)
ds@1952	1434	{
ds@1952	1435	int lvalue,tok;
ds@1952	1436	int tag,paranthese;
ds@1952	1437	cell val;
ds@1952	1438	char *st;
ds@1952	1439	symbol *sym;
ds@1952	1440	int saveresult;
ds@1952	1441
ds@1952	1442	tok=lex(&val,&st);
ds@1952	1443	switch (tok) {
ds@1952	1444	case tINC: /* ++lval */
ds@1952	1445	if (!hier2(lval))
ds@1952	1446	return error(22); /* must be lvalue */
ds@1952	1447	assert(lval->sym!=NULL);
ds@1952	1448	if ((lval->sym->usage & uCONST)!=0)
ds@1952	1449	return error(22); /* assignment to const argument */
ds@1952	1450	if (!check_userop(user_inc,lval->tag,0,1,lval,&lval->tag))
ds@1952	1451	inc(lval); /* increase variable first */
ds@1952	1452	rvalue(lval); /* and read the result into PRI */
ds@1952	1453	sideeffect=TRUE;
ds@1952	1454	return FALSE; /* result is no longer lvalue */
ds@1952	1455	case tDEC: /* --lval */
ds@1952	1456	if (!hier2(lval))
ds@1952	1457	return error(22); /* must be lvalue */
ds@1952	1458	assert(lval->sym!=NULL);
ds@1952	1459	if ((lval->sym->usage & uCONST)!=0)
ds@1952	1460	return error(22); /* assignment to const argument */
ds@1952	1461	if (!check_userop(user_dec,lval->tag,0,1,lval,&lval->tag))
ds@1952	1462	dec(lval); /* decrease variable first */
ds@1952	1463	rvalue(lval); /* and read the result into PRI */
ds@1952	1464	sideeffect=TRUE;
ds@1952	1465	return FALSE; /* result is no longer lvalue */
ds@1952	1466	case '~': /* ~ (one's complement) */
ds@1952	1467	if (hier2(lval))
ds@1952	1468	rvalue(lval);
ds@1952	1469	invert(); /* bitwise NOT */
ds@1952	1470	lval->constval=~lval->constval;
ds@1952	1471	return FALSE;
ds@1952	1472	case '!': /* ! (logical negate) */
ds@1952	1473	if (hier2(lval))
ds@1952	1474	rvalue(lval);
ds@1952	1475	if (check_userop(lneg,lval->tag,0,1,NULL,&lval->tag)) {
ds@1952	1476	lval->ident=iEXPRESSION;
ds@1952	1477	lval->constval=0;
ds@1952	1478	} else {
ds@1952	1479	lneg(); /* 0 -> 1, !0 -> 0 */
ds@1952	1480	lval->constval=!lval->constval;
ds@1952	1481	lval->tag=pc_addtag("bool");
ds@1952	1482	} /* if */
ds@1952	1483	return FALSE;
ds@1952	1484	case '-': /* unary - (two's complement) */
ds@1952	1485	if (hier2(lval))
ds@1952	1486	rvalue(lval);
ds@1952	1487	/* make a special check for a constant expression with the tag of a
ds@1952	1488	* rational number, so that we can simple swap the sign of that constant.
ds@1952	1489	*/
ds@1952	1490	if (lval->ident==iCONSTEXPR && lval->tag==sc_rationaltag && sc_rationaltag!=0) {
ds@1952	1491	if (rational_digits==0) {
ds@1952	1492	#if PAWN_CELL_SIZE==32
ds@1952	1493	float f = (float )&lval->constval;
ds@1952	1494	#elif PAWN_CELL_SIZE==64
ds@1952	1495	double f = (double )&lval->constval;
ds@1952	1496	#else
ds@1952	1497	#error Unsupported cell size
ds@1952	1498	#endif
ds@1952	1499	f= - f; /* this modifies lval->constval */
ds@1952	1500	} else {
ds@1952	1501	/* the negation of a fixed point number is just an integer negation */
ds@1952	1502	lval->constval=-lval->constval;
ds@1952	1503	} /* if */
ds@1952	1504	} else if (check_userop(neg,lval->tag,0,1,NULL,&lval->tag)) {
ds@1952	1505	lval->ident=iEXPRESSION;
ds@1952	1506	lval->constval=0;
ds@1952	1507	} else {
ds@1952	1508	neg(); /* arithmic negation */
ds@1952	1509	lval->constval=-lval->constval;
ds@1952	1510	} /* if */
ds@1952	1511	return FALSE;
ds@1952	1512	case tLABEL: /* tagname override */
ds@1952	1513	tag=pc_addtag(st);
ds@1952	1514	lval->cmptag=tag;
ds@1952	1515	lvalue=hier2(lval);
ds@1952	1516	lval->tag=tag;
ds@1952	1517	return lvalue;
ds@1952	1518	case tDEFINED:
ds@1952	1519	paranthese=0;
ds@1952	1520	while (matchtoken('('))
ds@1952	1521	paranthese++;
ds@1952	1522	tok=lex(&val,&st);
ds@1952	1523	if (tok!=tSYMBOL)
ds@1952	1524	return error(20,st); /* illegal symbol name */
ds@1952	1525	sym=findloc(st);
ds@1952	1526	if (sym==NULL)
ds@1952	1527	sym=findglb(st,sSTATEVAR);
ds@1952	1528	if (sym!=NULL && sym->ident!=iFUNCTN && sym->ident!=iREFFUNC && (sym->usage & uDEFINE)==0)
ds@1952	1529	sym=NULL; /* symbol is not a function, it is in the table, but not "defined" */
ds@1952	1530	val= (sym!=NULL);
ds@1952	1531	if (!val && find_subst(st,strlen(st))!=NULL)
ds@1952	1532	val=1;
ds@1952	1533	clear_value(lval);
ds@1952	1534	lval->ident=iCONSTEXPR;
ds@1952	1535	lval->constval= val;
ds@1952	1536	lval->tag=pc_addtag("bool");
ds@1952	1537	ldconst(lval->constval,sPRI);
ds@1952	1538	while (paranthese--)
ds@1952	1539	needtoken(')');
ds@1952	1540	return FALSE;
ds@1952	1541	case tSIZEOF:
ds@1952	1542	paranthese=0;
ds@1952	1543	while (matchtoken('('))
ds@1952	1544	paranthese++;
ds@1952	1545	tok=lex(&val,&st);
ds@1952	1546	if (tok!=tSYMBOL)
ds@1952	1547	return error(20,st); /* illegal symbol name */
ds@1952	1548	sym=findloc(st);
ds@1952	1549	if (sym==NULL)
ds@1952	1550	sym=findglb(st,sSTATEVAR);
ds@1952	1551	if (sym==NULL)
ds@1952	1552	return error(17,st); /* undefined symbol */
ds@1952	1553	if (sym->ident==iCONSTEXPR)
ds@1952	1554	error(39); /* constant symbol has no size */
ds@1952	1555	else if (sym->ident==iFUNCTN \|\| sym->ident==iREFFUNC)
ds@1952	1556	error(72); /* "function" symbol has no size */
ds@1952	1557	else if ((sym->usage & uDEFINE)==0)
ds@1952	1558	return error(17,st); /* undefined symbol (symbol is in the table, but it is "used" only) */
ds@1952	1559	clear_value(lval);
ds@1952	1560	lval->ident=iCONSTEXPR;
ds@1952	1561	lval->constval=1; /* preset */
ds@1952	1562	if (sym->ident==iARRAY \|\| sym->ident==iREFARRAY) {
ds@1952	1563	int level;
ds@1952	1564	symbol *idxsym=NULL;
ds@1952	1565	symbol *subsym=sym;
ds@1952	1566	for (level=0; matchtoken('['); level++) {
ds@1952	1567	idxsym=NULL;
ds@1952	1568	if (subsym!=NULL && level==subsym->dim.array.level && matchtoken(tSYMBOL)) {
ds@1952	1569	char *idxname;
ds@1952	1570	int cmptag=subsym->x.tags.index;
ds@1952	1571	tokeninfo(&val,&idxname);
ds@1952	1572	if ((idxsym=findconst(idxname,&cmptag))==NULL)
ds@1952	1573	error(80,idxname); /* unknown symbol, or non-constant */
ds@1952	1574	else if (cmptag>1)
ds@1952	1575	error(91,idxname); /* ambiguous constant */
ds@1952	1576	} /* if */
ds@1952	1577	needtoken(']');
ds@1952	1578	if (subsym!=NULL)
ds@1952	1579	subsym=finddepend(subsym);
ds@1952	1580	} /* for */
ds@1952	1581	if (level>sym->dim.array.level+1) {
ds@1952	1582	error(28,sym->name); /* invalid subscript */
ds@1952	1583	} else if (level==sym->dim.array.level+1) {
ds@1952	1584	lval->constval=(idxsym!=NULL && idxsym->dim.array.length>0) ? idxsym->dim.array.length : 1;
ds@1952	1585	} else {
ds@1952	1586	lval->constval=array_levelsize(sym,level);
ds@1952	1587	}
ds@1952	1588	if (lval->constval==0 && strchr((char *)lptr,PREPROC_TERM)==NULL)
ds@1952	1589	error(224,st); /* indeterminate array size in "sizeof" expression */
ds@1952	1590	} /* if */
ds@1952	1591	ldconst(lval->constval,sPRI);
ds@1952	1592	while (paranthese--)
ds@1952	1593	needtoken(')');
ds@1952	1594	return FALSE;
ds@1952	1595	case tCELLSOF:
ds@1952	1596	paranthese=0;
ds@1952	1597	while (matchtoken('('))
ds@1952	1598	paranthese++;
ds@1952	1599	tok=lex(&val,&st);
ds@1952	1600	if (tok!=tSYMBOL)
ds@1952	1601	return error(20,st); /* illegal symbol name */
ds@1952	1602	sym=findloc(st);
ds@1952	1603	if (sym==NULL)
ds@1952	1604	sym=findglb(st,sSTATEVAR);
ds@1952	1605	if (sym==NULL)
ds@1952	1606	return error(17,st); /* undefined symbol */
ds@1952	1607	if (sym->ident==iCONSTEXPR)
ds@1952	1608	error(39); /* constant symbol has no size */
ds@1952	1609	else if (sym->ident==iFUNCTN \|\| sym->ident==iREFFUNC)
ds@1952	1610	error(72); /* "function" symbol has no size */
ds@1952	1611	else if ((sym->usage & uDEFINE)==0)
ds@1952	1612	return error(17,st); /* undefined symbol (symbol is in the table, but it is "used" only) */
ds@1952	1613	clear_value(lval);
ds@1952	1614	lval->ident=iCONSTEXPR;
ds@1952	1615	lval->constval=1; /* preset */
ds@1952	1616	if (sym->ident==iARRAY \|\| sym->ident==iREFARRAY) {
ds@1952	1617	int level;
ds@1952	1618	symbol *idxsym=NULL;
ds@1952	1619	symbol *subsym=sym;
ds@1952	1620	for (level=0; matchtoken('['); level++) {
ds@1952	1621	idxsym=NULL;
ds@1952	1622	if (subsym!=NULL && level==subsym->dim.array.level && matchtoken(tSYMBOL)) {
ds@1952	1623	char *idxname;
ds@1952	1624	int cmptag=subsym->x.tags.index;
ds@1952	1625	tokeninfo(&val,&idxname);
ds@1952	1626	if ((idxsym=findconst(idxname,&cmptag))==NULL)
ds@1952	1627	error(80,idxname); /* unknown symbol, or non-constant */
ds@1952	1628	else if (cmptag>1)
ds@1952	1629	error(91,idxname); /* ambiguous constant */
ds@1952	1630	} /* if */
ds@1952	1631	needtoken(']');
ds@1952	1632	if (subsym!=NULL)
ds@1952	1633	subsym=finddepend(subsym);
ds@1952	1634	} /* for */
ds@1952	1635	if (level>sym->dim.array.level+1) {
ds@1952	1636	error(28,sym->name); /* invalid subscript */
ds@1952	1637	} else if (level==sym->dim.array.level+1) {
ds@1952	1638	lval->constval= (idxsym!=NULL && idxsym->dim.array.length>0) ? idxsym->dim.array.length : 1;
ds@1952	1639	} else {
ds@1952	1640	lval->constval=array_levelsize(sym,level);
ds@1952	1641	}
ds@1952	1642	if (lval->constval==0 && strchr((char *)lptr,PREPROC_TERM)==NULL)
ds@1952	1643	error(224,st); /* indeterminate array size in "sizeof" expression */
ds@1952	1644	} /* if */
ds@1952	1645	ldconst(lval->constval,sPRI);
ds@1952	1646	while (paranthese--)
ds@1952	1647	needtoken(')');
ds@1952	1648	return FALSE;
ds@1952	1649	case tTAGOF:
ds@1952	1650	paranthese=0;
ds@1952	1651	while (matchtoken('('))
ds@1952	1652	paranthese++;
ds@1952	1653	tok=lex(&val,&st);
ds@1952	1654	if (tok!=tSYMBOL && tok!=tLABEL)
ds@1952	1655	return error(20,st); /* illegal symbol name */
ds@1952	1656	if (tok==tLABEL) {
ds@1952	1657	constvalue *tagsym=find_constval(&tagname_tab,st,0);
ds@1952	1658	tag=(int)((tagsym!=NULL) ? tagsym->value : 0);
ds@1952	1659	} else {
ds@1952	1660	sym=findloc(st);
ds@1952	1661	if (sym==NULL)
ds@1952	1662	sym=findglb(st,sSTATEVAR);
ds@1952	1663	if (sym==NULL)
ds@1952	1664	return error(17,st); /* undefined symbol */
ds@1952	1665	if ((sym->usage & uDEFINE)==0)
ds@1952	1666	return error(17,st); /* undefined symbol (symbol is in the table, but it is "used" only) */
ds@1952	1667	tag=sym->tag;
ds@1952	1668	} /* if */
ds@1952	1669	if (sym->ident==iARRAY \|\| sym->ident==iREFARRAY) {
ds@1952	1670	int level;
ds@1952	1671	symbol *idxsym=NULL;
ds@1952	1672	symbol *subsym=sym;
ds@1952	1673	for (level=0; matchtoken('['); level++) {
ds@1952	1674	idxsym=NULL;
ds@1952	1675	if (subsym!=NULL && level==subsym->dim.array.level && matchtoken(tSYMBOL)) {
ds@1952	1676	char *idxname;
ds@1952	1677	int cmptag=subsym->x.tags.index;
ds@1952	1678	tokeninfo(&val,&idxname);
ds@1952	1679	if ((idxsym=findconst(idxname,&cmptag))==NULL)
ds@1952	1680	error(80,idxname); /* unknown symbol, or non-constant */
ds@1952	1681	else if (cmptag>1)
ds@1952	1682	error(91,idxname); /* ambiguous constant */
ds@1952	1683	} /* if */
ds@1952	1684	needtoken(']');
ds@1952	1685	if (subsym!=NULL)
ds@1952	1686	subsym=finddepend(subsym);
ds@1952	1687	} /* for */
ds@1952	1688	if (level>sym->dim.array.level+1)
ds@1952	1689	error(28,sym->name); /* invalid subscript */
ds@1952	1690	else if (level==sym->dim.array.level+1 && idxsym!=NULL)
ds@1952	1691	tag= idxsym->x.tags.index;
ds@1952	1692	} /* if */
ds@1952	1693	exporttag(tag);
ds@1952	1694	clear_value(lval);
ds@1952	1695	lval->ident=iCONSTEXPR;
ds@1952	1696	lval->constval=tag \| PUBLICTAG;
ds@1952	1697	ldconst(lval->constval,sPRI);
ds@1952	1698	while (paranthese--)
ds@1952	1699	needtoken(')');
ds@1952	1700	return FALSE;
ds@1952	1701	case tSTATE: {
ds@1952	1702	constvalue *automaton;
ds@1952	1703	constvalue *state;
ds@1952	1704	if (sc_getstateid(&automaton,&state)) {
ds@1952	1705	assert(automaton!=NULL);
ds@1952	1706	assert(automaton->index==0 && automaton->name[0]=='\0' \|\| automaton->index>0);
ds@1952	1707	loadreg(automaton->value,sALT);
ds@1952	1708	assert(state!=NULL);
ds@1952	1709	ldconst(state->value,sPRI);
ds@1952	1710	ob_eq();
ds@1952	1711	clear_value(lval);
ds@1952	1712	lval->ident=iEXPRESSION;
ds@1952	1713	lval->tag=pc_addtag("bool");
ds@1952	1714	} /* if */
ds@1952	1715	return FALSE;
ds@1952	1716	} /* case */
ds@1952	1717	default:
ds@1952	1718	lexpush();
ds@1952	1719	lvalue=hier1(lval);
ds@1952	1720	/* check for postfix operators */
ds@1952	1721	if (matchtoken(';')) {
ds@1952	1722	/* Found a ';', do not look further for postfix operators */
ds@1952	1723	lexpush(); /* push ';' back after successful match */
ds@1952	1724	return lvalue;
ds@1952	1725	} else if (matchtoken(tTERM)) {
ds@1952	1726	/* Found a newline that ends a statement (this is the case when
ds@1952	1727	* semicolons are optional). Note that an explicit semicolon was
ds@1952	1728	* handled above. This case is similar, except that the token must
ds@1952	1729	* not be pushed back.
ds@1952	1730	*/
ds@1952	1731	return lvalue;
ds@1952	1732	} else {
ds@1952	1733	tok=lex(&val,&st);
ds@1952	1734	switch (tok) {
ds@1952	1735	case tINC: /* lval++ */
ds@1952	1736	if (!lvalue)
ds@1952	1737	return error(22); /* must be lvalue */
ds@1952	1738	assert(lval->sym!=NULL);
ds@1952	1739	if ((lval->sym->usage & uCONST)!=0)
ds@1952	1740	return error(22); /* assignment to const argument */
ds@1952	1741	/* on incrementing array cells, the address in PRI must be saved for
ds@1952	1742	* incremening the value, whereas the current value must be in PRI
ds@1952	1743	* on exit.
ds@1952	1744	*/
ds@1952	1745	saveresult= (lval->ident==iARRAYCELL \|\| lval->ident==iARRAYCHAR);
ds@1952	1746	if (saveresult)
ds@1952	1747	pushreg(sPRI); /* save address in PRI */
ds@1952	1748	rvalue(lval); /* read current value into PRI */
ds@1952	1749	if (saveresult)
ds@1952	1750	swap1(); /* save PRI on the stack, restore address in PRI */
ds@1952	1751	if (!check_userop(user_inc,lval->tag,0,1,lval,&lval->tag))
ds@1952	1752	inc(lval); /* increase variable afterwards */
ds@1952	1753	if (saveresult)
ds@1952	1754	popreg(sPRI); /* restore PRI (result of rvalue()) */
ds@1952	1755	sideeffect=TRUE;
ds@1952	1756	return FALSE; /* result is no longer lvalue */
ds@1952	1757	case tDEC: /* lval-- */
ds@1952	1758	if (!lvalue)
ds@1952	1759	return error(22); /* must be lvalue */
ds@1952	1760	assert(lval->sym!=NULL);
ds@1952	1761	if ((lval->sym->usage & uCONST)!=0)
ds@1952	1762	return error(22); /* assignment to const argument */
ds@1952	1763	saveresult= (lval->ident==iARRAYCELL \|\| lval->ident==iARRAYCHAR);
ds@1952	1764	if (saveresult)
ds@1952	1765	pushreg(sPRI); /* save address in PRI */
ds@1952	1766	rvalue(lval); /* read current value into PRI */
ds@1952	1767	if (saveresult)
ds@1952	1768	swap1(); /* save PRI on the stack, restore address in PRI */
ds@1952	1769	if (!check_userop(user_dec,lval->tag,0,1,lval,&lval->tag))
ds@1952	1770	dec(lval); /* decrease variable afterwards */
ds@1952	1771	if (saveresult)
ds@1952	1772	popreg(sPRI); /* restore PRI (result of rvalue()) */
ds@1952	1773	sideeffect=TRUE;
ds@1952	1774	return FALSE;
ds@1952	1775	/* This is temporarily disabled because we detect it automatically.
ds@1952	1776	* Thus, it could be weird if both were used at once
ds@1952	1777	*/
ds@1952	1778	#if 0
ds@1952	1779	case tCHAR: /* char (compute required # of cells */
ds@1952	1780	if (lval->ident==iCONSTEXPR) {
ds@1952	1781	lval->constval = sCHARBITS/8; / from char to bytes */
ds@1952	1782	lval->constval = (lval->constval + sizeof(cell)-1) / sizeof(cell);
ds@1952	1783	} else {
ds@1952	1784	if (lvalue)
ds@1952	1785	rvalue(lval); /* fetch value if not already in PRI */
ds@1952	1786	char2addr(); /* from characters to bytes */
ds@1952	1787	addconst(sizeof(cell)-1); /* make sure the value is rounded up */
ds@1952	1788	addr2cell(); /* truncate to number of cells */
ds@1952	1789	} /* if */
ds@1952	1790	return FALSE;
ds@1952	1791	#endif
ds@1952	1792	default:
ds@1952	1793	lexpush();
ds@1952	1794	return lvalue;
ds@1952	1795	} /* switch */
ds@1952	1796	} /* if */
ds@1952	1797	} /* switch */
ds@1952	1798	}
ds@1952	1799
ds@1952	1800	/* hier1
ds@1952	1801	*
ds@1952	1802	* The highest hierarchy level: it looks for pointer and array indices
ds@1952	1803	* and function calls.
ds@1952	1804	* Generates code to fetch a pointer value if it is indexed and code to
ds@1952	1805	* add to the pointer value or the array address (the address is already
ds@1952	1806	* read at primary()). It also generates code to fetch a function address
ds@1952	1807	* if that hasn't already been done at primary() (check lval[4]) and calls
ds@1952	1808	* callfunction() to call the function.
ds@1952	1809	*/
ds@1952	1810	static int hier1(value *lval1)
ds@1952	1811	{
ds@1952	1812	int lvalue,index,tok,symtok;
ds@1952	1813	cell val,cidx;
ds@1952	1814	value lval2={0};
ds@1952	1815	char *st;
ds@1952	1816	char close;
ds@1952	1817	symbol *sym;
ds@1952	1818	int magic_string=0;
ds@1952	1819	symbol dummysymbol,cursym; / for changing the index tags in case of enumerated pseudo-arrays */
ds@1952	1820
ds@1952	1821	lvalue=primary(lval1);
ds@1952	1822	symtok=tokeninfo(&val,&st); /* get token read by primary() */
ds@1952	1823	cursym=lval1->sym;
ds@1952	1824	restart:
ds@1952	1825	sym=cursym;
ds@1952	1826	if (matchtoken('[') \|\| matchtoken('{') \|\| matchtoken('(')) {
ds@1952	1827	tok=tokeninfo(&val,&st); /* get token read by matchtoken() */
ds@1952	1828	magic_string = (sym && (sym->tag == pc_tag_string && sym->dim.array.level == 0));
ds@1952	1829	if (sym==NULL && symtok!=tSYMBOL) {
ds@1952	1830	/* we do not have a valid symbol and we appear not to have read a valid
ds@1952	1831	* symbol name (so it is unlikely that we would have read a name of an
ds@1952	1832	* undefined symbol) */
ds@1952	1833	error(29); /* expression error, assumed 0 */
ds@1952	1834	lexpush(); /* analyse '(', '{' or '[' again later */
ds@1952	1835	return FALSE;
ds@1952	1836	} /* if */
ds@1952	1837	if (tok=='[' \|\| tok=='{') { /* subscript */
ds@1952	1838	close = (char)((tok=='[') ? ']' : '}');
ds@1952	1839	if (sym==NULL) { /* sym==NULL if lval is a constant or a literal */
ds@1952	1840	error(28,"<no variable>"); /* cannot subscript */
ds@1952	1841	needtoken(close);
ds@1952	1842	return FALSE;
ds@1952	1843	} else if (sym->ident!=iARRAY && sym->ident!=iREFARRAY){
ds@1952	1844	error(28,sym->name); /* cannot subscript, variable is not an array */
ds@1952	1845	needtoken(close);
ds@1952	1846	return FALSE;
ds@1952	1847	} else if (sym->dim.array.level>0 && close!=']') {
ds@1952	1848	error(51); /* invalid subscript, must use [ ] */
ds@1952	1849	needtoken(close);
ds@1952	1850	return FALSE;
ds@1952	1851	} /* if */
ds@1952	1852	/* set the tag to match (enumeration fields as indices) */
ds@1952	1853	lval2.cmptag=sym->x.tags.index;
ds@1952	1854	stgget(&index,&cidx); /* mark position in code generator */
ds@1952	1855	pushreg(sPRI); /* save base address of the array */
ds@1952	1856	if (hier14(&lval2)) /* create expression for the array index */
ds@1952	1857	rvalue(&lval2);
ds@1952	1858	if (lval2.ident==iARRAY \|\| lval2.ident==iREFARRAY)
ds@1952	1859	error(33,lval2.sym->name); /* array must be indexed */
ds@1952	1860	needtoken(close);
ds@1952	1861	if ((sym->usage & uENUMROOT) && !matchtag(sym->x.tags.index,lval2.tag,TRUE))
ds@1952	1862	error(213);
ds@1952	1863	if (lval2.ident==iCONSTEXPR) { /* constant expression */
ds@1952	1864	stgdel(index,cidx); /* scratch generated code */
ds@1952	1865	if (lval1->arrayidx!=NULL) { /* keep constant index, for checking */
ds@1952	1866	assert(sym->dim.array.level>=0 && sym->dim.array.level<sDIMEN_MAX);
ds@1952	1867	lval1->arrayidx[sym->dim.array.level]=lval2.constval;
ds@1952	1868	} /* if */
ds@1952	1869	if (close==']' && !(sym->tag == pc_tag_string && sym->dim.array.level == 0)) {
ds@1952	1870	/* normal array index */
ds@1952	1871	if (lval2.constval<0 \|\| sym->dim.array.length!=0 && sym->dim.array.length<=lval2.constval)
ds@1952	1872	error(32,sym->name); /* array index out of bounds */
ds@1952	1873	if (lval2.constval!=0) {
ds@1952	1874	/* don't add offsets for zero subscripts */
ds@1952	1875	#if PAWN_CELL_SIZE==16
ds@1952	1876	ldconst(lval2.constval<<1,sALT);
ds@1952	1877	#elif PAWN_CELL_SIZE==32
ds@1952	1878	ldconst(lval2.constval<<2,sALT);
ds@1952	1879	#elif PAWN_CELL_SIZE==64
ds@1952	1880	ldconst(lval2.constval<<3,sALT);
ds@1952	1881	#else
ds@1952	1882	#error Unsupported cell size
ds@1952	1883	#endif
ds@1952	1884	ob_add();
ds@1952	1885	} /* if */
ds@1952	1886	} else {
ds@1952	1887	/* character index */
ds@1952	1888	if (lval2.constval<0 \|\| sym->dim.array.length!=0
ds@1952	1889	&& sym->dim.array.length((8sizeof(cell))/sCHARBITS)<=(ucell)lval2.constval)
ds@1952	1890	error(32,sym->name); /* array index out of bounds */
ds@1952	1891	if (lval2.constval!=0) {
ds@1952	1892	/* don't add offsets for zero subscripts */
ds@1952	1893	#if sCHARBITS==16
ds@1952	1894	ldconst(lval2.constval<<1,sALT);/* 16-bit character */
ds@1952	1895	#else
ds@1952	1896	ldconst(lval2.constval,sALT); /* 8-bit character */
ds@1952	1897	#endif
ds@1952	1898	ob_add();
ds@1952	1899	} /* if */
ds@1952	1900	charalign(); /* align character index into array */
ds@1952	1901	} /* if */
ds@1952	1902	/* if the array index is a field from an enumeration, get the tag name
ds@1952	1903	* from the field and save the size of the field too.
ds@1952	1904	*/
ds@1952	1905	assert(lval2.sym==NULL \|\| lval2.sym->dim.array.level==0);
ds@1952	1906	if (lval2.sym!=NULL && lval2.sym->dim.array.length>0 && sym->dim.array.level==0) {
ds@1952	1907	lval1->tag=lval2.sym->x.tags.index;
ds@1952	1908	lval1->constval=lval2.sym->dim.array.length;
ds@1952	1909	} /* if */
ds@1952	1910	} else {
ds@1952	1911	/* array index is not constant */
ds@1952	1912	lval1->arrayidx=NULL; /* reset, so won't be checked */
ds@1952	1913	if (close==']' && !magic_string) {
ds@1952	1914	if (sym->dim.array.length!=0)
ds@1952	1915	ffbounds(sym->dim.array.length-1); /* run time check for array bounds */
ds@1952	1916	cell2addr(); /* normal array index */
ds@1952	1917	} else {
ds@1952	1918	if (sym->dim.array.length!=0)
ds@1952	1919	ffbounds(sym->dim.array.length*(32/sCHARBITS)-1);
ds@1952	1920	char2addr(); /* character array index */
ds@1952	1921	} /* if */
ds@1952	1922	popreg(sALT);
ds@1952	1923	ob_add(); /* base address was popped into secondary register */
ds@1952	1924	if (close!=']' \|\| magic_string)
ds@1952	1925	charalign(); /* align character index into array */
ds@1952	1926	} /* if */
ds@1952	1927	/* the indexed item may be another array (multi-dimensional arrays) */
ds@1952	1928	assert(cursym==sym && sym!=NULL); /* should still be set */
ds@1952	1929	if (sym->dim.array.level>0) {
ds@1952	1930	assert(close==']'); /* checked earlier */
ds@1952	1931	assert(cursym==lval1->sym);
ds@1952	1932	/* read the offset to the subarray and add it to the current address */
ds@1952	1933	lval1->ident=iARRAYCELL;
ds@1952	1934	pushreg(sPRI); /* the optimizer makes this to a MOVE.alt */
ds@1952	1935	rvalue(lval1);
ds@1952	1936	popreg(sALT);
ds@1952	1937	ob_add();
ds@1952	1938	/* adjust the "value" structure and find the referenced array */
ds@1952	1939	lval1->ident=iREFARRAY;
ds@1952	1940	lval1->sym=finddepend(sym);
ds@1952	1941	assert(lval1->sym!=NULL);
ds@1952	1942	assert(lval1->sym->dim.array.level==sym->dim.array.level-1);
ds@1952	1943	cursym=lval1->sym;
ds@1952	1944	/* try to parse subsequent array indices */
ds@1952	1945	lvalue=FALSE; /* for now, a iREFARRAY is no lvalue */
ds@1952	1946	goto restart;
ds@1952	1947	} /* if */
ds@1952	1948	assert(sym->dim.array.level==0);
ds@1952	1949	/* set type to fetch... INDIRECTLY */
ds@1952	1950	if (sym->tag == pc_tag_string) {
ds@1952	1951	lval1->ident = iARRAYCHAR;
ds@1952	1952	} else {
ds@1952	1953	lval1->ident= (char)((close==']') ? iARRAYCELL : iARRAYCHAR);
ds@1952	1954	}
ds@1952	1955	/* if the array index is a field from an enumeration, get the tag name
ds@1952	1956	* from the field and save the size of the field too. Otherwise, the
ds@1952	1957	* tag is the one from the array symbol.
ds@1952	1958	*/
ds@1952	1959	if (lval2.ident==iCONSTEXPR && lval2.sym!=NULL
ds@1952	1960	&& lval2.sym->dim.array.length>0 && sym->dim.array.level==0)
ds@1952	1961	{
ds@1952	1962	lval1->tag=lval2.sym->x.tags.index;
ds@1952	1963	lval1->constval=lval2.sym->dim.array.length;
ds@1952	1964	if (lval2.tag==sym->x.tags.index && lval1->constval>1 && matchtoken('[')) {
ds@1952	1965	/* an array indexed with an enumeration field may be considered a sub-array */
ds@1952	1966	lexpush();
ds@1952	1967	lvalue=FALSE; /* for now, a iREFARRAY is no lvalue */
ds@1952	1968	lval1->ident=iREFARRAY;
ds@1952	1969	/* initialize a dummy symbol, which is a copy of the current symbol,
ds@1952	1970	* but with an adjusted index tag
ds@1952	1971	*/
ds@1952	1972	assert(sym!=NULL);
ds@1952	1973	dummysymbol=*sym;
ds@1952	1974	/* get the tag of the root of the enumeration */
ds@1952	1975	assert(lval2.sym!=NULL);
ds@1952	1976	dummysymbol.x.tags.index=lval2.sym->x.tags.field;
ds@1952	1977	dummysymbol.dim.array.length=lval2.sym->dim.array.length;
ds@1952	1978	cursym=&dummysymbol;
ds@1952	1979	/* recurse */
ds@1952	1980	goto restart;
ds@1952	1981	} /* if */
ds@1952	1982	} else {
ds@1952	1983	assert(sym!=NULL);
ds@1952	1984	if (cursym!=&dummysymbol)
ds@1952	1985	lval1->tag=sym->tag;
ds@1952	1986	lval1->constval=0;
ds@1952	1987	} /* if */
ds@1952	1988	/* a cell in an array is an lvalue, a character in an array is not
ds@1952	1989	* always a valid lvalue */
ds@1952	1990	return TRUE;
ds@1952	1991	} else { /* tok=='(' -> function(...) */
ds@1952	1992	assert(tok=='(');
ds@1952	1993	if (sym==NULL
ds@1952	1994	\|\| (sym->ident!=iFUNCTN && sym->ident!=iREFFUNC))
ds@1952	1995	{
ds@1952	1996	if (sym==NULL && sc_status==statFIRST) {
ds@1952	1997	/* could be a "use before declaration"; in that case, create a stub
ds@1952	1998	* function so that the usage can be marked.
ds@1952	1999	*/
ds@1952	2000	sym=fetchfunc(lastsymbol,0);
ds@1952	2001	if (sym==NULL)
ds@1952	2002	error(123); /* insufficient memory */
ds@1952	2003	markusage(sym,uREAD);
ds@1952	2004	} else {
ds@1952	2005	return error(12); /* invalid function call */
ds@1952	2006	} /* if */
ds@1952	2007	} else if ((sym->usage & uMISSING)!=0) {
ds@1952	2008	char symname[2sNAMEMAX+16]; / allow space for user defined operators */
ds@1952	2009	funcdisplayname(symname,sym->name);
ds@1952	2010	error(4,symname); /* function not defined */
ds@1952	2011	} /* if */
ds@1952	2012	callfunction(sym,lval1,TRUE);
ds@1952	2013	return FALSE; /* result of function call is no lvalue */
ds@1952	2014	} /* if */
ds@1952	2015	} /* if */
ds@1952	2016	if (sym!=NULL && lval1->ident==iFUNCTN) {
ds@1952	2017	assert(sym->ident==iFUNCTN);
ds@1952	2018	if (sc_allowproccall) {
ds@1952	2019	callfunction(sym,lval1,FALSE);
ds@1952	2020	} else if ((sym->usage & uNATIVE) != uNATIVE) {
ds@1952	2021	symbol *oldsym=sym;
ds@1952	2022	int n=-1,iter=0;
ds@1952	2023	int usage = ((sym->usage & uPUBLIC) == uPUBLIC) ? uPUBLIC : 0;
ds@1952	2024	cell code_addr=0;
ds@1952	2025	for (sym=glbtab.next; sym!=NULL; sym=sym->next) {
ds@1952	2026	if (sym->ident==iFUNCTN && sym->vclass == sGLOBAL && (!usage \|\| (sym->usage & usage)))
ds@1952	2027	{
ds@1952	2028	if (strcmp(sym->name, lval1->sym->name)==0) {
ds@1952	2029	n = iter;
ds@1952	2030	code_addr = sym->codeaddr;
ds@1952	2031	break;
ds@1952	2032	}
ds@1952	2033	iter++;
ds@1952	2034	}
ds@1952	2035	}
ds@1952	2036	if (n!=-1) {
ds@1952	2037	char faketag[sNAMEMAX+1];
ds@1952	2038	lval1->sym=NULL;
ds@1952	2039	lval1->ident=iCONSTEXPR;
ds@1952	2040	/* Generate a quick pseudo-tag! */
ds@1952	2041	if (usage == uPUBLIC) {
ds@1952	2042	lval1->constval=(n<<1)\|1;
ds@1952	2043	snprintf(faketag, sizeof(faketag)-1, "$Func@%d", n);
ds@1952	2044	} else {
ds@1952	2045	lval1->constval=(code_addr<<1)\|0;
ds@1952	2046	snprintf(faketag, sizeof(faketag)-1, "$Func!%d", code_addr);
ds@1952	2047	}
ds@1952	2048	lval1->tag=pc_addfunctag(faketag);
ds@1952	2049	oldsym->usage \|= uREAD;
ds@1952	2050	sym->usage \|= uREAD;
ds@1952	2051	} else {
ds@1952	2052	error(76); /* invalid function call, or syntax error */
ds@1952	2053	} /* if */
ds@1952	2054	return FALSE;
ds@1952	2055	} else {
ds@1952	2056	error(76); /* invalid function call, or syntax error */
ds@1952	2057	}
ds@1952	2058	} /* if */
ds@1952	2059	return lvalue;
ds@1952	2060	}
ds@1952	2061
ds@1952	2062	/* primary
ds@1952	2063	*
ds@1952	2064	* Returns 1 if the operand is an lvalue (everything except arrays, functions
ds@1952	2065	* constants and -of course- errors).
ds@1952	2066	* Generates code to fetch the address of arrays. Code for constants is
ds@1952	2067	* already generated by constant().
ds@1952	2068	* This routine first clears the entire lval array (all fields are set to 0).
ds@1952	2069	*
ds@1952	2070	* Global references: sc_intest (may be altered, but restored upon termination)
ds@1952	2071	*/
ds@1952	2072	static int primary(value *lval)
ds@1952	2073	{
ds@1952	2074	char *st;
ds@1952	2075	int lvalue,tok;
ds@1952	2076	cell val;
ds@1952	2077	symbol *sym;
ds@1952	2078
ds@1952	2079	if (matchtoken('(')){ /* sub-expression - (expression,...) */
ds@1952	2080	PUSHSTK_I(sc_intest);
ds@1952	2081	PUSHSTK_I(sc_allowtags);
ds@1952	2082
ds@1952	2083	sc_intest=FALSE; /* no longer in "test" expression */
ds@1952	2084	sc_allowtags=TRUE; /* allow tagnames to be used in parenthesized expressions */
ds@1952	2085	sc_allowproccall=FALSE;
ds@1952	2086	do
ds@1952	2087	lvalue=hier14(lval);
ds@1952	2088	while (matchtoken(','));
ds@1952	2089	needtoken(')');
ds@1952	2090	lexclr(FALSE); /* clear lex() push-back, it should have been
ds@1952	2091	* cleared already by needtoken() */
ds@1952	2092	sc_allowtags=(short)POPSTK_I();
ds@1952	2093	sc_intest=(short)POPSTK_I();
ds@1952	2094	return lvalue;
ds@1952	2095	} /* if */
ds@1952	2096
ds@1952	2097	clear_value(lval); /* clear lval */
ds@1952	2098	tok=lex(&val,&st);
ds@1952	2099	if (tok==tSYMBOL) {
ds@1952	2100	/* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol
ds@1952	2101	* to sNAMEMAX significant characters */
ds@1952	2102	assert(strlen(st)<sizeof lastsymbol);
ds@1952	2103	strcpy(lastsymbol,st);
ds@1952	2104	} /* if */
ds@1952	2105	if (tok==tSYMBOL && !findconst(st,NULL)) {
ds@1952	2106	/* first look for a local variable */
ds@1952	2107	if ((sym=findloc(st))!=0) {
ds@1952	2108	if (sym->ident==iLABEL) {
ds@1952	2109	error(29); /* expression error, assumed 0 */
ds@1952	2110	ldconst(0,sPRI); /* load 0 */
ds@1952	2111	return FALSE; /* return 0 for labels (expression error) */
ds@1952	2112	} /* if */
ds@1952	2113	lval->sym=sym;
ds@1952	2114	lval->ident=sym->ident;
ds@1952	2115	lval->tag=sym->tag;
ds@1952	2116	if (sym->ident==iARRAY \|\| sym->ident==iREFARRAY) {
ds@1952	2117	address(sym,sPRI); /* get starting address in primary register */
ds@1952	2118	return FALSE; /* return 0 for array (not lvalue) */
ds@1952	2119	} else {
ds@1952	2120	return TRUE; /* return 1 if lvalue (not label or array) */
ds@1952	2121	} /* if */
ds@1952	2122	} /* if */
ds@1952	2123	/* now try a global variable */
ds@1952	2124	if ((sym=findglb(st,sSTATEVAR))!=0) {
ds@1952	2125	if (sym->ident==iFUNCTN \|\| sym->ident==iREFFUNC) {
ds@1952	2126	/* if the function is only in the table because it was inserted as a
ds@1952	2127	* stub in the first pass (i.e. it was "used" but never declared or
ds@1952	2128	* implemented, issue an error
ds@1952	2129	*/
ds@1952	2130	if ((sym->usage & uPROTOTYPED)==0)
ds@1952	2131	error(17,st);
ds@1952	2132	} else {
ds@1952	2133	if ((sym->usage & uDEFINE)==0)
ds@1952	2134	error(17,st);
ds@1952	2135	lval->sym=sym;
ds@1952	2136	lval->ident=sym->ident;
ds@1952	2137	lval->tag=sym->tag;
ds@1952	2138	if (sym->ident==iARRAY \|\| sym->ident==iREFARRAY) {
ds@1952	2139	address(sym,sPRI); /* get starting address in primary register */
ds@1952	2140	return FALSE; /* return 0 for array (not lvalue) */
ds@1952	2141	} else {
ds@1952	2142	return TRUE; /* return 1 if lvalue (not function or array) */
ds@1952	2143	} /* if */
ds@1952	2144	} /* if */
ds@1952	2145	} else {
ds@1952	2146	if (!sc_allowproccall)
ds@1952	2147	return error(17,st); /* undefined symbol */
ds@1952	2148	/* an unknown symbol, but used in a way compatible with the "procedure
ds@1952	2149	* call" syntax. So assume that the symbol refers to a function.
ds@1952	2150	*/
ds@1952	2151	assert(sc_status==statFIRST);
ds@1952	2152	sym=fetchfunc(st,0);
ds@1952	2153	if (sym==NULL)
ds@1952	2154	error(123); /* insufficient memory */
ds@1952	2155	} /* if */
ds@1952	2156	assert(sym!=NULL);
ds@1952	2157	assert(sym->ident==iFUNCTN \|\| sym->ident==iREFFUNC);
ds@1952	2158	lval->sym=sym;
ds@1952	2159	lval->ident=sym->ident;
ds@1952	2160	lval->tag=sym->tag;
ds@1952	2161	return FALSE; /* return 0 for function (not an lvalue) */
ds@1952	2162	} /* if */
ds@1952	2163	lexpush(); /* push the token, it is analyzed by constant() */
ds@1952	2164	if (constant(lval)==0) {
ds@1952	2165	error(29); /* expression error, assumed 0 */
ds@1952	2166	ldconst(0,sPRI); /* load 0 */
ds@1952	2167	} /* if */
ds@1952	2168	return FALSE; /* return 0 for constants (or errors) */
ds@1952	2169	}
ds@1952	2170
ds@1952	2171	static void clear_value(value *lval)
ds@1952	2172	{
ds@1952	2173	lval->sym=NULL;
ds@1952	2174	lval->constval=0L;
ds@1952	2175	lval->tag=0;
ds@1952	2176	lval->ident=0;
ds@1952	2177	lval->boolresult=FALSE;
ds@1952	2178	/* do not clear lval->arrayidx, it is preset in hier14() */
ds@1952	2179	/* do not clear lval->cmptag */
ds@1952	2180	}
ds@1952	2181
ds@1952	2182	static void setdefarray(cell string,cell size,cell array_sz,cell dataaddr,int fconst)
ds@1952	2183	{
ds@1952	2184	/* The routine must copy the default array data onto the heap, as to avoid
ds@1952	2185	* that a function can change the default value. An optimization is that
ds@1952	2186	* the default array data is "dumped" into the data segment only once (on the
ds@1952	2187	* first use).
ds@1952	2188	*/
ds@1952	2189	/* check whether to dump the default array */
ds@1952	2190	assert(dataaddr!=NULL);
ds@1952	2191	if (sc_status==statWRITE && *dataaddr<0) {
ds@1952	2192	int i;
ds@1952	2193	dataaddr=(litidx+glb_declared)sizeof(cell);
ds@1952	2194	for (i=0; i<size; i++)
ds@1952	2195	litadd(*string++);
ds@1952	2196	} /* if */
ds@1952	2197
ds@1952	2198	/* if the function is known not to modify the array (meaning that it also
ds@1952	2199	* does not modify the default value), directly pass the address of the
ds@1952	2200	* array in the data segment.
ds@1952	2201	*/
ds@1952	2202	if (fconst \|\| !string) {
ds@1952	2203	ldconst(*dataaddr,sPRI);
ds@1952	2204	} else {
ds@1952	2205	/* Generate the code:
ds@1952	2206	* CONST.pri dataaddr ;address of the default array data
ds@1952	2207	* HEAP array_sz*sizeof(cell) ;heap address in ALT
ds@1952	2208	* MOVS size*sizeof(cell) ;copy data from PRI to ALT
ds@1952	2209	* MOVE.PRI ;PRI = address on the heap
ds@1952	2210	*/
ds@1952	2211	ldconst(*dataaddr,sPRI);
ds@1952	2212	/* "array_sz" is the size of the argument (the value between the brackets
ds@1952	2213	* in the declaration), "size" is the size of the default array data.
ds@1952	2214	*/
ds@1952	2215	assert(array_sz>=size);
ds@1952	2216	modheap((int)array_sz*sizeof(cell));
ds@1952	2217	markheap(MEMUSE_STATIC, array_sz);
ds@1952	2218	/* ??? should perhaps fill with zeros first */
ds@1952	2219	memcopy(size*sizeof(cell));
ds@1952	2220	moveto1();
ds@1952	2221	} /* if */
ds@1952	2222	}
ds@1952	2223
ds@1952	2224	static int findnamedarg(arginfo arg,char name)
ds@1952	2225	{
ds@1952	2226	int i;
ds@1952	2227
ds@1952	2228	for (i=0; arg[i].ident!=0 && arg[i].ident!=iVARARGS; i++)
ds@1952	2229	if (strcmp(arg[i].name,name)==0)
ds@1952	2230	return i;
ds@1952	2231	return -1;
ds@1952	2232	}
ds@1952	2233
ds@1952	2234	int checktag(int tags[],int numtags,int exprtag)
ds@1952	2235	{
ds@1952	2236	int i;
ds@1952	2237
ds@1952	2238	assert(tags!=0);
ds@1952	2239	assert(numtags>0);
ds@1952	2240	for (i=0; i<numtags; i++)
ds@1952	2241	if (matchtag(tags[i],exprtag,TRUE))
ds@1952	2242	return TRUE; /* matching tag */
ds@1952	2243	return FALSE; /* no tag matched */
ds@1952	2244	}
ds@1952	2245
ds@1952	2246	enum {
ds@1952	2247	ARG_UNHANDLED,
ds@1952	2248	ARG_IGNORED,
ds@1952	2249	ARG_DONE,
ds@1952	2250	};
ds@1952	2251
ds@1952	2252	/* callfunction
ds@1952	2253	*
ds@1952	2254	* Generates code to call a function. This routine handles default arguments
ds@1952	2255	* and positional as well as named parameters.
ds@1952	2256	*/
ds@1952	2257	static void callfunction(symbol sym,value lval_result,int matchparanthesis)
ds@1952	2258	{
ds@1952	2259	static long nest_stkusage=0L;
ds@1952	2260	static int nesting=0;
ds@1952	2261	int close,lvalue;
ds@1952	2262	int argpos; /* index in the output stream (argpos==nargs if positional parameters) */
ds@1952	2263	int argidx=0; /* index in "arginfo" list */
ds@1952	2264	int nargs=0; /* number of arguments */
ds@1952	2265	int heapalloc=0;
ds@1952	2266	int namedparams=FALSE;
ds@1952	2267	value lval = {0};
ds@1952	2268	arginfo *arg;
ds@1952	2269	char arglist[sMAXARGS];
ds@1952	2270	constvalue arrayszlst = { NULL, "", 0, 0};/* array size list starts empty */
ds@1952	2271	constvalue taglst = { NULL, "", 0, 0}; /* tag list starts empty */
ds@1952	2272	symbol *symret;
ds@1952	2273	cell lexval;
ds@1952	2274	char *lexstr;
ds@1952	2275
ds@1952	2276	assert(sym!=NULL);
ds@1952	2277	lval_result->ident=iEXPRESSION; /* preset, may be changed later */
ds@1952	2278	lval_result->constval=0;
ds@1952	2279	lval_result->tag=sym->tag;
ds@1952	2280	/* check whether this is a function that returns an array */
ds@1952	2281	symret=finddepend(sym);
ds@1952	2282	assert(symret==NULL \|\| symret->ident==iREFARRAY);
ds@1952	2283	if (symret!=NULL) {
ds@1952	2284	int retsize;
ds@1952	2285	/* allocate space on the heap for the array, and pass the pointer to the
ds@1952	2286	* reserved memory block as a hidden parameter
ds@1952	2287	*/
ds@1952	2288	retsize=(int)array_totalsize(symret);
ds@1952	2289	assert(retsize>0);
ds@1952	2290	modheap(retsizesizeof(cell));/ address is in ALT */
ds@1952	2291	pushreg(sALT); /* pass ALT as the last (hidden) parameter */
ds@1952	2292	markheap(MEMUSE_STATIC, retsize);
ds@1952	2293	/* also mark the ident of the result as "array" */
ds@1952	2294	lval_result->ident=iREFARRAY;
ds@1952	2295	lval_result->sym=symret;
ds@1952	2296	} /* if */
ds@1952	2297	pushheaplist();
ds@1952	2298
ds@1952	2299	nesting++;
ds@1952	2300	assert(nest_stkusage>=0);
ds@1952	2301	#if !defined NDEBUG
ds@1952	2302	if (nesting==1)
ds@1952	2303	assert(nest_stkusage==0);
ds@1952	2304	#endif
ds@1952	2305	sc_allowproccall=FALSE; /* parameters may not use procedure call syntax */
ds@1952	2306
ds@1952	2307	if ((sym->flags & flgDEPRECATED)!=0) {
ds@1952	2308	char *ptr= (sym->documentation!=NULL) ? sym->documentation : "";
ds@1952	2309	error(234,sym->name,ptr); /* deprecated (probably a native function) */
ds@1952	2310	} /* if */
ds@1952	2311
ds@1952	2312	/* run through the arguments */
ds@1952	2313	arg=sym->dim.arglist;
ds@1952	2314	assert(arg!=NULL);
ds@1952	2315	stgmark(sSTARTREORDER);
ds@1952	2316	memset(arglist,ARG_UNHANDLED,sizeof arglist);
ds@1952	2317	if (matchparanthesis) {
ds@1952	2318	/* Opening brace was already parsed, if closing brace follows, this
ds@1952	2319	* call passes no parameters.
ds@1952	2320	*/
ds@1952	2321	close=matchtoken(')');
ds@1952	2322	} else {
ds@1952	2323	/* When we find an end of line here, it may be a function call passing
ds@1952	2324	* no parameters, or it may be that the first parameter is on a line
ds@1952	2325	* below. But as a parameter can be anything, this is difficult to check.
ds@1952	2326	* The only simple check that we have is the use of "named parameters".
ds@1952	2327	*/
ds@1952	2328	close=matchtoken(tTERM);
ds@1952	2329	if (close) {
ds@1952	2330	close=!matchtoken('.');
ds@1952	2331	if (!close)
ds@1952	2332	lexpush(); /* reset the '.' */
ds@1952	2333	} /* if */
ds@1952	2334	} /* if */
ds@1952	2335	if (!close) {
ds@1952	2336	do {
ds@1952	2337	if (matchtoken('.')) {
ds@1952	2338	namedparams=TRUE;
ds@1952	2339	if (needtoken(tSYMBOL))
ds@1952	2340	tokeninfo(&lexval,&lexstr);
ds@1952	2341	else
ds@1952	2342	lexstr="";
ds@1952	2343	argpos=findnamedarg(arg,lexstr);
ds@1952	2344	if (argpos<0) {
ds@1952	2345	error(17,lexstr); /* undefined symbol */
ds@1952	2346	break; /* exit loop, argpos is invalid */
ds@1952	2347	} /* if */
ds@1952	2348	needtoken('=');
ds@1952	2349	argidx=argpos;
ds@1952	2350	} else {
ds@1952	2351	if (namedparams)
ds@1952	2352	error(44); /* positional parameters must precede named parameters */
ds@1952	2353	argpos=nargs;
ds@1952	2354	} /* if */
ds@1952	2355	/* the number of arguments this was already checked at the declaration
ds@1952	2356	* of the function; check it again for functions with a variable
ds@1952	2357	* argument list
ds@1952	2358	*/
ds@1952	2359	if (argpos>=sMAXARGS)
ds@1952	2360	error(45); /* too many function arguments */
ds@1952	2361	stgmark((char)(sEXPRSTART+argpos));/* mark beginning of new expression in stage */
ds@1952	2362	if (arglist[argpos]!=ARG_UNHANDLED)
ds@1952	2363	error(58); /* argument already set */
ds@1952	2364	if (matchtoken('_')) {
ds@1952	2365	arglist[argpos]=ARG_IGNORED; /* flag argument as "present, but ignored" */
ds@1952	2366	if (arg[argidx].ident==0 \|\| arg[argidx].ident==iVARARGS) {
ds@1952	2367	error(92); /* argument count mismatch */
ds@1952	2368	} else if (!arg[argidx].hasdefault) {
ds@1952	2369	error(34,nargs+1); /* argument has no default value */
ds@1952	2370	} /* if */
ds@1952	2371	if (arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS)
ds@1952	2372	argidx++;
ds@1952	2373	/* The rest of the code to handle default values is at the bottom
ds@1952	2374	* of this routine where default values for unspecified parameters
ds@1952	2375	* are (also) handled. Note that above, the argument is flagged as
ds@1952	2376	* ARG_IGNORED.
ds@1952	2377	*/
ds@1952	2378	} else {
ds@1952	2379	arglist[argpos]=ARG_DONE; /* flag argument as "present" */
ds@1952	2380	if (arg[argidx].ident!=0 && arg[argidx].numtags==1) /* set the expected tag, if any */
ds@1952	2381	lval.cmptag=arg[argidx].tags[0];
ds@1952	2382	lvalue=hier14(&lval);
ds@1952	2383	assert(sc_status==statFIRST \|\| arg[argidx].tags!=NULL);
ds@1952	2384	switch (arg[argidx].ident) {
ds@1952	2385	case 0:
ds@1952	2386	error(92); /* argument count mismatch */
ds@1952	2387	break;
ds@1952	2388	case iVARARGS:
ds@1952	2389	/* always pass by reference */
ds@1952	2390	if (lval.ident==iVARIABLE \|\| lval.ident==iREFERENCE) {
ds@1952	2391	assert(lval.sym!=NULL);
ds@1952	2392	if ((lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0) {
ds@1952	2393	/* treat a "const" variable passed to a function with a non-const
ds@1952	2394	* "variable argument list" as a constant here */
ds@1952	2395	if (!lvalue) {
ds@1952	2396	error(22); /* need lvalue */
ds@1952	2397	} else {
ds@1952	2398	rvalue(&lval); /* get value in PRI */
ds@1952	2399	setheap_pri(); /* address of the value on the heap in PRI */
ds@1952	2400	heapalloc+=markheap(MEMUSE_STATIC, 1);
ds@1952	2401	nest_stkusage++;
ds@1952	2402	} /* if */
ds@1952	2403	} else if (lvalue) {
ds@1952	2404	address(lval.sym,sPRI);
ds@1952	2405	} else {
ds@1952	2406	setheap_pri(); /* address of the value on the heap in PRI */
ds@1952	2407	heapalloc+=markheap(MEMUSE_STATIC, 1);
ds@1952	2408	nest_stkusage++;
ds@1952	2409	} /* if */
ds@1952	2410	} else if (lval.ident==iCONSTEXPR \|\| lval.ident==iEXPRESSION)
ds@1952	2411	{
ds@1952	2412	/* allocate a cell on the heap and store the
ds@1952	2413	* value (already in PRI) there */
ds@1952	2414	setheap_pri(); /* address of the value on the heap in PRI */
ds@1952	2415	heapalloc+=markheap(MEMUSE_STATIC, 1);
ds@1952	2416	nest_stkusage++;
ds@1952	2417	} /* if */
ds@1952	2418	/* ??? handle const array passed by reference */
ds@1952	2419	/* otherwise, the address is already in PRI */
ds@1952	2420	if (lval.sym!=NULL)
ds@1952	2421	markusage(lval.sym,uWRITTEN);
ds@1952	2422	if (!checktags_string(arg[argidx].tags, arg[argidx].numtags, &lval)
ds@1952	2423	&& !checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
ds@1952	2424	error(213);
ds@1952	2425	if (lval.tag!=0)
ds@1952	2426	append_constval(&taglst,arg[argidx].name,lval.tag,0);
ds@1952	2427	break;
ds@1952	2428	case iVARIABLE:
ds@1952	2429	if (lval.ident==iLABEL \|\| lval.ident==iFUNCTN \|\| lval.ident==iREFFUNC
ds@1952	2430	\|\| lval.ident==iARRAY \|\| lval.ident==iREFARRAY)
ds@1952	2431	error(35,argidx+1); /* argument type mismatch */
ds@1952	2432	if (lvalue)
ds@1952	2433	rvalue(&lval); /* get value (direct or indirect) */
ds@1952	2434	/* otherwise, the expression result is already in PRI */
ds@1952	2435	assert(arg[argidx].numtags>0);
ds@1952	2436	check_userop(NULL,lval.tag,arg[argidx].tags[0],2,NULL,&lval.tag);
ds@1952	2437	if (!checktags_string(arg[argidx].tags, arg[argidx].numtags, &lval)
ds@1952	2438	&& !checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
ds@1952	2439	{
ds@1952	2440	if (arg[argidx].numtags == 1 && arg[argidx].tags[0] & FUNCTAG)
ds@1952	2441	error(100); /* error - function prototypes do not match */
ds@1952	2442	else
ds@1952	2443	error(213); /* warning - tag mismatch */
ds@1952	2444	}
ds@1952	2445	if (lval.tag!=0)
ds@1952	2446	append_constval(&taglst,arg[argidx].name,lval.tag,0);
ds@1952	2447	argidx++; /* argument done */
ds@1952	2448	break;
ds@1952	2449	case iREFERENCE:
ds@1952	2450	if (!lvalue)
ds@1952	2451	error(35,argidx+1); /* argument type mismatch */
ds@1952	2452	if (lval.sym!=NULL && (lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0)
ds@1952	2453	error(35,argidx+1); /* argument type mismatch */
ds@1952	2454	if (lval.ident==iVARIABLE \|\| lval.ident==iREFERENCE) {
ds@1952	2455	if (lvalue) {
ds@1952	2456	assert(lval.sym!=NULL);
ds@1952	2457	address(lval.sym,sPRI);
ds@1952	2458	} else {
ds@1952	2459	setheap_pri(); /* address of the value on the heap in PRI */
ds@1952	2460	heapalloc+=markheap(MEMUSE_STATIC, 1);
ds@1952	2461	nest_stkusage++;
ds@1952	2462	} /* if */
ds@1952	2463	} /* if */
ds@1952	2464	/* otherwise, the address is already in PRI */
ds@1952	2465	if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
ds@1952	2466	error(213);
ds@1952	2467	if (lval.tag!=0)
ds@1952	2468	append_constval(&taglst,arg[argidx].name,lval.tag,0);
ds@1952	2469	argidx++; /* argument done */
ds@1952	2470	if (lval.sym!=NULL)
ds@1952	2471	markusage(lval.sym,uWRITTEN);
ds@1952	2472	break;
ds@1952	2473	case iREFARRAY:
ds@1952	2474	if (lval.ident!=iARRAY && lval.ident!=iREFARRAY
ds@1952	2475	&& lval.ident!=iARRAYCELL && lval.ident!=iARRAYCHAR)
ds@1952	2476	{
ds@1952	2477	error(35,argidx+1); /* argument type mismatch */
ds@1952	2478	break;
ds@1952	2479	} /* if */
ds@1952	2480	if (lval.sym!=NULL && (lval.sym->usage & uCONST)!=0 && (arg[argidx].usage & uCONST)==0)
ds@1952	2481	error(35,argidx+1); /* argument type mismatch */
ds@1952	2482	/* Verify that the dimensions match with those in arg[argidx].
ds@1952	2483	* A literal array always has a single dimension.
ds@1952	2484	* An iARRAYCELL parameter is also assumed to have a single dimension.
ds@1952	2485	*/
ds@1952	2486	if (lval.sym==NULL \|\| lval.ident==iARRAYCELL \|\| lval.ident==iARRAYCHAR) {
ds@1952	2487	if (arg[argidx].numdim!=1) {
ds@1952	2488	error(48); /* array dimensions must match */
ds@1952	2489	} else if (arg[argidx].dim[0]!=0) {
ds@1952	2490	assert(arg[argidx].dim[0]>0);
ds@1952	2491	if (lval.ident==iARRAYCELL) {
ds@1952	2492	error(47); /* array sizes must match */
ds@1952	2493	} else {
ds@1952	2494	assert(lval.constval!=0); /* literal array must have a size */
ds@1952	2495	/* A literal array must have exactly the same size as the
ds@1952	2496	* function argument; a literal string may be smaller than
ds@1952	2497	* the function argument.
ds@1952	2498	*/
ds@1952	2499	if (lval.constval>0 && arg[argidx].dim[0]!=lval.constval
ds@1952	2500	\|\| lval.constval<0 && arg[argidx].dim[0] < -lval.constval)
ds@1952	2501	error(47); /* array sizes must match */
ds@1952	2502	} /* if */
ds@1952	2503	} /* if */
ds@1952	2504	if (lval.ident!=iARRAYCELL && lval.ident!=iARRAYCHAR) {
ds@1952	2505	/* save array size, for default values with uSIZEOF flag */
ds@1952	2506	cell array_sz=lval.constval;
ds@1952	2507	assert(array_sz!=0);/* literal array must have a size */
ds@1952	2508	if (array_sz<0)
ds@1952	2509	array_sz= -array_sz;
ds@1952	2510	append_constval(&arrayszlst,arg[argidx].name,array_sz,0);
ds@1952	2511	}/* if */
ds@1952	2512	} else {
ds@1952	2513	symbol *sym=lval.sym;
ds@1952	2514	short level=0;
ds@1952	2515	assert(sym!=NULL);
ds@1952	2516	if (sym->dim.array.level+1!=arg[argidx].numdim)
ds@1952	2517	error(48); /* array dimensions must match */
ds@1952	2518	/* the lengths for all dimensions must match, unless the dimension
ds@1952	2519	* length was defined at zero (which means "undefined")
ds@1952	2520	*/
ds@1952	2521	while (sym->dim.array.level>0) {
ds@1952	2522	assert(level<sDIMEN_MAX);
ds@1952	2523	if (arg[argidx].dim[level]!=0 && sym->dim.array.length!=arg[argidx].dim[level])
ds@1952	2524	error(47); /* array sizes must match */
ds@1952	2525	else if (!matchtag(arg[argidx].idxtag[level],sym->x.tags.index,TRUE))
ds@1952	2526	error(229,sym->name); /* index tag mismatch */
ds@1952	2527	append_constval(&arrayszlst,arg[argidx].name,sym->dim.array.length,level);
ds@1952	2528	sym=finddepend(sym);
ds@1952	2529	assert(sym!=NULL);
ds@1952	2530	level++;
ds@1952	2531	} /* if */
ds@1952	2532	/* the last dimension is checked too, again, unless it is zero */
ds@1952	2533	assert(level<sDIMEN_MAX);
ds@1952	2534	assert(sym!=NULL);
ds@1952	2535	if (arg[argidx].dim[level]!=0 && sym->dim.array.length!=arg[argidx].dim[level])
ds@1952	2536	error(47); /* array sizes must match */
ds@1952	2537	else if (!matchtag(arg[argidx].idxtag[level],sym->x.tags.index,TRUE))
ds@1952	2538	error(229,sym->name); /* index tag mismatch */
ds@1952	2539	append_constval(&arrayszlst,arg[argidx].name,sym->dim.array.length,level);
ds@1952	2540	} /* if */
ds@1952	2541	/* address already in PRI */
ds@1952	2542	if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
ds@1952	2543	error(213);
ds@1952	2544	if (lval.tag!=0)
ds@1952	2545	append_constval(&taglst,arg[argidx].name,lval.tag,0);
ds@1952	2546	// ??? set uWRITTEN?
ds@1952	2547	argidx++; /* argument done */
ds@1952	2548	break;
ds@1952	2549	} /* switch */
ds@1952	2550	pushreg(sPRI); /* store the function argument on the stack */
ds@1952	2551	markexpr(sPARM,NULL,0); /* mark the end of a sub-expression */
ds@1952	2552	nest_stkusage++;
ds@1952	2553	} /* if */
ds@1952	2554	assert(arglist[argpos]!=ARG_UNHANDLED);
ds@1952	2555	nargs++;
ds@1952	2556	if (matchparanthesis) {
ds@1952	2557	close=matchtoken(')');
ds@1952	2558	if (!close) /* if not paranthese... */
ds@1952	2559	if (!needtoken(',')) /* ...should be comma... */
ds@1952	2560	break; /* ...but abort loop if neither */
ds@1952	2561	} else {
ds@1952	2562	close=!matchtoken(',');
ds@1952	2563	if (close) { /* if not comma... */
ds@1952	2564	if (needtoken(tTERM)==1)/* ...must be end of statement */
ds@1952	2565	lexpush(); /* push again, because end of statement is analised later */
ds@1952	2566	} /* if */
ds@1952	2567	} /* if */
ds@1952	2568	} while (!close && freading && !matchtoken(tENDEXPR)); /* do */
ds@1952	2569	} /* if */
ds@1952	2570	/* check remaining function arguments (they may have default values) */
ds@1952	2571	for (argidx=0; arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS; argidx++) {
ds@1952	2572	if (arglist[argidx]==ARG_DONE)
ds@1952	2573	continue; /* already seen and handled this argument */
ds@1952	2574	/* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;
ds@1952	2575	* these are handled last
ds@1952	2576	*/
ds@1952	2577	if ((arg[argidx].hasdefault & uSIZEOF)!=0 \|\| (arg[argidx].hasdefault & uTAGOF)!=0) {
ds@1952	2578	assert(arg[argidx].ident==iVARIABLE);
ds@1952	2579	continue;
ds@1952	2580	} /* if */
ds@1952	2581	stgmark((char)(sEXPRSTART+argidx));/* mark beginning of new expression in stage */
ds@1952	2582	if (arg[argidx].hasdefault) {
ds@1952	2583	if (arg[argidx].ident==iREFARRAY) {
ds@1952	2584	short level;
ds@1952	2585	setdefarray(arg[argidx].defvalue.array.data,
ds@1952	2586	arg[argidx].defvalue.array.size,
ds@1952	2587	arg[argidx].defvalue.array.arraysize,
ds@1952	2588	&arg[argidx].defvalue.array.addr,
ds@1952	2589	(arg[argidx].usage & uCONST)!=0);
ds@1952	2590	if (arg[argidx].defvalue.array.data != NULL) {
ds@1952	2591	if ((arg[argidx].usage & uCONST)==0) {
ds@1952	2592	heapalloc+=arg[argidx].defvalue.array.arraysize;
ds@1952	2593	nest_stkusage+=arg[argidx].defvalue.array.arraysize;
ds@1952	2594	} /* if */
ds@1952	2595	/* keep the lengths of all dimensions of a multi-dimensional default array */
ds@1952	2596	assert(arg[argidx].numdim>0);
ds@1952	2597	if (arg[argidx].numdim==1) {
ds@1952	2598	append_constval(&arrayszlst,arg[argidx].name,arg[argidx].defvalue.array.arraysize,0);
ds@1952	2599	} else {
ds@1952	2600	for (level=0; level<arg[argidx].numdim; level++) {
ds@1952	2601	assert(level<sDIMEN_MAX);
ds@1952	2602	append_constval(&arrayszlst,arg[argidx].name,arg[argidx].dim[level],level);
ds@1952	2603	} /* for */
ds@1952	2604	} /* if */
ds@1952	2605	}
ds@1952	2606	} else if (arg[argidx].ident==iREFERENCE) {
ds@1952	2607	setheap(arg[argidx].defvalue.val);
ds@1952	2608	/* address of the value on the heap in PRI */
ds@1952	2609	heapalloc+=markheap(MEMUSE_STATIC, 1);
ds@1952	2610	nest_stkusage++;
ds@1952	2611	} else {
ds@1952	2612	int dummytag=arg[argidx].tags[0];
ds@1952	2613	ldconst(arg[argidx].defvalue.val,sPRI);
ds@1952	2614	assert(arg[argidx].numtags>0);
ds@1952	2615	check_userop(NULL,arg[argidx].defvalue_tag,arg[argidx].tags[0],2,NULL,&dummytag);
ds@1952	2616	assert(dummytag==arg[argidx].tags[0]);
ds@1952	2617	} /* if */
ds@1952	2618	pushreg(sPRI); /* store the function argument on the stack */
ds@1952	2619	markexpr(sPARM,NULL,0); /* mark the end of a sub-expression */
ds@1952	2620	nest_stkusage++;
ds@1952	2621	} else {
ds@1952	2622	error(92,argidx); /* argument count mismatch */
ds@1952	2623	} /* if */
ds@1952	2624	if (arglist[argidx]==ARG_UNHANDLED)
ds@1952	2625	nargs++;
ds@1952	2626	arglist[argidx]=ARG_DONE;
ds@1952	2627	} /* for */
ds@1952	2628	/* now a second loop to catch the arguments with default values that are
ds@1952	2629	* the "sizeof" or "tagof" of other arguments
ds@1952	2630	*/
ds@1952	2631	for (argidx=0; arg[argidx].ident!=0 && arg[argidx].ident!=iVARARGS; argidx++) {
ds@1952	2632	constvalue *asz;
ds@1952	2633	cell array_sz;
ds@1952	2634	if (arglist[argidx]==ARG_DONE)
ds@1952	2635	continue; /* already seen and handled this argument */
ds@1952	2636	stgmark((char)(sEXPRSTART+argidx));/* mark beginning of new expression in stage */
ds@1952	2637	assert(arg[argidx].ident==iVARIABLE); /* if "sizeof", must be single cell */
ds@1952	2638	/* if unseen, must be "sizeof" or "tagof" */
ds@1952	2639	assert((arg[argidx].hasdefault & uSIZEOF)!=0 \|\| (arg[argidx].hasdefault & uTAGOF)!=0);
ds@1952	2640	if ((arg[argidx].hasdefault & uSIZEOF)!=0) {
ds@1952	2641	/* find the argument; if it isn't found, the argument's default value
ds@1952	2642	* was a "sizeof" of a non-array (a warning for this was already given
ds@1952	2643	* when declaring the function)
ds@1952	2644	*/
ds@1952	2645	asz=find_constval(&arrayszlst,arg[argidx].defvalue.size.symname,
ds@1952	2646	arg[argidx].defvalue.size.level);
ds@1952	2647	if (asz!=NULL) {
ds@1952	2648	array_sz=asz->value;
ds@1952	2649	if (array_sz==0)
ds@1952	2650	error(224,arg[argidx].name); /* indeterminate array size in "sizeof" expression */
ds@1952	2651	} else {
ds@1952	2652	array_sz=1;
ds@1952	2653	} /* if */
ds@1952	2654	} else {
ds@1952	2655	asz=find_constval(&taglst,arg[argidx].defvalue.size.symname,
ds@1952	2656	arg[argidx].defvalue.size.level);
ds@1952	2657	if (asz != NULL) {
ds@1952	2658	exporttag(asz->value);
ds@1952	2659	array_sz=asz->value \| PUBLICTAG; /* must be set, because it just was exported */
ds@1952	2660	} else {
ds@1952	2661	array_sz=0;
ds@1952	2662	} /* if */
ds@1952	2663	} /* if */
ds@1952	2664	ldconst(array_sz,sPRI);
ds@1952	2665	pushreg(sPRI); /* store the function argument on the stack */
ds@1952	2666	markexpr(sPARM,NULL,0);
ds@1952	2667	nest_stkusage++;
ds@1952	2668	if (arglist[argidx]==ARG_UNHANDLED)
ds@1952	2669	nargs++;
ds@1952	2670	arglist[argidx]=ARG_DONE;
ds@1952	2671	} /* for */
ds@1952	2672	stgmark(sENDREORDER); /* mark end of reversed evaluation */
ds@1952	2673	pushval((cell)nargs /* sizeof(cell)/ );
ds@1952	2674	nest_stkusage++;
ds@1952	2675	ffcall(sym,NULL,nargs);
ds@1952	2676	if (sc_status!=statSKIP)
ds@1952	2677	markusage(sym,uREAD); /* do not mark as "used" when this call itself is skipped */
ds@1952	2678	if ((sym->usage & uNATIVE)!=0 &&sym->x.lib!=NULL)
ds@1952	2679	sym->x.lib->value += 1; /* increment "usage count" of the library */
ds@1952	2680	if (symret!=NULL)
ds@1952	2681	popreg(sPRI); /* pop hidden parameter as function result */
ds@1952	2682	sideeffect=TRUE; /* assume functions carry out a side-effect */
ds@1952	2683	delete_consttable(&arrayszlst); /* clear list of array sizes */
ds@1952	2684	delete_consttable(&taglst); /* clear list of parameter tags */
ds@1952	2685
ds@1952	2686	/* maintain max. amount of memory used */
ds@1952	2687	{
ds@1952	2688	long totalsize;
ds@1952	2689	totalsize=declared+heapalloc+1; /* local variables & return value size,
ds@1952	2690	* +1 for PROC opcode */
ds@1952	2691	if (lval_result->ident==iREFARRAY)
ds@1952	2692	totalsize++; /* add hidden parameter (on the stack) */
ds@1952	2693	if ((sym->usage & uNATIVE)==0)
ds@1952	2694	totalsize++; /* add "call" opcode */
ds@1952	2695	totalsize+=nest_stkusage;
ds@1952	2696	if (curfunc != NULL) {
ds@1952	2697	if (curfunc->x.stacksize<totalsize)
ds@1952	2698	curfunc->x.stacksize=totalsize;
ds@1952	2699	} else {
ds@1952	2700	error(10);
ds@1952	2701	}
ds@1952	2702	nest_stkusage-=nargs+heapalloc+1; /* stack/heap space, +1 for argcount param */
ds@1952	2703	/* if there is a syntax error in the script, the stack calculation is
ds@1952	2704	* probably incorrect; but we may not allow it to drop below zero
ds@1952	2705	*/
ds@1952	2706	if (nest_stkusage<0)
ds@1952	2707	nest_stkusage=0;
ds@1952	2708	}
ds@1952	2709
ds@1952	2710	/* scrap any arrays left on the heap, with the exception of the array that
ds@1952	2711	* this function has as a result (in other words, scrap all arrays on the
ds@1952	2712	* heap that caused by expressions in the function arguments)
ds@1952	2713	*/
ds@1952	2714	popheaplist();
ds@1952	2715	nesting--;
ds@1952	2716	}
ds@1952	2717
ds@1952	2718	/* dbltest
ds@1952	2719	*
ds@1952	2720	* Returns a non-zero value if lval1 an array and lval2 is not an array and
ds@1952	2721	* the operation is addition or subtraction.
ds@1952	2722	*
ds@1952	2723	* Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell
ds@1952	2724	* to an array offset.
ds@1952	2725	*/
ds@1952	2726	static int dbltest(void (oper)(),value lval1,value *lval2)
ds@1952	2727	{
ds@1952	2728	if ((oper!=ob_add) && (oper!=ob_sub))
ds@1952	2729	return 0;
ds@1952	2730	if (lval1->ident!=iARRAY)
ds@1952	2731	return 0;
ds@1952	2732	if (lval2->ident==iARRAY)
ds@1952	2733	return 0;
ds@1952	2734	return sizeof(cell)/2; /* 1 for 16-bit, 2 for 32-bit */
ds@1952	2735	}
ds@1952	2736
ds@1952	2737	/* commutative
ds@1952	2738	*
ds@1952	2739	* Test whether an operator is commutative, i.e. x oper y == y oper x.
ds@1952	2740	* Commutative operators are: + (addition)
ds@1952	2741	* * (multiplication)
ds@1952	2742	* == (equality)
ds@1952	2743	* != (inequality)
ds@1952	2744	* & (bitwise and)
ds@1952	2745	* ^ (bitwise xor)
ds@1952	2746	* \| (bitwise or)
ds@1952	2747	*
ds@1952	2748	* If in an expression, code for the left operand has been generated and
ds@1952	2749	* the right operand is a constant and the operator is commutative, the
ds@1952	2750	* precautionary "push" of the primary register is scrapped and the constant
ds@1952	2751	* is read into the secondary register immediately.
ds@1952	2752	*/
ds@1952	2753	static int commutative(void (*oper)())
ds@1952	2754	{
ds@1952	2755	return oper==ob_add \|\| oper==os_mult
ds@1952	2756	\|\| oper==ob_eq \|\| oper==ob_ne
ds@1952	2757	\|\| oper==ob_and \|\| oper==ob_xor \|\| oper==ob_or;
ds@1952	2758	}
ds@1952	2759
ds@1952	2760	/* constant
ds@1952	2761	*
ds@1952	2762	* Generates code to fetch a number, a literal character (which is returned
ds@1952	2763	* by lex() as a number as well) or a literal string (lex() stores the
ds@1952	2764	* strings in the literal queue). If the operand was a number, it is stored
ds@1952	2765	* in lval->constval.
ds@1952	2766	*
ds@1952	2767	* The function returns 1 if the token was a constant or a string, 0
ds@1952	2768	* otherwise.
ds@1952	2769	*/
ds@1952	2770	static int constant(value *lval)
ds@1952	2771	{
ds@1952	2772	int tok,index,ident;
ds@1952	2773	cell val,item,cidx;
ds@1952	2774	char *st;
ds@1952	2775	symbol *sym;
ds@1952	2776	int cmptag=lval->cmptag;
ds@1952	2777
ds@1952	2778	tok=lex(&val,&st);
ds@1952	2779	if (tok==tSYMBOL && (sym=findconst(st,&cmptag))!=0) {
ds@1952	2780	if (cmptag>1)
ds@1952	2781	error(91,sym->name); /* ambiguity: multiple matching constants (different tags) */
ds@1952	2782	lval->constval=sym->addr;
ds@1952	2783	ldconst(lval->constval,sPRI);
ds@1952	2784	lval->ident=iCONSTEXPR;
ds@1952	2785	lval->tag=sym->tag;
ds@1952	2786	lval->sym=sym;
ds@1952	2787	markusage(sym,uREAD);
ds@1952	2788	} else if (tok==tNUMBER) {
ds@1952	2789	lval->constval=val;
ds@1952	2790	ldconst(lval->constval,sPRI);
ds@1952	2791	lval->ident=iCONSTEXPR;
ds@1952	2792	} else if (tok==tRATIONAL) {
ds@1952	2793	lval->constval=val;
ds@1952	2794	ldconst(lval->constval,sPRI);
ds@1952	2795	lval->ident=iCONSTEXPR;
ds@1952	2796	lval->tag=sc_rationaltag;
ds@1952	2797	} else if (tok==tSTRING) {
ds@1952	2798	/* lex() stores starting index of string in the literal table in 'val' */
ds@1952	2799	ldconst((val+glb_declared)*sizeof(cell),sPRI);
ds@1952	2800	lval->ident=iARRAY; /* pretend this is a global array */
ds@1952	2801	lval->constval=val-litidx; /* constval == the negative value of the
ds@1952	2802	* size of the literal array; using a negative
ds@1952	2803	* value distinguishes between literal arrays
ds@1952	2804	* and literal strings (this was done for
ds@1952	2805	* array assignment). */
ds@1952	2806	lval->tag=pc_tag_string;
ds@1952	2807	} else if (tok=='{') {
ds@1952	2808	int tag,lasttag=-1;
ds@1952	2809	val=litidx;
ds@1952	2810	do {
ds@1952	2811	/* cannot call constexpr() here, because "staging" is already turned
ds@1952	2812	* on at this point */
ds@1952	2813	assert(staging);
ds@1952	2814	stgget(&index,&cidx); /* mark position in code generator */
ds@1952	2815	ident=expression(&item,&tag,NULL,FALSE,NULL);
ds@1952	2816	stgdel(index,cidx); /* scratch generated code */
ds@1952	2817	if (ident!=iCONSTEXPR)
ds@1952	2818	error(8); /* must be constant expression */
ds@1952	2819	if (lasttag<0)
ds@1952	2820	lasttag=tag;
ds@1952	2821	else if (!matchtag(lasttag,tag,FALSE))
ds@1952	2822	error(213); /* tagname mismatch */
ds@1952	2823	litadd(item); /* store expression result in literal table */
ds@1952	2824	} while (matchtoken(','));
ds@1952	2825	if (!needtoken('}'))
ds@1952	2826	lexclr(FALSE);
ds@1952	2827	ldconst((val+glb_declared)*sizeof(cell),sPRI);
ds@1952	2828	lval->ident=iARRAY; /* pretend this is a global array */
ds@1952	2829	lval->constval=litidx-val; /* constval == the size of the literal array */
ds@1952	2830	} else {
ds@1952	2831	return FALSE; /* no, it cannot be interpreted as a constant */
ds@1952	2832	} /* if */
ds@1952	2833	return TRUE; /* yes, it was a constant value */
ds@1952	2834	}
ds@1952	2835

author	David Anderson <dvander@alliedmods.net>
	Sun Sep 07 09:51:38 2008 +0000 (2008-09-07)
changeset 2273	fc2bb71d0291
parent 1952	b7aa2b626807
child 2289	44045ead61cd
permissions	-rw-r--r--