v21i070: Pascal to C translator, Part25/32
Rich Salz
rsalz at uunet.uu.net
Thu Mar 29 23:49:08 AEST 1990
Submitted-by: Dave Gillespie <daveg at 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 at 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 at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list