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

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

author	Nicholas Hastings <skamonkey@gmail.com>
	Mon Jun 14 09:32:50 2010 -0400 (2010-06-14)
changeset 3041	a0587dee87ae
parent 2741	efbe232c5834
child 3066	ca5fc683fd7d
permissions	-rw-r--r--