From dd7595a3475407a7fa96a97393bae8c5220e8762 Mon Sep 17 00:00:00 2001 From: David Walter Seikel Date: Wed, 4 Jan 2012 18:41:13 +1000 Subject: Add the base Enlightenment Foundation Libraries - eina, eet, evas, ecore, embryo, and edje. Note that embryo wont be used, but I'm not sure yet if you can build edje without it. --- libraries/embryo/src/bin/embryo_cc_sc3.c | 2438 ++++++++++++++++++++++++++++++ 1 file changed, 2438 insertions(+) create mode 100644 libraries/embryo/src/bin/embryo_cc_sc3.c (limited to 'libraries/embryo/src/bin/embryo_cc_sc3.c') diff --git a/libraries/embryo/src/bin/embryo_cc_sc3.c b/libraries/embryo/src/bin/embryo_cc_sc3.c new file mode 100644 index 0000000..99b24ed --- /dev/null +++ b/libraries/embryo/src/bin/embryo_cc_sc3.c @@ -0,0 +1,2438 @@ +/* Small compiler - Recursive descend expresion parser + * + * Copyright (c) ITB CompuPhase, 1997-2003 + * + * This software is provided "as-is", without any express or implied warranty. + * In no event will the authors be held liable for any damages arising from + * the use of this software. + * + * Permission is granted to anyone to use this software for any purpose, + * including commercial applications, and to alter it and redistribute it + * freely, subject to the following restrictions: + * + * 1. The origin of this software must not be misrepresented; you must not + * claim that you wrote the original software. If you use this software in + * a product, an acknowledgment in the product documentation would be + * appreciated but is not required. + * 2. Altered source versions must be plainly marked as such, and must not be + * misrepresented as being the original software. + * 3. This notice may not be removed or altered from any source distribution. + * + * Version: $Id: embryo_cc_sc3.c 52451 2010-09-19 03:00:12Z raster $ + */ + + +#ifdef HAVE_CONFIG_H +# include +#endif + +#include +#include +#include /* for PATH_MAX */ +#include + +#include "embryo_cc_sc.h" + +static int skim(int *opstr, void (*testfunc) (int), int dropval, + int endval, int (*hier) (value *), value * lval); +static void dropout(int lvalue, void (*testfunc) (int val), int exit1, + value * lval); +static int plnge(int *opstr, int opoff, int (*hier) (value * lval), + value * lval, char *forcetag, int chkbitwise); +static int plnge1(int (*hier) (value * lval), value * lval); +static void plnge2(void (*oper) (void), + int (*hier) (value * lval), + value * lval1, value * lval2); +static cell calc(cell left, void (*oper) (), cell right, + char *boolresult); +static int hier13(value * lval); +static int hier12(value * lval); +static int hier11(value * lval); +static int hier10(value * lval); +static int hier9(value * lval); +static int hier8(value * lval); +static int hier7(value * lval); +static int hier6(value * lval); +static int hier5(value * lval); +static int hier4(value * lval); +static int hier3(value * lval); +static int hier2(value * lval); +static int hier1(value * lval1); +static int primary(value * lval); +static void clear_value(value * lval); +static void callfunction(symbol * sym); +static int dbltest(void (*oper) (), value * lval1, value * lval2); +static int commutative(void (*oper) ()); +static int constant(value * lval); + +static char lastsymbol[sNAMEMAX + 1]; /* name of last function/variable */ +static int bitwise_opercount; /* count of bitwise operators in an expression */ + +/* Function addresses of binary operators for signed operations */ +static void (*op1[17]) (void) = +{ + os_mult, os_div, os_mod, /* hier3, index 0 */ + ob_add, ob_sub, /* hier4, index 3 */ + ob_sal, os_sar, ou_sar, /* hier5, index 5 */ + ob_and, /* hier6, index 8 */ + ob_xor, /* hier7, index 9 */ + ob_or, /* hier8, index 10 */ + os_le, os_ge, os_lt, os_gt, /* hier9, index 11 */ + ob_eq, ob_ne, /* hier10, index 15 */ +}; +/* These two functions are defined because the functions inc() and dec() in + * SC4.C have a different prototype than the other code generation functions. + * The arrays for user-defined functions use the function pointers for + * identifying what kind of operation is requested; these functions must all + * have the same prototype. As inc() and dec() are special cases already, it + * is simplest to add two "do-nothing" functions. + */ +static void +user_inc(void) +{ +} +static void +user_dec(void) +{ +} + +/* + * Searches for a binary operator a list of operators. The list is stored in + * the array "list". The last entry in the list should be set to 0. + * + * The index of an operator in "list" (if found) is returned in "opidx". If + * no operator is found, nextop() returns 0. + */ +static int +nextop(int *opidx, int *list) +{ + *opidx = 0; + while (*list) + { + if (matchtoken(*list)) + { + return TRUE; /* found! */ + } + else + { + list += 1; + *opidx += 1; + } /* if */ + } /* while */ + return FALSE; /* entire list scanned, nothing found */ +} + +int +check_userop(void (*oper) (void), int tag1, int tag2, int numparam, + value * lval, int *resulttag) +{ + static char *binoperstr[] = { "*", "/", "%", "+", "-", "", "", "", + "", "", "", "<=", ">=", "<", ">", "==", "!=" + }; + static int binoper_savepri[] = + { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, FALSE, FALSE, + TRUE, TRUE, TRUE, TRUE, FALSE, FALSE + }; + static char *unoperstr[] = { "!", "-", "++", "--" }; + static void (*unopers[]) (void) = + { + lneg, neg, user_inc, user_dec}; + char opername[4] = "", symbolname[sNAMEMAX + 1]; + int i, swapparams, savepri, savealt; + int paramspassed; + symbol *sym; + + /* since user-defined operators on untagged operands are forbidden, we have + * a quick exit. + */ + assert(numparam == 1 || numparam == 2); + if (tag1 == 0 && (numparam == 1 || tag2 == 0)) + return FALSE; + + savepri = savealt = FALSE; + /* find the name with the operator */ + if (numparam == 2) + { + if (!oper) + { + /* assignment operator: a special case */ + strcpy(opername, "="); + if (lval + && (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)) + savealt = TRUE; + } + else + { + assert((sizeof binoperstr / sizeof binoperstr[0]) == + (sizeof op1 / sizeof op1[0])); + for (i = 0; i < (int)(sizeof op1 / sizeof op1[0]); i++) + { + if (oper == op1[i]) + { + strcpy(opername, binoperstr[i]); + savepri = binoper_savepri[i]; + break; + } /* if */ + } /* for */ + } /* if */ + } + else + { + assert(oper != NULL); + assert(numparam == 1); + /* try a select group of unary operators */ + assert((sizeof unoperstr / sizeof unoperstr[0]) == + (sizeof unopers / sizeof unopers[0])); + if (opername[0] == '\0') + { + for (i = 0; i < (int)(sizeof unopers / sizeof unopers[0]); i++) + { + if (oper == unopers[i]) + { + strcpy(opername, unoperstr[i]); + break; + } /* if */ + } /* for */ + } /* if */ + } /* if */ + /* if not found, quit */ + if (opername[0] == '\0') + return FALSE; + + /* create a symbol name from the tags and the operator name */ + assert(numparam == 1 || numparam == 2); + operator_symname(symbolname, opername, tag1, tag2, numparam, tag2); + swapparams = FALSE; + sym = findglb(symbolname); + if (!sym /*|| (sym->usage & uDEFINE)==0 */ ) + { /* ??? should not check uDEFINE; first pass clears these bits */ + /* check for commutative operators */ + if (tag1 == tag2 || !oper || !commutative(oper)) + return FALSE; /* not commutative, cannot swap operands */ + /* if arrived here, the operator is commutative and the tags are different, + * swap tags and try again + */ + assert(numparam == 2); /* commutative operator must be a binary operator */ + operator_symname(symbolname, opername, tag2, tag1, numparam, tag1); + swapparams = TRUE; + sym = findglb(symbolname); + if (!sym /*|| (sym->usage & uDEFINE)==0 */ ) + return FALSE; + } /* if */ + + /* check existence and the proper declaration of this function */ + if ((sym->usage & uMISSING) != 0 || (sym->usage & uPROTOTYPED) == 0) + { + char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */ + + funcdisplayname(symname, sym->name); + if ((sym->usage & uMISSING) != 0) + error(4, symname); /* function not defined */ + if ((sym->usage & uPROTOTYPED) == 0) + error(71, symname); /* operator must be declared before use */ + } /* if */ + + /* we don't want to use the redefined operator in the function that + * redefines the operator itself, otherwise the snippet below gives + * an unexpected recursion: + * fixed:operator+(fixed:a, fixed:b) + * return a + b + */ + if (sym == curfunc) + return FALSE; + + /* for increment and decrement operators, the symbol must first be loaded + * (and stored back afterwards) + */ + if (oper == user_inc || oper == user_dec) + { + assert(!savepri); + assert(lval != NULL); + if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR) + push1(); /* save current address in PRI */ + rvalue(lval); /* get the symbol's value in PRI */ + } /* if */ + + assert(!savepri || !savealt); /* either one MAY be set, but not both */ + if (savepri) + { + /* the chained comparison operators require that the ALT register is + * unmodified, so we save it here; actually, we save PRI because the normal + * instruction sequence (without user operator) swaps PRI and ALT + */ + push1(); /* right-hand operand is in PRI */ + } + else if (savealt) + { + /* for the assignment operator, ALT may contain an address at which the + * result must be stored; this address must be preserved across the + * call + */ + assert(lval != NULL); /* this was checked earlier */ + assert(lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR); /* checked earlier */ + push2(); + } /* if */ + + /* push parameters, call the function */ + paramspassed = (!oper) ? 1 : numparam; + switch (paramspassed) + { + case 1: + push1(); + break; + case 2: + /* note that 1) a function expects that the parameters are pushed + * in reversed order, and 2) the left operand is in the secondary register + * and the right operand is in the primary register */ + if (swapparams) + { + push2(); + push1(); + } + else + { + push1(); + push2(); + } /* if */ + break; + default: + assert(0); + } /* switch */ + endexpr(FALSE); /* mark the end of a sub-expression */ + pushval((cell) paramspassed * sizeof(cell)); + assert(sym->ident == iFUNCTN); + ffcall(sym, paramspassed); + if (sc_status != statSKIP) + markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */ + if (sym->x.lib) + sym->x.lib->value += 1; /* increment "usage count" of the library */ + sideeffect = TRUE; /* assume functions carry out a side-effect */ + assert(resulttag != NULL); + *resulttag = sym->tag; /* save tag of the called function */ + + if (savepri || savealt) + pop2(); /* restore the saved PRI/ALT that into ALT */ + if (oper == user_inc || oper == user_dec) + { + assert(lval != NULL); + if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR) + pop2(); /* restore address (in ALT) */ + store(lval); /* store PRI in the symbol */ + moveto1(); /* make sure PRI is restored on exit */ + } /* if */ + return TRUE; +} + +int +matchtag(int formaltag, int actualtag, int allowcoerce) +{ + if (formaltag != actualtag) + { + /* if the formal tag is zero and the actual tag is not "fixed", the actual + * tag is "coerced" to zero + */ + if (!allowcoerce || formaltag != 0 || (actualtag & FIXEDTAG) != 0) + return FALSE; + } /* if */ + return TRUE; +} + +/* + * The AMX pseudo-processor has no direct support for logical (boolean) + * operations. These have to be done via comparing and jumping. Since we are + * already jumping through the code, we might as well implement an "early + * drop-out" evaluation (also called "short-circuit"). This conforms to + * standard C: + * + * expr1 || expr2 expr2 will only be evaluated if expr1 is false. + * expr1 && expr2 expr2 will only be evaluated if expr1 is true. + * + * expr1 || expr2 && expr3 expr2 will only be evaluated if expr1 is false + * and expr3 will only be evaluated if expr1 is + * false and expr2 is true. + * + * Code generation for the last example proceeds thus: + * + * evaluate expr1 + * operator || found + * jump to "l1" if result of expr1 not equal to 0 + * evaluate expr2 + * -> operator && found; skip to higher level in hierarchy diagram + * jump to "l2" if result of expr2 equal to 0 + * evaluate expr3 + * jump to "l2" if result of expr3 equal to 0 + * set expression result to 1 (true) + * jump to "l3" + * l2: set expression result to 0 (false) + * l3: + * <- drop back to previous hierarchy level + * jump to "l1" if result of expr2 && expr3 not equal to 0 + * set expression result to 0 (false) + * jump to "l4" + * l1: set expression result to 1 (true) + * l4: + * + */ + +/* Skim over terms adjoining || and && operators + * dropval The value of the expression after "dropping out". An "or" drops + * out when the left hand is TRUE, so dropval must be 1 on "or" + * expressions. + * endval The value of the expression when no expression drops out. In an + * "or" expression, this happens when both the left hand and the + * right hand are FALSE, so endval must be 0 for "or" expressions. + */ +static int +skim(int *opstr, void (*testfunc) (int), int dropval, int endval, + int (*hier) (value *), value * lval) +{ + int lvalue, hits, droplab, endlab, opidx; + int allconst; + cell constval; + int index; + cell cidx; + + stgget(&index, &cidx); /* mark position in code generator */ + hits = FALSE; /* no logical operators "hit" yet */ + allconst = TRUE; /* assume all values "const" */ + constval = 0; + droplab = 0; /* to avoid a compiler warning */ + for (;;) + { + lvalue = plnge1(hier, lval); /* evaluate left expression */ + + allconst = allconst && (lval->ident == iCONSTEXPR); + if (allconst) + { + if (hits) + { + /* one operator was already found */ + if (testfunc == jmp_ne0) + lval->constval = lval->constval || constval; + else + lval->constval = lval->constval && constval; + } /* if */ + constval = lval->constval; /* save result accumulated so far */ + } /* if */ + + if (nextop(&opidx, opstr)) + { + if (!hits) + { + /* this is the first operator in the list */ + hits = TRUE; + droplab = getlabel(); + } /* if */ + dropout(lvalue, testfunc, droplab, lval); + } + else if (hits) + { /* no (more) identical operators */ + dropout(lvalue, testfunc, droplab, lval); /* found at least one operator! */ + const1(endval); + jumplabel(endlab = getlabel()); + setlabel(droplab); + const1(dropval); + setlabel(endlab); + lval->sym = NULL; + lval->tag = 0; + if (allconst) + { + lval->ident = iCONSTEXPR; + lval->constval = constval; + stgdel(index, cidx); /* scratch generated code and calculate */ + } + else + { + lval->ident = iEXPRESSION; + lval->constval = 0; + } /* if */ + return FALSE; + } + else + { + return lvalue; /* none of the operators in "opstr" were found */ + } /* if */ + + } /* while */ +} + +/* + * Reads into the primary register the variable pointed to by lval if + * plunging through the hierarchy levels detected an lvalue. Otherwise + * if a constant was detected, it is loaded. If there is no constant and + * no lvalue, the primary register must already contain the expression + * result. + * + * After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which + * compare the primary register against 0, and jump to the "early drop-out" + * label "exit1" if the condition is true. + */ +static void +dropout(int lvalue, void (*testfunc) (int val), int exit1, value * lval) +{ + if (lvalue) + rvalue(lval); + else if (lval->ident == iCONSTEXPR) + const1(lval->constval); + (*testfunc) (exit1); +} + +static void +checkfunction(value * lval) +{ + symbol *sym = lval->sym; + + if (!sym || (sym->ident != iFUNCTN && sym->ident != iREFFUNC)) + return; /* no known symbol, or not a function result */ + + if ((sym->usage & uDEFINE) != 0) + { + /* function is defined, can now check the return value (but make an + * exception for directly recursive functions) + */ + if (sym != curfunc && (sym->usage & uRETVALUE) == 0) + { + char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */ + + funcdisplayname(symname, sym->name); + error(209, symname); /* function should return a value */ + } /* if */ + } + else + { + /* function not yet defined, set */ + sym->usage |= uRETVALUE; /* make sure that a future implementation of + * the function uses "return " */ + } /* if */ +} + +/* + * Plunge to a lower level + */ +static int +plnge(int *opstr, int opoff, int (*hier) (value * lval), value * lval, + char *forcetag, int chkbitwise) +{ + int lvalue, opidx; + int count; + value lval2 = { NULL, 0, 0, 0, 0, NULL }; + + lvalue = plnge1(hier, lval); + if (nextop(&opidx, opstr) == 0) + return lvalue; /* no operator in "opstr" found */ + if (lvalue) + rvalue(lval); + count = 0; + do + { + if (chkbitwise && count++ > 0 && bitwise_opercount != 0) + error(212); + opidx += opoff; /* add offset to index returned by nextop() */ + plnge2(op1[opidx], hier, lval, &lval2); + if (op1[opidx] == ob_and || op1[opidx] == ob_or) + bitwise_opercount++; + if (forcetag) + lval->tag = sc_addtag(forcetag); + } + while (nextop(&opidx, opstr)); /* do */ + return FALSE; /* result of expression is not an lvalue */ +} + +/* plnge_rel + * + * Binary plunge to lower level; this is very simular to plnge, but + * it has special code generation sequences for chained operations. + */ +static int +plnge_rel(int *opstr, int opoff, int (*hier) (value * lval), value * lval) +{ + int lvalue, opidx; + value lval2 = { NULL, 0, 0, 0, 0, NULL }; + int count; + + /* this function should only be called for relational operators */ + assert(op1[opoff] == os_le); + lvalue = plnge1(hier, lval); + if (nextop(&opidx, opstr) == 0) + return lvalue; /* no operator in "opstr" found */ + if (lvalue) + rvalue(lval); + count = 0; + lval->boolresult = TRUE; + do + { + /* same check as in plnge(), but "chkbitwise" is always TRUE */ + if (count > 0 && bitwise_opercount != 0) + error(212); + if (count > 0) + { + relop_prefix(); + *lval = lval2; /* copy right hand expression of the previous iteration */ + } /* if */ + opidx += opoff; + plnge2(op1[opidx], hier, lval, &lval2); + if (count++ > 0) + relop_suffix(); + } + while (nextop(&opidx, opstr)); /* enddo */ + lval->constval = lval->boolresult; + lval->tag = sc_addtag("bool"); /* force tag to be "bool" */ + return FALSE; /* result of expression is not an lvalue */ +} + +/* plnge1 + * + * Unary plunge to lower level + * Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13() + */ +static int +plnge1(int (*hier) (value * lval), value * lval) +{ + int lvalue, index; + cell cidx; + + stgget(&index, &cidx); /* mark position in code generator */ + lvalue = (*hier) (lval); + if (lval->ident == iCONSTEXPR) + stgdel(index, cidx); /* load constant later */ + return lvalue; +} + +/* plnge2 + * + * Binary plunge to lower level + * Called by: plnge(), plnge_rel(), hier14() and hier1() + */ +static void +plnge2(void (*oper) (void), + int (*hier) (value * lval), value * lval1, value * lval2) +{ + int index; + cell cidx; + + stgget(&index, &cidx); /* mark position in code generator */ + if (lval1->ident == iCONSTEXPR) + { /* constant on left side; it is not yet loaded */ + if (plnge1(hier, lval2)) + rvalue(lval2); /* load lvalue now */ + else if (lval2->ident == iCONSTEXPR) + const1(lval2->constval << dbltest(oper, lval2, lval1)); + const2(lval1->constval << dbltest(oper, lval2, lval1)); + /* ^ doubling of constants operating on integer addresses */ + /* is restricted to "add" and "subtract" operators */ + } + else + { /* non-constant on left side */ + push1(); + if (plnge1(hier, lval2)) + rvalue(lval2); + if (lval2->ident == iCONSTEXPR) + { /* constant on right side */ + if (commutative(oper)) + { /* test for commutative operators */ + value lvaltmp = { NULL, 0, 0, 0, 0, NULL }; + stgdel(index, cidx); /* scratch push1() and constant fetch (then + * fetch the constant again */ + const2(lval2->constval << dbltest(oper, lval1, lval2)); + /* now, the primary register has the left operand and the secondary + * register the right operand; swap the "lval" variables so that lval1 + * is associated with the secondary register and lval2 with the + * primary register, as is the "normal" case. + */ + lvaltmp = *lval1; + *lval1 = *lval2; + *lval2 = lvaltmp; + } + else + { + const1(lval2->constval << dbltest(oper, lval1, lval2)); + pop2(); /* pop result of left operand into secondary register */ + } /* if */ + } + else + { /* non-constants on both sides */ + pop2(); + if (dbltest(oper, lval1, lval2)) + cell2addr(); /* double primary register */ + if (dbltest(oper, lval2, lval1)) + cell2addr_alt(); /* double secondary register */ + } /* if */ + } /* if */ + if (oper) + { + /* If used in an expression, a function should return a value. + * If the function has been defined, we can check this. If the + * function was not defined, we can set this requirement (so that + * a future function definition can check this bit. + */ + checkfunction(lval1); + checkfunction(lval2); + if (lval1->ident == iARRAY || lval1->ident == iREFARRAY) + { + char *ptr = + (lval1->sym) ? lval1->sym->name : "-unknown-"; + error(33, ptr); /* array must be indexed */ + } + else if (lval2->ident == iARRAY || lval2->ident == iREFARRAY) + { + char *ptr = + (lval2->sym) ? lval2->sym->name : "-unknown-"; + error(33, ptr); /* array must be indexed */ + } /* if */ + /* ??? ^^^ should do same kind of error checking with functions */ + + /* check whether an "operator" function is defined for the tag names + * (a constant expression cannot be optimized in that case) + */ + if (check_userop(oper, lval1->tag, lval2->tag, 2, NULL, &lval1->tag)) + { + lval1->ident = iEXPRESSION; + lval1->constval = 0; + } + else if (lval1->ident == iCONSTEXPR && lval2->ident == iCONSTEXPR) + { + /* only constant expression if both constant */ + stgdel(index, cidx); /* scratch generated code and calculate */ + if (!matchtag(lval1->tag, lval2->tag, FALSE)) + error(213); /* tagname mismatch */ + lval1->constval = + calc(lval1->constval, oper, lval2->constval, + &lval1->boolresult); + } + else + { + if (!matchtag(lval1->tag, lval2->tag, FALSE)) + error(213); /* tagname mismatch */ + (*oper) (); /* do the (signed) operation */ + lval1->ident = iEXPRESSION; + } /* if */ + } /* if */ +} + +static cell +truemodulus(cell a, cell b) +{ + return (a % b + b) % b; +} + +static cell +calc(cell left, void (*oper) (), cell right, char *boolresult) +{ + if (oper == ob_or) + return (left | right); + else if (oper == ob_xor) + return (left ^ right); + else if (oper == ob_and) + return (left & right); + else if (oper == ob_eq) + return (left == right); + else if (oper == ob_ne) + return (left != right); + else if (oper == os_le) + return *boolresult &= (char)(left <= right), right; + else if (oper == os_ge) + return *boolresult &= (char)(left >= right), right; + else if (oper == os_lt) + return *boolresult &= (char)(left < right), right; + else if (oper == os_gt) + return *boolresult &= (char)(left > right), right; + else if (oper == os_sar) + return (left >> (int)right); + else if (oper == ou_sar) + return ((ucell) left >> (ucell) right); + else if (oper == ob_sal) + return ((ucell) left << (int)right); + else if (oper == ob_add) + return (left + right); + else if (oper == ob_sub) + return (left - right); + else if (oper == os_mult) + return (left * right); + else if (oper == os_div) + return (left - truemodulus(left, right)) / right; + else if (oper == os_mod) + return truemodulus(left, right); + else + error(29); /* invalid expression, assumed 0 (this should never occur) */ + return 0; +} + +int +expression(int *constant, cell * val, int *tag, int chkfuncresult) +{ + value lval = { NULL, 0, 0, 0, 0, NULL }; + + if (hier14(&lval)) + rvalue(&lval); + if (lval.ident == iCONSTEXPR) + { /* constant expression */ + *constant = TRUE; + *val = lval.constval; + } + else + { + *constant = FALSE; + *val = 0; + } /* if */ + if (tag) + *tag = lval.tag; + if (chkfuncresult) + checkfunction(&lval); + return lval.ident; +} + +static cell +array_totalsize(symbol * sym) +{ + cell length; + + assert(sym != NULL); + assert(sym->ident == iARRAY || sym->ident == iREFARRAY); + length = sym->dim.array.length; + if (sym->dim.array.level > 0) + { + cell sublength = array_totalsize(finddepend(sym)); + + if (sublength > 0) + length = length + length * sublength; + else + length = 0; + } /* if */ + return length; +} + +static cell +array_levelsize(symbol * sym, int level) +{ + assert(sym != NULL); + assert(sym->ident == iARRAY || sym->ident == iREFARRAY); + assert(level <= sym->dim.array.level); + while (level-- > 0) + { + sym = finddepend(sym); + assert(sym != NULL); + } /* if */ + return sym->dim.array.length; +} + +/* hier14 + * + * Lowest hierarchy level (except for the , operator). + * + * Global references: intest (referred to only) + */ +int +hier14(value * lval1) +{ + int lvalue; + value lval2 = { NULL, 0, 0, 0, 0, NULL }; + value lval3 = { NULL, 0, 0, 0, 0, NULL }; + void (*oper) (void); + int tok, level, i; + cell val; + char *st; + int bwcount; + cell arrayidx1[sDIMEN_MAX], arrayidx2[sDIMEN_MAX]; /* last used array indices */ + cell *org_arrayidx; + + bwcount = bitwise_opercount; + bitwise_opercount = 0; + for (i = 0; i < sDIMEN_MAX; i++) + arrayidx1[i] = arrayidx2[i] = 0; + org_arrayidx = lval1->arrayidx; /* save current pointer, to reset later */ + if (!lval1->arrayidx) + lval1->arrayidx = arrayidx1; + lvalue = plnge1(hier13, lval1); + if (lval1->ident != iARRAYCELL && lval1->ident != iARRAYCHAR) + lval1->arrayidx = NULL; + if (lval1->ident == iCONSTEXPR) /* load constant here */ + const1(lval1->constval); + tok = lex(&val, &st); + switch (tok) + { + case taOR: + oper = ob_or; + break; + case taXOR: + oper = ob_xor; + break; + case taAND: + oper = ob_and; + break; + case taADD: + oper = ob_add; + break; + case taSUB: + oper = ob_sub; + break; + case taMULT: + oper = os_mult; + break; + case taDIV: + oper = os_div; + break; + case taMOD: + oper = os_mod; + break; + case taSHRU: + oper = ou_sar; + break; + case taSHR: + oper = os_sar; + break; + case taSHL: + oper = ob_sal; + break; + case '=': /* simple assignment */ + oper = NULL; + if (intest) + error(211); /* possibly unintended assignment */ + break; + default: + lexpush(); + bitwise_opercount = bwcount; + lval1->arrayidx = org_arrayidx; /* restore array index pointer */ + return lvalue; + } /* switch */ + + /* if we get here, it was an assignment; first check a few special cases + * and then the general */ + if (lval1->ident == iARRAYCHAR) + { + /* special case, assignment to packed character in a cell is permitted */ + lvalue = TRUE; + } + else if (lval1->ident == iARRAY || lval1->ident == iREFARRAY) + { + /* array assignment is permitted too (with restrictions) */ + if (oper) + return error(23); /* array assignment must be simple assigment */ + assert(lval1->sym != NULL); + if (array_totalsize(lval1->sym) == 0) + return error(46, lval1->sym->name); /* unknown array size */ + lvalue = TRUE; + } /* if */ + + /* operand on left side of assignment must be lvalue */ + if (!lvalue) + return error(22); /* must be lvalue */ + /* may not change "constant" parameters */ + assert(lval1->sym != NULL); + if ((lval1->sym->usage & uCONST) != 0) + return error(22); /* assignment to const argument */ + lval3 = *lval1; /* save symbol to enable storage of expresion result */ + lval1->arrayidx = org_arrayidx; /* restore array index pointer */ + if (lval1->ident == iARRAYCELL || lval1->ident == iARRAYCHAR + || lval1->ident == iARRAY || lval1->ident == iREFARRAY) + { + /* if indirect fetch: save PRI (cell address) */ + if (oper) + { + push1(); + rvalue(lval1); + } /* if */ + lval2.arrayidx = arrayidx2; + plnge2(oper, hier14, lval1, &lval2); + if (lval2.ident != iARRAYCELL && lval2.ident != iARRAYCHAR) + lval2.arrayidx = NULL; + if (oper) + pop2(); + if (!oper && lval3.arrayidx && lval2.arrayidx + && lval3.ident == lval2.ident && lval3.sym == lval2.sym) + { + int same = TRUE; + + assert(lval3.arrayidx == arrayidx1); + assert(lval2.arrayidx == arrayidx2); + for (i = 0; i < sDIMEN_MAX; i++) + same = same && (lval3.arrayidx[i] == lval2.arrayidx[i]); + if (same) + error(226, lval3.sym->name); /* self-assignment */ + } /* if */ + } + else + { + if (oper) + { + rvalue(lval1); + plnge2(oper, hier14, lval1, &lval2); + } + else + { + /* if direct fetch and simple assignment: no "push" + * and "pop" needed -> call hier14() directly, */ + if (hier14(&lval2)) + rvalue(&lval2); /* instead of plnge2(). */ + checkfunction(&lval2); + /* check whether lval2 and lval3 (old lval1) refer to the same variable */ + if (lval2.ident == iVARIABLE && lval3.ident == lval2.ident + && lval3.sym == lval2.sym) + { + assert(lval3.sym != NULL); + error(226, lval3.sym->name); /* self-assignment */ + } /* if */ + } /* if */ + } /* if */ + if (lval3.ident == iARRAY || lval3.ident == iREFARRAY) + { + /* left operand is an array, right operand should be an array variable + * of the same size and the same dimension, an array literal (of the + * same size) or a literal string. + */ + int exactmatch = TRUE; + + if (lval2.ident != iARRAY && lval2.ident != iREFARRAY) + error(33, lval3.sym->name); /* array must be indexed */ + if (lval2.sym) + { + val = lval2.sym->dim.array.length; /* array variable */ + level = lval2.sym->dim.array.level; + } + else + { + val = lval2.constval; /* literal array */ + level = 0; + /* If val is negative, it means that lval2 is a + * literal string. The string array size may be + * smaller than the destination array. + */ + if (val < 0) + { + val = -val; + exactmatch = FALSE; + } /* if */ + } /* if */ + if (lval3.sym->dim.array.level != level) + return error(48); /* array dimensions must match */ + else if (lval3.sym->dim.array.length < val + || (exactmatch && lval3.sym->dim.array.length > val)) + return error(47); /* array sizes must match */ + if (level > 0) + { + /* check the sizes of all sublevels too */ + symbol *sym1 = lval3.sym; + symbol *sym2 = lval2.sym; + int i; + + assert(sym1 != NULL && sym2 != NULL); + /* ^^^ sym2 must be valid, because only variables can be + * multi-dimensional (there are no multi-dimensional arrays), + * sym1 must be valid because it must be an lvalue + */ + assert(exactmatch); + for (i = 0; i < level; i++) + { + sym1 = finddepend(sym1); + sym2 = finddepend(sym2); + assert(sym1 != NULL && sym2 != NULL); + /* ^^^ both arrays have the same dimensions (this was checked + * earlier) so the dependend should always be found + */ + if (sym1->dim.array.length != sym2->dim.array.length) + error(47); /* array sizes must match */ + } /* for */ + /* get the total size in cells of the multi-dimensional array */ + val = array_totalsize(lval3.sym); + assert(val > 0); /* already checked */ + } /* if */ + } + else + { + /* left operand is not an array, right operand should then not be either */ + if (lval2.ident == iARRAY || lval2.ident == iREFARRAY) + error(6); /* must be assigned to an array */ + } /* if */ + if (lval3.ident == iARRAY || lval3.ident == iREFARRAY) + { + memcopy(val * sizeof(cell)); + } + else + { + check_userop(NULL, lval2.tag, lval3.tag, 2, &lval3, &lval2.tag); + store(&lval3); /* now, store the expression result */ + } /* if */ + if (!oper && !matchtag(lval3.tag, lval2.tag, TRUE)) + error(213); /* tagname mismatch (if "oper", warning already given in plunge2()) */ + if (lval3.sym) + markusage(lval3.sym, uWRITTEN); + sideeffect = TRUE; + bitwise_opercount = bwcount; + return FALSE; /* expression result is never an lvalue */ +} + +static int +hier13(value * lval) +{ + int lvalue, flab1, flab2; + value lval2 = { NULL, 0, 0, 0, 0, NULL }; + int array1, array2; + + lvalue = plnge1(hier12, lval); + if (matchtoken('?')) + { + flab1 = getlabel(); + flab2 = getlabel(); + if (lvalue) + { + rvalue(lval); + } + else if (lval->ident == iCONSTEXPR) + { + const1(lval->constval); + error(lval->constval ? 206 : 205); /* redundant test */ + } /* if */ + jmp_eq0(flab1); /* go to second expression if primary register==0 */ + if (hier14(lval)) + rvalue(lval); + jumplabel(flab2); + setlabel(flab1); + needtoken(':'); + if (hier14(&lval2)) + rvalue(&lval2); + array1 = (lval->ident == iARRAY || lval->ident == iREFARRAY); + array2 = (lval2.ident == iARRAY || lval2.ident == iREFARRAY); + if (array1 && !array2) + { + char *ptr = + (lval->sym->name) ? lval->sym->name : "-unknown-"; + error(33, ptr); /* array must be indexed */ + } + else if (!array1 && array2) + { + char *ptr = + (lval2.sym->name) ? lval2.sym->name : "-unknown-"; + error(33, ptr); /* array must be indexed */ + } /* if */ + /* ??? if both are arrays, should check dimensions */ + if (!matchtag(lval->tag, lval2.tag, FALSE)) + error(213); /* tagname mismatch ('true' and 'false' expressions) */ + setlabel(flab2); + if (lval->ident == iARRAY) + lval->ident = iREFARRAY; /* iARRAY becomes iREFARRAY */ + else if (lval->ident != iREFARRAY) + lval->ident = iEXPRESSION; /* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */ + return FALSE; /* conditional expression is no lvalue */ + } + else + { + return lvalue; + } /* endif */ +} + +/* the order of the operators in these lists is important and must cohere */ +/* with the order of the operators in the array "op1" */ +static int list3[] = { '*', '/', '%', 0 }; +static int list4[] = { '+', '-', 0 }; +static int list5[] = { tSHL, tSHR, tSHRU, 0 }; +static int list6[] = { '&', 0 }; +static int list7[] = { '^', 0 }; +static int list8[] = { '|', 0 }; +static int list9[] = { tlLE, tlGE, '<', '>', 0 }; +static int list10[] = { tlEQ, tlNE, 0 }; +static int list11[] = { tlAND, 0 }; +static int list12[] = { tlOR, 0 }; + +static int +hier12(value * lval) +{ + return skim(list12, jmp_ne0, 1, 0, hier11, lval); +} + +static int +hier11(value * lval) +{ + return skim(list11, jmp_eq0, 0, 1, hier10, lval); +} + +static int +hier10(value * lval) +{ /* ==, != */ + return plnge(list10, 15, hier9, lval, "bool", TRUE); +} /* ^ this variable is the starting index in the op1[] + * array of the operators of this hierarchy level */ + +static int +hier9(value * lval) +{ /* <=, >=, <, > */ + return plnge_rel(list9, 11, hier8, lval); +} + +static int +hier8(value * lval) +{ /* | */ + return plnge(list8, 10, hier7, lval, NULL, FALSE); +} + +static int +hier7(value * lval) +{ /* ^ */ + return plnge(list7, 9, hier6, lval, NULL, FALSE); +} + +static int +hier6(value * lval) +{ /* & */ + return plnge(list6, 8, hier5, lval, NULL, FALSE); +} + +static int +hier5(value * lval) +{ /* <<, >>, >>> */ + return plnge(list5, 5, hier4, lval, NULL, FALSE); +} + +static int +hier4(value * lval) +{ /* +, - */ + return plnge(list4, 3, hier3, lval, NULL, FALSE); +} + +static int +hier3(value * lval) +{ /* *, /, % */ + return plnge(list3, 0, hier2, lval, NULL, FALSE); +} + +static int +hier2(value * lval) +{ + int lvalue, tok; + int tag, paranthese; + cell val; + char *st; + symbol *sym; + int saveresult; + + tok = lex(&val, &st); + switch (tok) + { + case tINC: /* ++lval */ + if (!hier2(lval)) + return error(22); /* must be lvalue */ + assert(lval->sym != NULL); + if ((lval->sym->usage & uCONST) != 0) + return error(22); /* assignment to const argument */ + if (!check_userop(user_inc, lval->tag, 0, 1, lval, &lval->tag)) + inc(lval); /* increase variable first */ + rvalue(lval); /* and read the result into PRI */ + sideeffect = TRUE; + return FALSE; /* result is no longer lvalue */ + case tDEC: /* --lval */ + if (!hier2(lval)) + return error(22); /* must be lvalue */ + assert(lval->sym != NULL); + if ((lval->sym->usage & uCONST) != 0) + return error(22); /* assignment to const argument */ + if (!check_userop(user_dec, lval->tag, 0, 1, lval, &lval->tag)) + dec(lval); /* decrease variable first */ + rvalue(lval); /* and read the result into PRI */ + sideeffect = TRUE; + return FALSE; /* result is no longer lvalue */ + case '~': /* ~ (one's complement) */ + if (hier2(lval)) + rvalue(lval); + invert(); /* bitwise NOT */ + lval->constval = ~lval->constval; + return FALSE; + case '!': /* ! (logical negate) */ + if (hier2(lval)) + rvalue(lval); + if (check_userop(lneg, lval->tag, 0, 1, NULL, &lval->tag)) + { + lval->ident = iEXPRESSION; + lval->constval = 0; + } + else + { + lneg(); /* 0 -> 1, !0 -> 0 */ + lval->constval = !lval->constval; + lval->tag = sc_addtag("bool"); + } /* if */ + return FALSE; + case '-': /* unary - (two's complement) */ + if (hier2(lval)) + rvalue(lval); + /* make a special check for a constant expression with the tag of a + * rational number, so that we can simple swap the sign of that constant. + */ + if (lval->ident == iCONSTEXPR && lval->tag == sc_rationaltag + && sc_rationaltag != 0) + { + if (rational_digits == 0) + { + float *f = (float *)&lval->constval; + + *f = -*f; /* this modifies lval->constval */ + } + else + { + /* the negation of a fixed point number is just an integer negation */ + lval->constval = -lval->constval; + } /* if */ + } + else if (check_userop(neg, lval->tag, 0, 1, NULL, &lval->tag)) + { + lval->ident = iEXPRESSION; + lval->constval = 0; + } + else + { + neg(); /* arithmic negation */ + lval->constval = -lval->constval; + } /* if */ + return FALSE; + case tLABEL: /* tagname override */ + tag = sc_addtag(st); + lvalue = hier2(lval); + lval->tag = tag; + return lvalue; + case tDEFINED: + paranthese = 0; + while (matchtoken('(')) + paranthese++; + tok = lex(&val, &st); + if (tok != tSYMBOL) + return error(20, st); /* illegal symbol name */ + sym = findloc(st); + if (!sym) + sym = findglb(st); + if (sym && sym->ident != iFUNCTN && sym->ident != iREFFUNC + && (sym->usage & uDEFINE) == 0) + sym = NULL; /* symbol is not a function, it is in the table, but not "defined" */ + val = !!sym; + if (!val && find_subst(st, strlen(st))) + val = 1; + clear_value(lval); + lval->ident = iCONSTEXPR; + lval->constval = val; + const1(lval->constval); + while (paranthese--) + needtoken(')'); + return FALSE; + case tSIZEOF: + paranthese = 0; + while (matchtoken('(')) + paranthese++; + tok = lex(&val, &st); + if (tok != tSYMBOL) + return error(20, st); /* illegal symbol name */ + sym = findloc(st); + if (!sym) + sym = findglb(st); + if (!sym) + return error(17, st); /* undefined symbol */ + if (sym->ident == iCONSTEXPR) + error(39); /* constant symbol has no size */ + else if (sym->ident == iFUNCTN || sym->ident == iREFFUNC) + error(72); /* "function" symbol has no size */ + else if ((sym->usage & uDEFINE) == 0) + return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */ + clear_value(lval); + lval->ident = iCONSTEXPR; + lval->constval = 1; /* preset */ + if (sym->ident == iARRAY || sym->ident == iREFARRAY) + { + int level; + + for (level = 0; matchtoken('['); level++) + needtoken(']'); + if (level > sym->dim.array.level) + error(28); /* invalid subscript */ + else + lval->constval = array_levelsize(sym, level); + if (lval->constval == 0 && !strchr(lptr, PREPROC_TERM)) + error(224, st); /* indeterminate array size in "sizeof" expression */ + } /* if */ + const1(lval->constval); + while (paranthese--) + needtoken(')'); + return FALSE; + case tTAGOF: + paranthese = 0; + while (matchtoken('(')) + paranthese++; + tok = lex(&val, &st); + if (tok != tSYMBOL && tok != tLABEL) + return error(20, st); /* illegal symbol name */ + if (tok == tLABEL) + { + tag = sc_addtag(st); + } + else + { + sym = findloc(st); + if (!sym) + sym = findglb(st); + if (!sym) + return error(17, st); /* undefined symbol */ + if ((sym->usage & uDEFINE) == 0) + return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */ + tag = sym->tag; + } /* if */ + exporttag(tag); + clear_value(lval); + lval->ident = iCONSTEXPR; + lval->constval = tag; + const1(lval->constval); + while (paranthese--) + needtoken(')'); + return FALSE; + default: + lexpush(); + lvalue = hier1(lval); + /* check for postfix operators */ + if (matchtoken(';')) + { + /* Found a ';', do not look further for postfix operators */ + lexpush(); /* push ';' back after successful match */ + return lvalue; + } + else if (matchtoken(tTERM)) + { + /* Found a newline that ends a statement (this is the case when + * semicolons are optional). Note that an explicit semicolon was + * handled above. This case is similar, except that the token must + * not be pushed back. + */ + return lvalue; + } + else + { + tok = lex(&val, &st); + switch (tok) + { + case tINC: /* lval++ */ + if (!lvalue) + return error(22); /* must be lvalue */ + assert(lval->sym != NULL); + if ((lval->sym->usage & uCONST) != 0) + return error(22); /* assignment to const argument */ + /* on incrementing array cells, the address in PRI must be saved for + * incremening the value, whereas the current value must be in PRI + * on exit. + */ + saveresult = (lval->ident == iARRAYCELL + || lval->ident == iARRAYCHAR); + if (saveresult) + push1(); /* save address in PRI */ + rvalue(lval); /* read current value into PRI */ + if (saveresult) + swap1(); /* save PRI on the stack, restore address in PRI */ + if (!check_userop + (user_inc, lval->tag, 0, 1, lval, &lval->tag)) + inc(lval); /* increase variable afterwards */ + if (saveresult) + pop1(); /* restore PRI (result of rvalue()) */ + sideeffect = TRUE; + return FALSE; /* result is no longer lvalue */ + case tDEC: /* lval-- */ + if (!lvalue) + return error(22); /* must be lvalue */ + assert(lval->sym != NULL); + if ((lval->sym->usage & uCONST) != 0) + return error(22); /* assignment to const argument */ + saveresult = (lval->ident == iARRAYCELL + || lval->ident == iARRAYCHAR); + if (saveresult) + push1(); /* save address in PRI */ + rvalue(lval); /* read current value into PRI */ + if (saveresult) + swap1(); /* save PRI on the stack, restore address in PRI */ + if (!check_userop + (user_dec, lval->tag, 0, 1, lval, &lval->tag)) + dec(lval); /* decrease variable afterwards */ + if (saveresult) + pop1(); /* restore PRI (result of rvalue()) */ + sideeffect = TRUE; + return FALSE; + case tCHAR: /* char (compute required # of cells */ + if (lval->ident == iCONSTEXPR) + { + lval->constval *= charbits / 8; /* from char to bytes */ + lval->constval = + (lval->constval + sizeof(cell) - 1) / sizeof(cell); + } + else + { + if (lvalue) + rvalue(lval); /* fetch value if not already in PRI */ + char2addr(); /* from characters to bytes */ + addconst(sizeof(cell) - 1); /* make sure the value is rounded up */ + addr2cell(); /* truncate to number of cells */ + } /* if */ + return FALSE; + default: + lexpush(); + return lvalue; + } /* switch */ + } /* if */ + } /* switch */ +} + +/* hier1 + * + * The highest hierarchy level: it looks for pointer and array indices + * and function calls. + * Generates code to fetch a pointer value if it is indexed and code to + * add to the pointer value or the array address (the address is already + * read at primary()). It also generates code to fetch a function address + * if that hasn't already been done at primary() (check lval[4]) and calls + * callfunction() to call the function. + */ +static int +hier1(value * lval1) +{ + int lvalue, index, tok, symtok; + cell val, cidx; + value lval2 = { NULL, 0, 0, 0, 0, NULL }; + char *st; + char close; + symbol *sym; + + lvalue = primary(lval1); + symtok = tokeninfo(&val, &st); /* get token read by primary() */ + restart: + sym = lval1->sym; + if (matchtoken('[') || matchtoken('{') || matchtoken('(')) + { + tok = tokeninfo(&val, &st); /* get token read by matchtoken() */ + if (!sym && symtok != tSYMBOL) + { + /* we do not have a valid symbol and we appear not to have read a valid + * symbol name (so it is unlikely that we would have read a name of an + * undefined symbol) */ + error(29); /* expression error, assumed 0 */ + lexpush(); /* analyse '(', '{' or '[' again later */ + return FALSE; + } /* if */ + if (tok == '[' || tok == '{') + { /* subscript */ + close = (char)((tok == '[') ? ']' : '}'); + if (!sym) + { /* sym==NULL if lval is a constant or a literal */ + error(28); /* cannot subscript */ + needtoken(close); + return FALSE; + } + else if (sym->ident != iARRAY && sym->ident != iREFARRAY) + { + error(28); /* cannot subscript, variable is not an array */ + needtoken(close); + return FALSE; + } + else if (sym->dim.array.level > 0 && close != ']') + { + error(51); /* invalid subscript, must use [ ] */ + needtoken(close); + return FALSE; + } /* if */ + stgget(&index, &cidx); /* mark position in code generator */ + push1(); /* save base address of the array */ + if (hier14(&lval2)) /* create expression for the array index */ + rvalue(&lval2); + if (lval2.ident == iARRAY || lval2.ident == iREFARRAY) + error(33, lval2.sym->name); /* array must be indexed */ + needtoken(close); + if (!matchtag(sym->x.idxtag, lval2.tag, TRUE)) + error(213); + if (lval2.ident == iCONSTEXPR) + { /* constant expression */ + stgdel(index, cidx); /* scratch generated code */ + if (lval1->arrayidx) + { /* keep constant index, for checking */ + assert(sym->dim.array.level >= 0 + && sym->dim.array.level < sDIMEN_MAX); + lval1->arrayidx[sym->dim.array.level] = lval2.constval; + } /* if */ + if (close == ']') + { + /* normal array index */ + if (lval2.constval < 0 || (sym->dim.array.length != 0 + && sym->dim.array.length <= lval2.constval)) + error(32, sym->name); /* array index out of bounds */ + if (lval2.constval != 0) + { + /* don't add offsets for zero subscripts */ +#if defined(BIT16) + const2(lval2.constval << 1); +#else + const2(lval2.constval << 2); +#endif + ob_add(); + } /* if */ + } + else + { + /* character index */ + if (lval2.constval < 0 || (sym->dim.array.length != 0 + && sym->dim.array.length * ((8 * sizeof(cell)) / + charbits) <= + (ucell) lval2.constval)) + error(32, sym->name); /* array index out of bounds */ + if (lval2.constval != 0) + { + /* don't add offsets for zero subscripts */ + if (charbits == 16) + const2(lval2.constval << 1); /* 16-bit character */ + else + const2(lval2.constval); /* 8-bit character */ + ob_add(); + } /* if */ + charalign(); /* align character index into array */ + } /* if */ + } + else + { + /* array index is not constant */ + lval1->arrayidx = NULL; /* reset, so won't be checked */ + if (close == ']') + { + if (sym->dim.array.length != 0) + ffbounds(sym->dim.array.length - 1); /* run time check for array bounds */ + cell2addr(); /* normal array index */ + } + else + { + if (sym->dim.array.length != 0) + ffbounds(sym->dim.array.length * (32 / charbits) - 1); + char2addr(); /* character array index */ + } /* if */ + pop2(); + ob_add(); /* base address was popped into secondary register */ + if (close != ']') + charalign(); /* align character index into array */ + } /* if */ + /* the indexed item may be another array (multi-dimensional arrays) */ + assert(lval1->sym == sym && sym != NULL); /* should still be set */ + if (sym->dim.array.level > 0) + { + assert(close == ']'); /* checked earlier */ + /* read the offset to the subarray and add it to the current address */ + lval1->ident = iARRAYCELL; + push1(); /* the optimizer makes this to a MOVE.alt */ + rvalue(lval1); + pop2(); + ob_add(); + /* adjust the "value" structure and find the referenced array */ + lval1->ident = iREFARRAY; + lval1->sym = finddepend(sym); + assert(lval1->sym != NULL); + assert(lval1->sym->dim.array.level == + sym->dim.array.level - 1); + /* try to parse subsequent array indices */ + lvalue = FALSE; /* for now, a iREFARRAY is no lvalue */ + goto restart; + } /* if */ + assert(sym->dim.array.level == 0); + /* set type to fetch... INDIRECTLY */ + lval1->ident = (char)((close == ']') ? iARRAYCELL : iARRAYCHAR); + lval1->tag = sym->tag; + /* a cell in an array is an lvalue, a character in an array is not + * always a *valid* lvalue */ + return TRUE; + } + else + { /* tok=='(' -> function(...) */ + if (!sym + || (sym->ident != iFUNCTN && sym->ident != iREFFUNC)) + { + if (!sym && sc_status == statFIRST) + { + /* could be a "use before declaration"; in that case, create a stub + * function so that the usage can be marked. + */ + sym = fetchfunc(lastsymbol, 0); + if (sym) + markusage(sym, uREAD); + } /* if */ + return error(12); /* invalid function call */ + } + else if ((sym->usage & uMISSING) != 0) + { + char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */ + + funcdisplayname(symname, sym->name); + error(4, symname); /* function not defined */ + } /* if */ + callfunction(sym); + lval1->ident = iEXPRESSION; + lval1->constval = 0; + lval1->tag = sym->tag; + return FALSE; /* result of function call is no lvalue */ + } /* if */ + } /* if */ + if (sym && lval1->ident == iFUNCTN) + { + assert(sym->ident == iFUNCTN); + address(sym); + lval1->sym = NULL; + lval1->ident = iREFFUNC; + /* ??? however... function pointers (or function references are not (yet) allowed */ + error(29); /* expression error, assumed 0 */ + return FALSE; + } /* if */ + return lvalue; +} + +/* primary + * + * Returns 1 if the operand is an lvalue (everything except arrays, functions + * constants and -of course- errors). + * Generates code to fetch the address of arrays. Code for constants is + * already generated by constant(). + * This routine first clears the entire lval array (all fields are set to 0). + * + * Global references: intest (may be altered, but restored upon termination) + */ +static int +primary(value * lval) +{ + char *st; + int lvalue, tok; + cell val; + symbol *sym; + + if (matchtoken('(')) + { /* sub-expression - (expression,...) */ + pushstk((stkitem) intest); + pushstk((stkitem) sc_allowtags); + + intest = 0; /* no longer in "test" expression */ + sc_allowtags = TRUE; /* allow tagnames to be used in parenthised expressions */ + do + lvalue = hier14(lval); + while (matchtoken(',')); + needtoken(')'); + lexclr(FALSE); /* clear lex() push-back, it should have been + * cleared already by needtoken() */ + sc_allowtags = (int)(long)popstk(); + intest = (int)(long)popstk(); + return lvalue; + } /* if */ + + clear_value(lval); /* clear lval */ + tok = lex(&val, &st); + if (tok == tSYMBOL) + { + /* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol + * to sNAMEMAX significant characters */ + assert(strlen(st) < sizeof lastsymbol); + strcpy(lastsymbol, st); + } /* if */ + if (tok == tSYMBOL && !findconst(st)) + { + /* first look for a local variable */ + if ((sym = findloc(st))) + { + if (sym->ident == iLABEL) + { + error(29); /* expression error, assumed 0 */ + const1(0); /* load 0 */ + return FALSE; /* return 0 for labels (expression error) */ + } /* if */ + lval->sym = sym; + lval->ident = sym->ident; + lval->tag = sym->tag; + if (sym->ident == iARRAY || sym->ident == iREFARRAY) + { + address(sym); /* get starting address in primary register */ + return FALSE; /* return 0 for array (not lvalue) */ + } + else + { + return TRUE; /* return 1 if lvalue (not label or array) */ + } /* if */ + } /* if */ + /* now try a global variable */ + if ((sym = findglb(st))) + { + if (sym->ident == iFUNCTN || sym->ident == iREFFUNC) + { + /* if the function is only in the table because it was inserted as a + * stub in the first pass (i.e. it was "used" but never declared or + * implemented, issue an error + */ + if ((sym->usage & uPROTOTYPED) == 0) + error(17, st); + } + else + { + if ((sym->usage & uDEFINE) == 0) + error(17, st); + lval->sym = sym; + lval->ident = sym->ident; + lval->tag = sym->tag; + if (sym->ident == iARRAY || sym->ident == iREFARRAY) + { + address(sym); /* get starting address in primary register */ + return FALSE; /* return 0 for array (not lvalue) */ + } + else + { + return TRUE; /* return 1 if lvalue (not function or array) */ + } /* if */ + } /* if */ + } + else + { + return error(17, st); /* undefined symbol */ + } /* endif */ + assert(sym != NULL); + assert(sym->ident == iFUNCTN || sym->ident != iREFFUNC); + lval->sym = sym; + lval->ident = sym->ident; + lval->tag = sym->tag; + return FALSE; /* return 0 for function (not an lvalue) */ + } /* if */ + lexpush(); /* push the token, it is analyzed by constant() */ + if (constant(lval) == 0) + { + error(29); /* expression error, assumed 0 */ + const1(0); /* load 0 */ + } /* if */ + return FALSE; /* return 0 for constants (or errors) */ +} + +static void +clear_value(value * lval) +{ + lval->sym = NULL; + lval->constval = 0L; + lval->tag = 0; + lval->ident = 0; + lval->boolresult = FALSE; + /* do not clear lval->arrayidx, it is preset in hier14() */ +} + +static void +setdefarray(cell * string, cell size, cell array_sz, cell * dataaddr, + int fconst) +{ + /* The routine must copy the default array data onto the heap, as to avoid + * that a function can change the default value. An optimization is that + * the default array data is "dumped" into the data segment only once (on the + * first use). + */ + assert(string != NULL); + assert(size > 0); + /* check whether to dump the default array */ + assert(dataaddr != NULL); + if (sc_status == statWRITE && *dataaddr < 0) + { + int i; + + *dataaddr = (litidx + glb_declared) * sizeof(cell); + for (i = 0; i < size; i++) + stowlit(*string++); + } /* if */ + + /* if the function is known not to modify the array (meaning that it also + * does not modify the default value), directly pass the address of the + * array in the data segment. + */ + if (fconst) + { + const1(*dataaddr); + } + else + { + /* Generate the code: + * CONST.pri dataaddr ;address of the default array data + * HEAP array_sz*sizeof(cell) ;heap address in ALT + * MOVS size*sizeof(cell) ;copy data from PRI to ALT + * MOVE.PRI ;PRI = address on the heap + */ + const1(*dataaddr); + /* "array_sz" is the size of the argument (the value between the brackets + * in the declaration), "size" is the size of the default array data. + */ + assert(array_sz >= size); + modheap((int)array_sz * sizeof(cell)); + /* ??? should perhaps fill with zeros first */ + memcopy(size * sizeof(cell)); + moveto1(); + } /* if */ +} + +static int +findnamedarg(arginfo * arg, char *name) +{ + int i; + + for (i = 0; arg[i].ident != 0 && arg[i].ident != iVARARGS; i++) + if (strcmp(arg[i].name, name) == 0) + return i; + return -1; +} + +static int +checktag(int tags[], int numtags, int exprtag) +{ + int i; + + assert(tags != 0); + assert(numtags > 0); + for (i = 0; i < numtags; i++) + if (matchtag(tags[i], exprtag, TRUE)) + return TRUE; /* matching tag */ + return FALSE; /* no tag matched */ +} + +enum +{ + ARG_UNHANDLED, + ARG_IGNORED, + ARG_DONE, +}; + +/* callfunction + * + * Generates code to call a function. This routine handles default arguments + * and positional as well as named parameters. + */ +static void +callfunction(symbol * sym) +{ + int close, lvalue; + int argpos; /* index in the output stream (argpos==nargs if positional parameters) */ + int argidx = 0; /* index in "arginfo" list */ + int nargs = 0; /* number of arguments */ + int heapalloc = 0; + int namedparams = FALSE; + value lval = { NULL, 0, 0, 0, 0, NULL }; + arginfo *arg; + char arglist[sMAXARGS]; + constvalue arrayszlst = { NULL, "", 0, 0 }; /* array size list starts empty */ + cell lexval; + char *lexstr; + + assert(sym != NULL); + arg = sym->dim.arglist; + assert(arg != NULL); + stgmark(sSTARTREORDER); + for (argpos = 0; argpos < sMAXARGS; argpos++) + arglist[argpos] = ARG_UNHANDLED; + if (!matchtoken(')')) + { + do + { + if (matchtoken('.')) + { + namedparams = TRUE; + if (needtoken(tSYMBOL)) + tokeninfo(&lexval, &lexstr); + else + lexstr = ""; + argpos = findnamedarg(arg, lexstr); + if (argpos < 0) + { + error(17, lexstr); /* undefined symbol */ + break; /* exit loop, argpos is invalid */ + } /* if */ + needtoken('='); + argidx = argpos; + } + else + { + if (namedparams) + error(44); /* positional parameters must precede named parameters */ + argpos = nargs; + } /* if */ + stgmark((char)(sEXPRSTART + argpos)); /* mark beginning of new expression in stage */ + if (arglist[argpos] != ARG_UNHANDLED) + error(58); /* argument already set */ + if (matchtoken('_')) + { + arglist[argpos] = ARG_IGNORED; /* flag argument as "present, but ignored" */ + if (arg[argidx].ident == 0 || arg[argidx].ident == iVARARGS) + { + error(202); /* argument count mismatch */ + } + else if (!arg[argidx].hasdefault) + { + error(34, nargs + 1); /* argument has no default value */ + } /* if */ + if (arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS) + argidx++; + /* The rest of the code to handle default values is at the bottom + * of this routine where default values for unspecified parameters + * are (also) handled. Note that above, the argument is flagged as + * ARG_IGNORED. + */ + } + else + { + arglist[argpos] = ARG_DONE; /* flag argument as "present" */ + lvalue = hier14(&lval); + switch (arg[argidx].ident) + { + case 0: + error(202); /* argument count mismatch */ + break; + case iVARARGS: + /* always pass by reference */ + if (lval.ident == iVARIABLE || lval.ident == iREFERENCE) + { + assert(lval.sym != NULL); + if ((lval.sym->usage & uCONST) != 0 + && (arg[argidx].usage & uCONST) == 0) + { + /* treat a "const" variable passed to a function with a non-const + * "variable argument list" as a constant here */ + assert(lvalue); + rvalue(&lval); /* get value in PRI */ + setheap_pri(); /* address of the value on the heap in PRI */ + heapalloc++; + } + else if (lvalue) + { + address(lval.sym); + } + else + { + setheap_pri(); /* address of the value on the heap in PRI */ + heapalloc++; + } /* if */ + } + else if (lval.ident == iCONSTEXPR + || lval.ident == iEXPRESSION + || lval.ident == iARRAYCHAR) + { + /* fetch value if needed */ + if (lval.ident == iARRAYCHAR) + rvalue(&lval); + /* allocate a cell on the heap and store the + * value (already in PRI) there */ + setheap_pri(); /* address of the value on the heap in PRI */ + heapalloc++; + } /* if */ + /* ??? handle const array passed by reference */ + /* otherwise, the address is already in PRI */ + if (lval.sym) + markusage(lval.sym, uWRITTEN); +/* + * Dont need this warning - its varargs. there is no way of knowing the + * required tag/type... + * + if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag)) + error(213); + */ + break; + case iVARIABLE: + if (lval.ident == iLABEL || lval.ident == iFUNCTN + || lval.ident == iREFFUNC || lval.ident == iARRAY + || lval.ident == iREFARRAY) + error(35, argidx + 1); /* argument type mismatch */ + if (lvalue) + rvalue(&lval); /* get value (direct or indirect) */ + /* otherwise, the expression result is already in PRI */ + assert(arg[argidx].numtags > 0); + check_userop(NULL, lval.tag, arg[argidx].tags[0], 2, + NULL, &lval.tag); + if (!checktag + (arg[argidx].tags, arg[argidx].numtags, lval.tag)) + error(213); + argidx++; /* argument done */ + break; + case iREFERENCE: + if (!lvalue || lval.ident == iARRAYCHAR) + error(35, argidx + 1); /* argument type mismatch */ + if (lval.sym && (lval.sym->usage & uCONST) != 0 + && (arg[argidx].usage & uCONST) == 0) + error(35, argidx + 1); /* argument type mismatch */ + if (lval.ident == iVARIABLE || lval.ident == iREFERENCE) + { + if (lvalue) + { + assert(lval.sym != NULL); + address(lval.sym); + } + else + { + setheap_pri(); /* address of the value on the heap in PRI */ + heapalloc++; + } /* if */ + } /* if */ + /* otherwise, the address is already in PRI */ + if (!checktag + (arg[argidx].tags, arg[argidx].numtags, lval.tag)) + error(213); + argidx++; /* argument done */ + if (lval.sym) + markusage(lval.sym, uWRITTEN); + break; + case iREFARRAY: + if (lval.ident != iARRAY && lval.ident != iREFARRAY + && lval.ident != iARRAYCELL) + { + error(35, argidx + 1); /* argument type mismatch */ + break; + } /* if */ + if (lval.sym && (lval.sym->usage & uCONST) != 0 + && (arg[argidx].usage & uCONST) == 0) + error(35, argidx + 1); /* argument type mismatch */ + /* Verify that the dimensions match with those in arg[argidx]. + * A literal array always has a single dimension. + * An iARRAYCELL parameter is also assumed to have a single dimension. + */ + if (!lval.sym || lval.ident == iARRAYCELL) + { + if (arg[argidx].numdim != 1) + { + error(48); /* array dimensions must match */ + } + else if (arg[argidx].dim[0] != 0) + { + assert(arg[argidx].dim[0] > 0); + if (lval.ident == iARRAYCELL) + { + error(47); /* array sizes must match */ + } + else + { + assert(lval.constval != 0); /* literal array must have a size */ + /* A literal array must have exactly the same size as the + * function argument; a literal string may be smaller than + * the function argument. + */ + if ((lval.constval > 0 + && arg[argidx].dim[0] != lval.constval) + || (lval.constval < 0 + && arg[argidx].dim[0] < + -lval.constval)) + error(47); /* array sizes must match */ + } /* if */ + } /* if */ + if (lval.ident != iARRAYCELL) + { + /* save array size, for default values with uSIZEOF flag */ + cell array_sz = lval.constval; + + assert(array_sz != 0); /* literal array must have a size */ + if (array_sz < 0) + array_sz = -array_sz; + append_constval(&arrayszlst, arg[argidx].name, + array_sz, 0); + } /* if */ + } + else + { + symbol *sym = lval.sym; + short level = 0; + + assert(sym != NULL); + if (sym->dim.array.level + 1 != arg[argidx].numdim) + error(48); /* array dimensions must match */ + /* the lengths for all dimensions must match, unless the dimension + * length was defined at zero (which means "undefined") + */ + while (sym->dim.array.level > 0) + { + assert(level < sDIMEN_MAX); + if (arg[argidx].dim[level] != 0 + && sym->dim.array.length != + arg[argidx].dim[level]) + error(47); /* array sizes must match */ + append_constval(&arrayszlst, arg[argidx].name, + sym->dim.array.length, level); + sym = finddepend(sym); + assert(sym != NULL); + level++; + } /* if */ + /* the last dimension is checked too, again, unless it is zero */ + assert(level < sDIMEN_MAX); + assert(sym != NULL); + if (arg[argidx].dim[level] != 0 + && sym->dim.array.length != + arg[argidx].dim[level]) + error(47); /* array sizes must match */ + append_constval(&arrayszlst, arg[argidx].name, + sym->dim.array.length, level); + } /* if */ + /* address already in PRI */ + if (!checktag + (arg[argidx].tags, arg[argidx].numtags, lval.tag)) + error(213); + // ??? set uWRITTEN? + argidx++; /* argument done */ + break; + } /* switch */ + push1(); /* store the function argument on the stack */ + endexpr(FALSE); /* mark the end of a sub-expression */ + } /* if */ + assert(arglist[argpos] != ARG_UNHANDLED); + nargs++; + close = matchtoken(')'); + if (!close) /* if not paranthese... */ + if (!needtoken(',')) /* ...should be comma... */ + break; /* ...but abort loop if neither */ + } + while (!close && freading && !matchtoken(tENDEXPR)); /* do */ + } /* if */ + /* check remaining function arguments (they may have default values) */ + for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS; + argidx++) + { + if (arglist[argidx] == ARG_DONE) + continue; /* already seen and handled this argument */ + /* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF; + * these are handled last + */ + if ((arg[argidx].hasdefault & uSIZEOF) != 0 + || (arg[argidx].hasdefault & uTAGOF) != 0) + { + assert(arg[argidx].ident == iVARIABLE); + continue; + } /* if */ + stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */ + if (arg[argidx].hasdefault) + { + if (arg[argidx].ident == iREFARRAY) + { + short level; + + setdefarray(arg[argidx].defvalue.array.data, + arg[argidx].defvalue.array.size, + arg[argidx].defvalue.array.arraysize, + &arg[argidx].defvalue.array.addr, + (arg[argidx].usage & uCONST) != 0); + if ((arg[argidx].usage & uCONST) == 0) + heapalloc += arg[argidx].defvalue.array.arraysize; + /* keep the lengths of all dimensions of a multi-dimensional default array */ + assert(arg[argidx].numdim > 0); + if (arg[argidx].numdim == 1) + { + append_constval(&arrayszlst, arg[argidx].name, + arg[argidx].defvalue.array.arraysize, 0); + } + else + { + for (level = 0; level < arg[argidx].numdim; level++) + { + assert(level < sDIMEN_MAX); + append_constval(&arrayszlst, arg[argidx].name, + arg[argidx].dim[level], level); + } /* for */ + } /* if */ + } + else if (arg[argidx].ident == iREFERENCE) + { + setheap(arg[argidx].defvalue.val); + /* address of the value on the heap in PRI */ + heapalloc++; + } + else + { + int dummytag = arg[argidx].tags[0]; + + const1(arg[argidx].defvalue.val); + assert(arg[argidx].numtags > 0); + check_userop(NULL, arg[argidx].defvalue_tag, + arg[argidx].tags[0], 2, NULL, &dummytag); + assert(dummytag == arg[argidx].tags[0]); + } /* if */ + push1(); /* store the function argument on the stack */ + endexpr(FALSE); /* mark the end of a sub-expression */ + } + else + { + error(202, argidx); /* argument count mismatch */ + } /* if */ + if (arglist[argidx] == ARG_UNHANDLED) + nargs++; + arglist[argidx] = ARG_DONE; + } /* for */ + /* now a second loop to catch the arguments with default values that are + * the "sizeof" or "tagof" of other arguments + */ + for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS; + argidx++) + { + constvalue *asz; + cell array_sz; + + if (arglist[argidx] == ARG_DONE) + continue; /* already seen and handled this argument */ + stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */ + assert(arg[argidx].ident == iVARIABLE); /* if "sizeof", must be single cell */ + /* if unseen, must be "sizeof" or "tagof" */ + assert((arg[argidx].hasdefault & uSIZEOF) != 0 + || (arg[argidx].hasdefault & uTAGOF) != 0); + if ((arg[argidx].hasdefault & uSIZEOF) != 0) + { + /* find the argument; if it isn't found, the argument's default value + * was a "sizeof" of a non-array (a warning for this was already given + * when declaring the function) + */ + asz = find_constval(&arrayszlst, arg[argidx].defvalue.size.symname, + arg[argidx].defvalue.size.level); + if (asz) + { + array_sz = asz->value; + if (array_sz == 0) + error(224, arg[argidx].name); /* indeterminate array size in "sizeof" expression */ + } + else + { + array_sz = 1; + } /* if */ + } + else + { + symbol *sym; + + assert((arg[argidx].hasdefault & uTAGOF) != 0); + sym = findloc(arg[argidx].defvalue.size.symname); + if (!sym) + sym = findglb(arg[argidx].defvalue.size.symname); + array_sz = (sym) ? sym->tag : 0; + exporttag(array_sz); + } /* if */ + const1(array_sz); + push1(); /* store the function argument on the stack */ + endexpr(FALSE); + if (arglist[argidx] == ARG_UNHANDLED) + nargs++; + arglist[argidx] = ARG_DONE; + } /* for */ + stgmark(sENDREORDER); /* mark end of reversed evaluation */ + pushval((cell) nargs * sizeof(cell)); + ffcall(sym, nargs); + if (sc_status != statSKIP) + markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */ + if (sym->x.lib) + sym->x.lib->value += 1; /* increment "usage count" of the library */ + modheap(-heapalloc * sizeof(cell)); + sideeffect = TRUE; /* assume functions carry out a side-effect */ + delete_consttable(&arrayszlst); /* clear list of array sizes */ +} + +/* dbltest + * + * Returns a non-zero value if lval1 an array and lval2 is not an array and + * the operation is addition or subtraction. + * + * Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell + * to an array offset. + */ +static int +dbltest(void (*oper) (), value * lval1, value * lval2) +{ + if ((oper != ob_add) && (oper != ob_sub)) + return 0; + if (lval1->ident != iARRAY) + return 0; + if (lval2->ident == iARRAY) + return 0; + return sizeof(cell) / 2; /* 1 for 16-bit, 2 for 32-bit */ +} + +/* commutative + * + * Test whether an operator is commutative, i.e. x oper y == y oper x. + * Commutative operators are: + (addition) + * * (multiplication) + * == (equality) + * != (inequality) + * & (bitwise and) + * ^ (bitwise xor) + * | (bitwise or) + * + * If in an expression, code for the left operand has been generated and + * the right operand is a constant and the operator is commutative, the + * precautionary "push" of the primary register is scrapped and the constant + * is read into the secondary register immediately. + */ +static int +commutative(void (*oper) ()) +{ + return oper == ob_add || oper == os_mult + || oper == ob_eq || oper == ob_ne + || oper == ob_and || oper == ob_xor || oper == ob_or; +} + +/* constant + * + * Generates code to fetch a number, a literal character (which is returned + * by lex() as a number as well) or a literal string (lex() stores the + * strings in the literal queue). If the operand was a number, it is stored + * in lval->constval. + * + * The function returns 1 if the token was a constant or a string, 0 + * otherwise. + */ +static int +constant(value * lval) +{ + int tok, index, constant; + cell val, item, cidx; + char *st; + symbol *sym; + + tok = lex(&val, &st); + if (tok == tSYMBOL && (sym = findconst(st))) + { + lval->constval = sym->addr; + const1(lval->constval); + lval->ident = iCONSTEXPR; + lval->tag = sym->tag; + markusage(sym, uREAD); + } + else if (tok == tNUMBER) + { + lval->constval = val; + const1(lval->constval); + lval->ident = iCONSTEXPR; + } + else if (tok == tRATIONAL) + { + lval->constval = val; + const1(lval->constval); + lval->ident = iCONSTEXPR; + lval->tag = sc_rationaltag; + } + else if (tok == tSTRING) + { + /* lex() stores starting index of string in the literal table in 'val' */ + const1((val + glb_declared) * sizeof(cell)); + lval->ident = iARRAY; /* pretend this is a global array */ + lval->constval = val - litidx; /* constval == the negative value of the + * size of the literal array; using a negative + * value distinguishes between literal arrays + * and literal strings (this was done for + * array assignment). */ + } + else if (tok == '{') + { + int tag, lasttag = -1; + + val = litidx; + do + { + /* cannot call constexpr() here, because "staging" is already turned + * on at this point */ + assert(staging); + stgget(&index, &cidx); /* mark position in code generator */ + expression(&constant, &item, &tag, FALSE); + stgdel(index, cidx); /* scratch generated code */ + if (constant == 0) + error(8); /* must be constant expression */ + if (lasttag < 0) + lasttag = tag; + else if (!matchtag(lasttag, tag, FALSE)) + error(213); /* tagname mismatch */ + stowlit(item); /* store expression result in literal table */ + } + while (matchtoken(',')); + needtoken('}'); + const1((val + glb_declared) * sizeof(cell)); + lval->ident = iARRAY; /* pretend this is a global array */ + lval->constval = litidx - val; /* constval == the size of the literal array */ + } + else + { + return FALSE; /* no, it cannot be interpreted as a constant */ + } /* if */ + return TRUE; /* yes, it was a constant value */ +} -- cgit v1.1