rsalz@uunet.uu.net (Rich Salz) (03/28/90)
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 -- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.