v21i061: Pascal to C translator, Part16/32

Rich Salz rsalz at uunet.uu.net
Wed Mar 28 08:16:59 AEST 1990


Submitted-by: Dave Gillespie <daveg at 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 at 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 at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.



More information about the Comp.sources.unix mailing list