rsalz@uunet.uu.net (Rich Salz) (03/29/90)
Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu> Posting-number: Volume 21, Issue 70 Archive-name: p2c/part25 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 25 (of 32)." # Contents: src/expr.c.2 # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:48 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'src/expr.c.2' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/expr.c.2'\" else echo shar: Extracting \"'src/expr.c.2'\" \(48964 characters\) sed "s/^X//" >'src/expr.c.2' <<'END_OF_FILE' X a->args[i]->val.i - a->args[j]->val.i); X for (k = 0; k < - a->args[j]->val.i; k++) X a->args[i]->val.s[k] = '>'; X delfreearg(&a, j); X j--; X } X } X } X } X if (checkconst(a->args[a->nargs-1], 0)) X delfreearg(&a, a->nargs-1); X for (i = 0; i < a->nargs; i++) { X if (a->args[i]->kind == EK_NEG && nosideeffects(a->args[i], 1)) { X for (j = 0; j < a->nargs; j++) { X if (exprsame(a->args[j], a->args[i]->args[0], 1)) { X delfreearg(&a, i); X if (i < j) j--; else i--; X delfreearg(&a, j); X i--; X break; X } X } X } X } X if (a->nargs < 2) { X if (a->nargs < 1) { X type = a->val.type; X FREE(a); X a = gentle_cast(makeexpr_long(0), type); X a->val.type = type; X return a; X } else { X b = a->args[0]; X FREE(a); X return b; X } X } X if (a->nargs == 2 && ISCONST(a->args[1]->kind) && X a->args[1]->val.i <= -127 && X true_type(a->args[0]) == tp_char && signedchars != 0) { X a->args[0] = force_unsigned(a->args[0]); X } X if (a->nargs > 2 && X ISCONST(a->args[a->nargs-1]->kind) && X ISCONST(a->args[a->nargs-2]->kind) && X ischartype(a->args[a->nargs-1]) && X ischartype(a->args[a->nargs-2])) { X i = a->args[a->nargs-1]->val.i; X j = a->args[a->nargs-2]->val.i; X if ((i == 'a' || i == 'A' || i == -'a' || i == -'A') && X (j == 'a' || j == 'A' || j == -'a' || j == -'A')) { X if (abs(i+j) == 32) { X delfreearg(&a, a->nargs-1); X delsimpfreearg(&a, a->nargs-1); X a = makeexpr_bicall_1((i+j > 0) ? "_tolower" : "_toupper", X tp_char, a); X } X } X } X return a; X} X X XExpr *makeexpr_minus(a, b) XExpr *a, *b; X{ X int okneg; X X if (debug>2) { fprintf(outf,"makeexpr_minus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); } X if (ISCONST(b->kind) && b->val.i == 0 && /* kludge for array indexing */ X ord_type(b->val.type)->kind == TK_ENUM) { X b->val.type = tp_integer; X } X okneg = (a->kind != EK_PLUS && b->kind != EK_PLUS); X a = makeexpr_plus(a, makeexpr_neg(b)); X if (okneg && a->kind == EK_PLUS) X a->val.i = 1; /* this flag says to write as "a-b" if possible */ X return a; X} X X XExpr *makeexpr_inc(a, b) XExpr *a, *b; X{ X Type *type; X X type = a->val.type; X a = makeexpr_plus(makeexpr_charcast(a), b); X if (ord_type(type)->kind != TK_INTEGER && X ord_type(type)->kind != TK_CHAR) X a = makeexpr_cast(a, type); X return a; X} X X X X/* Apply the distributive law for a sum of products */ XExpr *distribute_plus(ex) XExpr *ex; X{ X int i, j, icom; X Expr *common, *outer, *ex2, **exp; X X if (debug>2) { fprintf(outf,"distribute_plus("); dumpexpr(ex); fprintf(outf,")\n"); } X if (ex->kind != EK_PLUS) X return ex; X for (i = 0; i < ex->nargs; i++) X if (ex->args[i]->kind == EK_TIMES) X break; X if (i == ex->nargs) X return ex; X outer = NULL; X icom = 0; X for (;;) { X ex2 = ex->args[0]; X if (ex2->kind == EK_NEG) X ex2 = ex2->args[0]; X if (ex2->kind == EK_TIMES) { X if (icom >= ex2->nargs) X break; X common = ex2->args[icom]; X if (common->kind == EK_NEG) X common = common->args[0]; X } else { X if (icom > 0) X break; X common = ex2; X icom++; X } X for (i = 1; i < ex->nargs; i++) { X ex2 = ex->args[i]; X if (ex2->kind == EK_NEG) X ex2 = ex2->args[i]; X if (ex2->kind == EK_TIMES) { X for (j = ex2->nargs; --j >= 0; ) { X if (exprsame(ex2->args[j], common, 1) || X (ex2->args[j]->kind == EK_NEG && X exprsame(ex2->args[j]->args[0], common, 1))) X break; X } X if (j < 0) X break; X } else { X if (!exprsame(ex2, common, 1)) X break; X } X } X if (i == ex->nargs) { X if (debug>2) { fprintf(outf,"distribute_plus does "); dumpexpr(common); fprintf(outf,"\n"); } X common = copyexpr(common); X for (i = 0; i < ex->nargs; i++) { X if (ex->args[i]->kind == EK_NEG) X ex2 = *(exp = &ex->args[i]->args[0]); X else X ex2 = *(exp = &ex->args[i]); X if (ex2->kind == EK_TIMES) { X for (j = ex2->nargs; --j >= 0; ) { X if (exprsame(ex2->args[j], common, 1)) { X delsimpfreearg(exp, j); X break; X } else if (ex2->args[j]->kind == EK_NEG && X exprsame(ex2->args[j]->args[0], common,1)) { X freeexpr(ex2->args[j]); X ex2->args[j] = makeexpr_long(-1); X break; X } X } X } else { X freeexpr(ex2); X *exp = makeexpr_long(1); X } X ex->args[i] = resimplify(ex->args[i]); X } X outer = makeexpr_times(common, outer); X } else X icom++; X } X return makeexpr_times(resimplify(ex), outer); X} X X X X X XExpr *makeexpr_times(a, b) XExpr *a, *b; X{ X int i, n; X Type *type; X X if (debug>2) { fprintf(outf,"makeexpr_times("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); } X if (!a) X return b; X if (!b) X return a; X a = commute(a, b, EK_TIMES); X if (a->val.type->kind == TK_INTEGER) { X i = a->nargs-1; X if (i > 0 && ISCONST(a->args[i-1]->kind)) { X a->args[i-1]->val.i *= a->args[i]->val.i; X delfreearg(&a, i); X } X } X for (i = n = 0; i < a->nargs; i++) { X if (expr_neg_cost(a->args[i]) < 0) X n++; X } X if (n & 1) { X for (i = 0; i < a->nargs; i++) { X if (ISCONST(a->args[i]->kind) && X expr_neg_cost(a->args[i]) >= 0) { X a->args[i] = makeexpr_neg(a->args[i]); X n++; X break; X } X } X } else X n++; X for (i = 0; i < a->nargs && n >= 2; i++) { X if (expr_neg_cost(a->args[i]) < 0) { X a->args[i] = makeexpr_neg(a->args[i]); X n--; X } X } X if (checkconst(a->args[a->nargs-1], 1)) X delfreearg(&a, a->nargs-1); X if (checkconst(a->args[a->nargs-1], -1)) { X delfreearg(&a, a->nargs-1); X a->args[0] = makeexpr_neg(a->args[0]); X } X if (checkconst(a->args[a->nargs-1], 0) && nosideeffects(a, 1)) { X type = a->val.type; X return makeexpr_cast(grabarg(a, a->nargs-1), type); X } X if (a->nargs < 2) { X if (a->nargs < 1) { X FREE(a); X a = makeexpr_long(1); X } else { X b = a->args[0]; X FREE(a); X a = b; X } X } X return a; X} X X X XExpr *makeexpr_sqr(ex, cube) XExpr *ex; Xint cube; X{ X Expr *ex2; X Meaning *tvar; X Type *type; X X if (exprspeed(ex) <= 2 && nosideeffects(ex, 0)) { X ex2 = NULL; X } else { X type = (ex->val.type->kind == TK_REAL) ? tp_longreal : tp_integer; X tvar = makestmttempvar(type, name_TEMP); X ex2 = makeexpr_assign(makeexpr_var(tvar), ex); X ex = makeexpr_var(tvar); X } X if (cube) X ex = makeexpr_times(ex, makeexpr_times(copyexpr(ex), copyexpr(ex))); X else X ex = makeexpr_times(ex, copyexpr(ex)); X return makeexpr_comma(ex2, ex); X} X X X XExpr *makeexpr_divide(a, b) XExpr *a, *b; X{ X Expr *ex; X int p; X X if (debug>2) { fprintf(outf,"makeexpr_divide("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); } X if (a->val.type->kind != TK_REAL && X b->val.type->kind != TK_REAL) { /* must do a real division */ X ex = docast(a, tp_longreal); X if (ex) X a = ex; X else { X ex = docast(b, tp_longreal); X if (ex) X b = ex; X else X a = makeexpr_cast(a, tp_longreal); X } X } X if (a->kind == EK_TIMES) { X for (p = 0; p < a->nargs; p++) X if (exprsame(a->args[p], b, 1)) X break; X if (p < a->nargs) { X delfreearg(&a, p); X freeexpr(b); X if (a->nargs == 1) X return grabarg(a, 0); X else X return a; X } X } X if (expr_neg_cost(a) < 0 && expr_neg_cost(b) < 0) { X a = makeexpr_neg(a); X b = makeexpr_neg(b); X } X if (checkconst(b, 0)) X warning("Division by zero [163]"); X return makeexpr_bin(EK_DIVIDE, tp_longreal, a, b); X} X X X X Xint gcd(a, b) Xint a, b; X{ X if (a < 0) a = -a; X if (b < 0) b = -b; X while (a != 0) { X b %= a; X if (b != 0) X a %= b; X else X return a; X } X return b; X} X X X X/* possible signs of ex: 1=may be neg, 2=may be zero, 4=may be pos */ X Xint negsigns(mask) Xint mask; X{ X return (mask & 2) | X ((mask & 1) << 2) | X ((mask & 4) >> 2); X} X X Xint possiblesigns(ex) XExpr *ex; X{ X Value val; X Type *tp; X char *cp; X int i, mask, mask2; X X if (isliteralconst(ex, &val) && val.type) { X if (val.type == tp_real || val.type == tp_longreal) { X if (realzero(val.s)) X return 2; X if (*val.s == '-') X return 1; X return 4; X } else X return (val.i < 0) ? 1 : (val.i == 0) ? 2 : 4; X } X if (ex->kind == EK_CAST && X similartypes(ex->val.type, ex->args[0]->val.type)) X return possiblesigns(ex->args[0]); X if (ex->kind == EK_NEG) X return negsigns(possiblesigns(ex->args[0])); X if (ex->kind == EK_TIMES || ex->kind == EK_DIVIDE) { X mask = possiblesigns(ex->args[0]); X for (i = 1; i < ex->nargs; i++) { X mask2 = possiblesigns(ex->args[i]); X if (mask2 & 2) X mask |= 2; X if ((mask2 & (1|4)) == 1) X mask = negsigns(mask); X else if ((mask2 & (1|4)) != 4) X mask = 1|2|4; X } X return mask; X } X if (ex->kind == EK_DIV || ex->kind == EK_MOD) { X mask = possiblesigns(ex->args[0]); X mask2 = possiblesigns(ex->args[1]); X if (!((mask | mask2) & 1)) X return 2|4; X } X if (ex->kind == EK_PLUS) { X mask = 0; X for (i = 0; i < ex->nargs; i++) { X mask2 = possiblesigns(ex->args[i]); X if ((mask & negsigns(mask2)) & (1|4)) X mask |= (1|2|4); X else X mask |= mask2; X } X return mask; X } X if (ex->kind == EK_COND) { X return possiblesigns(ex->args[1]) | possiblesigns(ex->args[2]); X } X if (ex->kind == EK_EQ || ex->kind == EK_LT || ex->kind == EK_GT || X ex->kind == EK_NE || ex->kind == EK_LE || ex->kind == EK_GE || X ex->kind == EK_AND || ex->kind == EK_OR || ex->kind == EK_NOT) X return 2|4; X if (ex->kind == EK_BICALL) { X cp = ex->val.s; X if (!strcmp(cp, "strlen") || X !strcmp(cp, "abs") || X !strcmp(cp, "labs") || X !strcmp(cp, "fabs")) X return 2|4; X } X tp = (ex->kind == EK_VAR) ? ((Meaning *)ex->val.i)->type : ex->val.type; X if (ord_range(ex->val.type, &val.i, NULL)) { X if (val.i > 0) X return 4; X if (val.i >= 0) X return 2|4; X } X if (ord_range(ex->val.type, NULL, &val.i)) { X if (val.i < 0) X return 1; X if (val.i <= 0) X return 1|2; X } X return 1|2|4; X} X X X X X XExpr *dodivmod(funcname, ekind, a, b) Xchar *funcname; Xenum exprkind ekind; XExpr *a, *b; X{ X Meaning *tvar; X Type *type; X Expr *asn; X int sa, sb; X X type = promote_type_bin(a->val.type, b->val.type); X tvar = NULL; X sa = possiblesigns(a); X sb = possiblesigns(b); X if ((sa & 1) || (sb & 1)) { X if (*funcname) { X asn = NULL; X if (*funcname == '*') { X if (exprspeed(a) >= 5 || !nosideeffects(a, 0)) { X tvar = makestmttempvar(a->val.type, name_TEMP); X asn = makeexpr_assign(makeexpr_var(tvar), a); X a = makeexpr_var(tvar); X } X if (exprspeed(b) >= 5 || !nosideeffects(b, 0)) { X tvar = makestmttempvar(b->val.type, name_TEMP); X asn = makeexpr_comma(asn, X makeexpr_assign(makeexpr_var(tvar), X b)); X b = makeexpr_var(tvar); X } X } X return makeexpr_comma(asn, X makeexpr_bicall_2(funcname, type, a, b)); X } else { X if ((sa & 1) && (ekind == EK_MOD)) X note("Using % for possibly-negative arguments [317]"); X return makeexpr_bin(ekind, type, a, b); X } X } else X return makeexpr_bin(ekind, type, a, b); X} X X X XExpr *makeexpr_div(a, b) XExpr *a, *b; X{ X Meaning *mp; X Type *type; X long i; X int p; X X if (ISCONST(a->kind) && ISCONST(b->kind)) { X if (a->val.i >= 0 && b->val.i > 0) { X a->val.i /= b->val.i; X freeexpr(b); X return a; X } X i = gcd(a->val.i, b->val.i); X if (i >= 0) { X a->val.i /= i; X b->val.i /= i; X } X } X if (((b->kind == EK_CONST && (i = b->val.i)) || X (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST && X (i = mp->val.i) && foldconsts != 0)) && i > 0) { X if (i == 1) X return a; X if (div_po2 > 0) { X p = 0; X while (!(i&1)) X p++, i >>= 1; X if (i == 1) { X type = promote_type_bin(a->val.type, b->val.type); X return makeexpr_bin(EK_RSH, type, a, makeexpr_long(p)); X } X } X } X if (a->kind == EK_TIMES) { X for (p = 0; p < a->nargs; p++) { X if (exprsame(a->args[p], b, 1)) { X delfreearg(&a, p); X freeexpr(b); X if (a->nargs == 1) X return grabarg(a, 0); X else X return a; X } else if (ISCONST(a->args[p]->kind) && ISCONST(b->kind)) { X i = gcd(a->args[p]->val.i, b->val.i); X if (i > 1) { X a->args[p]->val.i /= i; X b->val.i /= i; X i = a->args[p]->val.i; X delfreearg(&a, p); X a = makeexpr_times(a, makeexpr_long(i)); /* resimplify */ X p = -1; /* start the loop over */ X } X } X } X } X if (checkconst(b, 1)) { X freeexpr(b); X return a; X } else if (checkconst(b, -1)) { X freeexpr(b); X return makeexpr_neg(a); X } else { X if (checkconst(b, 0)) X warning("Division by zero [163]"); X return dodivmod(divname, EK_DIV, a, b); X } X} X X X XExpr *makeexpr_mod(a, b) XExpr *a, *b; X{ X Meaning *mp; X Type *type; X long i; X X if (a->kind == EK_CONST && b->kind == EK_CONST && X a->val.i >= 0 && b->val.i > 0) { X a->val.i %= b->val.i; X freeexpr(b); X return a; X } X if (((b->kind == EK_CONST && (i = b->val.i)) || X (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST && X (i = mp->val.i) && foldconsts != 0)) && i > 0) { X if (i == 1) X return makeexpr_long(0); X if (mod_po2 != 0) { X while (!(i&1)) X i >>= 1; X if (i == 1) { X type = promote_type_bin(a->val.type, b->val.type); X return makeexpr_bin(EK_BAND, type, a, X makeexpr_minus(b, makeexpr_long(1))); X } X } X } X if (checkconst(b, 0)) X warning("Division by zero [163]"); X return dodivmod(modname, EK_MOD, a, b); X} X X X XExpr *makeexpr_rem(a, b) XExpr *a, *b; X{ X if (!(possiblesigns(a) & 1) && !(possiblesigns(b) & 1)) X return makeexpr_mod(a, b); X if (checkconst(b, 0)) X warning("Division by zero [163]"); X if (!*remname) X note("Translating REM same as MOD [141]"); X return dodivmod(*remname ? remname : modname, EK_MOD, a, b); X} X X X X X Xint expr_not_cost(a) XExpr *a; X{ X int i, c; X X switch (a->kind) { X X case EK_CONST: X return 0; X X case EK_NOT: X return -1; X X case EK_EQ: X case EK_NE: X case EK_LT: X case EK_GT: X case EK_LE: X case EK_GE: X return 0; X X case EK_AND: X case EK_OR: X c = 0; X for (i = 0; i < a->nargs; i++) X c += expr_not_cost(a->args[i]); X return (c > 1) ? 1 : c; X X case EK_BICALL: X if (!strcmp(a->val.s, oddname) || X !strcmp(a->val.s, evenname)) X return 0; X return 1; X X default: X return 1; X } X} X X X XExpr *makeexpr_not(a) XExpr *a; X{ X Expr *ex; X int i; X X if (debug>2) { fprintf(outf,"makeexpr_not("); dumpexpr(a); fprintf(outf,")\n"); } X switch (a->kind) { X X case EK_CONST: X if (a->val.type == tp_boolean) { X a->val.i = !a->val.i; X return a; X } X break; X X case EK_EQ: X a->kind = EK_NE; X return a; X X case EK_NE: X a->kind = EK_EQ; X return a; X X case EK_LT: X a->kind = EK_GE; X return a; X X case EK_GT: X a->kind = EK_LE; X return a; X X case EK_LE: X a->kind = EK_GT; X return a; X X case EK_GE: X a->kind = EK_LT; X return a; X X case EK_AND: X case EK_OR: X if (expr_not_cost(a) > 0) X break; X a->kind = (a->kind == EK_OR) ? EK_AND : EK_OR; X for (i = 0; i < a->nargs; i++) X a->args[i] = makeexpr_not(a->args[i]); X return a; X X case EK_NOT: X ex = a->args[0]; X FREE(a); X ex->val.type = tp_boolean; X return ex; X X case EK_BICALL: X if (!strcmp(a->val.s, oddname) && *evenname) { X strchange(&a->val.s, evenname); X return a; X } else if (!strcmp(a->val.s, evenname)) { X strchange(&a->val.s, oddname); X return a; X } X break; X X default: X break; X } X return makeexpr_un(EK_NOT, tp_boolean, a); X} X X X X XType *mixsets(ep1, ep2) XExpr **ep1, **ep2; X{ X Expr *ex1 = *ep1, *ex2 = *ep2; X Meaning *tvar; X long min1, max1, min2, max2; X Type *type; X X if (ex1->val.type->kind == TK_SMALLSET && X ex2->val.type->kind == TK_SMALLSET) X return ex1->val.type; X if (ex1->val.type->kind == TK_SMALLSET) { X tvar = makestmttempvar(ex2->val.type, name_SET); X ex1 = makeexpr_bicall_2(setexpandname, ex2->val.type, X makeexpr_var(tvar), X makeexpr_arglong(ex1, 1)); X } X if (ex2->val.type->kind == TK_SMALLSET) { X tvar = makestmttempvar(ex1->val.type, name_SET); X ex2 = makeexpr_bicall_2(setexpandname, ex1->val.type, X makeexpr_var(tvar), X makeexpr_arglong(ex2, 1)); X } X if (ord_range(ex1->val.type->indextype, &min1, &max1) && X ord_range(ex2->val.type->indextype, &min2, &max2)) { X if (min1 <= min2 && max1 >= max2) X type = ex1->val.type; X else if (min2 <= min1 && max2 >= max1) X type = ex2->val.type; X else { X if (min2 < min1) min1 = min2; X if (max2 > max1) max1 = max2; X type = maketype(TK_SET); X type->basetype = tp_integer; X type->indextype = maketype(TK_SUBR); X type->indextype->basetype = ord_type(ex1->val.type->indextype); X type->indextype->smin = makeexpr_long(min1); X type->indextype->smax = makeexpr_long(max1); X } X } else X type = ex1->val.type; X *ep1 = ex1, *ep2 = ex2; X return type; X} X X X XMeaning *istempprocptr(ex) XExpr *ex; X{ X Meaning *mp; X X if (debug>2) { fprintf(outf,"istempprocptr("); dumpexpr(ex); fprintf(outf,")\n"); } X if (ex->kind == EK_COMMA && ex->nargs == 3) { X if ((mp = istempvar(ex->args[2])) != NULL && X mp->type->kind == TK_PROCPTR && X ex->args[0]->kind == EK_ASSIGN && X ex->args[0]->args[0]->kind == EK_DOT && X exprsame(ex->args[0]->args[0]->args[0], ex->args[2], 1) && X ex->args[1]->kind == EK_ASSIGN && X ex->args[1]->args[0]->kind == EK_DOT && X exprsame(ex->args[1]->args[0]->args[0], ex->args[2], 1)) X return mp; X } X if (ex->kind == EK_COMMA && ex->nargs == 2) { X if ((mp = istempvar(ex->args[1])) != NULL && X mp->type->kind == TK_CPROCPTR && X ex->args[0]->kind == EK_ASSIGN && X exprsame(ex->args[0]->args[0], ex->args[1], 1)) X return mp; X } X return NULL; X} X X X X XExpr *makeexpr_stringify(ex) XExpr *ex; X{ X ex = makeexpr_stringcast(ex); X if (ex->val.type->kind == TK_STRING) X return ex; X return makeexpr_sprintfify(ex); X} X X X XExpr *makeexpr_rel(rel, a, b) Xenum exprkind rel; XExpr *a, *b; X{ X int i, sign; X Expr *ex, *ex2; X Meaning *mp; X char *name; X X if (debug>2) { fprintf(outf,"makeexpr_rel(%s,", exprkindname(rel)); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); } X X a = makeexpr_unlongcast(a); X b = makeexpr_unlongcast(b); X if ((compenums == 0 || (compenums < 0 && ansiC <= 0)) && X (rel != EK_EQ && rel != EK_NE)){ X a = enum_to_int(a); X b = enum_to_int(b); X } X if (a->val.type != b->val.type) { X if (a->val.type->kind == TK_STRING && X a->kind != EK_CONST) { X b = makeexpr_stringify(b); X } else if (b->val.type->kind == TK_STRING && X b->kind != EK_CONST) { X a = makeexpr_stringify(a); X } else if (ord_type(a->val.type)->kind == TK_CHAR || X a->val.type->kind == TK_ARRAY) { X b = gentle_cast(b, ord_type(a->val.type)); X } else if (ord_type(b->val.type)->kind == TK_CHAR || X b->val.type->kind == TK_ARRAY) { X a = gentle_cast(a, ord_type(b->val.type)); X } else if (a->val.type == tp_anyptr && !voidstar) { X a = gentle_cast(a, b->val.type); X } else if (b->val.type == tp_anyptr && !voidstar) { X b = gentle_cast(b, a->val.type); X } X } X if (useisspace && b->val.type->kind == TK_CHAR && checkconst(b, ' ')) { X if (rel == EK_EQ) { X freeexpr(b); X return makeexpr_bicall_1("isspace", tp_boolean, a); X } else if (rel == EK_NE) { X freeexpr(b); X return makeexpr_not(makeexpr_bicall_1("isspace", tp_boolean, a)); X } X } X if (rel == EK_LT || rel == EK_GE) X sign = 1; X else if (rel == EK_GT || rel == EK_LE) X sign = -1; X else X sign = 0; X if (ord_type(b->val.type)->kind == TK_INTEGER || X ord_type(b->val.type)->kind == TK_CHAR) { X for (;;) { X if (a->kind == EK_PLUS && ISCONST(a->args[a->nargs-1]->kind) && X a->args[a->nargs-1]->val.i && X (ISCONST(b->kind) || X (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind)))) { X b = makeexpr_minus(b, copyexpr(a->args[a->nargs-1])); X a = makeexpr_minus(a, copyexpr(a->args[a->nargs-1])); X continue; X } X if (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind) && X b->args[b->nargs-1]->val.i && X ISCONST(a->kind)) { X a = makeexpr_minus(a, copyexpr(b->args[b->nargs-1])); X b = makeexpr_minus(b, copyexpr(b->args[b->nargs-1])); X continue; X } X if (b->kind == EK_PLUS && sign && X checkconst(b->args[b->nargs-1], sign)) { X b = makeexpr_plus(b, makeexpr_long(-sign)); X switch (rel) { X case EK_LT: X rel = EK_LE; X break; X case EK_GT: X rel = EK_GE; X break; X case EK_LE: X rel = EK_LT; X break; X case EK_GE: X rel = EK_GT; X break; X default: X break; X } X sign = -sign; X continue; X } X if (a->kind == EK_TIMES && checkconst(b, 0) && !sign) { X for (i = 0; i < a->nargs; i++) { X if (ISCONST(a->args[i]->kind) && a->args[i]->val.i) X break; X if (a->args[i]->kind == EK_SIZEOF) X break; X } X if (i < a->nargs) { X delfreearg(&a, i); X continue; X } X } X break; X } X if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen") && X checkconst(b, 0)) { X if (rel == EK_LT || rel == EK_GE) { X note("Unusual use of STRLEN encountered [142]"); X } else { X freeexpr(b); X a = makeexpr_hat(grabarg(a, 0), 0); X b = makeexpr_char(0); /* "strlen(a) = 0" => "*a == 0" */ X if (rel == EK_EQ || rel == EK_LE) X return makeexpr_rel(EK_EQ, a, b); X else X return makeexpr_rel(EK_NE, a, b); X } X } X if (ISCONST(a->kind) && ISCONST(b->kind)) { X if ((a->val.i == b->val.i && (rel == EK_EQ || rel == EK_GE || rel == EK_LE)) || X (a->val.i < b->val.i && (rel == EK_NE || rel == EK_LE || rel == EK_LT)) || X (a->val.i > b->val.i && (rel == EK_NE || rel == EK_GE || rel == EK_GT))) X return makeexpr_val(make_ord(tp_boolean, 1)); X else X return makeexpr_val(make_ord(tp_boolean, 0)); X } X if ((a->val.type == tp_char || true_type(a) == tp_char) && X ISCONST(b->kind) && signedchars != 0) { X i = (b->val.i == 128 && sign == 1) || X (b->val.i == 127 && sign == -1); X if (highcharbits && (highcharbits > 0 || signedchars < 0) && i) { X if (highcharbits == 2) X b = makeexpr_long(128); X else X b = makeexpr_un(EK_BNOT, tp_integer, makeexpr_long(127)); X return makeexpr_rel((rel == EK_GE || rel == EK_GT) X ? EK_NE : EK_EQ, X makeexpr_bin(EK_BAND, tp_integer, X eatcasts(a), b), X makeexpr_long(0)); X } else if (signedchars == 1 && i) { X return makeexpr_rel((rel == EK_GE || rel == EK_GT) X ? EK_LT : EK_GE, X eatcasts(a), makeexpr_long(0)); X } else if (signedchars == 1 && b->val.i >= 128 && sign == 0) { X b->val.i -= 256; X } else if (b->val.i >= 128 || X (b->val.i == 127 && sign != 0)) { X if (highcharbits && (highcharbits > 0 || signedchars < 0)) X a = makeexpr_bin(EK_BAND, a->val.type, eatcasts(a), X makeexpr_long(255)); X else X a = force_unsigned(a); X } X } X } else if (a->val.type->kind == TK_STRING && X b->val.type->kind == TK_STRING) { X if (b->kind == EK_CONST && b->val.i == 0 && !sign) { X a = makeexpr_hat(a, 0); X b = makeexpr_char(0); /* "a = ''" => "*a == 0" */ X } else { X a = makeexpr_bicall_2("strcmp", tp_int, a, b); X b = makeexpr_long(0); X } X } else if ((a->val.type->kind == TK_ARRAY || X a->val.type->kind == TK_STRING || X a->val.type->kind == TK_RECORD) && X (b->val.type->kind == TK_ARRAY || X b->val.type->kind == TK_STRING || X b->val.type->kind == TK_RECORD)) { X if (a->val.type->kind == TK_ARRAY) { X if (b->val.type->kind == TK_ARRAY) { X ex = makeexpr_sizeof(copyexpr(a), 0); X ex2 = makeexpr_sizeof(copyexpr(b), 0); X if (!exprsame(ex, ex2, 1)) X warning("Incompatible array sizes [164]"); X freeexpr(ex2); X } else { X ex = makeexpr_sizeof(copyexpr(a), 0); X } X } else X ex = makeexpr_sizeof(copyexpr(b), 0); X name = (usestrncmp && X a->val.type->kind == TK_ARRAY && X a->val.type->basetype->kind == TK_CHAR) ? "strncmp" : "memcmp"; X a = makeexpr_bicall_3(name, tp_int, X makeexpr_addr(a), X makeexpr_addr(b), ex); X b = makeexpr_long(0); X } else if (a->val.type->kind == TK_SET || X a->val.type->kind == TK_SMALLSET) { X if (rel == EK_GE) { X swapexprs(a, b); X rel = EK_LE; X } X if (mixsets(&a, &b)->kind == TK_SMALLSET) { X if (rel == EK_LE) { X a = makeexpr_bin(EK_BAND, tp_integer, X a, makeexpr_un(EK_BNOT, tp_integer, b)); X b = makeexpr_long(0); X rel = EK_EQ; X } X } else if (b->kind == EK_BICALL && X !strcmp(b->val.s, setexpandname) && X (mp = istempvar(b->args[0])) != NULL && X checkconst(b->args[1], 0)) { X canceltempvar(mp); X a = makeexpr_hat(a, 0); X b = grabarg(b, 1); X if (rel == EK_LE) X rel = EK_EQ; X } else { X ex = makeexpr_bicall_2((rel == EK_LE) ? subsetname : setequalname, X tp_boolean, a, b); X return (rel == EK_NE) ? makeexpr_not(ex) : ex; X } X } else if (a->val.type->kind == TK_PROCPTR || X a->val.type->kind == TK_CPROCPTR) { X /* we compare proc only (not link) -- same as Pascal compiler! */ X if (a->val.type->kind == TK_PROCPTR) X a = makeexpr_dotq(a, "proc", tp_anyptr); X if ((mp = istempprocptr(b)) != NULL) { X canceltempvar(mp); X b = grabarg(grabarg(b, 0), 1); X if (!voidstar) X b = makeexpr_cast(b, tp_anyptr); X } else if (b->val.type->kind == TK_PROCPTR) X b = makeexpr_dotq(b, "proc", tp_anyptr); X } X return makeexpr_bin(rel, tp_boolean, a, b); X} X X X X XExpr *makeexpr_and(a, b) XExpr *a, *b; X{ X Expr *ex, **exp, *low; X X if (!a) X return b; X if (!b) X return a; X for (exp = &a; (ex = *exp)->kind == EK_AND; exp = &ex->args[1]) ; X if ((b->kind == EK_LT || b->kind == EK_LE) && X ((ex->kind == EK_LE && exprsame(ex->args[1], b->args[0], 1)) || X (ex->kind == EK_GE && exprsame(ex->args[0], b->args[0], 1)))) { X low = (ex->kind == EK_LE) ? ex->args[0] : ex->args[1]; X if (unsignedtrick && checkconst(low, 0)) { X freeexpr(ex); X b->args[0] = force_unsigned(b->args[0]); X *exp = b; X return a; X } X if (b->args[1]->val.type->kind == TK_CHAR && useisalpha) { X if (checkconst(low, 'A') && checkconst(b->args[1], 'Z')) { X freeexpr(ex); X *exp = makeexpr_bicall_1("isupper", tp_boolean, grabarg(b, 0)); X return a; X } X if (checkconst(low, 'a') && checkconst(b->args[1], 'z')) { X freeexpr(ex); X *exp = makeexpr_bicall_1("islower", tp_boolean, grabarg(b, 0)); X return a; X } X if (checkconst(low, '0') && checkconst(b->args[1], '9')) { X freeexpr(ex); X *exp = makeexpr_bicall_1("isdigit", tp_boolean, grabarg(b, 0)); X return a; X } X } X } X return makeexpr_bin(EK_AND, tp_boolean, a, b); X} X X X XExpr *makeexpr_or(a, b) XExpr *a, *b; X{ X Expr *ex, **exp, *low; X X if (!a) X return b; X if (!b) X return a; X for (exp = &a; (ex = *exp)->kind == EK_OR; exp = &ex->args[1]) ; X if (((b->kind == EK_BICALL && !strcmp(b->val.s, "isdigit") && X ex->kind == EK_BICALL && !strcmp(ex->val.s, "isalpha")) || X (b->kind == EK_BICALL && !strcmp(b->val.s, "isalpha") && X ex->kind == EK_BICALL && !strcmp(ex->val.s, "isdigit"))) && X exprsame(ex->args[0], b->args[0], 1)) { X strchange(&ex->val.s, "isalnum"); X freeexpr(b); X return a; X } X if (((b->kind == EK_BICALL && !strcmp(b->val.s, "islower") && X ex->kind == EK_BICALL && !strcmp(ex->val.s, "isupper")) || X (b->kind == EK_BICALL && !strcmp(b->val.s, "isupper") && X ex->kind == EK_BICALL && !strcmp(ex->val.s, "islower"))) && X exprsame(ex->args[0], b->args[0], 1)) { X strchange(&ex->val.s, "isalpha"); X freeexpr(b); X return a; X } X if ((b->kind == EK_GT || b->kind == EK_GE) && X ((ex->kind == EK_GT && exprsame(ex->args[1], b->args[0], 1)) || X (ex->kind == EK_LT && exprsame(ex->args[0], b->args[0], 1)))) { X low = (ex->kind == EK_GT) ? ex->args[0] : ex->args[1]; X if (unsignedtrick && checkconst(low, 0)) { X freeexpr(ex); X b->args[0] = force_unsigned(b->args[0]); X *exp = b; X return a; X } X } X return makeexpr_bin(EK_OR, tp_boolean, a, b); X} X X X XExpr *makeexpr_range(ex, exlow, exhigh, higheq) XExpr *ex, *exlow, *exhigh; Xint higheq; X{ X Expr *ex2; X enum exprkind rel = (higheq) ? EK_LE : EK_LT; X X if (exprsame(exlow, exhigh, 1) && higheq) X return makeexpr_rel(EK_EQ, ex, exlow); X ex2 = makeexpr_rel(rel, copyexpr(ex), exhigh); X if (lelerange) X return makeexpr_and(makeexpr_rel(EK_LE, exlow, ex), ex2); X else X return makeexpr_and(makeexpr_rel(EK_GE, ex, exlow), ex2); X} X X X X XExpr *makeexpr_cond(c, a, b) XExpr *c, *a, *b; X{ X Expr *ex; X X ex = makeexpr(EK_COND, 3); X ex->val.type = a->val.type; X ex->args[0] = c; X ex->args[1] = a; X ex->args[2] = b; X if (debug>2) { fprintf(outf,"makeexpr_cond returns "); dumpexpr(ex); fprintf(outf,"\n"); } X return ex; X} X X X X Xint expr_is_lvalue(ex) XExpr *ex; X{ X Meaning *mp; X X switch (ex->kind) { X X case EK_VAR: X mp = (Meaning *)ex->val.i; X return ((mp->kind == MK_VAR || mp->kind == MK_PARAM) || X (mp->kind == MK_CONST && X (mp->type->kind == TK_ARRAY || X mp->type->kind == TK_RECORD || X mp->type->kind == TK_SET))); X X case EK_HAT: X return 1; X X case EK_INDEX: X return expr_is_lvalue(ex->args[0]); X X case EK_DOT: X return expr_is_lvalue(ex->args[0]); X X default: X return 0; X } X} X X Xint expr_has_address(ex) XExpr *ex; X{ X if (ex->kind == EK_DOT && X ((Meaning *)ex->val.i)->val.i) X return 0; /* bit fields do not have an address */ X return expr_is_lvalue(ex); X} X X X XExpr *checknil(ex) XExpr *ex; X{ X if (nilcheck == 1) { X if (singlevar(ex)) { X ex = makeexpr_un(EK_CHECKNIL, ex->val.type, ex); X } else { X ex = makeexpr_bin(EK_CHECKNIL, ex->val.type, ex, X makeexpr_var(makestmttempvar(ex->val.type, X name_PTR))); X } X } X return ex; X} X X Xint checkvarinlists(yes, no, def, mp) XStrlist *yes, *no; Xint def; XMeaning *mp; X{ X char *cp; X Meaning *ctx; X X if (mp->kind == MK_FIELD) X ctx = mp->rectype->meaning; X else X ctx = mp->ctx; X if (ctx && ctx->name) X cp = format_ss("%s.%s", ctx->name, mp->name); X else X cp = NULL; X if (strlist_cifind(yes, cp)) X return 1; X if (strlist_cifind(no, cp)) X return 0; X if (strlist_cifind(yes, mp->name)) X return 1; X if (strlist_cifind(no, mp->name)) X return 0; X if (strlist_cifind(yes, "1")) X return 1; X if (strlist_cifind(no, "1")) X return 0; X return def; X} X X Xvoid requirefilebuffer(ex) XExpr *ex; X{ X Meaning *mp; X X mp = isfilevar(ex); X if (!mp) { X if (ex->kind == EK_HAT) X ex = ex->args[0]; X if (ex->kind == EK_VAR) { X mp = (Meaning *)ex->val.i; X if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM) X note(format_s("File parameter %s needs its associated buffers [318]", X mp->name)); X } X } else if (!mp->bufferedfile && X checkvarinlists(bufferedfiles, unbufferedfiles, 1, mp)) { X if (mp->wasdeclared) X note(format_s("Discovered too late that %s should be buffered [143]", X mp->name)); X mp->bufferedfile = 1; X } X} X X XExpr *makeexpr_hat(a, check) XExpr *a; Xint check; X{ X Expr *ex; X X if (debug>2) { fprintf(outf,"makeexpr_hat("); dumpexpr(a); fprintf(outf,")\n"); } X if (isfiletype(a->val.type)) { X requirefilebuffer(a); X if (*chargetfbufname && X a->val.type->basetype->basetype->kind == TK_CHAR) X return makeexpr_bicall_1(chargetfbufname, X a->val.type->basetype->basetype, a); X else if (*arraygetfbufname && X a->val.type->basetype->basetype->kind == TK_ARRAY) X return makeexpr_bicall_2(arraygetfbufname, X a->val.type->basetype->basetype, a, X makeexpr_type(a->val.type->basetype->basetype)); X else X return makeexpr_bicall_2(getfbufname, X a->val.type->basetype->basetype, a, X makeexpr_type(a->val.type->basetype->basetype)); X } X if (a->kind == EK_PLUS && X (ex = a->args[0])->val.type->kind == TK_POINTER && X (ex->val.type->basetype->kind == TK_ARRAY || X ex->val.type->basetype->kind == TK_STRING || X ex->val.type->basetype->kind == TK_SET)) { X ex->val.type = ex->val.type->basetype; /* convert *(a+n) to a[n] */ X deletearg(&a, 0); X if (a->nargs == 1) X a = grabarg(a, 0); X return makeexpr_bin(EK_INDEX, ex->val.type->basetype, ex, a); X } X if (a->val.type->kind == TK_STRING || X a->val.type->kind == TK_ARRAY || X a->val.type->kind == TK_SET) { X if (starindex == 0) X return makeexpr_bin(EK_INDEX, a->val.type->basetype, a, makeexpr_long(0)); X else X return makeexpr_un(EK_HAT, a->val.type->basetype, a); X } X if (a->val.type->kind != TK_POINTER || !a->val.type->basetype) { X warning("bad pointer dereference [165]"); X return a; X } X if (a->kind == EK_CAST && X a->val.type->basetype->kind == TK_POINTER && X a->args[0]->val.type->kind == TK_POINTER && X a->args[0]->val.type->basetype->kind == TK_POINTER) { X return makeexpr_cast(makeexpr_hat(a->args[0], 0), X a->val.type->basetype); X } X switch (a->val.type->basetype->kind) { X X case TK_ARRAY: X case TK_STRING: X case TK_SET: X if (a->kind != EK_HAT || 1 || X a->val.type == a->args[0]->val.type->basetype) { X a->val.type = a->val.type->basetype; X return a; X } X X default: X if (a->kind == EK_ADDR) { X ex = a->args[0]; X FREE(a); X return ex; X } else { X if (check) X ex = checknil(a); X else X ex = a; X return makeexpr_un(EK_HAT, a->val.type->basetype, ex); X } X } X} X X X XExpr *un_sign_extend(a) XExpr *a; X{ X if (a->kind == EK_BICALL && X !strcmp(a->val.s, signextname) && *signextname) { X return grabarg(a, 0); X } X return a; X} X X X XExpr *makeexpr_addr(a) XExpr *a; X{ X Expr *ex; X Type *type; X X a = un_sign_extend(a); X type = makepointertype(a->val.type); X if (debug>2) { fprintf(outf,"makeexpr_addr("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); } X if (a->kind == EK_CONST && a->val.type->kind == TK_STRING) { X return a; /* kludge to help assignments */ X } else if (a->kind == EK_INDEX && X (a->val.type->kind != TK_ARRAY && X a->val.type->kind != TK_SET && X a->val.type->kind != TK_STRING) && X (addindex == 1 || X (addindex != 0 && checkconst(a->args[1], 0)))) { X ex = makeexpr_plus(makeexpr_addr(a->args[0]), a->args[1]); X FREE(a); X ex->val.type = type; X return ex; X } else { X switch (a->val.type->kind) { X X case TK_ARRAY: X case TK_STRING: X case TK_SET: X if (a->val.type->smin) { X return makeexpr_un(EK_ADDR, type, X makeexpr_index(a, X copyexpr(a->val.type->smin), X NULL)); X } X a->val.type = type; X return a; X X default: X if (a->kind == EK_HAT) { X ex = a->args[0]; X FREE(a); X return ex; X } else if (a->kind == EK_ACTCAST) X return makeexpr_actcast(makeexpr_addr(grabarg(a, 0)), type); X else if (a->kind == EK_CAST) X return makeexpr_cast(makeexpr_addr(grabarg(a, 0)), type); X else X return makeexpr_un(EK_ADDR, type, a); X } X } X} X X X XExpr *makeexpr_addrstr(a) XExpr *a; X{ X if (debug>2) { fprintf(outf,"makeexpr_addrstr("); dumpexpr(a); fprintf(outf,")\n"); } X if (a->val.type->kind == TK_POINTER) X return a; X return makeexpr_addr(a); X} X X X XExpr *makeexpr_addrf(a) XExpr *a; X{ X Meaning *mp, *tvar; X X mp = (Meaning *)a->val.i; X if ((a->kind == EK_VAR && X (mp == mp_input || mp == mp_output)) || X (a->kind == EK_NAME && X !strcmp(a->val.s, "stderr"))) { X if (addrstdfiles == 0) { X note(format_s("Taking address of %s; consider setting VarFiles = 0 [144]", X (a->kind == EK_VAR) ? ((Meaning *)a->val.i)->name X : a->val.s)); X tvar = makestmttempvar(tp_text, name_TEMP); X return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), a), X makeexpr_addr(makeexpr_var(tvar))); X } X } X if ((a->kind == EK_VAR && X mp->kind == MK_FIELD && mp->val.i) || X (a->kind == EK_BICALL && X !strcmp(a->val.s, getbitsname))) { X warning("Can't take the address of a bit-field [166]"); X } X return makeexpr_addr(a); X} X X X XExpr *makeexpr_index(a, b, offset) XExpr *a, *b, *offset; X{ X Type *indextype, *btype; X X if (debug>2) { fprintf(outf,"makeexpr_index("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); X fprintf(outf,", "); dumpexpr(offset); fprintf(outf,")\n"); } X indextype = (a->val.type->kind == TK_ARRAY) ? a->val.type->indextype X : tp_integer; X b = gentle_cast(b, indextype); X if (!offset) X offset = makeexpr_long(0); X b = makeexpr_minus(b, gentle_cast(offset, indextype)); X btype = a->val.type; X if (btype->basetype) X btype = btype->basetype; X if (checkconst(b, 0) && starindex == 1) X return makeexpr_un(EK_HAT, btype, a); X else X return makeexpr_bin(EK_INDEX, btype, a, X gentle_cast(b, indextype)); X} X X X XExpr *makeexpr_type(type) XType *type; X{ X Expr *ex; X X ex = makeexpr(EK_TYPENAME, 0); X ex->val.type = type; X return ex; X} X X XExpr *makeexpr_sizeof(ex, incskipped) XExpr *ex; Xint incskipped; X{ X Expr *ex2, *ex3; X Type *btype; X char *name; X X if (ex->val.type->meaning) { X name = find_special_variant(ex->val.type->meaning->name, X "SpecialSizeOf", specialsizeofs, 1); X if (name) { X freeexpr(ex); X return pc_expr_str(name); X } X } X switch (ex->val.type->kind) { X X case TK_CHAR: X case TK_BOOLEAN: X freeexpr(ex); X return makeexpr_long(1); X X case TK_SUBR: X btype = findbasetype(ex->val.type, 0); X if (btype->kind == TK_CHAR || btype == tp_abyte) { X freeexpr(ex); X return makeexpr_long(1); X } X break; X X case TK_STRING: X case TK_ARRAY: X if (!ex->val.type->meaning || ex->val.type->kind == TK_STRING) { X ex3 = arraysize(ex->val.type, incskipped); X return makeexpr_times(ex3, X makeexpr_sizeof(makeexpr_type( X ex->val.type->basetype), 1)); X } X break; X X case TK_SET: X ord_range_expr(ex->val.type->indextype, NULL, &ex2); X freeexpr(ex); X return makeexpr_times(makeexpr_plus(makeexpr_div(copyexpr(ex2), X makeexpr_setbits()), X makeexpr_long(2)), X makeexpr_sizeof(makeexpr_type(tp_integer), 0)); X break; X X default: X break; X } X if (ex->kind != EK_CONST && X (findbasetype(ex->val.type,0)->meaning || /* if type has a name... */ X ex->val.type->kind == TK_STRING || /* if C sizeof(expr) will give wrong answer */ X ex->val.type->kind == TK_ARRAY || X ex->val.type->kind == TK_SET)) { X ex2 = makeexpr_type(ex->val.type); X freeexpr(ex); X ex = ex2; X } X return makeexpr_un(EK_SIZEOF, tp_integer, ex); X} X X X X X/* Compute a measure of how fast or slow the expression is likely to be. X 0 is a constant, 1 is a variable, extra points added per "operation". */ X Xint exprspeed(ex) XExpr *ex; X{ X Meaning *mp, *mp2; X int i, cost, speed; X X switch (ex->kind) { X X case EK_VAR: X mp = (Meaning *)ex->val.i; X if (mp->kind == MK_CONST) X return 0; X if (!mp->ctx || mp->ctx->kind == MK_FUNCTION) X return 1; X i = 1; X for (mp2 = curctx; mp2 && mp2 != mp->ctx; mp2 = mp2->ctx) X i++; /* cost of following static links */ X return (i); X X case EK_CONST: X case EK_LONGCONST: X case EK_SIZEOF: X return 0; X X case EK_ADDR: X speed = exprspeed(ex->args[0]); X return (speed > 1) ? speed : 0; X X case EK_DOT: X return exprspeed(ex->args[0]); X X case EK_NEG: X return exprspeed(ex->args[0]) + 1; X X case EK_CAST: X case EK_ACTCAST: X i = (ord_type(ex->val.type)->kind == TK_REAL) != X (ord_type(ex->args[0]->val.type)->kind == TK_REAL); X return (i + exprspeed(ex->args[0])); X X case EK_COND: X return 2 + exprspeed(ex->args[0]) + X MAX(exprspeed(ex->args[1]), exprspeed(ex->args[2])); X X case EK_AND: X case EK_OR: X case EK_COMMA: X speed = 2; X for (i = 0; i < ex->nargs; i++) X speed += exprspeed(ex->args[i]); X return speed; X X case EK_FUNCTION: X case EK_BICALL: X case EK_SPCALL: X return 1000; X X case EK_ASSIGN: X case EK_POSTINC: X case EK_POSTDEC: X return 100 + exprspeed(ex->args[0]) + exprspeed(ex->args[1]); X X default: X cost = (ex->kind == EK_PLUS) ? 1 : 2; X if (ex->val.type->kind == TK_REAL) X cost *= 2; X speed = -cost; X for (i = 0; i < ex->nargs; i++) { X if (!isliteralconst(ex->args[i], NULL) || X ex->val.type->kind == TK_REAL) X speed += exprspeed(ex->args[i]) + cost; X } X return MAX(speed, 0); X } X} X X X X Xint noargdependencies(ex, vars) XExpr *ex; Xint vars; X{ X int i; X X for (i = 0; i < ex->nargs; i++) { X if (!nodependencies(ex->args[i], vars)) X return 0; X } X return 1; X} X X Xint nodependencies(ex, vars) XExpr *ex; Xint vars; /* 1 if explicit dependencies on vars count as dependencies */ X{ /* 2 if global but not local vars count as dependencies */ X Meaning *mp; X X if (debug>2) { fprintf(outf,"nodependencies("); dumpexpr(ex); fprintf(outf,")\n"); } X if (!noargdependencies(ex, vars)) X return 0; X switch (ex->kind) { X X case EK_VAR: X mp = (Meaning *)ex->val.i; X if (mp->kind == MK_CONST) X return 1; X if (vars == 2 && X mp->ctx == curctx && X mp->ctx->kind == MK_FUNCTION && X !mp->varstructflag) X return 1; X return (mp->kind == MK_CONST || X (!vars && X (mp->kind == MK_VAR || mp->kind == MK_VARREF || X mp->kind == MK_PARAM || mp->kind == MK_VARPARAM))); X X case EK_BICALL: X return nosideeffects_func(ex); X X case EK_FUNCTION: X case EK_SPCALL: X case EK_ASSIGN: X case EK_POSTINC: X case EK_POSTDEC: X case EK_HAT: X case EK_INDEX: X return 0; X X default: X return 1; X } X} X X X Xint exprdependsvar(ex, mp) XExpr *ex; XMeaning *mp; X{ X int i; X X i = ex->nargs; X while (--i >= 0) X if (exprdependsvar(ex->args[i], mp)) X return 1; X switch (ex->kind) { X X case EK_VAR: X return ((Meaning *)ex->val.i == mp); X X case EK_BICALL: X if (nodependencies(ex, 1)) X return 0; X X /* fall through */ X case EK_FUNCTION: X case EK_SPCALL: X return (mp->ctx != curctx || X mp->ctx->kind != MK_FUNCTION || X mp->varstructflag); X X case EK_HAT: X return 1; X X default: X return 0; X } X} X X Xint exprdepends(ex, ex2) XExpr *ex, *ex2; /* Expression ex somehow depends on value of ex2 */ X{ X switch (ex2->kind) { X X case EK_VAR: X return exprdependsvar(ex, (Meaning *)ex2->val.i); X X case EK_CONST: X case EK_LONGCONST: X return 0; X X case EK_INDEX: X case EK_DOT: X return exprdepends(ex, ex2->args[0]); X X default: X return !nodependencies(ex, 1); X } X} X X Xint nosideeffects_func(ex) XExpr *ex; X{ X Meaning *mp; X Symbol *sp; X X switch (ex->kind) { X X case EK_FUNCTION: X mp = (Meaning *)ex->val.i; X sp = findsymbol_opt(mp->name); X return sp && (sp->flags & (NOSIDEEFF|DETERMF)); X X case EK_BICALL: X sp = findsymbol_opt(ex->val.s); X return sp && (sp->flags & (NOSIDEEFF|DETERMF)); X X default: X return 0; X } X} X X X Xint deterministic_func(ex) XExpr *ex; X{ X Meaning *mp; X Symbol *sp; X X switch (ex->kind) { X X case EK_FUNCTION: X mp = (Meaning *)ex->val.i; X sp = findsymbol_opt(mp->name); X return sp && (sp->flags & DETERMF); X X case EK_BICALL: X sp = findsymbol_opt(ex->val.s); X return sp && (sp->flags & DETERMF); X X default: X return 0; X } X} X X X X Xint noargsideeffects(ex, mode) XExpr *ex; Xint mode; X{ X int i; X X for (i = 0; i < ex->nargs; i++) { END_OF_FILE if test 48964 -ne `wc -c <'src/expr.c.2'`; then echo shar: \"'src/expr.c.2'\" unpacked with wrong size! fi # end of 'src/expr.c.2' fi echo shar: End of archive 25 \(of 32\). cp /dev/null ark25isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 32 archives. echo "Now see PACKNOTES and the README" rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.