v21i068: Pascal to C translator, Part23/32
Rich Salz
rsalz at uunet.uu.net
Thu Mar 29 23:48:54 AEST 1990
Submitted-by: Dave Gillespie <daveg at csvax.caltech.edu>
Posting-number: Volume 21, Issue 68
Archive-name: p2c/part23
#! /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 23 (of 32)."
# Contents: src/pexpr.c.1
# Wrapped by rsalz at litchi.bbn.com on Mon Mar 26 14:29:46 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'src/pexpr.c.1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/pexpr.c.1'\"
else
echo shar: Extracting \"'src/pexpr.c.1'\" \(48768 characters\)
sed "s/^X//" >'src/pexpr.c.1' <<'END_OF_FILE'
X/* "p2c", a Pascal to C translator.
X Copyright (C) 1989 David Gillespie.
X Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
X
XThis program is free software; you can redistribute it and/or modify
Xit under the terms of the GNU General Public License as published by
Xthe Free Software Foundation (any version).
X
XThis program is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY; without even the implied warranty of
XMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
XGNU General Public License for more details.
X
XYou should have received a copy of the GNU General Public License
Xalong with this program; see the file COPYING. If not, write to
Xthe Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
X
X
X
X#define PROTO_PEXPR_C
X#include "trans.h"
X
X
X
X
XExpr *dots_n_hats(ex, target)
XExpr *ex;
XType *target;
X{
X Expr *ex2, *ex3;
X Type *tp, *tp2, *ot;
X Meaning *mp, *tvar;
X int bits, hassl;
X
X for (;;) {
X if ((ex->val.type->kind == TK_PROCPTR ||
X ex->val.type->kind == TK_CPROCPTR) &&
X curtok != TOK_ASSIGN &&
X ((mp = (tp2 = ex->val.type)->basetype->fbase) == NULL ||
X (mp->isreturn && mp->xnext == NULL) ||
X curtok == TOK_LPAR) &&
X (tp2->basetype->basetype != tp_void || target == tp_void) &&
X (!target || (target->kind != TK_PROCPTR &&
X target->kind != TK_CPROCPTR))) {
X hassl = tp2->escale;
X ex2 = ex;
X ex3 = copyexpr(ex2);
X if (hassl != 0)
X ex3 = makeexpr_cast(makeexpr_dotq(ex3, "proc", tp_anyptr),
X makepointertype(tp2->basetype));
X ex = makeexpr_un(EK_SPCALL, tp2->basetype->basetype, ex3);
X if (mp && mp->isreturn) { /* pointer to buffer for return value */
X tvar = makestmttempvar(ex->val.type->basetype,
X (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
X insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
X mp = mp->xnext;
X }
X if (mp) {
X if (wneedtok(TOK_LPAR)) {
X ex = p_funcarglist(ex, mp, 0, 0);
X skipcloseparen();
X }
X } else if (curtok == TOK_LPAR) {
X gettok();
X if (!wneedtok(TOK_RPAR))
X skippasttoken(TOK_RPAR);
X }
X if (hassl != 1 || hasstaticlinks == 2) {
X freeexpr(ex2);
X } else {
X ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
X ex3 = copyexpr(ex);
X insertarg(&ex3, ex3->nargs, copyexpr(ex2));
X tp = maketype(TK_FUNCTION);
X tp->basetype = tp2->basetype->basetype;
X tp->fbase = tp2->basetype->fbase;
X tp->issigned = 1;
X ex3->args[0]->val.type = makepointertype(tp);
X ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
X ex3, ex);
X }
X if (tp2->basetype->fbase &&
X tp2->basetype->fbase->isreturn &&
X tp2->basetype->fbase->kind == MK_VARPARAM)
X ex = makeexpr_hat(ex, 0); /* returns pointer to structured result */
X continue;
X }
X switch (curtok) {
X
X case TOK_HAT:
X case TOK_ADDR:
X gettok();
X ex = makeexpr_hat(ex, 1);
X break;
X
X case TOK_LBR:
X do {
X gettok();
X tp = ex->val.type;
X if (tp->kind == TK_STRING) {
X ex2 = p_expr(tp_integer);
X if (checkconst(ex2, 0)) /* is it "s[0]"? */
X ex = makeexpr_bicall_1("strlen", tp_char, ex);
X else
X ex = makeexpr_index(ex, ex2, makeexpr_long(1));
X } else if (tp->kind == TK_ARRAY ||
X tp->kind == TK_SMALLARRAY) {
X if (tp->smax) {
X ord_range_expr(tp->indextype, &ex2, NULL);
X ex2 = makeexpr_minus(p_ord_expr(),
X copyexpr(ex2));
X if (!nodependencies(ex2, 0) &&
X *getbitsname == '*') {
X mp = makestmttempvar(tp_integer, name_TEMP);
X ex3 = makeexpr_assign(makeexpr_var(mp), ex2);
X ex2 = makeexpr_var(mp);
X } else
X ex3 = NULL;
X ex = makeexpr_bicall_3(getbitsname, tp_int,
X ex, ex2,
X makeexpr_long(tp->escale));
X if (tp->kind == TK_ARRAY) {
X if (tp->basetype == tp_sshort)
X bits = 4;
X else
X bits = 3;
X insertarg(&ex, 3, makeexpr_long(bits));
X }
X ex = makeexpr_comma(ex3, ex);
X ot = ord_type(tp->smax->val.type);
X if (ot->kind == TK_ENUM && ot->meaning && useenum)
X ex = makeexpr_cast(ex, tp->smax->val.type);
X ex->val.type = tp->smax->val.type;
X } else {
X ord_range_expr(ex->val.type->indextype, &ex2, NULL);
X if (debug>2) { fprintf(outf, "ord_range_expr returns "); dumpexpr(ex2); fprintf(outf, "\n"); }
X ex = makeexpr_index(ex, p_ord_expr(),
X copyexpr(ex2));
X }
X } else {
X warning("Index on a non-array variable [287]");
X ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
X }
X } while (curtok == TOK_COMMA);
X if (!wneedtok(TOK_RBR))
X skippasttotoken(TOK_RBR, TOK_SEMI);
X break;
X
X case TOK_DOT:
X gettok();
X if (!wexpecttok(TOK_IDENT))
X break;
X if (ex->val.type->kind == TK_STRING) {
X if (!strcicmp(curtokbuf, "LENGTH")) {
X ex = makeexpr_bicall_1("strlen", tp_int, ex);
X } else if (!strcicmp(curtokbuf, "BODY")) {
X /* nothing to do */
X }
X gettok();
X break;
X }
X mp = curtoksym->fbase;
X while (mp && mp->rectype != ex->val.type)
X mp = mp->snext;
X if (mp)
X ex = makeexpr_dot(ex, mp);
X else {
X warning(format_s("No field called %s in that record [288]", curtokbuf));
X ex = makeexpr_dotq(ex, curtokcase, tp_integer);
X }
X gettok();
X break;
X
X case TOK_COLONCOLON:
X gettok();
X if (wexpecttok(TOK_IDENT)) {
X ex = pascaltypecast(curtokmeaning->type, ex);
X gettok();
X }
X break;
X
X default:
X return ex;
X }
X }
X}
X
X
X
XExpr *fake_dots_n_hats(ex)
XExpr *ex;
X{
X for (;;) {
X switch (curtok) {
X
X case TOK_HAT:
X case TOK_ADDR:
X if (ex->val.type->kind == TK_POINTER)
X ex = makeexpr_hat(ex, 0);
X else {
X ex->val.type = makepointertype(ex->val.type);
X ex = makeexpr_un(EK_HAT, ex->val.type->basetype, ex);
X }
X gettok();
X break;
X
X case TOK_LBR:
X do {
X gettok();
X ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
X } while (curtok == TOK_COMMA);
X if (!wneedtok(TOK_RBR))
X skippasttotoken(TOK_RBR, TOK_SEMI);
X break;
X
X case TOK_DOT:
X gettok();
X if (!wexpecttok(TOK_IDENT))
X break;
X ex = makeexpr_dotq(ex, curtokcase, tp_integer);
X gettok();
X break;
X
X case TOK_COLONCOLON:
X gettok();
X if (wexpecttok(TOK_IDENT)) {
X ex = pascaltypecast(curtokmeaning->type, ex);
X gettok();
X }
X break;
X
X default:
X return ex;
X }
X }
X}
X
X
X
XStatic void bindnames(ex)
XExpr *ex;
X{
X int i;
X Symbol *sp;
X Meaning *mp;
X
X if (ex->kind == EK_NAME) {
X sp = findsymbol_opt(fixpascalname(ex->val.s));
X if (sp) {
X mp = sp->mbase;
X while (mp && !mp->isactive)
X mp = mp->snext;
X if (mp && !strcmp(mp->name, ex->val.s)) {
X ex->kind = EK_VAR;
X ex->val.i = (long)mp;
X ex->val.type = mp->type;
X }
X }
X }
X i = ex->nargs;
X while (--i >= 0)
X bindnames(ex->args[i]);
X}
X
X
X
Xvoid var_reference(mp)
XMeaning *mp;
X{
X Meaning *mp2;
X
X mp->refcount++;
X if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
X mp->ctx->needvarstruct &&
X (mp->kind == MK_VAR ||
X mp->kind == MK_VARREF ||
X mp->kind == MK_VARMAC ||
X mp->kind == MK_PARAM ||
X mp->kind == MK_VARPARAM ||
X (mp->kind == MK_CONST &&
X (mp->type->kind == TK_ARRAY ||
X mp->type->kind == TK_RECORD)))) {
X if (debug>1) { fprintf(outf, "varstruct'ing %s\n", mp->name); }
X if (!mp->varstructflag) {
X mp->varstructflag = 1;
X if (mp->constdefn && /* move init code into function body */
X mp->kind != MK_VARMAC) {
X mp2 = addmeaningafter(mp, curtoksym, MK_VAR);
X curtoksym->mbase = mp2->snext; /* hide this fake variable */
X mp2->snext = mp; /* remember true variable */
X mp2->type = mp->type;
X mp2->constdefn = mp->constdefn;
X mp2->isforward = 1; /* declare it "static" */
X mp2->refcount++; /* so it won't be purged! */
X mp->constdefn = NULL;
X mp->isforward = 0;
X }
X }
X for (mp2 = curctx->ctx; mp2 != mp->ctx; mp2 = mp2->ctx)
X mp2->varstructflag = 1;
X mp2->varstructflag = 1;
X }
X}
X
X
X
XStatic Expr *p_variable(target)
XType *target;
X{
X Expr *ex, *ex2;
X Meaning *mp;
X Symbol *sym;
X
X if (curtok != TOK_IDENT) {
X warning("Expected a variable [289]");
X return makeexpr_long(0);
X }
X if (!curtokmeaning) {
X sym = curtoksym;
X ex = makeexpr_name(curtokcase, tp_integer);
X gettok();
X if (curtok == TOK_LPAR) {
X ex = makeexpr_bicall_0(ex->val.s, tp_integer);
X do {
X gettok();
X insertarg(&ex, ex->nargs, p_expr(NULL));
X } while (curtok == TOK_COMMA || curtok == TOK_ASSIGN);
X if (!wneedtok(TOK_RPAR))
X skippasttotoken(TOK_RPAR, TOK_SEMI);
X }
X if (!tryfuncmacro(&ex, NULL))
X undefsym(sym);
X return fake_dots_n_hats(ex);
X }
X var_reference(curtokmeaning);
X mp = curtokmeaning;
X if (mp->kind == MK_FIELD) {
X ex = makeexpr_dot(copyexpr(withexprs[curtokint]), mp);
X } else if (mp->kind == MK_CONST &&
X mp->type->kind == TK_SET &&
X mp->constdefn) {
X ex = copyexpr(mp->constdefn);
X mp = makestmttempvar(ex->val.type, name_SET);
X ex2 = makeexpr(EK_MACARG, 0);
X ex2->val.type = ex->val.type;
X ex = replaceexprexpr(ex, ex2, makeexpr_var(mp));
X freeexpr(ex2);
X } else if (mp->kind == MK_CONST &&
X (mp == mp_false ||
X mp == mp_true ||
X mp->anyvarflag ||
X (foldconsts > 0 &&
X (mp->type->kind == TK_INTEGER ||
X mp->type->kind == TK_BOOLEAN ||
X mp->type->kind == TK_CHAR ||
X mp->type->kind == TK_ENUM ||
X mp->type->kind == TK_SUBR ||
X mp->type->kind == TK_REAL)) ||
X (foldstrconsts > 0 &&
X (mp->type->kind == TK_STRING)))) {
X if (mp->constdefn) {
X ex = copyexpr(mp->constdefn);
X if (ex->val.type == tp_int) /* kludge! */
X ex->val.type = tp_integer;
X } else
X ex = makeexpr_val(copyvalue(mp->val));
X } else if (mp->kind == MK_VARPARAM ||
X mp->kind == MK_VARREF) {
X ex = makeexpr_hat(makeexpr_var(mp), 0);
X } else if (mp->kind == MK_VARMAC) {
X ex = copyexpr(mp->constdefn);
X bindnames(ex);
X ex = gentle_cast(ex, mp->type);
X ex->val.type = mp->type;
X } else if (mp->kind == MK_SPVAR && mp->handler) {
X gettok();
X ex = (*mp->handler)(mp);
X return dots_n_hats(ex, target);
X } else if (mp->kind == MK_VAR ||
X mp->kind == MK_CONST ||
X mp->kind == MK_PARAM) {
X ex = makeexpr_var(mp);
X } else {
X symclass(mp->sym);
X ex = makeexpr_name(mp->name, tp_integer);
X }
X gettok();
X return dots_n_hats(ex, target);
X}
X
X
X
X
XExpr *p_ord_expr()
X{
X return makeexpr_charcast(p_expr(tp_integer));
X}
X
X
X
XStatic Expr *makesmallsetconst(bits, type)
Xlong bits;
XType *type;
X{
X Expr *ex;
X
X ex = makeexpr_long(bits);
X ex->val.type = type;
X if (smallsetconst != 2)
X insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
X return ex;
X}
X
X
X
XExpr *packset(ex, type)
XExpr *ex;
XType *type;
X{
X Meaning *mp;
X Expr *ex2;
X long max2;
X
X if (ex->kind == EK_BICALL) {
X if (!strcmp(ex->val.s, setexpandname) &&
X (mp = istempvar(ex->args[0])) != NULL) {
X canceltempvar(mp);
X return grabarg(ex, 1);
X }
X if (!strcmp(ex->val.s, setunionname) &&
X (mp = istempvar(ex->args[0])) != NULL &&
X !exproccurs(ex->args[1], ex->args[0]) &&
X !exproccurs(ex->args[2], ex->args[0])) {
X canceltempvar(mp);
X return makeexpr_bin(EK_BOR, type, packset(ex->args[1], type),
X packset(ex->args[2], type));
X }
X if (!strcmp(ex->val.s, setaddname)) {
X ex2 = makeexpr_bin(EK_LSH, type,
X makeexpr_longcast(makeexpr_long(1), 1),
X ex->args[1]);
X ex = packset(ex->args[0], type);
X if (checkconst(ex, 0))
X return ex2;
X else
X return makeexpr_bin(EK_BOR, type, ex, ex2);
X }
X if (!strcmp(ex->val.s, setaddrangename)) {
X if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
X note("Range construction was implemented by a subtraction which may overflow [278]");
X ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
X makeexpr_longcast(makeexpr_long(1), 1),
X makeexpr_plus(ex->args[2],
X makeexpr_long(1))),
X makeexpr_bin(EK_LSH, type,
X makeexpr_longcast(makeexpr_long(1), 1),
X ex->args[1]));
X ex = packset(ex->args[0], type);
X if (checkconst(ex, 0))
X return ex2;
X else
X return makeexpr_bin(EK_BOR, type, ex, ex2);
X }
X }
X return makeexpr_bicall_1(setpackname, type, ex);
X}
X
X
X
X#define MAXSETLIT 400
X
XExpr *p_setfactor(type)
XType *type;
X{
X Expr *ex, *exmax = NULL, *ex2;
X Expr *first[MAXSETLIT], *last[MAXSETLIT];
X char doneflag[MAXSETLIT];
X int i, j, num, donecount;
X int isconst, guesstype = 0;
X long maxv, max2;
X Value val;
X Type *tp;
X Meaning *tvar;
X
X if (curtok == TOK_LBRACE)
X gettok();
X else if (!wneedtok(TOK_LBR))
X return makeexpr_long(0);
X if (curtok == TOK_RBR || curtok == TOK_RBRACE) { /* empty set */
X gettok();
X val.type = tp_smallset;
X val.i = 0;
X val.s = NULL;
X return makeexpr_val(val);
X }
X if (!type)
X guesstype = 1;
X maxv = -1;
X isconst = 1;
X num = 0;
X for (;;) {
X if (num >= MAXSETLIT) {
X warning(format_d("Too many elements in set literal; max=%d [290]", MAXSETLIT));
X ex = p_expr(type);
X while (curtok != TOK_RBR && curtok != TOK_RBRACE) {
X gettok();
X ex = p_expr(type);
X }
X break;
X }
X if (guesstype && num == 0) {
X ex = p_ord_expr();
X type = ord_type(ex->val.type);
X } else {
X ex = p_expr(type);
X }
X first[num] = ex = gentle_cast(ex, type);
X doneflag[num] = 0;
X if (curtok == TOK_DOTS) {
X val = eval_expr(ex);
X if (val.type) {
X if (val.i > maxv) { /* In case of [127..0] */
X maxv = val.i;
X exmax = ex;
X }
X } else
X isconst = 0;
X gettok();
X last[num] = ex = gentle_cast(p_expr(type), type);
X } else {
X last[num] = NULL;
X }
X val = eval_expr(ex);
X if (val.type) {
X if (val.i > maxv) {
X maxv = val.i;
X exmax = ex;
X }
X } else {
X isconst = 0;
X maxv = LONG_MAX;
X }
X num++;
X if (curtok == TOK_COMMA)
X gettok();
X else
X break;
X }
X if (curtok == TOK_RBRACE)
X gettok();
X else if (!wneedtok(TOK_RBR))
X skippasttotoken(TOK_RBR, TOK_SEMI);
X tp = ord_type(first[0]->val.type);
X if (guesstype) { /* must determine type */
X if (!exmax || maxv == LONG_MAX) {
X maxv = defaultsetsize-1;
X if (ord_range(tp, NULL, &max2) && maxv > max2)
X maxv = max2;
X exmax = makeexpr_long(maxv);
X } else
X exmax = copyexpr(exmax);
X if (!ord_range(tp, NULL, &max2) || maxv != max2)
X tp = makesubrangetype(tp, makeexpr_long(0), exmax);
X type = makesettype(tp);
X } else
X type = makesettype(type);
X donecount = 0;
X if (smallsetconst > 0) {
X val.i = 0;
X for (i = 0; i < num; i++) {
X if (first[i]->kind == EK_CONST && first[i]->val.i < setbits &&
X (!last[i] || (last[i]->kind == EK_CONST &&
X last[i]->val.i >= 0 &&
X last[i]->val.i < setbits))) {
X if (last[i]) {
X for (j = first[i]->val.i; j <= last[i]->val.i; j++)
X val.i |= 1<<j;
X } else
X val.i |= 1 << first[i]->val.i;
X doneflag[i] = 1;
X donecount++;
X }
X }
X }
X if (donecount) {
X ex = makesmallsetconst(val.i, tp_smallset);
X } else
X ex = NULL;
X if (type->kind == TK_SMALLSET) {
X for (i = 0; i < num; i++) {
X if (!doneflag[i]) {
X ex2 = makeexpr_bin(EK_LSH, type,
X makeexpr_longcast(makeexpr_long(1), 1),
X enum_to_int(first[i]));
X if (last[i]) {
X if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
X note("Range construction was implemented by a subtraction which may overflow [278]");
X ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
X makeexpr_longcast(makeexpr_long(1), 1),
X makeexpr_plus(enum_to_int(last[i]),
X makeexpr_long(1))),
X ex2);
X }
X if (ex)
X ex = makeexpr_bin(EK_BOR, type, makeexpr_longcast(ex, 1), ex2);
X else
X ex = ex2;
X }
X }
X } else {
X tvar = makestmttempvar(type, name_SET);
X if (!ex) {
X val.type = tp_smallset;
X val.i = 0;
X val.s = NULL;
X ex = makeexpr_val(val);
X }
X ex = makeexpr_bicall_2(setexpandname, type,
X makeexpr_var(tvar), makeexpr_arglong(ex, 1));
X for (i = 0; i < num; i++) {
X if (!doneflag[i]) {
X if (last[i])
X ex = makeexpr_bicall_3(setaddrangename, type,
X ex, makeexpr_arglong(enum_to_int(first[i]), 0),
X makeexpr_arglong(enum_to_int(last[i]), 0));
X else
X ex = makeexpr_bicall_2(setaddname, type,
X ex, makeexpr_arglong(enum_to_int(first[i]), 0));
X }
X }
X }
X return ex;
X}
X
X
X
X
XExpr *p_funcarglist(ex, args, firstarg, ismacro)
XExpr *ex;
XMeaning *args;
Xint firstarg, ismacro;
X{
X Meaning *mp, *mp2, *arglist = args, *prevarg = NULL;
X Expr *ex2;
X int i, fi, fakenum = -1, castit, isconf, isnonpos = 0;
X Type *tp, *tp2;
X char *name;
X
X castit = castargs;
X if (castit < 0)
X castit = (prototypes == 0);
X while (args) {
X if (isnonpos) {
X while (curtok == TOK_COMMA)
X gettok();
X if (curtok == TOK_RPAR) {
X args = arglist;
X i = firstarg;
X while (args) {
X if (ex->nargs <= i)
X insertarg(&ex, ex->nargs, NULL);
X if (!ex->args[i]) {
X if (args->constdefn)
X ex->args[i] = copyexpr(args->constdefn);
X else {
X warning(format_s("Missing value for parameter %s [291]",
X args->name));
X ex->args[i] = makeexpr_long(0);
X }
X }
X args = args->xnext;
X i++;
X }
X break;
X }
X }
X if (args->isreturn || args->fakeparam) {
X if (args->fakeparam) {
X if (fakenum < 0)
X fakenum = ex->nargs;
X if (args->constdefn)
X insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
X else
X insertarg(&ex, ex->nargs, makeexpr_long(0));
X }
X args = args->xnext; /* return value parameter */
X continue;
X }
X if (curtok == TOK_RPAR) {
X if (args->constdefn) {
X insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
X args = args->xnext;
X continue;
X } else {
X if (ex->kind == EK_FUNCTION) {
X name = ((Meaning *)ex->val.i)->name;
X ex->kind = EK_BICALL;
X ex->val.s = stralloc(name);
X } else
X name = "function";
X warning(format_s("Too few arguments for %s [292]", name));
X return ex;
X }
X }
X if (curtok == TOK_COMMA) {
X if (args->constdefn)
X insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
X else {
X warning(format_s("Missing parameter %s [293]", args->name));
X insertarg(&ex, ex->nargs, makeexpr_long(0));
X }
X gettok();
X args = args->xnext;
X continue;
X }
X p_mech_spec(0);
X if (curtok == TOK_IDENT) {
X mp = arglist;
X mp2 = NULL;
X i = firstarg;
X fi = -1;
X while (mp && strcmp(curtokbuf, mp->sym->name)) {
X if (mp->fakeparam) {
X if (fi < 0)
X fi = i;
X } else
X fi = -1;
X i++;
X mp2 = mp;
X mp = mp->xnext;
X }
X if (mp &&
X (peeknextchar() == ':' || !curtokmeaning || isnonpos)) {
X gettok();
X wneedtok(TOK_ASSIGN);
X prevarg = mp2;
X args = mp;
X fakenum = fi;
X isnonpos = 1;
X } else
X i = ex->nargs;
X } else
X i = ex->nargs;
X while (ex->nargs <= i)
X insertarg(&ex, ex->nargs, NULL);
X if (ex->args[i])
X warning(format_s("Multiple values for parameter %s [294]",
X args->name));
X tp = args->type;
X ex2 = p_expr(tp);
X if (args->kind == MK_VARPARAM)
X tp = tp->basetype;
X tp2 = ex2->val.type;
X isconf = ((tp->kind == TK_ARRAY ||
X tp->kind == TK_STRING) && tp->structdefd);
X switch (args->kind) {
X
X case MK_PARAM:
X if (castit && tp->kind == TK_REAL &&
X ex2->val.type->kind != TK_REAL)
X ex2 = makeexpr_cast(ex2, tp);
X else if (ord_type(tp)->kind == TK_INTEGER && !ismacro)
X ex2 = makeexpr_arglong(ex2, long_type(tp));
X else if (args->othername && args->rectype != tp &&
X tp->kind != TK_STRING && args->type == tp2)
X ex2 = makeexpr_addr(ex2);
X else
X ex2 = gentle_cast(ex2, tp);
X ex->args[i] = ex2;
X break;
X
X case MK_VARPARAM:
X if (args->type == tp_strptr && args->anyvarflag) {
X ex->args[i] = strmax_func(ex2);
X insertarg(&ex, ex->nargs-1, makeexpr_addr(ex2));
X if (isnonpos)
X note("Non-positional conformant parameters may not work [279]");
X } else { /* regular VAR parameter */
X ex2 = makeexpr_addrf(ex2);
X if (args->anyvarflag ||
X (tp->kind == TK_POINTER && tp2->kind == TK_POINTER &&
X (tp == tp_anyptr || tp2 == tp_anyptr))) {
X if (!ismacro)
X ex2 = makeexpr_cast(ex2, args->type);
X } else {
X if (tp2 != tp && !isconf &&
X (tp2->kind != TK_STRING ||
X tp->kind != TK_STRING))
X warning(format_s("Type mismatch in VAR parameter %s [295]",
X args->name));
X }
X ex->args[i] = ex2;
X }
X break;
X
X default:
X intwarning("p_funcarglist",
X format_s("Parameter type is %s [296]",
X meaningkindname(args->kind)));
X break;
X }
X if (isconf && /* conformant array or string */
X (!prevarg || prevarg->type != args->type)) {
X while (tp->kind == TK_ARRAY && tp->structdefd) {
X if (tp2->kind == TK_SMALLARRAY) {
X warning("Trying to pass a small-array for a conformant array [297]");
X /* this has a chance of working... */
X ex->args[ex->nargs-1] =
X makeexpr_addr(ex->args[ex->nargs-1]);
X } else if (tp2->kind == TK_STRING) {
X ex->args[fakenum++] =
X makeexpr_arglong(makeexpr_long(1), integer16 == 0);
X ex->args[fakenum++] =
X makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
X integer16 == 0);
X break;
X } else if (tp2->kind != TK_ARRAY) {
X warning("Type mismatch for conformant array [298]");
X break;
X }
X ex->args[fakenum++] =
X makeexpr_arglong(copyexpr(tp2->indextype->smin),
X integer16 == 0);
X ex->args[fakenum++] =
X makeexpr_arglong(copyexpr(tp2->indextype->smax),
X integer16 == 0);
X tp = tp->basetype;
X tp2 = tp2->basetype;
X }
X if (tp->kind == TK_STRING && tp->structdefd) {
X ex->args[fakenum] =
X makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
X integer16 == 0);
X }
X }
X fakenum = -1;
X if (!isnonpos) {
X prevarg = args;
X args = args->xnext;
X if (args) {
X if (curtok != TOK_RPAR && !wneedtok(TOK_COMMA))
X skiptotoken2(TOK_RPAR, TOK_SEMI);
X }
X }
X }
X if (curtok == TOK_COMMA) {
X if (ex->kind == EK_FUNCTION) {
X name = ((Meaning *)ex->val.i)->name;
X ex->kind = EK_BICALL;
X ex->val.s = stralloc(name);
X } else
X name = "function";
X warning(format_s("Too many arguments for %s [299]", name));
X while (curtok == TOK_COMMA) {
X gettok();
X insertarg(&ex, ex->nargs, p_expr(tp_integer));
X }
X }
X return ex;
X}
X
X
X
XExpr *replacemacargs(ex, fex)
XExpr *ex, *fex;
X{
X int i;
X Expr *ex2;
X
X for (i = 0; i < ex->nargs; i++)
X ex->args[i] = replacemacargs(ex->args[i], fex);
X if (ex->kind == EK_MACARG) {
X if (ex->val.i <= fex->nargs) {
X ex2 = copyexpr(fex->args[ex->val.i - 1]);
X } else {
X ex2 = makeexpr_name("<meef>", tp_integer);
X note("FuncMacro specified more arguments than call [280]");
X }
X freeexpr(ex);
X return ex2;
X }
X return resimplify(ex);
X}
X
X
XExpr *p_noarglist(ex, mp, args)
XExpr *ex;
XMeaning *mp, *args;
X{
X while (args && args->constdefn) {
X insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
X args = args->xnext;
X }
X if (args) {
X warning(format_s("Expected an argument list for %s [300]", mp->name));
X ex->kind = EK_BICALL;
X ex->val.s = stralloc(mp->name);
X }
X return ex;
X}
X
X
Xvoid func_reference(func)
XMeaning *func;
X{
X Meaning *mp;
X
X if (func->ctx && func->ctx != curctx &&func->ctx->kind == MK_FUNCTION &&
X func->ctx->varstructflag && !curctx->ctx->varstructflag) {
X for (mp = curctx->ctx; mp != func->ctx; mp = mp->ctx)
X mp->varstructflag = 1;
X }
X}
X
X
XExpr *p_funccall(mp)
XMeaning *mp;
X{
X Meaning *mp2, *tvar;
X Expr *ex, *ex2;
X int firstarg = 0;
X
X func_reference(mp);
X ex = makeexpr(EK_FUNCTION, 0);
X ex->val.i = (long)mp;
X ex->val.type = mp->type->basetype;
X mp2 = mp->type->fbase;
X if (mp2 && mp2->isreturn) { /* pointer to buffer for return value */
X tvar = makestmttempvar(ex->val.type->basetype,
X (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
X insertarg(&ex, 0, makeexpr_addr(makeexpr_var(tvar)));
X mp2 = mp2->xnext;
X firstarg++;
X }
X if (mp2 && curtok != TOK_LPAR) {
X ex = p_noarglist(ex, mp, mp2);
X } else if (curtok == TOK_LPAR) {
X gettok();
X ex = p_funcarglist(ex, mp2, firstarg, (mp->constdefn != NULL));
X skipcloseparen();
X }
X if (mp->constdefn) {
X ex2 = replacemacargs(copyexpr(mp->constdefn), ex);
X ex2 = gentle_cast(ex2, ex->val.type);
X ex2->val.type = ex->val.type;
X freeexpr(ex);
X return ex2;
X }
X return ex;
X}
X
X
X
X
X
X
XExpr *accumulate_strlit()
X{
X char buf[256], ch, *cp, *cp2;
X int len, i, danger = 0;
X
X len = 0;
X cp = buf;
X for (;;) {
X if (curtok == TOK_STRLIT) {
X cp2 = curtokbuf;
X i = curtokint;
X while (--i >= 0) {
X if (++len <= 255) {
X ch = *cp++ = *cp2++;
X if (ch & 128)
X danger++;
X }
X }
X } else if (curtok == TOK_HAT) { /* Turbo */
X i = getchartok() & 0x1f;
X if (++len <= 255)
X *cp++ = i;
X } else if (curtok == TOK_LPAR) { /* VAX */
X Value val;
X do {
X gettok();
X val = p_constant(tp_integer);
X if (++len <= 255)
X *cp++ = val.i;
X } while (curtok == TOK_COMMA);
X skipcloseparen();
X continue;
X } else
X break;
X gettok();
X }
X if (len > 255) {
X warning("String literal too long [301]");
X len = 255;
X }
X if (danger &&
X !(unsignedchar == 1 ||
X (unsignedchar != 0 && signedchars == 0)))
X note(format_s("Character%s >= 128 encountered [281]", (danger > 1) ? "s" : ""));
X return makeexpr_lstring(buf, len);
X}
X
X
X
XExpr *pascaltypecast(type, ex2)
XType *type;
XExpr *ex2;
X{
X if ((ex2->val.type->kind == TK_INTEGER ||
X ex2->val.type->kind == TK_CHAR ||
X ex2->val.type->kind == TK_BOOLEAN ||
X ex2->val.type->kind == TK_ENUM ||
X ex2->val.type->kind == TK_SUBR ||
X ex2->val.type->kind == TK_REAL ||
X ex2->val.type->kind == TK_POINTER ||
X ex2->val.type->kind == TK_STRING) &&
X (type->kind == TK_INTEGER ||
X type->kind == TK_CHAR ||
X type->kind == TK_BOOLEAN ||
X type->kind == TK_ENUM ||
X type->kind == TK_SUBR ||
X type->kind == TK_REAL ||
X type->kind == TK_POINTER)) {
X if (type->kind == TK_POINTER || ex2->val.type->kind == TK_POINTER)
X return makeexpr_un(EK_CAST, type, ex2);
X else
X return makeexpr_un(EK_ACTCAST, type, ex2);
X } else {
X return makeexpr_hat(makeexpr_cast(makeexpr_addr(ex2),
X makepointertype(type)), 0);
X }
X}
X
X
X
X
XStatic Expr *p_factor(target)
XType *target;
X{
X Expr *ex, *ex2;
X Type *type;
X Meaning *mp, *mp2;
X
X switch (curtok) {
X
X case TOK_INTLIT:
X ex = makeexpr_long(curtokint);
X gettok();
X return ex;
X
X case TOK_HEXLIT:
X ex = makeexpr_long(curtokint);
X insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
X gettok();
X return ex;
X
X case TOK_OCTLIT:
X ex = makeexpr_long(curtokint);
X insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
X gettok();
X return ex;
X
X case TOK_MININT:
X strcat(curtokbuf, ".0");
X
X /* fall through */
X case TOK_REALLIT:
X ex = makeexpr_real(curtokbuf);
X gettok();
X return ex;
X
X case TOK_HAT:
X case TOK_STRLIT:
X ex = accumulate_strlit();
X return ex;
X
X case TOK_LPAR:
X gettok();
X ex = p_expr(target);
X skipcloseparen();
X return dots_n_hats(ex, target);
X
X case TOK_NOT:
X case TOK_TWIDDLE:
X gettok();
X ex = p_factor(tp_integer);
X if (ord_type(ex->val.type)->kind == TK_INTEGER)
X return makeexpr_un(EK_BNOT, tp_integer, ex);
X else
X return makeexpr_not(ex);
X
X case TOK_ADDR:
X gettok();
X if (curtok == TOK_ADDR) {
X gettok();
X ex = p_factor(tp_proc);
X if (ex->val.type->kind == TK_PROCPTR && ex->kind == EK_COMMA)
X return grabarg(grabarg(grabarg(ex, 0), 1), 0);
X if (ex->val.type->kind != TK_CPROCPTR)
X warning("@@ allowed only for procedure pointers [302]");
X return makeexpr_addrf(ex);
X }
X if (curtok == TOK_IDENT && 0 && /***/
X curtokmeaning && (curtokmeaning->kind == MK_FUNCTION ||
X curtokmeaning->kind == MK_SPECIAL)) {
X if (curtokmeaning->ctx == nullctx)
X warning(format_s("Can't take address of predefined object %s [303]",
X curtokmeaning->name));
X ex = makeexpr_name(curtokmeaning->name, tp_anyptr);
X gettok();
X } else {
X ex = p_factor(tp_proc);
X if (ex->val.type->kind == TK_PROCPTR) {
X /* ex = makeexpr_dotq(ex, "proc", tp_anyptr); */
X } else if (ex->val.type->kind == TK_CPROCPTR) {
X ex = makeexpr_cast(ex, tp_anyptr);
X } else
X ex = makeexpr_addrf(ex);
X }
X return ex;
X
X case TOK_LBR:
X case TOK_LBRACE:
X return p_setfactor(NULL);
X
X case TOK_NIL:
X gettok();
X return makeexpr_nil();
X
X case TOK_IF: /* nifty Pascal extension */
X gettok();
X ex = p_expr(tp_boolean);
X wneedtok(TOK_THEN);
X ex2 = p_expr(tp_integer);
X if (wneedtok(TOK_ELSE))
X return makeexpr_cond(ex, ex2, p_factor(ex2->val.type));
X else
X return makeexpr_cond(ex, ex2, makeexpr_long(0));
X
X case TOK_IDENT:
X mp = curtokmeaning;
X switch ((mp) ? mp->kind : MK_VAR) {
X
X case MK_TYPE:
X gettok();
X type = mp->type;
X switch (curtok) {
X
X case TOK_LPAR: /* Turbo type cast */
X gettok();
X ex2 = p_expr(type);
X ex = pascaltypecast(type, ex2);
X skipcloseparen();
X return dots_n_hats(ex, target);
X
X case TOK_LBR:
X case TOK_LBRACE:
X switch (type->kind) {
X
X case TK_SET:
X case TK_SMALLSET:
X return p_setfactor(type->indextype);
X
X case TK_RECORD:
X return p_constrecord(type, 0);
X
X case TK_ARRAY:
X case TK_SMALLARRAY:
X return p_constarray(type, 0);
X
X case TK_STRING:
X return p_conststring(type, 0);
X
X default:
X warning("Bad type for constructor [304]");
X skipparens();
X return makeexpr_name(mp->name, mp->type);
X }
X
X default:
X wexpected("an expression");
X return makeexpr_name(mp->name, mp->type);
X }
X
X case MK_SPECIAL:
X if (mp->handler && mp->isfunction &&
X (curtok == TOK_LPAR || !target ||
X (target->kind != TK_PROCPTR &&
X target->kind != TK_CPROCPTR))) {
X gettok();
X if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
X ex = makeexpr_bicall_0(mp->name, tp_integer);
X if (curtok == TOK_LPAR) {
X do {
X gettok();
X insertarg(&ex, ex->nargs, p_expr(NULL));
X } while (curtok == TOK_COMMA);
X skipcloseparen();
X }
X tryfuncmacro(&ex, mp);
X return ex;
X }
X ex = (*mp->handler)(mp);
X if (!ex)
X ex = makeexpr_long(0);
X return ex;
X } else {
X if (target->kind == TK_PROCPTR ||
X target->kind == TK_CPROCPTR)
X note("Using a built-in procedure as a procedure pointer [316]");
X else
X symclass(curtoksym);
X gettok();
X return makeexpr_name(mp->name, tp_integer);
X }
X
X case MK_FUNCTION:
X mp->refcount++;
X need_forward_decl(mp);
X gettok();
X if (mp->isfunction &&
X (curtok == TOK_LPAR || !target ||
X (target->kind != TK_PROCPTR &&
X target->kind != TK_CPROCPTR))) {
X ex = p_funccall(mp);
X if (!mp->constdefn) {
X if (mp->handler && !(mp->sym->flags & LEAVEALONE))
X ex = (*mp->handler)(ex);
X }
X if (mp->cbase->kind == MK_VARPARAM) {
X ex = makeexpr_hat(ex, 0); /* returns pointer to structured result */
X }
X return dots_n_hats(ex, target);
X } else {
X if (mp->handler && !(mp->sym->flags & LEAVEALONE))
X note("Using a built-in procedure as a procedure pointer [316]");
X if (target && target->kind == TK_CPROCPTR) {
X type = maketype(TK_CPROCPTR);
X type->basetype = mp->type;
X type->escale = 0;
X mp2 = makestmttempvar(type, name_TEMP);
X ex = makeexpr_comma(
X makeexpr_assign(
X makeexpr_var(mp2),
X makeexpr_name(mp->name, tp_text)),
X makeexpr_var(mp2));
X if (mp->ctx->kind == MK_FUNCTION)
X warning("Procedure pointer to nested procedure [305]");
X } else {
X type = maketype(TK_PROCPTR);
X type->basetype = mp->type;
X type->escale = 1;
X mp2 = makestmttempvar(type, name_TEMP);
X ex = makeexpr_comma(
X makeexpr_comma(
X makeexpr_assign(
X makeexpr_dotq(makeexpr_var(mp2),
X "proc",
X tp_anyptr),
X makeexpr_name(mp->name, tp_text)),
X /* handy pointer type */
X makeexpr_assign(
X makeexpr_dotq(makeexpr_var(mp2),
X "link",
X tp_anyptr),
X makeexpr_ctx(mp->ctx))),
X makeexpr_var(mp2));
X }
X return ex;
X }
X
X default:
X return p_variable(target);
X }
X
X default:
X wexpected("an expression");
X return makeexpr_long(0);
X
X }
X}
X
X
X
X
XStatic Expr *p_powterm(target)
XType *target;
X{
X Expr *ex = p_factor(target);
X Expr *ex2;
X int i, castit;
X long v;
X
X if (curtok == TOK_STARSTAR) {
X gettok();
X ex2 = p_powterm(target);
X if (ex->val.type->kind == TK_REAL ||
X ex2->val.type->kind == TK_REAL) {
X if (checkconst(ex2, 2)) {
X ex = makeexpr_sqr(ex, 0);
X } else if (checkconst(ex2, 3)) {
X ex = makeexpr_sqr(ex, 1);
X } else {
X castit = castargs >= 0 ? castargs : (prototypes == 0);
X if (ex->val.type->kind != TK_REAL && castit)
X ex = makeexpr_cast(ex, tp_longreal);
X if (ex2->val.type->kind != TK_REAL && castit)
X ex2 = makeexpr_cast(ex2, tp_longreal);
X ex = makeexpr_bicall_2("pow", tp_longreal, ex, ex2);
X }
X } else if (checkconst(ex, 2)) {
X freeexpr(ex);
X ex = makeexpr_bin(EK_LSH, tp_integer,
X makeexpr_longcast(makeexpr_long(1), 1), ex2);
X } else if (checkconst(ex, 0) ||
X checkconst(ex, 1) ||
X checkconst(ex2, 1)) {
X freeexpr(ex2);
X } else if (checkconst(ex2, 0)) {
X freeexpr(ex);
X freeexpr(ex2);
X ex = makeexpr_long(1);
X } else if (isliteralconst(ex, NULL) == 2 &&
X isliteralconst(ex2, NULL) == 2 &&
X ex2->val.i > 0) {
X v = ex->val.i;
X i = ex2->val.i;
X while (--i > 0)
X v *= ex->val.i;
X freeexpr(ex);
X freeexpr(ex2);
X ex = makeexpr_long(v);
X } else if (checkconst(ex2, 2)) {
X ex = makeexpr_sqr(ex, 0);
X } else if (checkconst(ex2, 3)) {
X ex = makeexpr_sqr(ex, 1);
X } else {
X ex = makeexpr_bicall_2("ipow", tp_integer,
X makeexpr_arglong(ex, 1),
X makeexpr_arglong(ex2, 1));
X }
X }
X return ex;
X}
X
X
XStatic Expr *p_term(target)
XType *target;
X{
X Expr *ex = p_powterm(target);
X Expr *ex2;
X Type *type;
X Meaning *tvar;
X int useshort;
X
X for (;;) {
X checkkeyword(TOK_SHL);
X checkkeyword(TOK_SHR);
X checkkeyword(TOK_REM);
X switch (curtok) {
X
X case TOK_STAR:
X gettok();
X if (ex->val.type->kind == TK_SET ||
X ex->val.type->kind == TK_SMALLSET) {
X ex2 = p_powterm(ex->val.type);
X type = mixsets(&ex, &ex2);
X if (type->kind == TK_SMALLSET) {
X ex = makeexpr_bin(EK_BAND, type, ex, ex2);
X } else {
X tvar = makestmttempvar(type, name_SET);
X ex = makeexpr_bicall_3(setintname, type,
X makeexpr_var(tvar),
X ex, ex2);
X }
X } else
X ex = makeexpr_times(ex, p_powterm(tp_integer));
X break;
X
X case TOK_SLASH:
X gettok();
X if (ex->val.type->kind == TK_SET ||
X ex->val.type->kind == TK_SMALLSET) {
X ex2 = p_powterm(ex->val.type);
X type = mixsets(&ex, &ex2);
X if (type->kind == TK_SMALLSET) {
X ex = makeexpr_bin(EK_BXOR, type, ex, ex2);
X } else {
X tvar = makestmttempvar(type, name_SET);
X ex = makeexpr_bicall_3(setxorname, type,
X makeexpr_var(tvar),
X ex, ex2);
X }
X } else
X ex = makeexpr_divide(ex, p_powterm(tp_integer));
X break;
X
X case TOK_DIV:
X gettok();
X ex = makeexpr_div(ex, p_powterm(tp_integer));
X break;
X
X case TOK_REM:
X gettok();
X ex = makeexpr_rem(ex, p_powterm(tp_integer));
X break;
X
X case TOK_MOD:
X gettok();
X ex = makeexpr_mod(ex, p_powterm(tp_integer));
X break;
X
X case TOK_AND:
X case TOK_AMP:
X useshort = (curtok == TOK_AMP);
X gettok();
X ex2 = p_powterm(tp_integer);
X if (ord_type(ex->val.type)->kind == TK_INTEGER)
X ex = makeexpr_bin(EK_BAND, ex->val.type, ex, ex2);
X else if (partial_eval_flag || useshort ||
X (shortopt && nosideeffects(ex2, 1)))
X ex = makeexpr_and(ex, ex2);
X else
X ex = makeexpr_bin(EK_BAND, tp_boolean, ex, ex2);
X break;
X
X case TOK_SHL:
X gettok();
X ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_powterm(tp_integer));
X break;
X
X case TOK_SHR:
X gettok();
X ex = force_unsigned(ex);
X ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_powterm(tp_integer));
X break;
X
X default:
X return ex;
X }
X }
X}
X
X
X
XStatic Expr *p_sexpr(target)
XType *target;
X{
X Expr *ex, *ex2;
X Type *type;
X Meaning *tvar;
X int useshort;
X
X switch (curtok) {
X case TOK_MINUS:
X gettok();
X if (curtok == TOK_MININT) {
X gettok();
X ex = makeexpr_long(MININT);
X break;
X }
X ex = makeexpr_neg(p_term(target));
X break;
X case TOK_PLUS:
X gettok();
X /* fall through */
X default:
X ex = p_term(target);
X break;
X }
X if (curtok == TOK_PLUS &&
X (ex->val.type->kind == TK_STRING ||
X ord_type(ex->val.type)->kind == TK_CHAR ||
X ex->val.type->kind == TK_ARRAY)) {
X while (curtok == TOK_PLUS) {
X gettok();
X ex = makeexpr_concat(ex, p_term(NULL), 0);
X }
X return ex;
X } else {
X for (;;) {
X checkkeyword(TOK_XOR);
X switch (curtok) {
X
X case TOK_PLUS:
X gettok();
X if (ex->val.type->kind == TK_SET ||
X ex->val.type->kind == TK_SMALLSET) {
X ex2 = p_term(ex->val.type);
X type = mixsets(&ex, &ex2);
X if (type->kind == TK_SMALLSET) {
X ex = makeexpr_bin(EK_BOR, type, ex, ex2);
X } else {
X tvar = makestmttempvar(type, name_SET);
X ex = makeexpr_bicall_3(setunionname, type,
X makeexpr_var(tvar),
X ex, ex2);
X }
X } else
X ex = makeexpr_plus(ex, p_term(tp_integer));
X break;
X
X case TOK_MINUS:
X gettok();
X if (ex->val.type->kind == TK_SET ||
X ex->val.type->kind == TK_SMALLSET) {
X ex2 = p_term(tp_integer);
X type = mixsets(&ex, &ex2);
X if (type->kind == TK_SMALLSET) {
X ex = makeexpr_bin(EK_BAND, type, ex,
X makeexpr_un(EK_BNOT, type, ex2));
X } else {
X tvar = makestmttempvar(type, name_SET);
X ex = makeexpr_bicall_3(setdiffname, type,
X makeexpr_var(tvar), ex, ex2);
X }
X } else
X ex = makeexpr_minus(ex, p_term(tp_integer));
X break;
X
X case TOK_VBAR:
X if (modula2)
X return ex;
X /* fall through */
X
X case TOK_OR:
X useshort = (curtok == TOK_VBAR);
X gettok();
X ex2 = p_term(tp_integer);
X if (ord_type(ex->val.type)->kind == TK_INTEGER)
X ex = makeexpr_bin(EK_BOR, ex->val.type, ex, ex2);
X else if (partial_eval_flag || useshort ||
X (shortopt && nosideeffects(ex2, 1)))
X ex = makeexpr_or(ex, ex2);
X else
X ex = makeexpr_bin(EK_BOR, tp_boolean, ex, ex2);
X break;
X
X case TOK_XOR:
X gettok();
X ex2 = p_term(tp_integer);
X ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
X break;
X
X default:
X return ex;
X }
X }
X }
X}
X
X
X
XExpr *p_expr(target)
XType *target;
X{
X Expr *ex = p_sexpr(target);
X Expr *ex2, *ex3, *ex4;
X Type *type;
X Meaning *tvar;
X long mask, smin, smax;
X int i, j;
X
X switch (curtok) {
X
X case TOK_EQ:
X gettok();
X return makeexpr_rel(EK_EQ, ex, p_sexpr(ex->val.type));
X
X case TOK_NE:
X gettok();
X return makeexpr_rel(EK_NE, ex, p_sexpr(ex->val.type));
X
X case TOK_LT:
X gettok();
X return makeexpr_rel(EK_LT, ex, p_sexpr(ex->val.type));
X
X case TOK_GT:
X gettok();
X return makeexpr_rel(EK_GT, ex, p_sexpr(ex->val.type));
X
X case TOK_LE:
X gettok();
X return makeexpr_rel(EK_LE, ex, p_sexpr(ex->val.type));
X
X case TOK_GE:
X gettok();
X return makeexpr_rel(EK_GE, ex, p_sexpr(ex->val.type));
X
X case TOK_IN:
X gettok();
X ex2 = p_sexpr(tp_smallset);
X ex = gentle_cast(ex, ex2->val.type->indextype);
X if (ex2->val.type->kind == TK_SMALLSET) {
X if (!ord_range(ex->val.type, &smin, &smax)) {
X smin = -1;
X smax = setbits;
X }
X if (!nosideeffects(ex, 0)) {
X tvar = makestmttempvar(ex->val.type, name_TEMP);
X ex3 = makeexpr_assign(makeexpr_var(tvar), ex);
END_OF_FILE
if test 48768 -ne `wc -c <'src/pexpr.c.1'`; then
echo shar: \"'src/pexpr.c.1'\" unpacked with wrong size!
fi
# end of 'src/pexpr.c.1'
fi
echo shar: End of archive 23 \(of 32\).
cp /dev/null ark23isdone
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