home *** CD-ROM | disk | FTP | other *** search
- Subject: v21i061: Pascal to C translator, Part16/32
- Newsgroups: comp.sources.unix
- Approved: rsalz@uunet.UU.NET
- X-Checksum-Snefru: a713ac3c a1f8f4a6 88f31b90 cee897dc
-
- Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
- Posting-number: Volume 21, Issue 61
- Archive-name: p2c/part16
-
- #! /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 16 (of 32)."
- # Contents: src/expr.c.3
- # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:38 1990
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'src/expr.c.3' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'src/expr.c.3'\"
- else
- echo shar: Extracting \"'src/expr.c.3'\" \(41883 characters\)
- sed "s/^X//" >'src/expr.c.3' <<'END_OF_FILE'
- X if (!nosideeffects(ex->args[i], mode))
- X return 0;
- X }
- X return 1;
- X}
- X
- X
- X/* mode=0: liberal about bicall's: safe unless sideeffects_bicall() */
- X/* mode=1: conservative about bicall's: must be explicitly NOSIDEEFF */
- X
- Xint nosideeffects(ex, mode)
- XExpr *ex;
- Xint mode;
- X{
- X if (debug>2) { fprintf(outf,"nosideeffects("); dumpexpr(ex); fprintf(outf,")\n"); }
- X if (!noargsideeffects(ex, mode))
- X return 0;
- X switch (ex->kind) {
- X
- X case EK_BICALL:
- X if (mode == 0)
- X return !sideeffects_bicall(ex->val.s);
- X
- X /* fall through */
- X case EK_FUNCTION:
- X return nosideeffects_func(ex);
- X
- X case EK_SPCALL:
- X case EK_ASSIGN:
- X case EK_POSTINC:
- X case EK_POSTDEC:
- X return 0;
- X
- X default:
- X return 1;
- X }
- X}
- X
- X
- X
- Xint exproccurs(ex, ex2)
- XExpr *ex, *ex2;
- X{
- X int i, count = 0;
- X
- X if (debug>2) { fprintf(outf,"exproccurs("); dumpexpr(ex); fprintf(outf,", "); dumpexpr(ex2); fprintf(outf,")\n"); }
- X for (i = 0; i < ex->nargs; i++)
- X count += exproccurs(ex->args[i], ex2);
- X if (exprsame(ex, ex2, 0))
- X count++;
- X return count;
- X}
- X
- X
- X
- XExpr *singlevar(ex)
- XExpr *ex;
- X{
- X if (debug>2) { fprintf(outf,"singlevar("); dumpexpr(ex); fprintf(outf,")\n"); }
- X switch (ex->kind) {
- X
- X case EK_VAR:
- X case EK_MACARG:
- X return ex;
- X
- X case EK_HAT:
- X case EK_ADDR:
- X case EK_DOT:
- X return singlevar(ex->args[0]);
- X
- X case EK_INDEX:
- X if (!nodependencies(ex->args[1], 1))
- X return NULL;
- X return singlevar(ex->args[0]);
- X
- X default:
- X return NULL;
- X }
- X}
- X
- X
- X
- X/* Is "ex" a function which takes a return buffer pointer as its
- X first argument, and returns a copy of that pointer? */
- X
- Xint structuredfunc(ex)
- XExpr *ex;
- X{
- X Meaning *mp;
- X Symbol *sp;
- X
- X if (debug>2) { fprintf(outf,"structuredfunc("); dumpexpr(ex); fprintf(outf,")\n"); }
- X switch (ex->kind) {
- X
- X case EK_FUNCTION:
- X mp = (Meaning *)ex->val.i;
- X if (mp->isfunction && mp->cbase && mp->cbase->kind == MK_VARPARAM)
- X return 1;
- X sp = findsymbol_opt(mp->name);
- X return sp && (sp->flags & (STRUCTF|STRLAPF));
- X
- X case EK_BICALL:
- X sp = findsymbol_opt(ex->val.s);
- X return sp && (sp->flags & (STRUCTF|STRLAPF));
- X
- X default:
- X return 0;
- X }
- X}
- X
- X
- X
- Xint strlapfunc(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 & STRLAPF);
- X
- X case EK_BICALL:
- X sp = findsymbol_opt(ex->val.s);
- X return sp && (sp->flags & STRLAPF);
- X
- X default:
- X return 0;
- X }
- X}
- X
- X
- X
- XMeaning *istempvar(ex)
- XExpr *ex;
- X{
- X Meaning *mp;
- X
- X if (debug>2) { fprintf(outf,"istempvar("); dumpexpr(ex); fprintf(outf,")\n"); }
- X if (ex->kind == EK_VAR) {
- X mp = (Meaning *)ex->val.i;
- X if (mp->istemporary)
- X return mp;
- X else
- X return NULL;
- X }
- X return NULL;
- X}
- X
- X
- X
- XMeaning *isretvar(ex)
- XExpr *ex;
- X{
- X Meaning *mp;
- X
- X if (debug>2) { fprintf(outf,"isretvar("); dumpexpr(ex); fprintf(outf,")\n"); }
- 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->ctx && mp->ctx->kind == MK_FUNCTION &&
- X mp->ctx->isfunction && mp == mp->ctx->cbase)
- X return mp;
- X else
- X return NULL;
- X }
- X return NULL;
- X}
- X
- X
- X
- XExpr *bumpstring(ex, index, offset)
- XExpr *ex, *index;
- Xint offset;
- X{
- X if (checkconst(index, offset)) {
- X freeexpr(index);
- X return ex;
- X }
- X if (addindex != 0)
- X ex = makeexpr_plus(makeexpr_addrstr(ex),
- X makeexpr_minus(index, makeexpr_long(offset)));
- X else
- X ex = makeexpr_addr(makeexpr_index(ex, index, makeexpr_long(offset)));
- X ex->val.type = tp_str255;
- X return ex;
- X}
- X
- X
- X
- Xlong po2m1(n)
- Xint n;
- X{
- X if (n == 32)
- X return -1;
- X else if (n == 31)
- X return 0x7fffffff;
- X else
- X return (1<<n) - 1;
- X}
- X
- X
- X
- Xint isarithkind(kind)
- Xenum exprkind kind;
- X{
- X return (kind == EK_EQ || kind == EK_LT || kind == EK_GT ||
- X kind == EK_NE || kind == EK_LE || kind == EK_GE ||
- X kind == EK_PLUS || kind == EK_TIMES || kind == EK_DIVIDE ||
- X kind == EK_DIV || kind == EK_MOD || kind == EK_NEG ||
- X kind == EK_AND || kind == EK_OR || kind == EK_NOT ||
- X kind == EK_BAND || kind == EK_BOR || kind == EK_BXOR ||
- X kind == EK_LSH || kind == EK_RSH || kind == EK_BNOT ||
- X kind == EK_FUNCTION || kind == EK_BICALL);
- X}
- X
- X
- XExpr *makeexpr_assign(a, b)
- XExpr *a, *b;
- X{
- X int i, j;
- X Expr *ex, *ex2, *ex3, **ep;
- X Meaning *mp;
- X Type *tp;
- X
- X if (debug>2) { fprintf(outf,"makeexpr_assign("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
- X if (stringtrunclimit > 0 &&
- X a->val.type->kind == TK_STRING &&
- X (i = strmax(a)) <= stringtrunclimit &&
- X strmax(b) > i) {
- X note("Possible string truncation in assignment [145]");
- X }
- X a = un_sign_extend(a);
- X b = gentle_cast(b, a->val.type);
- X if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
- X (mp = istempvar(b->args[0])) != NULL &&
- X b->nargs >= 2 &&
- X b->args[1]->kind == EK_CONST && /* all this handles string appending */
- X b->args[1]->val.i > 2 && /* of the form, "s := s + ..." */
- X !strncmp(b->args[1]->val.s, "%s", 2) &&
- X exprsame(a, b->args[2], 1) &&
- X nosideeffects(a, 0) &&
- X (ex = singlevar(a)) != NULL) {
- X ex2 = copyexpr(b);
- X delfreearg(&ex2, 2);
- X freeexpr(ex2->args[1]);
- X ex2->args[1] = makeexpr_lstring(b->args[1]->val.s+2,
- X b->args[1]->val.i-2);
- X if (/*(ex = singlevar(a)) != NULL && */
- X /* noargdependencies(ex2) && */ !exproccurs(ex2, ex)) {
- X freeexpr(b);
- X if (ex2->args[1]->val.i == 2 && /* s := s + s2 */
- X !strncmp(ex2->args[1]->val.s, "%s", 2)) {
- X canceltempvar(mp);
- X tp = ex2->val.type;
- X return makeexpr_bicall_2("strcat", tp,
- X makeexpr_addrstr(a), grabarg(ex2, 2));
- X } else if (sprintflength(ex2, 0) >= 0) { /* s := s + 's2' */
- X tp = ex2->val.type;
- X return makeexpr_bicall_2("strcat", tp,
- X makeexpr_addrstr(a),
- X makeexpr_unsprintfify(ex2));
- X } else { /* general case */
- X canceltempvar(mp);
- X freeexpr(ex2->args[0]);
- X ex = makeexpr_bicall_1("strlen", tp_int, copyexpr(a));
- X ex2->args[0] = bumpstring(a, ex, 0);
- X return ex2;
- X }
- X } else
- X freeexpr(ex2);
- X }
- X if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
- X istempvar(b->args[0]) &&
- X (ex = singlevar(a)) != NULL) {
- X j = -1; /* does lhs var appear exactly once on rhs? */
- X for (i = 2; i < b->nargs; i++) {
- X if (exprsame(b->args[i], ex, 1) && j < 0)
- X j = i;
- X else if (exproccurs(b->args[i], ex))
- X break;
- X }
- X if (i == b->nargs && j > 0) {
- X b->args[j] = makeexpr_bicall_2("strcpy", tp_str255,
- X makeexpr_addrstr(b->args[0]),
- X makeexpr_addrstr(b->args[j]));
- X b->args[0] = makeexpr_addrstr(a);
- X return b;
- X }
- X }
- X if (structuredfunc(b) && (ex2 = singlevar(a)) != NULL) {
- X ep = &b->args[0];
- X i = strlapfunc(b);
- X while (structuredfunc((ex = *ep))) {
- X i = i && strlapfunc(ex);
- X ep = &ex->args[0];
- X }
- X if ((mp = istempvar(ex)) != NULL &&
- X (i || !exproccurs(b, ex2))) {
- X canceltempvar(mp);
- X freeexpr(*ep);
- X *ep = makeexpr_addrstr(a);
- X return b;
- X }
- X }
- X if (a->val.type->kind == TK_PROCPTR &&
- X (mp = istempprocptr(b)) != NULL &&
- X nosideeffects(a, 0)) {
- X freeexpr(b->args[0]->args[0]->args[0]);
- X b->args[0]->args[0]->args[0] = copyexpr(a);
- X if (b->nargs == 3) {
- X freeexpr(b->args[1]->args[0]->args[0]);
- X b->args[1]->args[0]->args[0] = a;
- X delfreearg(&b, 2);
- X } else {
- X freeexpr(b->args[1]);
- X b->args[1] = makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
- X makeexpr_nil());
- X }
- X canceltempvar(mp);
- X return b;
- X }
- X if (a->val.type->kind == TK_PROCPTR &&
- X (b->val.type->kind == TK_CPROCPTR ||
- X checkconst(b, 0))) {
- X ex = makeexpr_dotq(copyexpr(a), "proc", tp_anyptr);
- X b = makeexpr_comma(makeexpr_assign(ex, b),
- X makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
- X makeexpr_nil()));
- X return b;
- X }
- X if (a->val.type->kind == TK_CPROCPTR &&
- X (mp = istempprocptr(b)) != NULL &&
- X nosideeffects(a, 0)) {
- X freeexpr(b->args[0]->args[0]);
- X b->args[0]->args[0] = a;
- X if (b->nargs == 3)
- X delfreearg(&b, 1);
- X delfreearg(&b, 1);
- X canceltempvar(mp);
- X return b;
- X }
- X if (a->val.type->kind == TK_CPROCPTR &&
- X b->val.type->kind == TK_PROCPTR) {
- X b = makeexpr_dotq(b, "proc", tp_anyptr);
- X }
- X if (a->val.type->kind == TK_STRING) {
- X if (b->kind == EK_CONST && b->val.i == 0 && !isretvar(a)) {
- X /* optimizing retvar would mess up "return" optimization */
- X return makeexpr_assign(makeexpr_hat(a, 0),
- X makeexpr_char(0));
- X }
- X a = makeexpr_addrstr(a);
- X b = makeexpr_addrstr(b);
- X return makeexpr_bicall_2("strcpy", a->val.type, a, b);
- X }
- X if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen")) {
- X if (b->kind == EK_CAST &&
- X ord_type(b->args[0]->val.type)->kind == TK_INTEGER) {
- X b = grabarg(b, 0);
- X }
- X j = (b->kind == EK_PLUS && /* handle "s[0] := xxx" */
- X b->args[0]->kind == EK_BICALL &&
- X !strcmp(b->args[0]->val.s, "strlen") &&
- X exprsame(a->args[0], b->args[0]->args[0], 0) &&
- X isliteralconst(b->args[1], NULL) == 2);
- X if (j && b->args[1]->val.i > 0 &&
- X b->args[1]->val.i <= 5) { /* lengthening the string */
- X a = grabarg(a, 0);
- X i = b->args[1]->val.i;
- X freeexpr(b);
- X if (i == 1)
- X b = makeexpr_string(" ");
- X else
- X b = makeexpr_lstring("12345", i);
- X return makeexpr_bicall_2("strcat", a->val.type, a, b);
- X } else { /* maybe shortening the string */
- X if (!j && !isconstexpr(b, NULL))
- X note("Modification of string length may translate incorrectly [146]");
- X a = grabarg(a, 0);
- X b = makeexpr_ord(b);
- X return makeexpr_assign(makeexpr_index(a, b, NULL),
- X makeexpr_char(0));
- X }
- X }
- X if (a->val.type->kind == TK_ARRAY ||
- X (a->val.type->kind == TK_PROCPTR && copystructs < 1) ||
- X (a->val.type->kind == TK_RECORD &&
- X (copystructs < 1 || a->val.type != b->val.type))) {
- X ex = makeexpr_sizeof(copyexpr(a), 0);
- X ex2 = makeexpr_sizeof(copyexpr(b), 0);
- X if (!exprsame(ex, ex2, 1) &&
- X !(a->val.type->kind == TK_ARRAY &&
- X b->val.type->kind != TK_ARRAY))
- X warning("Incompatible types or sizes [167]");
- X freeexpr(ex2);
- X ex = makeexpr_arglong(ex, (size_t_long != 0));
- X a = makeexpr_addrstr(a);
- X b = makeexpr_addrstr(b);
- X return makeexpr_bicall_3("memcpy", a->val.type, a, b, ex);
- X }
- X if (a->val.type->kind == TK_SET) {
- X a = makeexpr_addrstr(a);
- X b = makeexpr_addrstr(b);
- X return makeexpr_bicall_2(setcopyname, a->val.type, a, b);
- X }
- X for (ep = &a; (ex3 = *ep); ) {
- X if (ex3->kind == EK_COMMA)
- X ep = &ex3->args[ex3->nargs-1];
- X else if (ex3->kind == EK_CAST || ex3->kind == EK_ACTCAST)
- X ep = &ex3->args[0];
- X else
- X break;
- X }
- X if (ex3->kind == EK_BICALL) {
- X if (!strcmp(ex3->val.s, getbitsname)) {
- X tp = ex3->args[0]->val.type;
- X if (tp->kind == TK_ARRAY)
- X ex3->args[0] = makeexpr_addr(ex3->args[0]);
- X ex3->val.type = tp_void;
- X if (checkconst(b, 0) && *clrbitsname) {
- X strchange(&ex3->val.s, clrbitsname);
- X } else if (*putbitsname &&
- X ((ISCONST(b->kind) &&
- X (b->val.i | ~((1 << (1 << tp->escale)) - 1)) == -1) ||
- X checkconst(b, (1 << (1 << tp->escale)) - 1))) {
- X strchange(&ex3->val.s, putbitsname);
- X insertarg(ep, 2, makeexpr_arglong(makeexpr_ord(b), 0));
- X } else {
- X b = makeexpr_arglong(makeexpr_ord(b), 0);
- X if (*storebitsname) {
- X strchange(&ex3->val.s, storebitsname);
- X insertarg(ep, 2, b);
- X } else {
- X if (exproccurs(b, ex3->args[0])) {
- X mp = makestmttempvar(b->val.type, name_TEMP);
- X ex2 = makeexpr_assign(makeexpr_var(mp), b);
- X b = makeexpr_var(mp);
- X } else
- X ex2 = NULL;
- X ex = copyexpr(ex3);
- X strchange(&ex3->val.s, putbitsname);
- X insertarg(&ex3, 2, b);
- X strchange(&ex->val.s, clrbitsname);
- X *ep = makeexpr_comma(ex2, makeexpr_comma(ex, ex3));
- X }
- X }
- X return a;
- X } else if (!strcmp(ex3->val.s, getfbufname)) {
- X ex3->val.type = tp_void;
- X strchange(&ex3->val.s, putfbufname);
- X insertarg(ep, 2, b);
- X return a;
- X } else if (!strcmp(ex3->val.s, chargetfbufname)) {
- X ex3->val.type = tp_void;
- X if (*charputfbufname) {
- X strchange(&ex3->val.s, charputfbufname);
- X insertarg(ep, 1, b);
- X } else {
- X strchange(&ex3->val.s, putfbufname);
- X insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
- X insertarg(ep, 2, b);
- X }
- X return a;
- X } else if (!strcmp(ex3->val.s, arraygetfbufname)) {
- X ex3->val.type = tp_void;
- X if (*arrayputfbufname) {
- X strchange(&ex3->val.s, arrayputfbufname);
- X insertarg(ep, 1, b);
- X } else {
- X strchange(&ex3->val.s, putfbufname);
- X insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
- X insertarg(ep, 2, b);
- X }
- X return a;
- X }
- X }
- X while (a->kind == EK_CAST || a->kind == EK_ACTCAST) {
- X if (ansiC < 2 || /* in GNU C, a cast is an lvalue */
- X isarithkind(a->args[0]->kind) ||
- X (a->val.type->kind == TK_POINTER &&
- X a->args[0]->val.type->kind == TK_POINTER)) {
- X if (a->kind == EK_CAST)
- X b = makeexpr_cast(b, a->args[0]->val.type);
- X else
- X b = makeexpr_actcast(b, a->args[0]->val.type);
- X a = grabarg(a, 0);
- X } else
- X break;
- X }
- X if (a->kind == EK_NEG)
- X return makeexpr_assign(grabarg(a, 0), makeexpr_neg(b));
- X if (a->kind == EK_NOT)
- X return makeexpr_assign(grabarg(a, 0), makeexpr_not(b));
- X if (a->kind == EK_BNOT)
- X return makeexpr_assign(grabarg(a, 0),
- X makeexpr_un(EK_BNOT, b->val.type, b));
- X if (a->kind == EK_PLUS) {
- X for (i = 0; i < a->nargs && a->nargs > 1; ) {
- X if (isconstantexpr(a->args[i])) {
- X b = makeexpr_minus(b, a->args[i]);
- X deletearg(&a, i);
- X } else
- X i++;
- X }
- X if (a->nargs == 1)
- X return makeexpr_assign(grabarg(a, 0), b);
- X }
- X if (a->kind == EK_TIMES) {
- X for (i = 0; i < a->nargs && a->nargs > 1; ) {
- X if (isconstantexpr(a->args[i])) {
- X if (a->val.type->kind == TK_REAL)
- X b = makeexpr_divide(b, a->args[i]);
- X else {
- X if (ISCONST(b->kind) && ISCONST(a->args[i]->kind) &&
- X (b->val.i % a->args[i]->val.i) != 0) {
- X break;
- X }
- X b = makeexpr_div(b, a->args[i]);
- X }
- X deletearg(&a, i);
- X } else
- X i++;
- X }
- X if (a->nargs == 1)
- X return makeexpr_assign(grabarg(a, 0), b);
- X }
- X if ((a->kind == EK_DIVIDE || a->kind == EK_DIV) &&
- X isconstantexpr(a->args[1])) {
- X b = makeexpr_times(b, a->args[1]);
- X return makeexpr_assign(a->args[0], b);
- X }
- X if (a->kind == EK_LSH && isconstantexpr(a->args[1])) {
- X if (ISCONST(b->kind) && ISCONST(a->args[1]->kind)) {
- X if ((b->val.i & ((1L << a->args[1]->val.i)-1)) == 0) {
- X b->val.i >>= a->args[1]->val.i;
- X return makeexpr_assign(grabarg(a, 0), b);
- X }
- X } else {
- X b = makeexpr_bin(EK_RSH, b->val.type, b, a->args[1]);
- X return makeexpr_assign(a->args[0], b);
- X }
- X }
- X if (a->kind == EK_RSH && isconstantexpr(a->args[1])) {
- X if (ISCONST(b->kind) && ISCONST(a->args[1]->kind))
- X b->val.i <<= a->args[1]->val.i;
- X else
- X b = makeexpr_bin(EK_LSH, b->val.type, b, a->args[1]);
- X return makeexpr_assign(a->args[0], b);
- X }
- X if (isarithkind(a->kind))
- X warning("Invalid assignment [168]");
- X return makeexpr_bin(EK_ASSIGN, a->val.type, a, makeexpr_unlongcast(b));
- X}
- X
- X
- X
- X
- XExpr *makeexpr_comma(a, b)
- XExpr *a, *b;
- X{
- X Type *type;
- X
- X if (!a || nosideeffects(a, 1))
- X return b;
- X if (!b)
- X return a;
- X type = b->val.type;
- X a = commute(a, b, EK_COMMA);
- X a->val.type = type;
- X return a;
- X}
- X
- X
- X
- X
- Xint strmax(ex)
- XExpr *ex;
- X{
- X Meaning *mp;
- X long smin, smax;
- X Value val;
- X Type *type;
- X
- X type = ex->val.type;
- X if (type->kind == TK_POINTER)
- X type = type->basetype;
- X if (type->kind == TK_CHAR)
- X return 1;
- X if (type->kind == TK_ARRAY && type->basetype->kind == TK_CHAR) {
- X if (ord_range(type->indextype, &smin, &smax))
- X return smax - smin + 1;
- X else
- X return stringceiling;
- X }
- X if (type->kind != TK_STRING) {
- X intwarning("strmax", "strmax encountered a non-string value [169]");
- X return stringceiling;
- X }
- X if (ex->kind == EK_CONST)
- X return ex->val.i;
- X if (ex->kind == EK_VAR && foldstrconsts != 0 &&
- X (mp = (Meaning *)(ex->val.i))->kind == MK_CONST)
- X return mp->val.i;
- X if (ex->kind == EK_BICALL) {
- X if (!strcmp(ex->val.s, strsubname)) {
- X if (isliteralconst(ex->args[3], &val) && val.type)
- X return val.i;
- X }
- X }
- X if (ord_range(type->indextype, NULL, &smax))
- X return smax;
- X else
- X return stringceiling;
- X}
- X
- X
- X
- X
- Xint strhasnull(val)
- XValue val;
- X{
- X int i;
- X
- X for (i = 0; i < val.i; i++) {
- X if (!val.s[i])
- X return (i == val.i-1) ? 1 : 2;
- X }
- X return 0;
- X}
- X
- X
- X
- Xint istempsprintf(ex)
- XExpr *ex;
- X{
- X return (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
- X ex->nargs >= 2 &&
- X istempvar(ex->args[0]) &&
- X ex->args[1]->kind == EK_CONST &&
- X ex->args[1]->val.type->kind == TK_STRING);
- X}
- X
- X
- X
- XExpr *makeexpr_sprintfify(ex)
- XExpr *ex;
- X{
- X Meaning *tvar;
- X char stringbuf[500];
- X char *cp, ch;
- X int j, nnulls;
- X Expr *ex2;
- X
- X if (debug>2) { fprintf(outf,"makeexpr_sprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
- X if (istempsprintf(ex))
- X return ex;
- X ex = makeexpr_stringcast(ex);
- X tvar = makestmttempvar(tp_str255, name_STRING);
- X if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
- X cp = stringbuf;
- X nnulls = 0;
- X for (j = 0; j < ex->val.i; j++) {
- X ch = ex->val.s[j];
- X if (!ch) {
- X if (j < ex->val.i-1)
- X note("Null character in sprintf control string [147]");
- X else
- X note("Null character at end of sprintf control string [148]");
- X if (keepnulls) {
- X *cp++ = '%';
- X *cp++ = 'c';
- X nnulls++;
- X }
- X } else {
- X *cp++ = ch;
- X if (ch == '%')
- X *cp++ = ch;
- X }
- X }
- X *cp = 0;
- X ex = makeexpr_bicall_2("sprintf", tp_str255,
- X makeexpr_var(tvar),
- X makeexpr_string(stringbuf));
- X while (--nnulls >= 0)
- X insertarg(&ex, 2, makeexpr_char(0));
- X return ex;
- X } else if (ex->val.type->kind == TK_ARRAY &&
- X ex->val.type->basetype->kind == TK_CHAR) {
- X ex2 = arraysize(ex->val.type, 0);
- X return cleansprintf(
- X makeexpr_bicall_4("sprintf", tp_str255,
- X makeexpr_var(tvar),
- X makeexpr_string("%.*s"),
- X ex2,
- X makeexpr_addrstr(ex)));
- X } else {
- X if (ord_type(ex->val.type)->kind == TK_CHAR)
- X cp = "%c";
- X else if (ex->val.type->kind == TK_STRING)
- X cp = "%s";
- X else {
- X warning("Mixing non-strings with strings [170]");
- X return ex;
- X }
- X return makeexpr_bicall_3("sprintf", tp_str255,
- X makeexpr_var(tvar),
- X makeexpr_string(cp),
- X ex);
- X }
- X}
- X
- X
- X
- XExpr *makeexpr_unsprintfify(ex)
- XExpr *ex;
- X{
- X char stringbuf[500];
- X char *cp, ch;
- X int i;
- X
- X if (debug>2) { fprintf(outf,"makeexpr_unsprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
- X if (!istempsprintf(ex))
- X return ex;
- X canceltempvar(istempvar(ex->args[0]));
- X for (i = 2; i < ex->nargs; i++) {
- X if (ex->args[i]->val.type->kind != TK_CHAR ||
- X !checkconst(ex, 0))
- X return ex;
- X }
- X cp = stringbuf;
- X for (i = 0; i < ex->args[1]->val.i; i++) {
- X ch = ex->args[1]->val.s[i];
- X *cp++ = ch;
- X if (ch == '%') {
- X if (++i == ex->args[1]->val.i)
- X return ex;
- X ch = ex->args[1]->val.s[i];
- X if (ch == 'c')
- X cp[-1] = 0;
- X else if (ch != '%')
- X return ex;
- X }
- X }
- X freeexpr(ex);
- X return makeexpr_lstring(stringbuf, cp - stringbuf);
- X}
- X
- X
- X
- X/* Returns >= 0 iff unsprintfify would return a string constant */
- X
- Xint sprintflength(ex, allownulls)
- XExpr *ex;
- Xint allownulls;
- X{
- X int i, len;
- X
- X if (!istempsprintf(ex))
- X return -1;
- X for (i = 2; i < ex->nargs; i++) {
- X if (!allownulls ||
- X ex->args[i]->val.type->kind != TK_CHAR ||
- X !checkconst(ex, 0))
- X return -1;
- X }
- X len = 0;
- X for (i = 0; i < ex->args[1]->val.i; i++) {
- X len++;
- X if (ex->args[1]->val.s[i] == '%') {
- X if (++i == ex->args[1]->val.i)
- X return -1;
- X if (ex->args[1]->val.s[i] != 'c' &&
- X ex->args[1]->val.s[i] != '%')
- X return -1;
- X }
- X }
- X return len;
- X}
- X
- X
- X
- XExpr *makeexpr_concat(a, b, usesprintf)
- XExpr *a, *b;
- Xint usesprintf;
- X{
- X int i, ii, j, len, nargs;
- X Type *type;
- X Meaning *mp, *tvar;
- X Expr *ex, *args[2];
- X int akind[2];
- X Value val, val1, val2;
- X char formatstr[300];
- X
- X if (debug>2) { fprintf(outf,"makeexpr_concat("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
- X if (!a)
- X return b;
- X if (!b)
- X return a;
- X a = makeexpr_stringcast(a);
- X b = makeexpr_stringcast(b);
- X if (checkconst(a, 0)) {
- X freeexpr(a);
- X return b;
- X }
- X if (checkconst(b, 0)) {
- X freeexpr(b);
- X return a;
- X }
- X len = strmax(a) + strmax(b);
- X type = makestringtype(len);
- X if (a->kind == EK_CONST && b->kind == EK_CONST) {
- X val1 = a->val;
- X val2 = b->val;
- X val.i = val1.i + val2.i;
- X val.s = ALLOC(val.i+1, char, literals);
- X val.s[val.i] = 0;
- X val.type = type;
- X memcpy(val.s, val1.s, val1.i);
- X memcpy(val.s + val1.i, val2.s, val2.i);
- X freeexpr(a);
- X freeexpr(b);
- X return makeexpr_val(val);
- X }
- X tvar = makestmttempvar(type, name_STRING);
- X if (sprintf_value != 2 || usesprintf) {
- X nargs = 2; /* Generate a call to sprintf(), unfolding */
- X args[0] = a; /* nested sprintf()'s. */
- X args[1] = b;
- X *formatstr = 0;
- X for (i = 0; i < 2; i++) {
- X#if 1
- X ex = args[i] = makeexpr_sprintfify(args[i]);
- X if (!ex->args[1] || !ex->args[1]->val.s)
- X intwarning("makeexpr_concat", "NULL in ex->args[1]");
- X else
- X strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
- X canceltempvar(istempvar(ex->args[0]));
- X nargs += (ex->nargs - 2);
- X akind[i] = 0; /* now obsolete */
- X#else
- X ex = args[i];
- X if (ex->kind == EK_CONST)
- X ex = makeexpr_sprintfify(ex);
- X if (istempsprintf(ex)) {
- X strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
- X canceltempvar(istempvar(ex->args[0]));
- X nargs += (ex->nargs - 2);
- X akind[i] = 0;
- X } else {
- X strcat(formatstr, "%s");
- X nargs++;
- X akind[i] = 1;
- X }
- X#endif
- X }
- X ex = makeexpr(EK_BICALL, nargs);
- X ex->val.type = type;
- X ex->val.s = stralloc("sprintf");
- X ex->args[0] = makeexpr_var(tvar);
- X ex->args[1] = makeexpr_string(formatstr);
- X j = 2;
- X for (i = 0; i < 2; i++) {
- X switch (akind[i]) {
- X case 0: /* flattened sub-sprintf */
- X for (ii = 2; ii < args[i]->nargs; ii++)
- X ex->args[j++] = copyexpr(args[i]->args[ii]);
- X freeexpr(args[i]);
- X break;
- X case 1: /* included string expr */
- X ex->args[j++] = args[i];
- X break;
- X }
- X }
- X } else {
- X ex = a;
- X while (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcat"))
- X ex = ex->args[0];
- X if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcpy") &&
- X (mp = istempvar(ex->args[0])) != NULL) {
- X canceltempvar(mp);
- X freeexpr(ex->args[0]);
- X ex->args[0] = makeexpr_var(tvar);
- X } else {
- X a = makeexpr_bicall_2("strcpy", type, makeexpr_var(tvar), a);
- X }
- X ex = makeexpr_bicall_2("strcat", type, a, b);
- X }
- X if (debug>2) { fprintf(outf,"makeexpr_concat returns "); dumpexpr(ex); fprintf(outf,"\n"); }
- X return ex;
- X}
- X
- X
- X
- XExpr *cleansprintf(ex)
- XExpr *ex;
- X{
- X int fidx, i, j, k, len, changed = 0;
- X char *cp, *bp;
- X char fmtbuf[300];
- X
- X if (ex->kind != EK_BICALL)
- X return ex;
- X if (!strcmp(ex->val.s, "printf"))
- X fidx = 0;
- X else if (!strcmp(ex->val.s, "sprintf") ||
- X !strcmp(ex->val.s, "fprintf"))
- X fidx = 1;
- X else
- X return ex;
- X len = ex->args[fidx]->val.i;
- X cp = ex->args[fidx]->val.s; /* printf("%*d",17,x) => printf("%17d",x) */
- X bp = fmtbuf;
- X j = fidx + 1;
- X for (i = 0; i < len; i++) {
- X *bp++ = cp[i];
- X if (cp[i] == '%') {
- X if (cp[i+1] == 's' && ex->args[j]->kind == EK_CONST) {
- X bp--;
- X for (k = 0; k < ex->args[j]->val.i; k++)
- X *bp++ = ex->args[j]->val.s[k];
- X delfreearg(&ex, j);
- X changed = 1;
- X i++;
- X continue;
- X }
- X for (i++; i < len &&
- X !(isalpha(cp[i]) && cp[i] != 'l'); i++) {
- X if (cp[i] == '*') {
- X if (isliteralconst(ex->args[j], NULL) == 2) {
- X sprintf(bp, "%ld", ex->args[j]->val.i);
- X bp += strlen(bp);
- X delfreearg(&ex, j);
- X changed = 1;
- X } else {
- X *bp++ = cp[i];
- X j++;
- X }
- X } else
- X *bp++ = cp[i];
- X }
- X if (i < len)
- X *bp++ = cp[i];
- X j++;
- X }
- X }
- X *bp = 0;
- X if (changed) {
- X freeexpr(ex->args[fidx]);
- X ex->args[fidx] = makeexpr_string(fmtbuf);
- X }
- X return ex;
- X}
- X
- X
- X
- XExpr *makeexpr_substring(vex, ex, exi, exj)
- XExpr *vex, *ex, *exi, *exj;
- X{
- X exi = makeexpr_unlongcast(exi);
- X exj = makeexpr_longcast(exj, 0);
- X ex = bumpstring(ex, exi, 1);
- X return cleansprintf(makeexpr_bicall_4("sprintf", tp_str255,
- X vex,
- X makeexpr_string("%.*s"),
- X exj,
- X ex));
- X}
- X
- X
- X
- X
- XExpr *makeexpr_dot(ex, mp)
- XExpr *ex;
- XMeaning *mp;
- X{
- X Type *ot1, *ot2;
- X Expr *ex2, *ex3, *nex;
- X Meaning *tvar;
- X
- X if (ex->kind == EK_FUNCTION && copystructfuncs > 0) {
- X tvar = makestmttempvar(ex->val.type, name_TEMP);
- X ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
- X ex = makeexpr_var(tvar);
- X } else
- X ex2 = NULL;
- X if (mp->constdefn) {
- X nex = makeexpr(EK_MACARG, 0);
- X nex->val.type = tp_integer;
- X ex3 = replaceexprexpr(copyexpr(mp->constdefn), nex, ex);
- X freeexpr(ex);
- X freeexpr(nex);
- X ex = gentle_cast(ex3, mp->val.type);
- X } else {
- X ex = makeexpr_un(EK_DOT, mp->type, ex);
- X ex->val.i = (long)mp;
- X ot1 = ord_type(mp->type);
- X ot2 = ord_type(mp->val.type);
- X if (ot1->kind != ot2->kind && ot2->kind == TK_ENUM && ot2->meaning && useenum)
- X ex = makeexpr_cast(ex, mp->val.type);
- X else if (mp->val.i && !hassignedchar &&
- X (mp->type == tp_sint || mp->type == tp_abyte)) {
- X if (*signextname) {
- X ex = makeexpr_bicall_2(signextname, tp_integer,
- X ex, makeexpr_long(mp->val.i));
- X } else
- X note(format_s("Unable to sign-extend field %s [149]", mp->name));
- X }
- X }
- X ex->val.type = mp->val.type;
- X return makeexpr_comma(ex2, ex);
- X}
- X
- X
- X
- XExpr *makeexpr_dotq(ex, name, type)
- XExpr *ex;
- Xchar *name;
- XType *type;
- X{
- X ex = makeexpr_un(EK_DOT, type, ex);
- X ex->val.s = stralloc(name);
- X return ex;
- X}
- X
- X
- X
- XExpr *strmax_func(ex)
- XExpr *ex;
- X{
- X Meaning *mp;
- X Expr *ex2;
- X Type *type;
- X
- X type = ex->val.type;
- X if (type->kind == TK_POINTER) {
- X intwarning("strmax_func", "got a pointer instead of a string [171]");
- X type = type->basetype;
- X }
- X if (type->kind == TK_CHAR)
- X return makeexpr_long(1);
- X if (type->kind != TK_STRING) {
- X warning("STRMAX of non-string value [172]");
- X return makeexpr_long(stringceiling);
- X }
- X if (ex->kind == EK_CONST)
- X return makeexpr_long(ex->val.i);
- X if (ex->kind == EK_VAR &&
- X (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
- X mp->type == tp_str255)
- X return makeexpr_long(mp->val.i);
- X if (ex->kind == EK_VAR &&
- X (mp = (Meaning *)ex->val.i)->kind == MK_VARPARAM &&
- X mp->type == tp_strptr) {
- X if (mp->anyvarflag) {
- X if (mp->ctx != curctx && mp->ctx->kind == MK_FUNCTION)
- X note(format_s("Reference to STRMAX of parent proc's \"%s\" must be fixed [150]",
- X mp->name));
- X return makeexpr_name(format_s(name_STRMAX, mp->name), tp_int);
- X } else
- X note(format_s("STRMAX of \"%s\" wants VarStrings=1 [151]", mp->name));
- X }
- X ord_range_expr(type->indextype, NULL, &ex2);
- X return copyexpr(ex2);
- X}
- X
- X
- X
- X
- XExpr *makeexpr_nil()
- X{
- X Expr *ex;
- X
- X ex = makeexpr(EK_CONST, 0);
- X ex->val.type = tp_anyptr;
- X ex->val.i = 0;
- X ex->val.s = NULL;
- X return ex;
- X}
- X
- X
- X
- XExpr *makeexpr_ctx(ctx)
- XMeaning *ctx;
- X{
- X Expr *ex;
- X
- X ex = makeexpr(EK_CTX, 0);
- X ex->val.type = tp_text; /* handy pointer type */
- X ex->val.i = (long)ctx;
- X return ex;
- X}
- X
- X
- X
- X
- XExpr *force_signed(ex)
- XExpr *ex;
- X{
- X Type *tp;
- X
- X if (isliteralconst(ex, NULL) == 2 && ex->nargs == 0)
- X return ex;
- X tp = true_type(ex);
- X if (tp == tp_ushort || tp == tp_ubyte || tp == tp_uchar)
- X return makeexpr_cast(ex, tp_sshort);
- X else if (tp == tp_unsigned || tp == tp_uint) {
- X if (exprlongness(ex) < 0)
- X return makeexpr_cast(ex, tp_sint);
- X else
- X return makeexpr_cast(ex, tp_integer);
- X }
- X return ex;
- X}
- X
- X
- X
- XExpr *force_unsigned(ex)
- XExpr *ex;
- X{
- X Type *tp;
- X
- X if (isliteralconst(ex, NULL) == 2 && !expr_is_neg(ex))
- X return ex;
- X tp = true_type(ex);
- X if (tp == tp_unsigned || tp == tp_uint || tp == tp_ushort ||
- X tp == tp_ubyte || tp == tp_uchar)
- X return ex;
- X if (tp->kind == TK_CHAR)
- X return makeexpr_actcast(ex, tp_uchar);
- X else if (exprlongness(ex) < 0)
- X return makeexpr_cast(ex, tp_uint);
- X else
- X return makeexpr_cast(ex, tp_unsigned);
- X}
- X
- X
- X
- X
- X#define CHECKSIZE(size) (((size) > 0 && (size)%charsize == 0) ? (size)/charsize : 0)
- X
- Xlong type_sizeof(type, pasc)
- XType *type;
- Xint pasc;
- X{
- X long s1, smin, smax;
- X int charsize = (sizeof_char) ? sizeof_char : CHAR_BIT; /* from <limits.h> */
- X
- X switch (type->kind) {
- X
- X case TK_INTEGER:
- X if (type == tp_integer ||
- X type == tp_unsigned)
- X return pasc ? 4 : CHECKSIZE(sizeof_integer);
- X else
- X return pasc ? 2 : CHECKSIZE(sizeof_short);
- X
- X case TK_CHAR:
- X case TK_BOOLEAN:
- X return 1;
- X
- X case TK_SUBR:
- X type = findbasetype(type, 0);
- X if (pasc) {
- X if (type == tp_integer || type == tp_unsigned)
- X return 4;
- X else
- X return 2;
- X } else {
- X if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte)
- X return 1;
- X else if (type == tp_ushort || type == tp_sshort)
- X return CHECKSIZE(sizeof_short);
- X else
- X return CHECKSIZE(sizeof_integer);
- X }
- X
- X case TK_POINTER:
- X return pasc ? 4 : CHECKSIZE(sizeof_pointer);
- X
- X case TK_REAL:
- X if (type == tp_longreal)
- X return pasc ? (which_lang == LANG_TURBO ? 6 : 8) : CHECKSIZE(sizeof_double);
- X else
- X return pasc ? 4 : CHECKSIZE(sizeof_float);
- X
- X case TK_ENUM:
- X if (!pasc)
- X return CHECKSIZE(sizeof_enum);
- X type = findbasetype(type, 0);
- X return type->kind != TK_ENUM ? type_sizeof(type, pasc)
- X : CHECKSIZE(pascalenumsize);
- X
- X case TK_SMALLSET:
- X case TK_SMALLARRAY:
- X return pasc ? 0 : type_sizeof(type->basetype, pasc);
- X
- X case TK_ARRAY:
- X s1 = type_sizeof(type->basetype, pasc);
- X if (s1 && ord_range(type->indextype, &smin, &smax))
- X return s1 * (smax - smin + 1);
- X else
- X return 0;
- X
- X case TK_RECORD:
- X if (pasc && type->meaning) {
- X if (!strcmp(type->meaning->sym->name, "NA_WORD"))
- X return 2;
- X else if (!strcmp(type->meaning->sym->name, "NA_LONGWORD"))
- X return 4;
- X else if (!strcmp(type->meaning->sym->name, "NA_QUADWORD"))
- X return 8;
- X else
- X return 0;
- X } else
- X return 0;
- X
- X default:
- X return 0;
- X }
- X}
- X
- X
- X
- XStatic Value eval_expr_either(ex, pasc)
- XExpr *ex;
- Xint pasc;
- X{
- X Value val, val2;
- X Meaning *mp;
- X int i;
- X
- X if (debug>2) { fprintf(outf,"eval_expr("); dumpexpr(ex); fprintf(outf,")\n"); }
- X switch (ex->kind) {
- X
- X case EK_CONST:
- X case EK_LONGCONST:
- X return ex->val;
- X
- X case EK_VAR:
- X mp = (Meaning *) ex->val.i;
- X if (mp->kind == MK_CONST &&
- X (foldconsts != 0 ||
- X mp == mp_maxint || mp == mp_minint))
- X return mp->val;
- X break;
- X
- X case EK_SIZEOF:
- X i = type_sizeof(ex->args[0]->val.type, pasc);
- X if (i)
- X return make_ord(tp_integer, i);
- X break;
- X
- X case EK_PLUS:
- X val = eval_expr_either(ex->args[0], pasc);
- X if (!val.type || ord_type(val.type) != tp_integer)
- X val.type = NULL;
- X for (i = 1; val.type && i < ex->nargs; i++) {
- X val2 = eval_expr_either(ex->args[i], pasc);
- X if (!val2.type || ord_type(val2.type) != tp_integer)
- X val.type = NULL;
- X else
- X val.i += val2.i;
- X }
- X return val;
- X
- X case EK_TIMES:
- X val = eval_expr_either(ex->args[0], pasc);
- X if (!val.type || ord_type(val.type) != tp_integer)
- X val.type = NULL;
- X for (i = 1; val.type && i < ex->nargs; i++) {
- X val2 = eval_expr_either(ex->args[i], pasc);
- X if (!val2.type || ord_type(val2.type) != tp_integer)
- X val.type = NULL;
- X else
- X val.i *= val2.i;
- X }
- X return val;
- X
- X case EK_DIV:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && ord_type(val.type) == tp_integer &&
- X val2.type && ord_type(val2.type) == tp_integer && val2.i) {
- X val.i /= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_MOD:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && ord_type(val.type) == tp_integer &&
- X val2.type && ord_type(val2.type) == tp_integer && val2.i) {
- X val.i %= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_NEG:
- X val = eval_expr_either(ex->args[0], pasc);
- X if (val.type) {
- X val.i = -val.i;
- X return val;
- X }
- X break;
- X
- X case EK_LSH:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && val2.type) {
- X val.i <<= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_RSH:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && val2.type) {
- X val.i >>= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_BAND:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && val2.type) {
- X val.i &= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_BOR:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && val2.type) {
- X val.i |= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_BXOR:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type && val2.type) {
- X val.i ^= val2.i;
- X return val;
- X }
- X break;
- X
- X case EK_BNOT:
- X val = eval_expr_either(ex->args[0], pasc);
- X if (val.type) {
- X val.i = ~val.i;
- X return val;
- X }
- X break;
- X
- X case EK_EQ:
- X case EK_NE:
- X case EK_GT:
- X case EK_LT:
- X case EK_GE:
- X case EK_LE:
- X val = eval_expr_either(ex->args[0], pasc);
- X val2 = eval_expr_either(ex->args[1], pasc);
- X if (val.type) {
- X if (val.i == val2.i)
- X val.i = (ex->kind == EK_EQ || ex->kind == EK_GE || ex->kind == EK_LE);
- X else if (val.i < val2.i)
- X val.i = (ex->kind == EK_LT || ex->kind == EK_LE || ex->kind == EK_NE);
- X else
- X val.i = (ex->kind == EK_GT || ex->kind == EK_GE || ex->kind == EK_NE);
- X val.type = tp_boolean;
- X return val;
- X }
- X break;
- X
- X case EK_NOT:
- X val = eval_expr_either(ex->args[0], pasc);
- X if (val.type)
- X val.i = !val.i;
- X return val;
- X
- X case EK_AND:
- X for (i = 0; i < ex->nargs; i++) {
- X val = eval_expr_either(ex->args[i], pasc);
- X if (!val.type || !val.i)
- X return val;
- X }
- X return val;
- X
- X case EK_OR:
- X for (i = 0; i < ex->nargs; i++) {
- X val = eval_expr_either(ex->args[i], pasc);
- X if (!val.type || val.i)
- X return val;
- X }
- X return val;
- X
- X case EK_COMMA:
- X return eval_expr_either(ex->args[ex->nargs-1], pasc);
- X
- X default:
- X break;
- X }
- X val.type = NULL;
- X return val;
- X}
- X
- X
- XValue eval_expr(ex)
- XExpr *ex;
- X{
- X return eval_expr_either(ex, 0);
- X}
- X
- X
- XValue eval_expr_consts(ex)
- XExpr *ex;
- X{
- X Value val;
- X short save_fold = foldconsts;
- X
- X foldconsts = 1;
- X val = eval_expr_either(ex, 0);
- X foldconsts = save_fold;
- X return val;
- X}
- X
- X
- XValue eval_expr_pasc(ex)
- XExpr *ex;
- X{
- X return eval_expr_either(ex, 1);
- X}
- X
- X
- X
- Xint expr_is_const(ex)
- XExpr *ex;
- X{
- X int i;
- X
- X switch (ex->kind) {
- X
- X case EK_CONST:
- X case EK_LONGCONST:
- X case EK_SIZEOF:
- X return 1;
- X
- X case EK_VAR:
- X return (((Meaning *)ex->val.i)->kind == MK_CONST);
- X
- X case EK_HAT:
- X case EK_ASSIGN:
- X case EK_POSTINC:
- X case EK_POSTDEC:
- X return 0;
- X
- X case EK_ADDR:
- X if (ex->args[0]->kind == EK_VAR)
- X return 1;
- X return 0; /* conservative */
- X
- X case EK_FUNCTION:
- X if (!nosideeffects_func(ex))
- X return 0;
- X break;
- X
- X case EK_BICALL:
- X if (!nosideeffects_func(ex))
- X return 0;
- X break;
- X
- X default:
- X break;
- X }
- X for (i = 0; i < ex->nargs; i++) {
- X if (!expr_is_const(ex->args[i]))
- X return 0;
- X }
- X return 1;
- X}
- X
- X
- X
- X
- X
- XExpr *eatcasts(ex)
- XExpr *ex;
- X{
- X while (ex->kind == EK_CAST)
- X ex = grabarg(ex, 0);
- X return ex;
- X}
- X
- X
- X
- X
- X
- X/* End. */
- X
- X
- X
- END_OF_FILE
- if test 41883 -ne `wc -c <'src/expr.c.3'`; then
- echo shar: \"'src/expr.c.3'\" unpacked with wrong size!
- fi
- # end of 'src/expr.c.3'
- fi
- echo shar: End of archive 16 \(of 32\).
- cp /dev/null ark16isdone
- 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
-