home *** CD-ROM | disk | FTP | other *** search
- Subject: v21i070: Pascal to C translator, Part25/32
- Newsgroups: comp.sources.unix
- Approved: rsalz@uunet.UU.NET
- X-Checksum-Snefru: 02158bff 52298f9e 19a2b2f2 708ebb7b
-
- 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
-