[llvm-commits] [parallel] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT Makefile citmods.c comment.c decl.c dir.c expr.c funcs.c hpmods.c lex.c libp2c.a loc.p2clib.c makeproto out.c p2c.h parse.c pexpr.c stuff.c trans.c trans.h
Misha Brukman
brukman at cs.uiuc.edu
Mon Mar 1 21:26:22 PST 2004
Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c:
LICENSE.TXT added (r1.1.2.1)
Makefile added (r1.2.2.1)
citmods.c added (r1.1.2.1)
comment.c added (r1.1.2.1)
decl.c added (r1.1.2.1)
dir.c added (r1.1.2.1)
expr.c added (r1.1.2.1)
funcs.c added (r1.1.2.1)
hpmods.c added (r1.1.2.1)
lex.c added (r1.1.2.1)
libp2c.a added (r1.1.2.1)
loc.p2clib.c added (r1.1.2.1)
makeproto added (r1.1.2.1)
out.c added (r1.1.2.1)
p2c.h added (r1.1.2.1)
parse.c added (r1.1.2.1)
pexpr.c added (r1.1.2.1)
stuff.c added (r1.1.2.1)
trans.c added (r1.1.2.1)
trans.h added (r1.1.2.1)
---
Log message:
Merge from trunk
---
Diffs of the changes: (+36197 -0)
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/LICENSE.TXT Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,10 ----
+ p2c - Part of the Malloc Benchmark Suite
+ -------------------------------------------------------------------------------
+ All files are licensed under the LLVM license with the following additions:
+
+ These files are licensed to you under the GNU General Public License (any
+ version). Redistribution must follow the additional restrictions required by
+ the GPL.
+
+ Please see individiual files for additional copyright information.
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/Makefile
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/Makefile:1.2.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/Makefile Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,6 ----
+ LEVEL = ../../../../../..
+ PROG = p2c
+ CPPFLAGS += -DNOMEMOPT
+ RUN_OPTIONS = -v
+ STDIN_FILENAME = $(SourceDir)/INPUT/mf.p
+ include ../../../Makefile.multisrc
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/citmods.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/citmods.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/citmods.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,1153 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_CITMODS_C
+ #include "trans.h"
+
+
+
+ /* The following functions define special translations for several
+ * HP Pascal modules developed locally at Caltech. For non-Caltech
+ * readers this file will serve mainly as a body of examples.
+ *
+ * The FuncMacro mechanism (introduced after this file was written)
+ * provides a simpler method for cases where the function translates
+ * into some fixed C equivalent.
+ */
+
+
+
+
+ /* NEWASM functions */
+
+
+ /* na_fillbyte: equivalent to memset, though convert_size is used to
+ * generalize the size a bit: na_fillbyte(a, 0, 80) where a is an array
+ * of integers (4 bytes in HP Pascal) will be translated to
+ * memset(a, 0, 20 * sizeof(int)).
+ */
+
+ Static Stmt *proc_na_fillbyte(ex)
+ Expr *ex;
+ {
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+ ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_FILLBYTE");
+ return makestmt_call(makeexpr_bicall_3("memset", tp_void,
+ ex->args[0],
+ makeexpr_arglong(ex->args[1], 0),
+ makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+
+
+
+ /* This function fills with a 32-bit pattern. If all four bytes of the
+ * pattern are equal, memset is used, otherwise the na_fill call is
+ * left unchanged.
+ */
+
+ Static Stmt *proc_na_fill(ex)
+ Expr *ex;
+ {
+ unsigned long ul;
+ Symbol *sym;
+
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+ ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_FILL");
+ if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_FILLP")) {
+ sym = findsymbol("NA_FILL");
+ if (sym->mbase)
+ ex->val.i = (long)sym->mbase;
+ }
+ if (isliteralconst(ex->args[1], NULL) != 2)
+ return makestmt_call(ex);
+ ul = ex->args[1]->val.i;
+ if ((((ul >> 16) ^ ul) & 0xffff) || /* all four bytes must be the same */
+ (((ul >> 8) ^ ul) & 0xff))
+ return makestmt_call(ex);
+ ex->args[1]->val.i &= 0xff;
+ return makestmt_call(makeexpr_bicall_3("memset", tp_void,
+ ex->args[0],
+ makeexpr_arglong(ex->args[1], 0),
+ makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+
+
+
+ Static Stmt *proc_na_move(ex)
+ Expr *ex;
+ {
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr); /* source */
+ ex->args[1] = gentle_cast(ex->args[1], tp_anyptr); /* dest */
+ ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+ argbasetype(ex->args[1])), ex->args[2], "NA_MOVE");
+ return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
+ ex->args[1],
+ ex->args[0],
+ makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+
+
+
+ /* This just generalizes the size and leaves the function call alone,
+ * except that na_exchp (a version using pointer args) is transformed
+ * to na_exch (a version using VAR args, equivalent in C).
+ */
+
+ Static Stmt *proc_na_exch(ex)
+ Expr *ex;
+ {
+ Symbol *sym;
+
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+ ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);
+ ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+ argbasetype(ex->args[1])), ex->args[2], "NA_EXCH");
+ if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_EXCHP")) {
+ sym = findsymbol("NA_EXCH");
+ if (sym->mbase)
+ ex->val.i = (long)sym->mbase;
+ }
+ return makestmt_call(ex);
+ }
+
+
+
+ Static Expr *func_na_comp(ex)
+ Expr *ex;
+ {
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+ ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);
+ ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+ argbasetype(ex->args[1])), ex->args[2], "NA_COMP");
+ return makeexpr_bicall_3("memcmp", tp_int,
+ ex->args[0],
+ ex->args[1],
+ makeexpr_arglong(ex->args[2], (size_t_long != 0)));
+ }
+
+
+
+ Static Expr *func_na_scaneq(ex)
+ Expr *ex;
+ {
+ Symbol *sym;
+
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+ ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_SCANEQ");
+ if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_SCANEQP")) {
+ sym = findsymbol("NA_SCANEQ");
+ if (sym->mbase)
+ ex->val.i = (long)sym->mbase;
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_na_scanne(ex)
+ Expr *ex;
+ {
+ Symbol *sym;
+
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);
+ ex->args[2] = convert_size(argbasetype(ex->args[0]), ex->args[2], "NA_SCANNE");
+ if (!strcmp(((Meaning *)ex->val.i)->sym->name, "NA_SCANNEP")) {
+ sym = findsymbol("NA_SCANNE");
+ if (sym->mbase)
+ ex->val.i = (long)sym->mbase;
+ }
+ return ex;
+ }
+
+
+
+ Static Stmt *proc_na_new(ex)
+ Expr *ex;
+ {
+ Expr *vex, *ex2, *sz = NULL;
+ Stmt *sp;
+
+ vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+ ex2 = ex->args[1];
+ if (vex->val.type->kind == TK_POINTER)
+ ex2 = convert_size(vex->val.type->basetype, ex2, "NA_NEW");
+ if (alloczeronil)
+ sz = copyexpr(ex2);
+ ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
+ sp = makestmt_assign(copyexpr(vex), ex2);
+ if (malloccheck) {
+ sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
+ makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int,
+ makeexpr_long(-2))),
+ NULL));
+ }
+ if (sz && !isconstantexpr(sz)) {
+ if (alloczeronil == 2)
+ note("Called NA_NEW with variable argument [500]");
+ sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
+ sp,
+ makestmt_assign(vex, makeexpr_nil()));
+ } else
+ freeexpr(vex);
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_na_dispose(ex)
+ Expr *ex;
+ {
+ Stmt *sp;
+ Expr *vex;
+
+ vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+ sp = makestmt_call(makeexpr_bicall_1(freename, tp_void, copyexpr(vex)));
+ if (alloczeronil) {
+ sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
+ sp, NULL);
+ } else
+ freeexpr(vex);
+ return sp;
+ }
+
+
+
+ /* These functions provide functionality similar to alloca; we just warn
+ * about them here since alloca would not have been portable enough for
+ * our purposes anyway.
+ */
+
+ Static Stmt *proc_na_alloc(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+
+ note("Call to NA_ALLOC [501]");
+ ex->args[0] = eatcasts(ex->args[0]);
+ ex2 = ex->args[0];
+ if (ex2->val.type->kind == TK_POINTER &&
+ ex2->val.type->basetype->kind == TK_POINTER)
+ ex->args[1] = convert_size(ex2->val.type->basetype->basetype,
+ ex->args[1], "NA_ALLOC");
+ return makestmt_call(ex);
+ }
+
+
+
+ Static Stmt *proc_na_outeralloc(ex)
+ Expr *ex;
+ {
+ note("Call to NA_OUTERALLOC [502]");
+ return makestmt_call(ex);
+ }
+
+
+
+ Static Stmt *proc_na_free(ex)
+ Expr *ex;
+ {
+ note("Call to NA_FREE [503]");
+ return makestmt_call(ex);
+ }
+
+
+
+
+ Static Expr *func_na_memavail(ex)
+ Expr *ex;
+ {
+ freeexpr(ex);
+ return makeexpr_bicall_0("memavail", tp_integer);
+ }
+
+
+
+
+ /* A simple collection of bitwise operations. */
+
+ Static Expr *func_na_and(ex)
+ Expr *ex;
+ {
+ Expr *ex0, *ex1;
+
+ ex0 = makeexpr_unlongcast(ex->args[0]);
+ ex1 = makeexpr_unlongcast(ex->args[1]);
+ return makeexpr_bin(EK_BAND, tp_integer, ex0, ex1);
+ }
+
+
+
+ Static Expr *func_na_bic(ex)
+ Expr *ex;
+ {
+ Expr *ex0, *ex1;
+
+ ex0 = makeexpr_unlongcast(ex->args[0]);
+ ex1 = makeexpr_unlongcast(ex->args[1]);
+ return makeexpr_bin(EK_BAND, tp_integer,
+ ex0,
+ makeexpr_un(EK_BNOT, ex1->val.type, ex1));
+ }
+
+
+
+ Static Expr *func_na_or(ex)
+ Expr *ex;
+ {
+ Expr *ex0, *ex1;
+
+ ex0 = makeexpr_unlongcast(ex->args[0]);
+ ex1 = makeexpr_unlongcast(ex->args[1]);
+ return makeexpr_bin(EK_BOR, tp_integer, ex0, ex1);
+ }
+
+
+
+ Static Expr *func_na_xor(ex)
+ Expr *ex;
+ {
+ Expr *ex0, *ex1;
+
+ ex0 = makeexpr_unlongcast(ex->args[0]);
+ ex1 = makeexpr_unlongcast(ex->args[1]);
+ return makeexpr_bin(EK_BXOR, tp_integer, ex0, ex1);
+ }
+
+
+
+ Static Expr *func_na_not(ex)
+ Expr *ex;
+ {
+ ex = makeexpr_unlongcast(grabarg(ex, 0));
+ return makeexpr_un(EK_BNOT, ex->val.type, ex);
+ }
+
+
+
+ Static Expr *func_na_mask(ex)
+ Expr *ex;
+ {
+ Expr *ex0, *ex1;
+
+ ex0 = makeexpr_unlongcast(ex->args[0]);
+ ex1 = makeexpr_unlongcast(ex->args[1]);
+ ex = makeexpr_bin(EK_BAND, tp_integer, ex0, ex1);
+ return makeexpr_rel(EK_NE, ex, makeexpr_long(0));
+ }
+
+
+
+ Static int check0_31(ex)
+ Expr *ex;
+ {
+ if (isliteralconst(ex, NULL) == 2)
+ return (ex->val.i >= 0 && ex->val.i <= 31);
+ else
+ return (assumebits != 0);
+ }
+
+
+
+ /* This function is defined to test a bit of an integer, returning false
+ * if the bit number is out of range. It is only safe to use C bitwise
+ * ops if we can prove the bit number is always in range, or if the
+ * user has asked us to assume that it is. Lacking flow analysis,
+ * we settle for checking constants only.
+ */
+
+ Static Expr *func_na_test(ex)
+ Expr *ex;
+ {
+ Expr *ex1;
+ int longness;
+
+ if (!check0_31(ex->args[0]))
+ return ex;
+ ex1 = makeexpr_unlongcast(ex->args[1]);
+ longness = (exprlongness(ex1) != 0);
+ return makeexpr_rel(EK_NE,
+ makeexpr_bin(EK_BAND, tp_integer,
+ ex1,
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1), longness),
+ makeexpr_unlongcast(ex->args[0]))),
+ makeexpr_long(0));
+ }
+
+
+
+ Static Stmt *proc_na_set(ex)
+ Expr *ex;
+ {
+ Stmt *sp;
+ Expr *vex;
+ Meaning *tvar;
+
+ if (!check0_31(ex->args[0]))
+ return makestmt_call(ex);
+ if (!nosideeffects(ex->args[1], 1)) {
+ tvar = makestmttempvar(ex->args[1]->val.type, name_TEMP);
+ sp = makestmt_assign(makeexpr_var(tvar), ex->args[1]);
+ vex = makeexpr_hat(makeexpr_var(tvar), 0);
+ } else {
+ sp = NULL;
+ vex = makeexpr_hat(ex->args[1], 0);
+ }
+ sp = makestmt_seq(sp,
+ makestmt_assign(vex,
+ makeexpr_bin(EK_BOR, tp_integer,
+ copyexpr(vex),
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ makeexpr_unlongcast(ex->args[0])))));
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_na_clear(ex)
+ Expr *ex;
+ {
+ Stmt *sp;
+ Expr *vex;
+ Meaning *tvar;
+
+ if (!check0_31(ex->args[0]))
+ return makestmt_call(ex);
+ if (!nosideeffects(ex->args[1], 1)) {
+ tvar = makestmttempvar(ex->args[1]->val.type, name_TEMP);
+ sp = makestmt_assign(makeexpr_var(tvar), ex->args[1]);
+ vex = makeexpr_hat(makeexpr_var(tvar), 0);
+ } else {
+ sp = NULL;
+ vex = makeexpr_hat(ex->args[1], 0);
+ }
+ sp = makestmt_seq(sp,
+ makestmt_assign(vex,
+ makeexpr_bin(EK_BAND, tp_integer,
+ copyexpr(vex),
+ makeexpr_un(EK_BNOT, tp_integer,
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ makeexpr_unlongcast(ex->args[0]))))));
+ return sp;
+ }
+
+
+
+ Static Expr *func_na_po2(ex)
+ Expr *ex;
+ {
+ if (!check0_31(ex->args[0]))
+ return ex;
+ return makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ makeexpr_unlongcast(grabarg(ex, 0)));
+ }
+
+
+
+ Static Expr *func_na_lobits(ex)
+ Expr *ex;
+ {
+ if (!check0_31(ex->args[0]))
+ return ex;
+ return makeexpr_un(EK_BNOT, tp_integer,
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(-1), 1),
+ makeexpr_unlongcast(grabarg(ex, 0))));
+ }
+
+
+
+ Static Expr *func_na_hibits(ex)
+ Expr *ex;
+ {
+ if (!check0_31(ex->args[0]))
+ return ex;
+ return makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(-1), 1),
+ makeexpr_minus(makeexpr_long(32),
+ makeexpr_unlongcast(grabarg(ex, 0))));
+ }
+
+
+
+ /* This function does an arithmetic shift left, or right for negative shift
+ * count. We translate into a C shift only if we are confident of the
+ * sign of the shift count.
+ */
+
+ Static Expr *func_na_asl(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+
+ ex2 = makeexpr_unlongcast(copyexpr(ex->args[0]));
+ if (expr_is_neg(ex2)) {
+ if (signedshift == 0 || signedshift == 2)
+ return ex;
+ if (possiblesigns(ex2) & 4) {
+ if (assumesigns)
+ note("Assuming count for NA_ASL is negative [504]");
+ else
+ return ex;
+ }
+ if (signedshift != 1)
+ note("Assuming >> is an arithmetic shift [505]");
+ return makeexpr_bin(EK_RSH, tp_integer,
+ grabarg(ex, 1), makeexpr_neg(ex2));
+ } else {
+ if (possiblesigns(ex2) & 1) {
+ if (assumesigns)
+ note("Assuming count for NA_ASL is positive [504]");
+ else
+ return ex;
+ }
+ return makeexpr_bin(EK_LSH, tp_integer, grabarg(ex, 1), ex2);
+ }
+ }
+
+
+
+ Static Expr *func_na_lsl(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+
+ ex2 = makeexpr_unlongcast(copyexpr(ex->args[0]));
+ if (expr_is_neg(ex2)) {
+ if (possiblesigns(ex2) & 4) {
+ if (assumesigns)
+ note("Assuming count for NA_LSL is negative [506]");
+ else
+ return ex;
+ }
+ return makeexpr_bin(EK_RSH, tp_integer,
+ force_unsigned(grabarg(ex, 1)),
+ makeexpr_neg(ex2));
+ } else {
+ if (possiblesigns(ex2) & 1) {
+ if (assumesigns)
+ note("Assuming count for NA_LSL is positive [506]");
+ else
+ return ex;
+ }
+ return makeexpr_bin(EK_LSH, tp_integer, grabarg(ex, 1), ex2);
+ }
+ }
+
+
+
+ /* These bit-field operations were generalized slightly on the way to C;
+ * they used to perform D &= S and now perform D = S1 & S2.
+ */
+
+ Static Stmt *proc_na_bfand(ex)
+ Expr *ex;
+ {
+ Stmt *sp;
+ Meaning *tvar;
+
+ if (!nosideeffects(ex->args[2], 1)) {
+ tvar = makestmttempvar(ex->args[2]->val.type, name_TEMP);
+ sp = makestmt_assign(makeexpr_var(tvar), ex->args[2]);
+ ex->args[2] = makeexpr_var(tvar);
+ } else
+ sp = NULL;
+ insertarg(&ex, 1, copyexpr(ex->args[2]));
+ return makestmt_seq(sp, makestmt_call(ex));
+ }
+
+
+
+ Static Stmt *proc_na_bfbic(ex)
+ Expr *ex;
+ {
+ return proc_na_bfand(ex);
+ }
+
+
+
+ Static Stmt *proc_na_bfor(ex)
+ Expr *ex;
+ {
+ return proc_na_bfand(ex);
+ }
+
+
+
+ Static Stmt *proc_na_bfxor(ex)
+ Expr *ex;
+ {
+ return proc_na_bfand(ex);
+ }
+
+
+
+ Static Expr *func_imin(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_2("P_imin2", tp_integer,
+ ex->args[0], ex->args[1]);
+ }
+
+
+
+ Static Expr *func_imax(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_2("P_imax2", tp_integer,
+ ex->args[0], ex->args[1]);
+ }
+
+
+
+ /* Unsigned non-overflowing arithmetic functions in Pascal; we translate
+ * into plain arithmetic in C and assume C doesn't check for overflow.
+ * (A valid assumption in the case when this was used.)
+ */
+
+ Static Expr *func_na_add(ex)
+ Expr *ex;
+ {
+ return makeexpr_plus(makeexpr_unlongcast(ex->args[0]),
+ makeexpr_unlongcast(ex->args[1]));
+ }
+
+
+
+ Static Expr *func_na_sub(ex)
+ Expr *ex;
+ {
+ return makeexpr_minus(makeexpr_unlongcast(ex->args[0]),
+ makeexpr_unlongcast(ex->args[1]));
+ }
+
+
+
+ extern Stmt *proc_exit(); /* from funcs.c */
+
+ Static Stmt *proc_return()
+ {
+ return proc_exit();
+ }
+
+
+
+ Static Expr *func_charupper(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("toupper", tp_char,
+ grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_charlower(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("tolower", tp_char,
+ grabarg(ex, 0));
+ }
+
+
+
+ /* Convert an integer to its string representation. We produce a sprintf
+ * into a temporary variable; the temporary will probably be eliminated
+ * as the surrounding code is translated.
+ */
+
+ Static Expr *func_strint(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+
+ ex2 = makeexpr_forcelongness(ex->args[1]);
+ return makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string((exprlongness(ex2) > 0) ? "%ld" : "%d"),
+ ex2);
+ }
+
+
+
+ Static Expr *func_strint2(ex)
+ Expr *ex;
+ {
+ Expr *ex2, *len, *fmt;
+
+ if (checkconst(ex->args[2], 0) || checkconst(ex->args[2], 1))
+ return func_strint(ex);
+ if (expr_is_neg(ex->args[2])) {
+ if (possiblesigns(ex->args[2]) & 4) {
+ if (assumesigns)
+ note("Assuming width for STRINT2 is negative [507]");
+ else
+ return ex;
+ }
+ ex2 = makeexpr_forcelongness(ex->args[1]);
+ fmt = makeexpr_string((exprlongness(ex2) > 0) ? "%0*ld" : "%0*d");
+ len = makeexpr_neg(makeexpr_longcast(ex->args[2], 0));
+ } else {
+ if (possiblesigns(ex->args[2]) & 1) {
+ if (assumesigns)
+ note("Assuming width for STRINT2 is positive [507]");
+ else
+ return ex;
+ }
+ ex2 = makeexpr_forcelongness(ex->args[1]);
+ fmt = makeexpr_string((exprlongness(ex2) > 0) ? "%*ld" : "%*d");
+ len = makeexpr_longcast(ex->args[2], 0);
+ }
+ ex = makeexpr_bicall_4("sprintf", ex->val.type,
+ ex->args[0], fmt, len, ex2);
+ return cleansprintf(ex);
+ }
+
+
+
+ Static Expr *func_strhex(ex)
+ Expr *ex;
+ {
+ Expr *ex2, *ex3;
+ Value val;
+
+ if (isliteralconst(ex->args[2], &val) == 2) {
+ ex2 = makeexpr_forcelongness(ex->args[1]);
+ if (val.i < 1 || val.i > 8) {
+ ex = makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string((exprlongness(ex2) > 0) ? "%lX" : "%X"),
+ ex2);
+ } else {
+ if (val.i < 8) {
+ ex3 = makeexpr_long((1 << (val.i*4)) - 1);
+ insertarg(&ex3, 0, makeexpr_name("%#lx", tp_integer));
+ ex2 = makeexpr_bin(EK_BAND, ex2->val.type, ex2, ex3);
+ }
+ ex = makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string(format_d((exprlongness(ex2) > 0) ? "%%.%ldlX" :
+ "%%.%ldX",
+ val.i)),
+ ex2);
+ }
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_strreal(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string("%g"),
+ ex->args[1]);
+ }
+
+
+
+ Static Expr *func_strchar(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string("%c"),
+ ex->args[1]);
+ }
+
+
+
+ Static Expr *func_strreadint(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_3("strtol", tp_integer,
+ grabarg(ex, 0),
+ makeexpr_nil(),
+ makeexpr_long(0));
+ }
+
+
+
+ Static Expr *func_strreadreal(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("atof", tp_longreal,
+ grabarg(ex, 0));
+ }
+
+
+
+ Static Stmt *proc_strappendc(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+
+ ex2 = makeexpr_hat(ex->args[0], 0);
+ return makestmt_assign(ex2, makeexpr_concat(copyexpr(ex2), ex->args[1], 0));
+ }
+
+
+
+ /* Check if a string begins with a given prefix; this is easy if the
+ * prefix is known at compile-time.
+ */
+
+ Static Expr *func_strbegins(ex)
+ Expr *ex;
+ {
+ Expr *ex1, *ex2;
+
+ ex1 = ex->args[0];
+ ex2 = ex->args[1];
+ if (ex2->kind == EK_CONST) {
+ if (ex2->val.i == 1) {
+ return makeexpr_rel(EK_EQ,
+ makeexpr_hat(ex1, 0),
+ makeexpr_char(ex2->val.s[0]));
+ } else {
+ return makeexpr_rel(EK_EQ,
+ makeexpr_bicall_3("strncmp", tp_int,
+ ex1,
+ ex2,
+ makeexpr_arglong(makeexpr_long(ex2->val.i), (size_t_long != 0))),
+ makeexpr_long(0));
+ }
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_strcontains(ex)
+ Expr *ex;
+ {
+ return makeexpr_rel(EK_NE,
+ makeexpr_bicall_2("strpbrk", tp_strptr,
+ ex->args[0],
+ ex->args[1]),
+ makeexpr_nil());
+ }
+
+
+
+ /* Extract a substring of a string. If arguments are out-of-range, extract
+ * an empty or shorter substring. Here, the length=infinity and constant
+ * starting index cases are handled specially.
+ */
+
+ Static Expr *func_strsub(ex)
+ Expr *ex;
+ {
+ if (isliteralconst(ex->args[3], NULL) == 2 &&
+ ex->args[3]->val.i >= stringceiling) {
+ return makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string("%s"),
+ bumpstring(ex->args[1],
+ makeexpr_unlongcast(ex->args[2]), 1));
+ }
+ if (checkconst(ex->args[2], 1)) {
+ return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1],
+ ex->args[2], ex->args[3]));
+ }
+ ex->args[2] = makeexpr_arglong(ex->args[2], 0);
+ ex->args[3] = makeexpr_arglong(ex->args[3], 0);
+ return ex;
+ }
+
+
+
+ Static Expr *func_strpart(ex)
+ Expr *ex;
+ {
+ return func_strsub(ex); /* all the special cases match */
+ }
+
+
+
+ Static Expr *func_strequal(ex)
+ Expr *ex;
+ {
+ if (!*strcicmpname)
+ return ex;
+ return makeexpr_rel(EK_EQ,
+ makeexpr_bicall_2(strcicmpname, tp_int,
+ ex->args[0], ex->args[1]),
+ makeexpr_long(0));
+ }
+
+
+
+ Static Expr *func_strcmp(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_2("strcmp", tp_int, ex->args[0], ex->args[1]);
+ }
+
+
+
+ Static Expr *func_strljust(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_4("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string("%-*s"),
+ makeexpr_longcast(ex->args[2], 0),
+ ex->args[1]);
+ }
+
+
+
+ Static Expr *func_strrjust(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_4("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string("%*s"),
+ makeexpr_longcast(ex->args[2], 0),
+ ex->args[1]);
+ }
+
+
+
+
+ /* The procedure strnew(p,s) is converted into an assignment p = strdup(s). */
+
+ Static Stmt *proc_strnew(ex)
+ Expr *ex;
+ {
+ return makestmt_assign(makeexpr_hat(ex->args[0], 0),
+ makeexpr_bicall_1("strdup", ex->args[1]->val.type,
+ ex->args[1]));
+ }
+
+
+
+ /* These procedures are also changed to functions returning a result. */
+
+ Static Stmt *proc_strlist_add(ex)
+ Expr *ex;
+ {
+ return makestmt_assign(makeexpr_hat(ex->args[1], 0),
+ makeexpr_bicall_2("strlist_add", ex->args[0]->val.type->basetype,
+ ex->args[0],
+ ex->args[2]));
+ }
+
+
+
+ Static Stmt *proc_strlist_append(ex)
+ Expr *ex;
+ {
+ return makestmt_assign(makeexpr_hat(ex->args[1], 0),
+ makeexpr_bicall_2("strlist_append", ex->args[0]->val.type->basetype,
+ ex->args[0],
+ ex->args[2]));
+ }
+
+
+
+ Static Stmt *proc_strlist_insert(ex)
+ Expr *ex;
+ {
+ return makestmt_assign(makeexpr_hat(ex->args[1], 0),
+ makeexpr_bicall_2("strlist_insert", ex->args[0]->val.type->basetype,
+ ex->args[0],
+ ex->args[2]));
+ }
+
+
+
+
+
+
+
+
+
+ /* NEWCI functions */
+
+
+ Static Stmt *proc_fixfname(ex)
+ Expr *ex;
+ {
+ if (ex->args[1]->kind == EK_CONST)
+ lwc(ex->args[1]->val.s); /* Unix uses lower-case suffixes */
+ return makestmt_call(ex);
+ }
+
+
+ Static Stmt *proc_forcefname(ex)
+ Expr *ex;
+ {
+ return proc_fixfname(ex);
+ }
+
+
+ /* In Pascal these were variables of type pointer-to-text; we translate
+ * them as, e.g., &stdin. Note that even though &stdin is not legal in
+ * many systems, in the common usage of writeln(stdin^) the & will
+ * cancel out in a later stage of the translation.
+ */
+
+ Static Expr *func_stdin()
+ {
+ return makeexpr_addr(makeexpr_var(mp_input));
+ }
+
+
+ Static Expr *func_stdout()
+ {
+ return makeexpr_addr(makeexpr_var(mp_output));
+ }
+
+
+ Static Expr *func_stderr()
+ {
+ return makeexpr_addr(makeexpr_var(mp_stderr));
+ }
+
+
+
+
+
+
+
+
+ /* MYLIB functions */
+
+
+ Static Stmt *proc_m_color(ex)
+ Expr *ex;
+ {
+ int i;
+ long val;
+
+ if (ex->kind == EK_PLUS) {
+ for (i = 0; i < ex->nargs; i++) {
+ if (isconstexpr(ex->args[i], &val)) {
+ if (val > 0 && (val & 15) == 0) {
+ note("M_COLOR called with suspicious argument [508]");
+ }
+ }
+ }
+ } else if (ex->kind == EK_CONST) {
+ if (ex->val.i >= 16 && ex->val.i < 255) { /* accept true colors and m_trans */
+ note("M_COLOR called with suspicious argument [508]");
+ }
+ }
+ return makestmt_call(ex);
+ }
+
+
+
+
+
+
+
+ void citmods(name, defn)
+ char *name;
+ int defn;
+ {
+ if (!strcmp(name, "NEWASM")) {
+ makestandardproc("na_fillbyte", proc_na_fillbyte);
+ makestandardproc("na_fill", proc_na_fill);
+ makestandardproc("na_fillp", proc_na_fill);
+ makestandardproc("na_move", proc_na_move);
+ makestandardproc("na_movep", proc_na_move);
+ makestandardproc("na_exch", proc_na_exch);
+ makestandardproc("na_exchp", proc_na_exch);
+ makestandardfunc("na_comp", func_na_comp);
+ makestandardfunc("na_compp", func_na_comp);
+ makestandardfunc("na_scaneq", func_na_scaneq);
+ makestandardfunc("na_scaneqp", func_na_scaneq);
+ makestandardfunc("na_scanne", func_na_scanne);
+ makestandardfunc("na_scannep", func_na_scanne);
+ makestandardproc("na_new", proc_na_new);
+ makestandardproc("na_dispose", proc_na_dispose);
+ makestandardproc("na_alloc", proc_na_alloc);
+ makestandardproc("na_outeralloc", proc_na_outeralloc);
+ makestandardproc("na_free", proc_na_free);
+ makestandardfunc("na_memavail", func_na_memavail);
+ makestandardfunc("na_and", func_na_and);
+ makestandardfunc("na_bic", func_na_bic);
+ makestandardfunc("na_or", func_na_or);
+ makestandardfunc("na_xor", func_na_xor);
+ makestandardfunc("na_not", func_na_not);
+ makestandardfunc("na_mask", func_na_mask);
+ makestandardfunc("na_test", func_na_test);
+ makestandardproc("na_set", proc_na_set);
+ makestandardproc("na_clear", proc_na_clear);
+ makestandardfunc("na_po2", func_na_po2);
+ makestandardfunc("na_hibits", func_na_hibits);
+ makestandardfunc("na_lobits", func_na_lobits);
+ makestandardfunc("na_asl", func_na_asl);
+ makestandardfunc("na_lsl", func_na_lsl);
+ makestandardproc("na_bfand", proc_na_bfand);
+ makestandardproc("na_bfbic", proc_na_bfbic);
+ makestandardproc("na_bfor", proc_na_bfor);
+ makestandardproc("na_bfxor", proc_na_bfxor);
+ makestandardfunc("imin", func_imin);
+ makestandardfunc("imax", func_imax);
+ makestandardfunc("na_add", func_na_add);
+ makestandardfunc("na_sub", func_na_sub);
+ makestandardproc("return", proc_return);
+ makestandardfunc("charupper", func_charupper);
+ makestandardfunc("charlower", func_charlower);
+ makestandardfunc("strint", func_strint);
+ makestandardfunc("strint2", func_strint2);
+ makestandardfunc("strhex", func_strhex);
+ makestandardfunc("strreal", func_strreal);
+ makestandardfunc("strchar", func_strchar);
+ makestandardfunc("strreadint", func_strreadint);
+ makestandardfunc("strreadreal", func_strreadreal);
+ makestandardproc("strappendc", proc_strappendc);
+ makestandardfunc("strbegins", func_strbegins);
+ makestandardfunc("strcontains", func_strcontains);
+ makestandardfunc("strsub", func_strsub);
+ makestandardfunc("strpart", func_strpart);
+ makestandardfunc("strequal", func_strequal);
+ makestandardfunc("strcmp", func_strcmp);
+ makestandardfunc("strljust", func_strljust);
+ makestandardfunc("strrjust", func_strrjust);
+ makestandardproc("strnew", proc_strnew);
+ makestandardproc("strlist_add", proc_strlist_add);
+ makestandardproc("strlist_append", proc_strlist_append);
+ makestandardproc("strlist_insert", proc_strlist_insert);
+ } else if (!strcmp(name, "NEWCI")) {
+ makestandardproc("fixfname", proc_fixfname);
+ makestandardproc("forcefname", proc_forcefname);
+ makestandardfunc("stdin", func_stdin);
+ makestandardfunc("stdout", func_stdout);
+ makestandardfunc("stderr", func_stderr);
+ } else if (!strcmp(name, "MYLIB")) {
+ makestandardproc("m_color", proc_m_color);
+ }
+ }
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/comment.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/comment.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/comment.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,466 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_COMMENT_C
+ #include "trans.h"
+
+
+
+ Static int cmttablesize;
+ Static uchar *cmttable;
+
+ Static int grabbed_comment;
+
+
+
+
+ /* Special comment forms:
+
+ \001\001\001... Blank line(s), one \001 char per blank line
+ \002text... Additional line for previous comment
+ \003text... Additional comment line, absolutely indented
+ \004text... Note or warning line, unindented
+
+ */
+
+
+
+
+ void setup_comment()
+ {
+ curcomments = NULL;
+ cmttablesize = 200;
+ cmttable = ALLOC(cmttablesize, uchar, misc);
+ grabbed_comment = 0;
+ }
+
+
+
+
+
+ int commentlen(cmt)
+ Strlist *cmt;
+ {
+ if (cmt)
+ if (*(cmt->s))
+ return strlen(cmt->s) + 4;
+ else
+ return 5;
+ else
+ return 0;
+ }
+
+
+ int commentvisible(cmt)
+ Strlist *cmt;
+ {
+ return (cmt &&
+ getcommentkind(cmt) != CMT_DONE &&
+ ((eatcomments != 1 && eatcomments != 2) ||
+ isembedcomment(cmt)));
+ }
+
+
+
+
+
+
+ /* If preceding statement's POST comments include blank lines,
+ steal all comments after longest stretch of blank lines as
+ PRE comments for the next statement. */
+
+ void steal_comments(olds, news, always)
+ long olds, news;
+ int always;
+ {
+ Strlist *cmt, *cmtfirst = NULL, *cmtblank = NULL;
+ int len, longest;
+
+ for (cmt = curcomments; cmt; cmt = cmt->next) {
+ if ((cmt->value & CMT_MASK) == olds &&
+ getcommentkind(cmt) == CMT_POST) {
+ if (!cmtfirst)
+ cmtfirst = cmt;
+ } else {
+ cmtfirst = NULL;
+ }
+ }
+ if (cmtfirst) {
+ if (!always) {
+ longest = 0;
+ for (cmt = cmtfirst; cmt; cmt = cmt->next) {
+ if (cmt->s[0] == '\001') { /* blank line(s) */
+ len = strlen(cmt->s);
+ if (len > longest) {
+ longest = len;
+ cmtblank = cmt;
+ }
+ }
+ }
+ if (longest > 0) {
+ if (blankafter)
+ cmtfirst = cmtblank->next;
+ else
+ cmtfirst = cmtblank;
+ } else if (commentafter == 1)
+ cmtfirst = NULL;
+ }
+ changecomments(cmtfirst, CMT_POST, olds, CMT_PRE, news);
+ }
+ }
+
+
+
+ Strlist *fixbeginendcomment(cmt)
+ Strlist *cmt;
+ {
+ char *cp, *cp2;
+
+ if (!cmt)
+ return NULL;
+ cp = cmt->s;
+ while (isspace(*cp))
+ cp++;
+ if (!strcincmp(cp, "procedure ", 10)) { /* remove "PROCEDURE" keyword */
+ strcpy(cp, cp+10);
+ } else if (!strcincmp(cp, "function ", 9)) {
+ strcpy(cp, cp+9);
+ }
+ while (isspace(*cp))
+ cp++;
+ if (!*cp)
+ return NULL;
+ if (getcommentkind(cmt) == CMT_ONBEGIN) {
+ cp2 = curctx->sym->name;
+ while (*cp2) {
+ if (toupper(*cp2++) != toupper(*cp++))
+ break;
+ }
+ while (isspace(*cp))
+ cp++;
+ if (!*cp2 && !*cp)
+ return NULL; /* eliminate function-begin comment */
+ }
+ return cmt;
+ }
+
+
+
+
+ Static void attach_mark(sp)
+ Stmt *sp;
+ {
+ long serial;
+
+ while (sp) {
+ serial = sp->serial;
+ if (serial >= 0 && serial < cmttablesize) {
+ cmttable[serial]++;
+ if (sp->kind == SK_IF && serial+1 < cmttablesize)
+ cmttable[serial+1]++; /* the "else" branch */
+ }
+ attach_mark(sp->stm1);
+ attach_mark(sp->stm2);
+ sp = sp->next;
+ }
+ }
+
+
+
+ void attach_comments(sbase)
+ Stmt *sbase;
+ {
+ Strlist *cmt;
+ long serial, i, j;
+ int kind;
+
+ if (spitorphancomments)
+ return;
+ if (serialcount >= cmttablesize) {
+ cmttablesize = serialcount + 100;
+ cmttable = REALLOC(cmttable, cmttablesize, uchar);
+ }
+ for (i = 0; i < cmttablesize; i++)
+ cmttable[i] = 0;
+ attach_mark(sbase);
+ for (cmt = curcomments; cmt; cmt = cmt->next) {
+ serial = cmt->value & CMT_MASK;
+ kind = getcommentkind(cmt);
+ if (serial < 0 || serial >= cmttablesize || cmttable[serial])
+ continue;
+ i = 0;
+ j = 0;
+ do {
+ if (commentafter == 1) {
+ j++;
+ if (j % 3 == 0)
+ i++;
+ } else if (commentafter == 0) {
+ i++;
+ if (i % 3 == 0)
+ j++;
+ } else {
+ i++;
+ j++;
+ }
+ if (serial+i < cmttablesize && cmttable[serial+i]) {
+ setcommentkind(cmt, CMT_PRE);
+ cmt->value += i;
+ break;
+ }
+ if (serial-j > 0 && cmttable[serial-j]) {
+ setcommentkind(cmt, CMT_POST);
+ cmt->value -= j;
+ break;
+ }
+ } while (serial+i < cmttablesize || serial-j > 0);
+ }
+ }
+
+
+
+
+ void setcommentkind(cmt, kind)
+ Strlist *cmt;
+ int kind;
+ {
+ cmt->value = (cmt->value & CMT_MASK) | (kind << CMT_SHIFT);
+ }
+
+
+
+ void commentline(kind)
+ int kind;
+ {
+ char *cp;
+ Strlist *sl;
+
+ if (grabbed_comment) {
+ grabbed_comment = 0;
+ return;
+ }
+ if (blockkind == TOK_IMPORT || skipping_module)
+ return;
+ if (eatcomments == 1)
+ return;
+ for (cp = curtokbuf; (cp = my_strchr(cp, '*')) != NULL; ) {
+ if (*++cp == '/') {
+ cp[-1] = '%';
+ note("Changed \"* /\" to \"% /\" in comment [140]");
+ }
+ }
+ sl = strlist_append(&curcomments, curtokbuf);
+ sl->value = curserial;
+ setcommentkind(sl, kind);
+ }
+
+
+
+ void addnote(msg, serial)
+ char *msg;
+ long serial;
+ {
+ int len1, len2, xextra, extra;
+ int defer = (notephase > 0 && spitcomments == 0);
+ Strlist *sl, *base = NULL, **pbase = (defer) ? &curcomments : &base;
+ char *prefix;
+
+ if (defer && (outf != stdout || !quietmode))
+ printf("%s, line %d: %s\n", infname, inf_lnum, msg);
+ else if (outf != stdout)
+ printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
+ if (notephase == 2 || regression)
+ prefix = format_s("\004 p2c: %s:", infname);
+ else
+ prefix = format_sd("\004 p2c: %s, line %d:", infname, inf_lnum);
+ len1 = strlen(prefix);
+ len2 = strlen(msg) + 2;
+ if (len1 + len2 < linewidth-4) {
+ msg = format_ss("%s %s ", prefix, msg);
+ } else {
+ extra = xextra = 0;
+ while (len2 - extra > linewidth-6) {
+ while (extra < len2 && !isspace(msg[extra]))
+ extra++;
+ xextra = extra;
+ while (extra < len2 && isspace(msg[extra]))
+ extra++;
+ }
+ prefix = format_sds("%s %.*s", prefix, xextra, msg);
+ msg += extra;
+ sl = strlist_append(pbase, prefix);
+ sl->value = serial;
+ setcommentkind(sl, CMT_POST);
+ msg = format_s("\003 * %s ", msg);
+ }
+ sl = strlist_append(pbase, msg);
+ sl->value = serial;
+ setcommentkind(sl, CMT_POST);
+ outputmode++;
+ outcomments(base);
+ outputmode--;
+ }
+
+
+
+
+
+ /* Grab a comment off the end of the current line */
+ Strlist *grabcomment(kind)
+ int kind;
+ {
+ char *cp, *cp2;
+ Strlist *cmt, *savecmt;
+
+ if (grabbed_comment || spitcomments == 1)
+ return NULL;
+ cp = inbufptr;
+ while (isspace(*cp))
+ cp++;
+ if (*cp == ';' || *cp == ',' || *cp == '.')
+ cp++;
+ while (isspace(*cp))
+ cp++;
+ cp2 = curtokbuf;
+ if (*cp == '{') {
+ cp++;
+ while (*cp && *cp != '}')
+ *cp2++ = *cp++;
+ if (!*cp)
+ return NULL;
+ cp++;
+ } else if (*cp == '(' && cp[1] == '*') {
+ cp += 2;
+ while (*cp && (*cp != '*' || cp[1] != ')'))
+ *cp2++ = *cp++;
+ if (!*cp)
+ return NULL;
+ cp += 2;
+ } else
+ return NULL;
+ while (isspace(*cp))
+ cp++;
+ if (*cp)
+ return NULL;
+ *cp2 = 0;
+ savecmt = curcomments;
+ curcomments = NULL;
+ commentline(kind);
+ cmt = curcomments;
+ curcomments = savecmt;
+ grabbed_comment = 1;
+ if (cmtdebug > 1)
+ fprintf(outf, "Grabbed comment [%d] \"%s\"\n", cmt->value & CMT_MASK, cmt->s);
+ return cmt;
+ }
+
+
+
+ int matchcomment(cmt, kind, stamp)
+ Strlist *cmt;
+ int kind, stamp;
+ {
+ if (spitcomments == 1 && (cmt->value & CMT_MASK) != 10000 &&
+ *cmt->s != '\001' && (kind >= 0 || stamp >= 0))
+ return 0;
+ if (!cmt || getcommentkind(cmt) == CMT_DONE)
+ return 0;
+ if (stamp >= 0 && (cmt->value & CMT_MASK) != stamp)
+ return 0;
+ if (kind >= 0) {
+ if (kind & CMT_NOT) {
+ if (getcommentkind(cmt) == kind - CMT_NOT)
+ return 0;
+ } else {
+ if (getcommentkind(cmt) != kind)
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+
+
+ Strlist *findcomment(cmt, kind, stamp)
+ Strlist *cmt;
+ int kind, stamp;
+ {
+ while (cmt && !matchcomment(cmt, kind, stamp))
+ cmt = cmt->next;
+ if (cmt && cmtdebug > 1)
+ fprintf(outf, "Found comment [%d] \"%s\"\n", cmt->value & CMT_MASK, cmt->s);
+ return cmt;
+ }
+
+
+
+ Strlist *extractcomment(cmt, kind, stamp)
+ Strlist **cmt;
+ int kind, stamp;
+ {
+ Strlist *base, **last, *sl;
+
+ last = &base;
+ while ((sl = *cmt)) {
+ if (matchcomment(sl, kind, stamp)) {
+ if (cmtdebug > 1)
+ fprintf(outf, "Extracted comment [%d] \"%s\"\n",
+ sl->value & CMT_MASK, sl->s);
+ *cmt = sl->next;
+ *last = sl;
+ last = &sl->next;
+ } else
+ cmt = &sl->next;
+ }
+ *last = NULL;
+ return base;
+ }
+
+
+ void changecomments(cmt, okind, ostamp, kind, stamp)
+ Strlist *cmt;
+ int okind, ostamp, kind, stamp;
+ {
+ while (cmt) {
+ if (matchcomment(cmt, okind, ostamp)) {
+ if (cmtdebug > 1)
+ fprintf(outf, "Changed comment [%s:%d] \"%s\" ",
+ CMT_NAMES[getcommentkind(cmt)],
+ cmt->value & CMT_MASK, cmt->s);
+ if (kind >= 0)
+ setcommentkind(cmt, kind);
+ if (stamp >= 0)
+ cmt->value = (cmt->value & ~CMT_MASK) | stamp;
+ if (cmtdebug > 1)
+ fprintf(outf, " to [%s:%d]\n",
+ CMT_NAMES[getcommentkind(cmt)], cmt->value & CMT_MASK);
+ }
+ cmt = cmt->next;
+ }
+ }
+
+
+
+
+
+
+ /* End. */
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/decl.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/decl.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/decl.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,5444 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_DECL_C
+ #include "trans.h"
+
+
+
+ #define MAXIMPORTS 100
+
+
+
+ Static struct ptrdesc {
+ struct ptrdesc *next;
+ Symbol *sym;
+ Type *tp;
+ } *ptrbase;
+
+ Static struct ctxstack {
+ struct ctxstack *next;
+ Meaning *ctx, *ctxlast;
+ struct tempvarlist *tempvars;
+ int tempvarcount, importmark;
+ } *ctxtop;
+
+ Static struct tempvarlist {
+ struct tempvarlist *next;
+ Meaning *tvar;
+ int active;
+ } *tempvars, *stmttempvars;
+
+ Static int tempvarcount;
+
+ Static int stringtypecachesize;
+ Static Type **stringtypecache;
+
+ Static Meaning *importlist[MAXIMPORTS];
+ Static int firstimport;
+
+ Static Type *tp_special_anyptr;
+
+ Static int wasaliased;
+ Static int deferallptrs;
+ Static int anydeferredptrs;
+ Static int silentalreadydef;
+ Static int nonloclabelcount;
+
+ Static Strlist *varstructdecllist;
+
+
+
+
+ Static Meaning *findstandardmeaning(kind, name)
+ enum meaningkind kind;
+ char *name;
+ {
+ Meaning *mp;
+ Symbol *sym;
+
+ sym = findsymbol(fixpascalname(name));
+ for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
+ if (mp) {
+ if (mp->kind == kind)
+ mp->refcount = 1;
+ else
+ mp = NULL;
+ }
+ return mp;
+ }
+
+
+ Static Meaning *makestandardmeaning(kind, name)
+ enum meaningkind kind;
+ char *name;
+ {
+ Meaning *mp;
+ Symbol *sym;
+
+ sym = findsymbol(fixpascalname(name));
+ for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
+ if (!mp) {
+ mp = addmeaning(sym, kind);
+ strchange(&mp->name, name);
+ if (debug < 4)
+ mp->dumped = partialdump; /* prevent irrelevant dumping */
+ } else {
+ mp->kind = kind;
+ }
+ mp->refcount = 1;
+ return mp;
+ }
+
+
+ Static Type *makestandardtype(kind, mp)
+ enum typekind kind;
+ Meaning *mp;
+ {
+ Type *tp;
+
+ tp = maketype(kind);
+ tp->meaning = mp;
+ if (mp)
+ mp->type = tp;
+ return tp;
+ }
+
+
+
+
+ Static Stmt *nullspecialproc(mp)
+ Meaning *mp;
+ {
+ warning(format_s("Procedure %s not yet supported [118]", mp->name));
+ if (curtok == TOK_LPAR)
+ skipparens();
+ return NULL;
+ }
+
+ Meaning *makespecialproc(name, handler)
+ char *name;
+ Stmt *(*handler)();
+ {
+ Meaning *mp;
+
+ if (!handler)
+ handler = nullspecialproc;
+ mp = makestandardmeaning(MK_SPECIAL, name);
+ mp->handler = (Expr *(*)())handler;
+ return mp;
+ }
+
+
+
+ Static Stmt *nullstandardproc(ex)
+ Expr *ex;
+ {
+ warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
+ return makestmt_call(ex);
+ }
+
+ Meaning *makestandardproc(name, handler)
+ char *name;
+ Stmt *(*handler)();
+ {
+ Meaning *mp;
+
+ if (!handler)
+ handler = nullstandardproc;
+ mp = findstandardmeaning(MK_FUNCTION, name);
+ if (mp) {
+ mp->handler = (Expr *(*)())handler;
+ if (mp->isfunction) {
+ warning(format_s("Procedure %s was declared as a function [119]", name));
+ mp->isfunction = 0;
+ }
+ } else if (debug > 0)
+ warning(format_s("Procedure %s was never declared [120]", name));
+ return mp;
+ }
+
+
+
+ Static Expr *nullspecialfunc(mp)
+ Meaning *mp;
+ {
+ warning(format_s("Function %s not yet supported [121]", mp->name));
+ if (curtok == TOK_LPAR)
+ skipparens();
+ return makeexpr_long(0);
+ }
+
+ Meaning *makespecialfunc(name, handler)
+ char *name;
+ Expr *(*handler)();
+ {
+ Meaning *mp;
+
+ if (!handler)
+ handler = nullspecialfunc;
+ mp = makestandardmeaning(MK_SPECIAL, name);
+ mp->isfunction = 1;
+ mp->handler = handler;
+ return mp;
+ }
+
+
+
+ Static Expr *nullstandardfunc(ex)
+ Expr *ex;
+ {
+ warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
+ return ex;
+ }
+
+ Meaning *makestandardfunc(name, handler)
+ char *name;
+ Expr *(*handler)();
+ {
+ Meaning *mp;
+
+ if (!handler)
+ handler = nullstandardfunc;
+ mp = findstandardmeaning(MK_FUNCTION, name);
+ if (mp) {
+ mp->handler = handler;
+ if (!mp->isfunction) {
+ warning(format_s("Function %s was declared as a procedure [122]", name));
+ mp->isfunction = 1;
+ }
+ } else if (debug > 0)
+ warning(format_s("Function %s was never declared [123]", name));
+ return mp;
+ }
+
+
+
+
+ Static Expr *nullspecialvar(mp)
+ Meaning *mp;
+ {
+ warning(format_s("Variable %s not yet supported [124]", mp->name));
+ if (curtok == TOK_LPAR || curtok == TOK_LBR)
+ skipparens();
+ return makeexpr_var(mp);
+ }
+
+ Meaning *makespecialvar(name, handler)
+ char *name;
+ Expr *(*handler)();
+ {
+ Meaning *mp;
+
+ if (!handler)
+ handler = nullspecialvar;
+ mp = makestandardmeaning(MK_SPVAR, name);
+ mp->handler = handler;
+ return mp;
+ }
+
+
+
+
+
+ void setup_decl()
+ {
+ Meaning *mp, *mp2, *mp_turbo_shortint;
+ Symbol *sym;
+ Type *tp;
+ int i;
+
+ numimports = 0;
+ firstimport = 0;
+ permimports = NULL;
+ stringceiling = stringceiling | 1; /* round up to odd */
+ stringtypecachesize = (stringceiling + 1) >> 1;
+ stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
+ curctxlast = NULL;
+ curctx = NULL; /* the meta-ctx has no parent ctx */
+ curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
+ strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
+ ptrbase = NULL;
+ tempvars = NULL;
+ stmttempvars = NULL;
+ tempvarcount = 0;
+ deferallptrs = 0;
+ silentalreadydef = 0;
+ varstructdecllist = NULL;
+ nonloclabelcount = -1;
+ for (i = 0; i < stringtypecachesize; i++)
+ stringtypecache[i] = NULL;
+
+ tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
+ (integer16) ? "LONGINT" : "INTEGER"));
+ tp_integer->smin = makeexpr_long(MININT); /* "long" */
+ tp_integer->smax = makeexpr_long(MAXINT);
+
+ if (sizeof_int >= 32) {
+ tp_int = tp_integer; /* "int" */
+ } else {
+ tp_int = makestandardtype(TK_INTEGER,
+ (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
+ : NULL);
+ tp_int->smin = makeexpr_long(min_sshort);
+ tp_int->smax = makeexpr_long(max_sshort);
+ }
+ mp = makestandardmeaning(MK_TYPE, "C_INT");
+ mp->type = tp_int;
+ if (!tp_int->meaning)
+ tp_int->meaning = mp;
+
+ mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
+ tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
+ tp_unsigned->smin = makeexpr_long(0); /* "unsigned long" */
+ tp_unsigned->smax = makeexpr_long(MAXINT);
+
+ if (sizeof_int >= 32) {
+ tp_uint = tp_unsigned; /* "unsigned int" */
+ mp_uint = mp_unsigned;
+ } else {
+ mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
+ tp_uint = makestandardtype(TK_INTEGER, mp_uint);
+ tp_uint->smin = makeexpr_long(0);
+ tp_uint->smax = makeexpr_long(MAXINT);
+ }
+
+ tp_sint = makestandardtype(TK_INTEGER, NULL);
+ tp_sint->smin = copyexpr(tp_int->smin); /* "signed int" */
+ tp_sint->smax = copyexpr(tp_int->smax);
+
+ tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
+ if (unsignedchar == 0) {
+ tp_char->smin = makeexpr_long(-128); /* "char" */
+ tp_char->smax = makeexpr_long(127);
+ } else {
+ tp_char->smin = makeexpr_long(0);
+ tp_char->smax = makeexpr_long(255);
+ }
+
+ tp_charptr = makestandardtype(TK_POINTER, NULL); /* "unsigned char *" */
+ tp_charptr->basetype = tp_char;
+ tp_char->pointertype = tp_charptr;
+
+ mp_schar = makestandardmeaning(MK_TYPE, "SCHAR"); /* "signed char" */
+ tp_schar = makestandardtype(TK_CHAR, mp_schar);
+ tp_schar->smin = makeexpr_long(-128);
+ tp_schar->smax = makeexpr_long(127);
+
+ mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR"); /* "unsigned char" */
+ tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
+ tp_uchar->smin = makeexpr_long(0);
+ tp_uchar->smax = makeexpr_long(255);
+
+ tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
+ tp_boolean->smin = makeexpr_long(0); /* "boolean" */
+ tp_boolean->smax = makeexpr_long(1);
+
+ sym = findsymbol("Boolean");
+ sym->flags |= SSYNONYM;
+ strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;
+
+ tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
+ /* "float" or "double" */
+ mp = makestandardmeaning(MK_TYPE, "LONGREAL");
+ if (doublereals)
+ mp->type = tp_longreal = tp_real;
+ else
+ tp_longreal = makestandardtype(TK_REAL, mp);
+
+ tp_void = makestandardtype(TK_VOID, NULL); /* "void" */
+
+ mp = makestandardmeaning(MK_TYPE, "SINGLE");
+ if (doublereals)
+ makestandardtype(TK_REAL, mp);
+ else
+ mp->type = tp_real;
+ makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
+ mp = makestandardmeaning(MK_TYPE, "DOUBLE");
+ mp->type = tp_longreal;
+ mp = makestandardmeaning(MK_TYPE, "EXTENDED");
+ mp->type = tp_longreal; /* good enough */
+ mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
+ mp->type = tp_longreal; /* good enough */
+
+ tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
+ (integer16 == 1) ? "INTEGER" : "SWORD"));
+ tp_sshort->basetype = tp_integer; /* "short" */
+ tp_sshort->smin = makeexpr_long(min_sshort);
+ tp_sshort->smax = makeexpr_long(max_sshort);
+
+ if (integer16) {
+ if (integer16 != 2) {
+ mp = makestandardmeaning(MK_TYPE, "SWORD");
+ mp->type = tp_sshort;
+ }
+ } else {
+ mp = makestandardmeaning(MK_TYPE, "LONGINT");
+ mp->type = tp_integer;
+ }
+
+ tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
+ tp_ushort->basetype = tp_integer; /* "unsigned short" */
+ tp_ushort->smin = makeexpr_long(0);
+ tp_ushort->smax = makeexpr_long(max_ushort);
+
+ mp = makestandardmeaning(MK_TYPE, "CARDINAL");
+ mp->type = (integer16) ? tp_ushort : tp_unsigned;
+ mp = makestandardmeaning(MK_TYPE, "LONGCARD");
+ mp->type = tp_unsigned;
+
+ if (modula2) {
+ mp = makestandardmeaning(MK_TYPE, "WORD");
+ mp->type = tp_integer;
+ } else {
+ makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
+ }
+
+ tp_sbyte = makestandardtype(TK_SUBR, NULL); /* "signed char" */
+ tp_sbyte->basetype = tp_integer;
+ tp_sbyte->smin = makeexpr_long(min_schar);
+ tp_sbyte->smax = makeexpr_long(max_schar);
+
+ mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
+ mp = makestandardmeaning(MK_TYPE, "SBYTE");
+ if (needsignedbyte || signedchars == 1 || hassignedchar) {
+ mp->type = tp_sbyte;
+ if (mp_turbo_shortint)
+ mp_turbo_shortint->type = tp_sbyte;
+ tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
+ } else {
+ mp->type = tp_sshort;
+ if (mp_turbo_shortint)
+ mp_turbo_shortint->type = tp_sshort;
+ }
+
+ tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
+ tp_ubyte->basetype = tp_integer; /* "unsigned char" */
+ tp_ubyte->smin = makeexpr_long(0);
+ tp_ubyte->smax = makeexpr_long(max_uchar);
+
+ if (signedchars == 1)
+ tp_abyte = tp_sbyte; /* "char" */
+ else if (signedchars == 0)
+ tp_abyte = tp_ubyte;
+ else {
+ tp_abyte = makestandardtype(TK_SUBR, NULL);
+ tp_abyte->basetype = tp_integer;
+ tp_abyte->smin = makeexpr_long(0);
+ tp_abyte->smax = makeexpr_long(max_schar);
+ }
+
+ mp = makestandardmeaning(MK_TYPE, "POINTER");
+ mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
+ tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
+ ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
+ tp_anyptr->basetype = tp_void; /* "void *" */
+ tp_void->pointertype = tp_anyptr;
+
+ if (useAnyptrMacros == 1) {
+ tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
+ tp_special_anyptr->basetype = tp_integer;
+ tp_special_anyptr->smin = makeexpr_long(0);
+ tp_special_anyptr->smax = makeexpr_long(max_schar);
+ } else
+ tp_special_anyptr = NULL;
+
+ tp_proc = maketype(TK_PROCPTR);
+ tp_proc->basetype = maketype(TK_FUNCTION);
+ tp_proc->basetype->basetype = tp_void;
+ tp_proc->escale = 1; /* saved "hasstaticlinks" */
+
+ tp_str255 = makestandardtype(TK_STRING, NULL); /* "Char []" */
+ tp_str255->basetype = tp_char;
+ tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
+ tp_str255->indextype->basetype = tp_integer;
+ tp_str255->indextype->smin = makeexpr_long(0);
+ tp_str255->indextype->smax = makeexpr_long(stringceiling);
+
+ tp_strptr = makestandardtype(TK_POINTER, NULL); /* "Char *" */
+ tp_str255->pointertype = tp_strptr;
+ tp_strptr->basetype = tp_str255;
+
+ mp_string = makestandardmeaning(MK_TYPE, "STRING");
+ tp = makestandardtype(TK_STRING, mp_string);
+ tp->basetype = tp_char;
+ tp->indextype = tp_str255->indextype;
+
+ tp_smallset = maketype(TK_SMALLSET);
+ tp_smallset->basetype = tp_integer;
+ tp_smallset->indextype = tp_boolean;
+
+ tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
+ tp_text->basetype = makestandardtype(TK_FILE, NULL); /* "FILE *" */
+ tp_text->basetype->basetype = tp_char;
+ tp_text->basetype->pointertype = tp_text;
+
+ tp_bigtext = makestandardtype(TK_BIGFILE, makestandardmeaning(MK_TYPE, "BIGTEXT"));
+ tp_bigtext->basetype = tp_char;
+ tp_bigtext->meaning->name = stralloc("_TEXT");
+ tp_bigtext->meaning->wasdeclared = 1;
+
+ tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);
+
+ mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
+ mp->type = tp_text;
+
+ mp = makestandardmeaning(MK_TYPE, "BITSET");
+ mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
+ makeexpr_long(setbits-1)));
+ mp->type->meaning = mp;
+
+ mp = makestandardmeaning(MK_TYPE, "INTSET");
+ mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
+ makeexpr_long(defaultsetsize-1)));
+ mp->type->meaning = mp;
+
+ mp_input = makestandardmeaning(MK_VAR, "INPUT");
+ mp_input->type = tp_text;
+ mp_input->name = stralloc("stdin");
+ ex_input = makeexpr_var(mp_input);
+
+ mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
+ mp_output->type = tp_text;
+ mp_output->name = stralloc("stdout");
+ ex_output = makeexpr_var(mp_output);
+
+ mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
+ mp_stderr->type = tp_text;
+ mp_stderr->name = stralloc("stderr");
+
+ mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
+ mp_escapecode->type = tp_sshort;
+ mp_escapecode->name = stralloc(name_ESCAPECODE);
+
+ mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
+ mp_ioresult->type = tp_integer;
+ mp_ioresult->name = stralloc(name_IORESULT);
+
+ mp_false = makestandardmeaning(MK_CONST, "FALSE");
+ mp_false->type = mp_false->val.type = tp_boolean;
+ mp_false->val.i = 0;
+
+ mp_true = makestandardmeaning(MK_CONST, "TRUE");
+ mp_true->type = mp_true->val.type = tp_boolean;
+ mp_true->val.i = 1;
+
+ mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
+ mp_maxint->type = mp_maxint->val.type = tp_integer;
+ mp_maxint->val.i = MAXINT;
+ mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
+ (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");
+
+ mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
+ mp->type = mp->val.type = tp_integer;
+ mp->val.i = MAXINT;
+ mp->name = stralloc("LONG_MAX");
+
+ mp_minint = makestandardmeaning(MK_CONST, "MININT");
+ mp_minint->type = mp_minint->val.type = tp_integer;
+ mp_minint->val.i = MININT;
+ mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
+ (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");
+
+ mp = makestandardmeaning(MK_CONST, "MAXCHAR");
+ mp->type = mp->val.type = tp_char;
+ mp->val.i = 127;
+ mp->name = stralloc("CHAR_MAX");
+
+ mp = makestandardmeaning(MK_CONST, "MINCHAR");
+ mp->type = mp->val.type = tp_char;
+ mp->val.i = 0;
+ mp->anyvarflag = 1;
+
+ mp = makestandardmeaning(MK_CONST, "BELL");
+ mp->type = mp->val.type = tp_char;
+ mp->val.i = 7;
+ mp->anyvarflag = 1;
+
+ mp = makestandardmeaning(MK_CONST, "TAB");
+ mp->type = mp->val.type = tp_char;
+ mp->val.i = 9;
+ mp->anyvarflag = 1;
+
+ mp_str_hp = mp_str_turbo = NULL;
+ mp_val_modula = mp_val_turbo = NULL;
+ mp_blockread_ucsd = mp_blockread_turbo = NULL;
+ mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
+ mp_dec_dec = mp_dec_turbo = NULL;
+ }
+
+
+
+ /* This makes sure that if A imports B and then C, C's interface is not
+ parsed in the environment of B */
+ int push_imports()
+ {
+ int mark = firstimport;
+ Meaning *mp;
+
+ while (firstimport < numimports) {
+ if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
+ for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
+ mp->isactive = 0;
+ }
+ firstimport++;
+ }
+ return mark;
+ }
+
+
+
+ void pop_imports(mark)
+ int mark;
+ {
+ Meaning *mp;
+
+ while (firstimport > mark) {
+ firstimport--;
+ for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
+ mp->isactive = 1;
+ }
+ }
+
+
+
+ void import_ctx(ctx)
+ Meaning *ctx;
+ {
+ Meaning *mp;
+ int i;
+
+ for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
+ if (i >= numimports) {
+ if (numimports == MAXIMPORTS)
+ error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
+ importlist[numimports++] = ctx;
+ }
+ for (mp = ctx->cbase; mp; mp = mp->cnext) {
+ if (mp->exported)
+ mp->isactive = 1;
+ }
+ }
+
+
+
+ void perm_import(ctx)
+ Meaning *ctx;
+ {
+ Meaning *mp;
+
+ /* Import permanently, as in Turbo's "system" unit */
+ for (mp = ctx->cbase; mp; mp = mp->cnext) {
+ if (mp->exported)
+ mp->isactive = 1;
+ }
+ }
+
+
+
+ void unimport(mark)
+ int mark;
+ {
+ Meaning *mp;
+
+ while (numimports > mark) {
+ numimports--;
+ if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
+ for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
+ mp->isactive = 0;
+ }
+ }
+ }
+
+
+
+
+ void activatemeaning(mp)
+ Meaning *mp;
+ {
+ Meaning *mp2;
+
+ if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
+ mp->isactive = 1;
+ if (mp->sym->mbase != mp) { /* move to front of symbol list */
+ mp2 = mp->sym->mbase;
+ for (;;) {
+ if (!mp2) {
+ /* Not on symbol list: must be a special kludge meaning */
+ return;
+ }
+ if (mp2->snext == mp)
+ break;
+ mp2 = mp2->snext;
+ }
+ mp2->snext = mp->snext;
+ mp->snext = mp->sym->mbase;
+ mp->sym->mbase = mp;
+ }
+ }
+
+
+
+ void pushctx(ctx)
+ Meaning *ctx;
+ {
+ struct ctxstack *top;
+
+ top = ALLOC(1, struct ctxstack, ctxstacks);
+ top->ctx = curctx;
+ top->ctxlast = curctxlast;
+ top->tempvars = tempvars;
+ top->tempvarcount = tempvarcount;
+ top->importmark = numimports;
+ top->next = ctxtop;
+ ctxtop = top;
+ curctx = ctx;
+ curctxlast = ctx->cbase;
+ if (curctxlast) {
+ activatemeaning(curctxlast);
+ while (curctxlast->cnext) {
+ curctxlast = curctxlast->cnext;
+ activatemeaning(curctxlast);
+ }
+ }
+ tempvars = NULL;
+ tempvarcount = 0;
+ if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
+ progress();
+ }
+
+
+
+ void popctx()
+ {
+ struct ctxstack *top;
+ struct tempvarlist *tv;
+ Meaning *mp;
+
+ if (!strlist_cifind(permimports, curctx->sym->name)) {
+ for (mp = curctx->cbase; mp; mp = mp->cnext) {
+ if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
+ mp->isactive = 0;
+ }
+ }
+ top = ctxtop;
+ ctxtop = top->next;
+ curctx = top->ctx;
+ curctxlast = top->ctxlast;
+ while (tempvars) {
+ tv = tempvars->next;
+ FREE(tempvars);
+ tempvars = tv;
+ }
+ tempvars = top->tempvars;
+ tempvarcount = top->tempvarcount;
+ unimport(top->importmark);
+ FREE(top);
+ if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
+ progress();
+ }
+
+
+
+ void forget_ctx(ctx, all)
+ Meaning *ctx;
+ int all;
+ {
+ register Meaning *mp, **mpprev, *mp2, **mpp2;
+
+ if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
+ mpprev = &ctx->cbase->cnext; /* Skip return-value variable */
+ else
+ mpprev = &ctx->cbase;
+ while ((mp = *mpprev) != NULL) {
+ if (all ||
+ (mp->kind != MK_PARAM &&
+ mp->kind != MK_VARPARAM)) {
+ *mpprev = mp->cnext;
+ mpp2 = &mp->sym->mbase;
+ while ((mp2 = *mpp2) != NULL && mp2 != mp)
+ mpp2 = &mp2->snext;
+ if (mp2)
+ *mpp2 = mp2->snext;
+ if (mp->kind == MK_CONST)
+ free_value(&mp->val);
+ freeexpr(mp->constdefn);
+ if (mp->cbase)
+ forget_ctx(mp, 1);
+ if (mp->kind == MK_FUNCTION && mp->val.i)
+ free_stmt((Stmt *)mp->val.i);
+ strlist_empty(&mp->comments);
+ if (mp->name)
+ FREE(mp->name);
+ if (mp->othername)
+ FREE(mp->othername);
+ FREE(mp);
+ } else
+ mpprev = &mp->cnext;
+ }
+ }
+
+
+
+
+ void handle_nameof()
+ {
+ Strlist *sl, *sl2;
+ Symbol *sp;
+ char *cp;
+
+ for (sl = nameoflist; sl; sl = sl->next) {
+ cp = my_strchr(sl->s, '.');
+ if (cp) {
+ sp = findsymbol(fixpascalname(cp + 1));
+ sl2 = strlist_add(&sp->symbolnames,
+ format_ds("%.*s", (int)(cp - sl->s), sl->s));
+ } else {
+ sp = findsymbol(fixpascalname(sl->s));
+ sl2 = strlist_add(&sp->symbolnames, "");
+ }
+ sl2->value = sl->value;
+ if (debug > 0)
+ fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
+ sp->name, sl2->s, sl2->value);
+ }
+ strlist_empty(&nameoflist);
+ }
+
+
+
+ Static void initmeaning(mp)
+ Meaning *mp;
+ {
+ /* mp->serial = curserial = ++serialcount; */
+ mp->cbase = NULL;
+ mp->xnext = NULL;
+ mp->othername = NULL;
+ mp->type = NULL;
+ mp->dtype = NULL;
+ mp->needvarstruct = 0;
+ mp->varstructflag = 0;
+ mp->wasdeclared = 0;
+ mp->isforward = 0;
+ mp->isfunction = 0;
+ mp->istemporary = 0;
+ mp->volatilequal = 0;
+ mp->constqual = 0;
+ mp->warnifused = (warnnames > 0);
+ mp->constdefn = NULL;
+ mp->val.i = 0;
+ mp->val.s = NULL;
+ mp->val.type = NULL;
+ mp->refcount = 1;
+ mp->anyvarflag = 0;
+ mp->isactive = 1;
+ mp->exported = 0;
+ mp->handler = NULL;
+ mp->dumped = 0;
+ mp->isreturn = 0;
+ mp->fakeparam = 0;
+ mp->namedfile = 0;
+ mp->bufferedfile = 0;
+ mp->comments = NULL;
+ }
+
+
+
+ int issafename(sp, isglobal, isdefine)
+ Symbol *sp;
+ int isglobal, isdefine;
+ {
+ if (isdefine && curctx->kind != MK_FUNCTION) {
+ if (sp->flags & FWDPARAM)
+ return 0;
+ }
+ if ((sp->flags & AVOIDNAME) ||
+ (isdefine && (sp->flags & AVOIDFIELD)) ||
+ (isglobal && (sp->flags & AVOIDGLOB)))
+ return 0;
+ else
+ return 1;
+ }
+
+
+
+ static Meaning *enum_tname;
+
+ void setupmeaning(mp, sym, kind, namekind)
+ Meaning *mp;
+ Symbol *sym;
+ enum meaningkind kind, namekind;
+ {
+ char *name, *symfmt, *editfmt, *cp, *cp2;
+ int altnum, isglobal, isdefine;
+ Symbol *sym2;
+ Strlist *sl;
+
+ if (!sym)
+ sym = findsymbol("Spam"); /* reduce crashes due to internal errors */
+ if (sym->mbase && sym->mbase->ctx == curctx &&
+ curctx != NULL && !silentalreadydef)
+ alreadydef(sym);
+ mp->sym = sym;
+ mp->snext = sym->mbase;
+ sym->mbase = mp;
+ if (sym == curtoksym) {
+ sym->kwtok = TOK_NONE;
+ sym->flags &= ~KWPOSS;
+ }
+ mp->ctx = curctx;
+ mp->kind = kind;
+ if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
+ strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
+ Meaning *mp2;
+ if (islower(sym->name[0]))
+ sym2 = findsymbol(strupper(sym->name));
+ else
+ sym2 = findsymbol(strlower(sym->name));
+ mp2 = addmeaning(sym2, MK_SYNONYM);
+ mp2->xnext = mp;
+ }
+ if (kind == MK_VAR) {
+ sl = strlist_find(varmacros, sym->name);
+ if (sl) {
+ kind = namekind = MK_VARMAC;
+ mp->constdefn = (Expr *)sl->value;
+ strlist_delete(&varmacros, sl);
+ }
+ }
+ if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
+ sl = strlist_find(funcmacros, sym->name);
+ if (sl) {
+ mp->constdefn = (Expr *)sl->value;
+ strlist_delete(&funcmacros, sl);
+ }
+ }
+ if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
+ kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
+ mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
+ if (blockkind == TOK_IMPORT)
+ mp->wasdeclared = 1; /* suppress future declaration */
+ } else
+ mp->exported = 0;
+ if (sym == curtoksym)
+ name = curtokcase;
+ else
+ name = sym->name;
+ isdefine = (namekind == MK_CONST || (namekind == MK_VARIANT && !useenum));
+ isglobal = (!curctx ||
+ curctx->kind != MK_FUNCTION ||
+ namekind == MK_FUNCTION ||
+ namekind == MK_TYPE ||
+ namekind == MK_VARIANT ||
+ isdefine) &&
+ (curctx != nullctx);
+ mp->refcount = isglobal ? 1 : 0; /* make sure globals don't disappear */
+ if (namekind == MK_SYNONYM)
+ return;
+ if (!mp->exported || !*exportsymbol)
+ symfmt = "";
+ else if (*export_symbol && my_strchr(name, '_'))
+ symfmt = export_symbol;
+ else
+ symfmt = exportsymbol;
+ wasaliased = 0;
+ if (*externalias && !my_strchr(externalias, '%')) {
+ register int i;
+ name = format_s("%s", externalias);
+ i = numparams;
+ while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
+ if (i < 0 || !undooption(i, ""))
+ *externalias = 0;
+ wasaliased = 1;
+ } else if (sym->symbolnames) {
+ if (curctx) {
+ if (debug > 2)
+ fprintf(outf, "checking for \"%s\" of %s\n", curctx->name, sym->name);
+ sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
+ if (sl) {
+ if (debug > 2)
+ fprintf(outf, "found \"%s\"\n", sl->value);
+ name = (char *)sl->value;
+ wasaliased = 1;
+ }
+ }
+ if (!wasaliased) {
+ if (debug > 2)
+ fprintf(outf, "checking for \"\" of %s\n", sym->name);
+ sl = strlist_find(sym->symbolnames, "");
+ if (sl) {
+ if (debug > 2)
+ fprintf(outf, "found \"%s\"\n", sl->value);
+ name = (char *)sl->value;
+ wasaliased = 1;
+ }
+ }
+ }
+ if (!*symfmt || wasaliased)
+ symfmt = "%s";
+ altnum = -1;
+ do {
+ altnum++;
+ cp = format_ss(symfmt, name, curctx ? curctx->name : "");
+ switch (namekind) {
+
+ case MK_CONST:
+ editfmt = constformat;
+ break;
+
+ case MK_MODULE:
+ editfmt = moduleformat;
+ break;
+
+ case MK_FUNCTION:
+ editfmt = functionformat;
+ break;
+
+ case MK_VAR:
+ case MK_VARPARAM:
+ case MK_VARREF:
+ case MK_VARMAC:
+ case MK_SPVAR:
+ editfmt = varformat;
+ break;
+
+ case MK_TYPE:
+ editfmt = typeformat;
+ break;
+
+ case MK_VARIANT: /* A true kludge! */
+ editfmt = enumformat;
+ if (!*editfmt)
+ editfmt = useenum ? varformat : constformat;
+ break;
+
+ default:
+ editfmt = "";
+ }
+ if (!*editfmt)
+ editfmt = symbolformat;
+ if (*editfmt)
+ if (editfmt == enumformat)
+ cp = format_ss(editfmt, cp,
+ enum_tname ? enum_tname->name : "ENUM");
+ else
+ cp = format_ss(editfmt, cp,
+ curctx ? curctx->name : "");
+ if (dollar_idents == 2) {
+ for (cp2 = cp; *cp2; cp2++)
+ if (*cp2 == '$' || *cp2 == '%')
+ *cp2 = '_';
+ }
+ sym2 = findsymbol(findaltname(cp, altnum));
+ } while (!issafename(sym2, isglobal, isdefine) &&
+ namekind != MK_MODULE && !wasaliased);
+ mp->name = stralloc(sym2->name);
+ if (sym2->flags & WARNNAME)
+ note(format_s("A symbol named %s was defined [100]", mp->name));
+ if (isglobal) {
+ switch (namekind) { /* prevent further name conflicts */
+
+ case MK_CONST:
+ case MK_VARIANT:
+ case MK_TYPE:
+ sym2->flags |= AVOIDNAME;
+ break;
+
+ case MK_VAR:
+ case MK_VARREF:
+ case MK_FUNCTION:
+ sym2->flags |= AVOIDGLOB;
+ break;
+
+ default:
+ /* name is completely local */
+ break;
+ }
+ }
+ if (debug > 4)
+ fprintf(outf, "Created meaning %s\n", mp->name);
+ }
+
+
+
+ Meaning *addmeaningas(sym, kind, namekind)
+ Symbol *sym;
+ enum meaningkind kind, namekind;
+ {
+ Meaning *mp;
+
+ mp = ALLOC(1, Meaning, meanings);
+ initmeaning(mp);
+ setupmeaning(mp, sym, kind, namekind);
+ mp->cnext = NULL;
+ if (curctx) {
+ if (curctxlast)
+ curctxlast->cnext = mp;
+ else
+ curctx->cbase = mp;
+ curctxlast = mp;
+ }
+ return mp;
+ }
+
+
+
+ Meaning *addmeaning(sym, kind)
+ Symbol *sym;
+ enum meaningkind kind;
+ {
+ return addmeaningas(sym, kind, kind);
+ }
+
+
+
+ Meaning *addmeaningafter(mpprev, sym, kind)
+ Meaning *mpprev;
+ Symbol *sym;
+ enum meaningkind kind;
+ {
+ Meaning *mp;
+
+ if (!mpprev->cnext && mpprev->ctx == curctx)
+ return addmeaning(sym, kind);
+ mp = ALLOC(1, Meaning, meanings);
+ initmeaning(mp);
+ setupmeaning(mp, sym, kind, kind);
+ mp->ctx = mpprev->ctx;
+ mp->cnext = mpprev->cnext;
+ mpprev->cnext = mp;
+ return mp;
+ }
+
+
+ void unaddmeaning(mp)
+ Meaning *mp;
+ {
+ Meaning *prev;
+
+ prev = mp->ctx;
+ while (prev && prev != mp)
+ prev = prev->cnext;
+ if (prev)
+ prev->cnext = mp->cnext;
+ else
+ mp->ctx = mp->cnext;
+ if (!mp->cnext && mp->ctx == curctx)
+ curctxlast = prev;
+ }
+
+
+ void readdmeaning(mp)
+ Meaning *mp;
+ {
+ mp->cnext = NULL;
+ if (curctx) {
+ if (curctxlast)
+ curctxlast->cnext = mp;
+ else
+ curctx->cbase = mp;
+ curctxlast = mp;
+ }
+ }
+
+
+ Meaning *addfield(sym, flast, rectype, tname)
+ Symbol *sym;
+ Meaning ***flast;
+ Type *rectype;
+ Meaning *tname;
+ {
+ Meaning *mp;
+ int altnum;
+ Symbol *sym2;
+ Strlist *sl;
+ char *name, *name2;
+
+ mp = ALLOC(1, Meaning, meanings);
+ initmeaning(mp);
+ mp->sym = sym;
+ if (sym) {
+ mp->snext = sym->fbase;
+ sym->fbase = mp;
+ if (sym == curtoksym)
+ name2 = curtokcase;
+ else
+ name2 = sym->name;
+ name = name2;
+ if (tname)
+ sl = strlist_find(fieldmacros,
+ format_ss("%s.%s", tname->sym->name, sym->name));
+ else
+ sl = NULL;
+ if (sl) {
+ mp->constdefn = (Expr *)sl->value;
+ strlist_delete(&fieldmacros, sl);
+ altnum = 0;
+ } else {
+ altnum = -1;
+ do {
+ altnum++;
+ if (*fieldformat)
+ name = format_ss(fieldformat, name2,
+ tname && tname->name ? tname->name
+ : "FIELD");
+ sym2 = findsymbol(findaltname(name, altnum));
+ } while (!issafename(sym2, 0, 0) ||
+ ((sym2->flags & AVOIDFIELD) && !reusefieldnames));
+ sym2->flags |= AVOIDFIELD;
+ }
+ mp->kind = MK_FIELD;
+ mp->name = stralloc(findaltname(name, altnum));
+ } else {
+ mp->name = stralloc("(variant)");
+ mp->kind = MK_VARIANT;
+ }
+ mp->cnext = NULL;
+ **flast = mp;
+ *flast = &(mp->cnext);
+ mp->ctx = NULL;
+ mp->rectype = rectype;
+ mp->val.i = 0;
+ return mp;
+ }
+
+
+
+
+
+ int isfiletype(type, big)
+ Type *type;
+ int big; /* 0=TK_FILE, 1=TK_BIGFILE, -1=either */
+ {
+ return ((type->kind == TK_POINTER &&
+ type->basetype->kind == TK_FILE && big != 1) ||
+ (type->kind == TK_BIGFILE && big != 0));
+ }
+
+
+ Meaning *isfilevar(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (ex->kind == EK_VAR) {
+ mp = (Meaning *)ex->val.i;
+ if (mp->kind == MK_VAR)
+ return mp;
+ } else if (ex->kind == EK_DOT) {
+ mp = (Meaning *)ex->val.i;
+ if (mp && mp->kind == MK_FIELD)
+ return mp;
+ }
+ return NULL;
+ }
+
+
+ Type *filebasetype(type)
+ Type *type;
+ {
+ if (type->kind == TK_BIGFILE)
+ return type->basetype;
+ else
+ return type->basetype->basetype;
+ }
+
+
+ Expr *filebasename(ex)
+ Expr *ex;
+ {
+ if (ex->val.type->kind == TK_BIGFILE)
+ return makeexpr_dotq(ex, "f", ex->val.type);
+ else
+ return ex;
+ }
+
+
+ Expr *filenamepart(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (ex->val.type->kind == TK_BIGFILE)
+ return makeexpr_dotq(copyexpr(ex), "name", tp_str255);
+ else if ((mp = isfilevar(ex)) && mp->namedfile)
+ return makeexpr_name(format_s(name_FNVAR, mp->name), tp_str255);
+ else
+ return NULL;
+ }
+
+
+ int fileisbuffered(ex, maybe)
+ Expr *ex;
+ int maybe;
+ {
+ Meaning *mp;
+
+ return (ex->val.type->kind == TK_BIGFILE ||
+ ((mp = isfilevar(ex)) && (maybe || mp->bufferedfile)));
+ }
+
+
+
+ Type *findbasetype_(type, flags)
+ Type *type;
+ int flags;
+ {
+ long smin, smax;
+ static Type typename;
+
+ for (;;) {
+ if (type->preserved && (type->kind != TK_POINTER) &&
+ !(flags & ODECL_NOPRES))
+ return type;
+ switch (type->kind) {
+
+ case TK_POINTER:
+ if (type->smin) /* unresolved forward */
+ return type;
+ if (type->basetype == tp_void) { /* ANYPTR */
+ if (tp_special_anyptr)
+ return tp_special_anyptr; /* write "Anyptr" */
+ if (!voidstar)
+ return tp_abyte; /* write "char *", not "void *" */
+ }
+ switch (type->basetype->kind) {
+
+ case TK_ARRAY: /* use basetype's basetype: */
+ case TK_STRING: /* ^array[5] of array[3] of integer */
+ case TK_SET: /* => int (*a)[3]; */
+ if (stararrays == 1 ||
+ !(flags & ODECL_FREEARRAY) ||
+ type->basetype->structdefd) {
+ type = type->basetype->basetype;
+ flags &= ~ODECL_CHARSTAR;
+ continue;
+ }
+ break;
+
+ default:
+ break;
+ }
+ if (type->preserved && !(flags & ODECL_NOPRES))
+ return type;
+ if (type->fbase && type->fbase->wasdeclared &&
+ (flags & ODECL_DECL)) {
+ typename.meaning = type->fbase;
+ typename.preserved = 1;
+ return &typename;
+ }
+ break;
+
+ case TK_FUNCTION:
+ case TK_STRING:
+ case TK_SET:
+ case TK_SMALLSET:
+ case TK_SMALLARRAY:
+ if (!type->basetype)
+ return type;
+ break;
+
+ case TK_ARRAY:
+ if (type->meaning && type->meaning->kind == MK_TYPE &&
+ type->meaning->wasdeclared)
+ return type;
+ if (type->fbase && type->fbase->wasdeclared &&
+ (flags & ODECL_DECL)) {
+ typename.meaning = type->fbase;
+ typename.preserved = 1;
+ return &typename;
+ }
+ break;
+
+ case TK_FILE:
+ return tp_text->basetype;
+
+ case TK_PROCPTR:
+ return tp_proc;
+
+ case TK_CPROCPTR:
+ type = type->basetype->basetype;
+ continue;
+
+ case TK_ENUM:
+ if (useenum)
+ return type;
+ else if (!enumbyte ||
+ type->smax->kind != EK_CONST ||
+ type->smax->val.i > 255)
+ return tp_sshort;
+ else if (type->smax->val.i > 127)
+ return tp_ubyte;
+ else
+ return tp_abyte;
+
+ case TK_BOOLEAN:
+ if (*name_BOOLEAN)
+ return type;
+ else
+ return tp_ubyte;
+
+ case TK_SUBR:
+ if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte ||
+ type == tp_ushort || type == tp_sshort) {
+ return type;
+ } else if ((type->basetype->kind == TK_ENUM && useenum) ||
+ type->basetype->kind == TK_BOOLEAN && *name_BOOLEAN) {
+ return type->basetype;
+ } else {
+ if (ord_range(type, &smin, &smax)) {
+ if (squeezesubr != 0) {
+ if (smin >= 0 && smax <= max_schar)
+ return tp_abyte;
+ else if (smin >= 0 && smax <= max_uchar)
+ return tp_ubyte;
+ else if (smin >= min_schar && smax <= max_schar &&
+ (signedchars == 1 || hassignedchar))
+ return tp_sbyte;
+ else if (smin >= min_sshort && smax <= max_sshort)
+ return tp_sshort;
+ else if (smin >= 0 && smax <= max_ushort)
+ return tp_ushort;
+ else
+ return tp_integer;
+ } else {
+ if (smin >= min_sshort && smax <= max_sshort)
+ return tp_sshort;
+ else
+ return tp_integer;
+ }
+ } else
+ return tp_integer;
+ }
+
+ case TK_CHAR:
+ if (type == tp_schar &&
+ (signedchars != 1 && !hassignedchar)) {
+ return tp_sshort;
+ }
+ return type;
+
+ default:
+ return type;
+ }
+ type = type->basetype;
+ }
+ }
+
+
+ Type *findbasetype(type, flags)
+ Type *type;
+ int flags;
+ {
+ if (debug>1) {
+ fprintf(outf, "findbasetype(");
+ dumptypename(type, 1);
+ fprintf(outf, ",%d) = ", flags);
+ type = findbasetype_(type, flags);
+ dumptypename(type, 1);
+ fprintf(outf, "\n");
+ return type;
+ }
+ return findbasetype_(type, flags);
+ }
+
+
+
+ Expr *arraysize(tp, incskipped)
+ Type *tp;
+ int incskipped;
+ {
+ Expr *ex, *minv, *maxv;
+ int denom;
+
+ ord_range_expr(tp->indextype, &minv, &maxv);
+ if (maxv->kind == EK_VAR && maxv->val.i == (long)mp_maxint &&
+ !exprdependsvar(minv, mp_maxint)) {
+ return NULL;
+ } else {
+ ex = makeexpr_plus(makeexpr_minus(copyexpr(maxv),
+ copyexpr(minv)),
+ makeexpr_long(1));
+ if (tp->smin && !incskipped) {
+ ex = makeexpr_minus(ex, copyexpr(tp->smin));
+ }
+ if (tp->smax) {
+ denom = (tp->basetype == tp_sshort) ? 16 : 8;
+ denom >>= tp->escale;
+ ex = makeexpr_div(makeexpr_plus(ex, makeexpr_long(denom-1)),
+ makeexpr_long(denom));
+ }
+ return ex;
+ }
+ }
+
+
+
+ Type *promote_type(tp)
+ Type *tp;
+ {
+ Type *tp2;
+
+ if (tp->kind == TK_ENUM) {
+ if (promote_enums == 0 ||
+ (promote_enums < 0 &&
+ (useenum)))
+ return tp;
+ }
+ if (tp->kind == TK_ENUM ||
+ tp->kind == TK_SUBR ||
+ tp->kind == TK_INTEGER ||
+ tp->kind == TK_CHAR ||
+ tp->kind == TK_BOOLEAN) {
+ tp2 = findbasetype(tp, ODECL_NOPRES);
+ if (tp2 == tp_ushort && sizeof_int == 16)
+ return tp_uint;
+ else if (tp2 == tp_sbyte || tp2 == tp_ubyte ||
+ tp2 == tp_abyte || tp2 == tp_char ||
+ tp2 == tp_sshort || tp2 == tp_ushort ||
+ tp2 == tp_boolean || tp2->kind == TK_ENUM) {
+ return tp_int;
+ }
+ }
+ if (tp == tp_real)
+ return tp_longreal;
+ return tp;
+ }
+
+
+ Type *promote_type_bin(t1, t2)
+ Type *t1, *t2;
+ {
+ t1 = promote_type(t1);
+ t2 = promote_type(t2);
+ if (t1 == tp_longreal || t2 == tp_longreal)
+ return tp_longreal;
+ if (t1 == tp_unsigned || t2 == tp_unsigned)
+ return tp_unsigned;
+ if (t1 == tp_integer || t2 == tp_integer) {
+ if ((t1 == tp_uint || t2 == tp_uint) &&
+ sizeof_int > 0 &&
+ sizeof_int < (sizeof_long > 0 ? sizeof_long : 32))
+ return tp_uint;
+ return tp_integer;
+ }
+ if (t1 == tp_uint || t2 == tp_uint)
+ return tp_uint;
+ return t1;
+ }
+
+
+
+ #if 0
+ void predeclare_varstruct(mp)
+ Meaning *mp;
+ {
+ if (mp->ctx &&
+ mp->ctx->kind == MK_FUNCTION &&
+ mp->ctx->varstructflag &&
+ (usePPMacros != 0 || prototypes != 0) &&
+ !strlist_find(varstructdecllist, mp->ctx->name)) {
+ output("struct ");
+ output(format_s(name_LOC, mp->ctx->name));
+ output(" ;\n");
+ strlist_insert(&varstructdecllist, mp->ctx->name);
+ }
+ }
+ #endif
+
+
+ Static void declare_args(type, isheader, isforward)
+ Type *type;
+ int isheader, isforward;
+ {
+ Meaning *mp = type->fbase;
+ Type *tp;
+ int firstflag = 0;
+ int usePP, dopromote, proto, showtypes, shownames;
+ int staticlink;
+ char *name;
+
+ #if 1 /* This seems to work better! */
+ isforward = !isheader;
+ #endif
+ usePP = (isforward && usePPMacros != 0);
+ dopromote = (promoteargs == 1 ||
+ (promoteargs < 0 && (usePP || !fullprototyping)));
+ if (ansiC == 1 && blockkind != TOK_EXPORT)
+ usePP = 0;
+ if (usePP)
+ proto = (prototypes) ? prototypes : 1;
+ else
+ proto = (isforward || fullprototyping) ? prototypes : 0;
+ showtypes = (proto > 0);
+ shownames = (proto == 1 || isheader);
+ staticlink = (type->issigned ||
+ (type->meaning &&
+ type->meaning->ctx->kind == MK_FUNCTION &&
+ type->meaning->ctx->varstructflag));
+ if (mp || staticlink) {
+ if (usePP)
+ output(" PP(");
+ else if (spacefuncs)
+ output(" ");
+ output("(");
+ if (showtypes || shownames) {
+ firstflag = 0;
+ while (mp) {
+ if (firstflag++)
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ name = (mp->othername && isheader) ? mp->othername : mp->name;
+ tp = (mp->othername) ? mp->rectype : mp->type;
+ if (!showtypes) {
+ output(name);
+ } else {
+ output(storageclassname(varstorageclass(mp)));
+ if (!shownames || (isforward && *name == '_')) {
+ out_type(tp, 1);
+ } else {
+ if (dopromote)
+ tp = promote_type(tp);
+ outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
+ output(" ");
+ outdeclarator(tp, name,
+ ODECL_CHARSTAR|ODECL_FREEARRAY);
+ }
+ }
+ if (isheader)
+ mp->wasdeclared = showtypes;
+ if (mp->type == tp_strptr && mp->anyvarflag) { /* VAR STRING parameter */
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ if (showtypes) {
+ if (useAnyptrMacros == 1 || useconsts == 2)
+ output("Const ");
+ else if (ansiC > 0)
+ output("const ");
+ output("int");
+ }
+ if (shownames) {
+ if (showtypes)
+ output(" ");
+ output(format_s(name_STRMAX, mp->name));
+ }
+ }
+ mp = mp->xnext;
+ }
+ if (staticlink) { /* sub-procedure with static link */
+ if (firstflag++)
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ if (type->issigned) {
+ if (showtypes)
+ if (tp_special_anyptr)
+ output("Anyptr ");
+ else if (voidstar)
+ output("void *");
+ else
+ output("char *");
+ if (shownames)
+ output("_link");
+ } else {
+ mp = type->meaning->ctx;
+ if (showtypes) {
+ output("struct ");
+ output(format_s(name_LOC, mp->name));
+ output(" *");
+ }
+ if (shownames) {
+ output(format_s(name_LINK, mp->name));
+ }
+ }
+ }
+ }
+ output(")");
+ if (usePP)
+ output(")");
+ } else {
+ if (usePP)
+ output(" PV()");
+ else {
+ if (spacefuncs)
+ output(" ");
+ if (void_args)
+ output("(void)");
+ else
+ output("()");
+ }
+ }
+ }
+
+
+
+ void outdeclarator(type, name, flags)
+ Type *type;
+ char *name;
+ int flags;
+ {
+ int i, depth, anyptrs, anyarrays;
+ Expr *dimen[30];
+ Expr *ex, *maxv;
+ Type *tp, *functype, *basetype;
+ Expr funcdummy; /* yow */
+
+ anyptrs = 0;
+ anyarrays = 0;
+ functype = NULL;
+ basetype = findbasetype(type, flags);
+ for (depth = 0, tp = type; tp && tp != basetype; tp = tp->basetype) {
+ switch (tp->kind) {
+
+ case TK_POINTER:
+ if (tp->basetype) {
+ switch (tp->basetype->kind) {
+
+ case TK_VOID:
+ if (tp->basetype == tp_void &&
+ tp_special_anyptr) {
+ tp = tp_special_anyptr;
+ continue;
+ }
+ break;
+
+ case TK_ARRAY: /* ptr to array of x => ptr to x */
+ case TK_STRING: /* or => array of x */
+ case TK_SET:
+ if (stararrays == 1 ||
+ !(flags & ODECL_FREEARRAY) ||
+ (tp->basetype->structdefd &&
+ stararrays != 2)) {
+ tp = tp->basetype;
+ flags &= ~ODECL_CHARSTAR;
+ } else {
+ continue;
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+ dimen[depth++] = NULL;
+ anyptrs++;
+ if (tp->kind == TK_POINTER &&
+ tp->fbase && tp->fbase->wasdeclared)
+ break;
+ continue;
+
+ case TK_ARRAY:
+ flags &= ~ODECL_CHARSTAR;
+ if (tp->meaning && tp->meaning->kind == MK_TYPE &&
+ tp->meaning->wasdeclared)
+ break;
+ if (tp->structdefd) { /* conformant array */
+ if (!variablearrays &&
+ !(tp->basetype->kind == TK_ARRAY &&
+ tp->basetype->structdefd)) /* avoid mult. notes */
+ note("Conformant array code may not work in all compilers [101]");
+ }
+ ex = arraysize(tp, 1);
+ if (!ex)
+ ex = makeexpr_name("", tp_integer);
+ dimen[depth++] = ex;
+ anyarrays++;
+ if (tp->fbase && tp->fbase->wasdeclared)
+ break;
+ continue;
+
+ case TK_SET:
+ ord_range_expr(tp->indextype, NULL, &maxv);
+ maxv = enum_to_int(copyexpr(maxv));
+ if (ord_type(maxv->val.type)->kind == TK_CHAR)
+ maxv->val.type = tp_integer;
+ dimen[depth++] = makeexpr_plus(makeexpr_div(maxv, makeexpr_setbits()),
+ makeexpr_long(2));
+ break;
+
+ case TK_STRING:
+ if ((flags & ODECL_CHARSTAR) && stararrays == 1) {
+ dimen[depth++] = NULL;
+ } else {
+ ord_range_expr(tp->indextype, NULL, &maxv);
+ dimen[depth++] = makeexpr_plus(copyexpr(maxv), makeexpr_long(1));
+ }
+ continue;
+
+ case TK_FILE:
+ break;
+
+ case TK_CPROCPTR:
+ dimen[depth++] = NULL;
+ anyptrs++;
+ if (procptrprototypes)
+ continue;
+ dimen[depth++] = &funcdummy;
+ break;
+
+ case TK_FUNCTION:
+ dimen[depth++] = &funcdummy;
+ if (!functype)
+ functype = tp;
+ continue;
+
+ default:
+ break;
+ }
+ break;
+ }
+ if (!*name && depth && (spaceexprs > 0 ||
+ (spaceexprs != 0 && !dimen[depth-1])))
+ output(" "); /* spacing for abstract declarator */
+ if ((flags & ODECL_FUNCTION) && anyptrs)
+ output(" ");
+ if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
+ output("\003");
+ for (i = depth; --i >= 0; ) {
+ if (!dimen[i])
+ output("*");
+ if (i > 0 &&
+ ((dimen[i] && !dimen[i-1]) ||
+ (dimen[i-1] && !dimen[i] && extraparens > 0)))
+ output("(");
+ }
+ if (flags & ODECL_FUNCTION)
+ output("\n");
+ if (anyarrays > 1 && (flags & ODECL_FUNCTION))
+ output("\003");
+ output(name);
+ for (i = 0; i < depth; i++) {
+ if (i > 0 &&
+ ((dimen[i] && !dimen[i-1]) ||
+ (dimen[i-1] && !dimen[i] && extraparens > 0)))
+ output(")");
+ if (dimen[i]) {
+ if (dimen[i] == &funcdummy) {
+ if (lookback(1) == ')')
+ output("\002");
+ if (functype)
+ declare_args(functype, (flags & ODECL_HEADER) != 0,
+ (flags & ODECL_FORWARD) != 0);
+ else if (spacefuncs)
+ output(" ()");
+ else
+ output("()");
+ } else {
+ if (lookback(1) == ']')
+ output("\002");
+ output("[");
+ if (!(flags & ODECL_FREEARRAY) || stararrays == 0 || i > 0)
+ out_expr(dimen[i]);
+ freeexpr(dimen[i]);
+ output("]");
+ }
+ }
+ }
+ if (anyarrays > 1)
+ output("\004");
+ }
+
+
+
+
+
+
+ /* Find out if types t1 and t2 will work out to be the same C type,
+ for purposes of type-casting */
+
+ Type *canonicaltype(type)
+ Type *type;
+ {
+ if (type->kind == TK_SUBR || type->kind == TK_ENUM ||
+ type->kind == TK_PROCPTR)
+ type = findbasetype(type, 0);
+ if (type == tp_char)
+ return tp_ubyte;
+ if (type->kind == TK_POINTER) {
+ if (type->smin)
+ return type;
+ else if (type->basetype->kind == TK_ARRAY ||
+ type->basetype->kind == TK_STRING ||
+ type->basetype->kind == TK_SET)
+ return makepointertype(canonicaltype(type->basetype->basetype));
+ else if (type->basetype == tp_void)
+ return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
+ else if (type->basetype->kind == TK_FILE)
+ return tp_text;
+ else
+ return makepointertype(canonicaltype(type->basetype));
+ }
+ return type;
+ }
+
+
+ int identicaltypes(t1, t2)
+ Type *t1, *t2;
+ {
+ if (t1 == t2)
+ return 1;
+ if (t1->kind == t2->kind) {
+ if (t1->kind == TK_SUBR)
+ return (identicaltypes(t1->basetype, t2->basetype) &&
+ exprsame(t1->smin, t2->smin, 2) &&
+ exprsame(t1->smax, t2->smax, 2));
+ if (t1->kind == TK_SET ||
+ t1->kind == TK_SMALLSET)
+ return (exprsame(t1->indextype->smax,
+ t2->indextype->smax, 2));
+ if (t1->kind == TK_ARRAY ||
+ t1->kind == TK_STRING ||
+ t1->kind == TK_SMALLARRAY)
+ return (identicaltypes(t1->basetype, t2->basetype) &&
+ identicaltypes(t1->indextype, t2->indextype) &&
+ t1->structdefd == t2->structdefd &&
+ ((!t1->smin && !t2->smin) ||
+ (t1->smin && t2->smin &&
+ exprsame(t1->smin, t2->smin, 2))) &&
+ ((!t1->smax && !t2->smax) ||
+ (t1->smax && t2->smax &&
+ exprsame(t1->smax, t2->smax, 2) &&
+ t1->escale == t2->escale &&
+ t1->issigned == t2->issigned)));
+ }
+ return 0;
+ }
+
+
+ int similartypes(t1, t2)
+ Type *t1, *t2;
+ {
+ if (debug > 3) { fprintf(outf, "similartypes("); dumptypename(t1,1); fprintf(outf, ","); dumptypename(t2,1); fprintf(outf, ") = %d\n", identicaltypes(t1, t2)); }
+ if (identicaltypes(t1, t2))
+ return 1;
+ t1 = canonicaltype(t1);
+ t2 = canonicaltype(t2);
+ return (t1 == t2);
+ }
+
+
+
+
+
+ Static int checkstructconst(mp)
+ Meaning *mp;
+ {
+ return (mp->kind == MK_VAR &&
+ mp->constdefn &&
+ mp->constdefn->kind == EK_CONST &&
+ (mp->constdefn->val.type->kind == TK_ARRAY ||
+ mp->constdefn->val.type->kind == TK_RECORD));
+ }
+
+
+ Static int mixable(mp1, mp2, args, flags)
+ Meaning *mp1, *mp2;
+ int args, flags;
+ {
+ Type *tp1 = mp1->type, *tp2 = mp2->type;
+
+ if (mixvars == 0)
+ return 0;
+ if (mp1->kind == MK_FIELD &&
+ (mp1->val.i || mp2->val.i) && mixfields == 0)
+ return 0;
+ if (checkstructconst(mp1) || checkstructconst(mp2))
+ return 0;
+ if (mp1->comments) {
+ if (findcomment(mp1->comments, CMT_NOT | CMT_PRE, -1))
+ return 0;
+ }
+ if (mp2->comments) {
+ if (findcomment(mp2->comments, CMT_PRE, -1))
+ return 0;
+ }
+ if ((mp1->constdefn && (mp1->kind == MK_VAR || mp1->kind == MK_VARREF)) ||
+ (mp2->constdefn && (mp2->kind == MK_VAR || mp2->kind == MK_VARREF))) {
+ if (mixinits == 0)
+ return 0;
+ if (mixinits != 1 &&
+ (!mp1->constdefn || !mp2->constdefn))
+ return 0;
+ }
+ if (args) {
+ if (mp1->kind == MK_PARAM && mp1->othername)
+ tp1 = mp1->rectype;
+ if (mp2->kind == MK_PARAM && mp2->othername)
+ tp2 = mp2->rectype;
+ }
+ if (tp1 == tp2)
+ return 1;
+ switch (mixtypes) {
+ case 0:
+ return 0;
+ case 1:
+ return (findbasetype(tp1, flags) == findbasetype(tp2, flags));
+ default:
+ if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
+ return 0;
+ while (tp1->kind == TK_POINTER && !tp1->smin && tp1->basetype)
+ tp1 = tp1->basetype;
+ while (tp2->kind == TK_POINTER && !tp2->smin && tp2->basetype)
+ tp2 = tp2->basetype;
+ return (tp1 == tp2);
+ }
+ }
+
+
+
+ void declarefiles(fnames)
+ Strlist *fnames;
+ {
+ Meaning *mp;
+ char *cp;
+
+ while (fnames) {
+ mp = (Meaning *)fnames->value;
+ if (mp->kind == MK_VAR || mp->kind == MK_FIELD) {
+ if (mp->namedfile) {
+ output(storageclassname(varstorageclass(mp)));
+ output(format_ss("%s %s", charname,
+ format_s(name_FNVAR, fnames->s)));
+ output(format_s("[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
+ }
+ if (mp->bufferedfile && *declbufname) {
+ cp = format_s("%s", storageclassname(varstorageclass(mp)));
+ if (*cp && isspace(cp[strlen(cp)-1]))
+ cp[strlen(cp)-1] = 0;
+ if (*cp || !*declbufncname) {
+ output(declbufname);
+ output("(");
+ output(fnames->s);
+ output(",");
+ output(cp);
+ } else {
+ output(declbufncname);
+ output("(");
+ output(fnames->s);
+ }
+ output(",");
+ out_type(mp->type->basetype->basetype, 1);
+ output(");\n");
+ }
+ }
+ strlist_eat(&fnames);
+ }
+ }
+
+
+
+ char *variantfieldname(num)
+ int num;
+ {
+ if (num >= 0)
+ return format_d("U%d", num);
+ else
+ return format_d("UM%d", -num);
+ }
+
+
+ int record_is_union(tp)
+ Type *tp;
+ {
+ return (tp->kind == TK_RECORD &&
+ tp->fbase && tp->fbase->kind == MK_VARIANT);
+ }
+
+
+ void outfieldlist(mp)
+ Meaning *mp;
+ {
+ Meaning *mp0;
+ int num, only_union, empty, saveindent, saveindent2;
+ Strlist *fnames, *fn;
+
+ if (!mp) {
+ output("int empty_struct; /* Pascal record was empty */\n");
+ return;
+ }
+ only_union = (mp && mp->kind == MK_VARIANT);
+ fnames = NULL;
+ while (mp && mp->kind == MK_FIELD) {
+ flushcomments(&mp->comments, CMT_PRE, -1);
+ output(storageclassname(varstorageclass(mp) & 0x10));
+ if (mp->dtype)
+ output(mp->dtype->name);
+ else
+ outbasetype(mp->type, 0);
+ output(" \005");
+ for (;;) {
+ if (mp->dtype)
+ output(mp->name);
+ else
+ outdeclarator(mp->type, mp->name, 0);
+ if (mp->val.i && (mp->type != tp_abyte || mp->val.i != 8))
+ output(format_d(" : %d", mp->val.i));
+ if (isfiletype(mp->type, 0)) {
+ fn = strlist_append(&fnames, mp->name);
+ fn->value = (long)mp;
+ }
+ mp->wasdeclared = 1;
+ if (!mp->cnext || mp->cnext->kind != MK_FIELD ||
+ mp->dtype != mp->cnext->dtype ||
+ varstorageclass(mp) != varstorageclass(mp->cnext) ||
+ !mixable(mp, mp->cnext, 0, 0))
+ break;
+ mp = mp->cnext;
+ if (spacecommas)
+ output(",\001 ");
+ else
+ output(",\001");
+ }
+ output(";");
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ flushcomments(&mp->comments, -1, -1);
+ mp = mp->cnext;
+ }
+ declarefiles(fnames);
+ if (mp) {
+ saveindent = outindent;
+ empty = 1;
+ if (!only_union) {
+ output("union {\n");
+ moreindent(tabsize);
+ moreindent(structindent);
+ }
+ while (mp) {
+ mp0 = mp->ctx;
+ num = ord_value(mp->val);
+ while (mp && mp->ctx == mp0)
+ mp = mp->cnext;
+ if (mp0) {
+ empty = 0;
+ if (!mp0->cnext && mp0->kind == MK_FIELD) {
+ mp0->val.i = 0; /* no need for bit fields in a union! */
+ outfieldlist(mp0);
+ } else {
+ if (mp0->kind == MK_VARIANT)
+ output("union {\n");
+ else
+ output("struct {\n");
+ saveindent2 = outindent;
+ moreindent(tabsize);
+ moreindent(structindent);
+ outfieldlist(mp0);
+ outindent = saveindent2;
+ output("} ");
+ output(format_s(name_VARIANT, variantfieldname(num)));
+ output(";\n");
+ }
+ flushcomments(&mp0->comments, -1, -1);
+ }
+ }
+ if (empty)
+ output("int empty_union; /* Pascal variant record was empty */\n");
+ if (!only_union) {
+ outindent = saveindent;
+ output("} ");
+ output(format_s(name_UNION, ""));
+ output(";\n");
+ }
+ }
+ }
+
+
+
+ void declarebigfile(type)
+ Type *type;
+ {
+ output("FILE *f;\n");
+ if (!*declbufncname) {
+ output(declbufname);
+ output("(f,,");
+ } else {
+ output(declbufncname);
+ output("(f,");
+ }
+ out_type(type->basetype, 1);
+ output(");\n");
+ output(charname);
+ output(format_s(" name[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
+ }
+
+
+
+ void outbasetype(type, flags)
+ Type *type;
+ int flags;
+ {
+ Meaning *mp;
+ int saveindent;
+
+ type = findbasetype(type, flags | ODECL_DECL);
+ if (type->preserved && type->meaning->wasdeclared) {
+ output(type->meaning->name);
+ return;
+ }
+ switch (type->kind) {
+
+ case TK_INTEGER:
+ if (type == tp_uint) {
+ output("unsigned");
+ } else if (type == tp_sint) {
+ if (useAnyptrMacros == 1)
+ output("Signed int");
+ else if (hassignedchar)
+ output("signed int");
+ else
+ output("int"); /* will sign-extend by hand */
+ } else if (type == tp_unsigned) {
+ output("unsigned long");
+ } else if (type != tp_int)
+ output(integername);
+ else
+ output("int");
+ break;
+
+ case TK_SUBR:
+ if (type == tp_special_anyptr) {
+ output("Anyptr");
+ } else if (type == tp_abyte) {
+ output("char");
+ } else if (type == tp_ubyte) {
+ output(ucharname);
+ } else if (type == tp_sbyte) {
+ output(scharname);
+ if (signedchars != 1 && !hassignedchar)
+ note("'signed char' may not be valid in all compilers [102]");
+ } else {
+ if (type == tp_ushort)
+ output("unsigned ");
+ output("short");
+ }
+ break;
+
+ case TK_CHAR:
+ if (type == tp_uchar) {
+ output(ucharname);
+ } else if (type == tp_schar) {
+ output(scharname);
+ if (signedchars != 1 && !hassignedchar)
+ note("'signed char' may not be valid in all compilers [102]");
+ } else
+ output(charname);
+ break;
+
+ case TK_BOOLEAN:
+ output((*name_BOOLEAN) ? name_BOOLEAN : ucharname);
+ break;
+
+ case TK_REAL:
+ if (type == tp_longreal)
+ output("double");
+ else
+ output("float");
+ break;
+
+ case TK_VOID:
+ if (ansiC == 0)
+ output("int");
+ else if (useAnyptrMacros == 1)
+ output("Void");
+ else
+ output("void");
+ break;
+
+ case TK_PROCPTR:
+ output(name_PROCEDURE);
+ break;
+
+ case TK_FILE:
+ output("FILE");
+ break;
+
+ case TK_SPECIAL:
+ if (type == tp_jmp_buf)
+ output("jmp_buf");
+ break;
+
+ default:
+ if (type->kind == TK_POINTER && type->smin) {
+ note("Forward pointer reference assumes struct type [323]");
+ output("struct ");
+ output(format_s(name_STRUCT, type->smin->val.s));
+ } else if (type->meaning && type->meaning->kind == MK_TYPE &&
+ type->meaning->wasdeclared) {
+ output(type->meaning->name);
+ } else {
+ switch (type->kind) {
+
+ case TK_ENUM:
+ output("enum {\n");
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structindent);
+ mp = type->fbase;
+ while (mp) {
+ output(mp->name);
+ mp = mp->xnext;
+ if (mp)
+ if (spacecommas)
+ output(",\001 ");
+ else
+ output(",\001");
+ }
+ outindent = saveindent;
+ output("\n}");
+ break;
+
+ case TK_RECORD:
+ case TK_BIGFILE:
+ if (record_is_union(type))
+ output("union ");
+ else
+ output("struct ");
+ if (type->meaning)
+ output(format_s(name_STRUCT, type->meaning->name));
+ if (!type->structdefd) {
+ if (type->meaning) {
+ type->structdefd = 1;
+ output(" ");
+ }
+ output("{\n");
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structindent);
+ if (type->kind == TK_BIGFILE)
+ declarebigfile(type);
+ else
+ outfieldlist(type->fbase);
+ outindent = saveindent;
+ output("}");
+ }
+ break;
+
+ default:
+ break;
+
+ }
+ }
+ break;
+ }
+ }
+
+
+
+ void out_type(type, witharrays)
+ Type *type;
+ int witharrays;
+ {
+ if (!witharrays && type->kind == TK_ARRAY)
+ type = makepointertype(type->basetype);
+ outbasetype(type, 0);
+ outdeclarator(type, "", 0); /* write an "abstract declarator" */
+ }
+
+
+
+
+ int varstorageclass(mp)
+ Meaning *mp;
+ {
+ int sclass;
+
+ if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM ||
+ mp->kind == MK_FIELD)
+ sclass = 0;
+ else if (blockkind == TOK_EXPORT)
+ if (usevextern)
+ if (mp->constdefn &&
+ (mp->kind == MK_VAR ||
+ mp->kind == MK_VARREF))
+ sclass = 2; /* extern */
+ else
+ sclass = 1; /* vextern */
+ else
+ sclass = 0; /* (plain) */
+ else if (mp->isfunction && mp->kind != MK_FUNCTION)
+ sclass = 2; /* extern */
+ else if (mp->ctx->kind == MK_MODULE &&
+ (var_static != 0 ||
+ (findsymbol(mp->name)->flags & NEEDSTATIC)) &&
+ !mp->exported && !mp->istemporary && blockkind != TOK_END)
+ sclass = (useAnyptrMacros) ? 4 : 3; /* (private) */
+ else if (mp->isforward)
+ sclass = 3; /* static */
+ else
+ sclass = 0; /* (plain) */
+ if (mp->volatilequal)
+ sclass |= 0x10;
+ if (mp->constqual)
+ sclass |= 0x20;
+ if (debug>2) fprintf(outf, "varstorageclass(%s) = %d\n", mp->name, sclass);
+ return sclass;
+ }
+
+
+ char *storageclassname(i)
+ int i;
+ {
+ char *scname;
+
+ switch (i & 0xf) {
+ case 1:
+ scname = "vextern ";
+ break;
+ case 2:
+ scname = "extern ";
+ break;
+ case 3:
+ scname = "static ";
+ break;
+ case 4:
+ scname = "Static ";
+ break;
+ default:
+ scname = "";
+ break;
+ }
+ if (i & 0x10)
+ if (useAnyptrMacros == 1)
+ scname = format_s("%sVolatile ", scname);
+ else if (ansiC > 0)
+ scname = format_s("%svolatile ", scname);
+ if (i & 0x20)
+ if (useAnyptrMacros == 1)
+ scname = format_s("%sConst ", scname);
+ else if (ansiC > 0)
+ scname = format_s("%sconst ", scname);
+ return scname;
+ }
+
+
+
+ Static int var_mixable;
+
+ void declarevar(mp, which)
+ Meaning *mp;
+ int which; /* 0x1=header, 0x2=body, 0x4=trailer, 0x8=in varstruct */
+ {
+ int isstatic, isstructconst, saveindent, i;
+ Strlist *sl;
+
+ isstructconst = checkstructconst(mp);
+ isstatic = varstorageclass(mp);
+ if (which & 0x8)
+ isstatic &= 0x10; /* clear all but Volatile flags */
+ flushcomments(&mp->comments, CMT_PRE, -1);
+ if (which & 0x1) {
+ if (isstructconst)
+ outsection(minorspace);
+ output(storageclassname(isstatic));
+ if (mp->dtype)
+ output(mp->dtype->name);
+ else
+ outbasetype(mp->type, 0);
+ output(" \005");
+ }
+ if (which & 0x2) {
+ if (mp->dtype)
+ output(mp->name);
+ else
+ outdeclarator(mp->type, mp->name, 0);
+ if (mp->constdefn && blockkind != TOK_EXPORT &&
+ (mp->kind == MK_VAR || mp->kind == MK_VARREF)) {
+ if (mp->varstructflag) { /* move init code into function body */
+ intwarning("declarevar",
+ format_s("Variable %s initializer not removed [125]", mp->name));
+ } else {
+ if (isstructconst) {
+ output(" = {\n");
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structinitindent);
+ out_expr((Expr *)mp->constdefn->val.i);
+ outindent = saveindent;
+ output("\n}");
+ var_mixable = 0;
+ } else if (mp->type->kind == TK_ARRAY &&
+ mp->constdefn->val.type->kind == TK_STRING &&
+ !initpacstrings) {
+ if (mp->ctx->kind == MK_MODULE) {
+ sl = strlist_append(&initialcalls,
+ format_sss("memcpy(%s,\002 %s,\002 sizeof(%s))",
+ mp->name,
+ makeCstring(mp->constdefn->val.s,
+ mp->constdefn->val.i),
+ mp->name));
+ sl->value = 1;
+ } else if (mp->isforward) {
+ output(" = {\005");
+ for (i = 0; i < mp->constdefn->val.i; i++) {
+ if (i > 0)
+ output(",\001");
+ output(makeCchar(mp->constdefn->val.s[i]));
+ }
+ output("}");
+ mp->constdefn = NULL;
+ var_mixable = 0;
+ }
+ } else {
+ output(" = ");
+ out_expr(mp->constdefn);
+ }
+ }
+ }
+ }
+ if (which & 0x4) {
+ output(";");
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ flushcomments(&mp->comments, -1, -1);
+ if (isstructconst)
+ outsection(minorspace);
+ }
+ }
+
+
+
+
+ Static int checkvarmacdef(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+ int i;
+
+ if ((ex->kind == EK_NAME || ex->kind == EK_BICALL) &&
+ !strcmp(ex->val.s, mp->name)) {
+ ex->kind = EK_VAR;
+ ex->val.i = (long)mp;
+ ex->val.type = mp->type;
+ return 1;
+ }
+ if (ex->kind == EK_VAR && ex->val.i == (long)mp)
+ return 1;
+ i = ex->nargs;
+ while (--i >= 0)
+ if (checkvarmacdef(ex->args[i], mp))
+ return 1;
+ return 0;
+ }
+
+
+ int checkvarmac(mp)
+ Meaning *mp;
+ {
+ if (mp->kind != MK_VARMAC && mp->kind != MK_FUNCTION)
+ return 0;
+ if (!mp->constdefn)
+ return 0;
+ return checkvarmacdef(mp->constdefn, mp);
+ }
+
+
+
+ #define varkind(k) ((k)==MK_VAR||(k)==MK_VARREF||(k)==MK_PARAM||(k)==MK_VARPARAM)
+
+ int declarevars(ctx, invarstruct)
+ Meaning *ctx;
+ int invarstruct;
+ {
+ Meaning *mp, *mp0, *mp2;
+ Strlist *fnames, *fn;
+ int flag, first;
+
+ if (ctx->kind == MK_FUNCTION && ctx->varstructflag && !invarstruct) {
+ output("struct ");
+ output(format_s(name_LOC, ctx->name));
+ output(" ");
+ output(format_s(name_VARS, ctx->name));
+ output(";\n");
+ flag = 1;
+ } else
+ flag = 0;
+ if (debug>2) {
+ fprintf(outf,"declarevars:\n");
+ for (mp = ctx->cbase; mp; mp = mp->xnext) {
+ fprintf(outf, " %-22s%-15s%3d", mp->name,
+ meaningkindname(mp->kind),
+ mp->refcount);
+ if (mp->wasdeclared)
+ fprintf(outf, " [decl]");
+ if (mp->varstructflag)
+ fprintf(outf, " [struct]");
+ fprintf(outf, "\n");
+ }
+ }
+ fnames = NULL;
+ for (;;) {
+ mp = ctx->cbase;
+ while (mp && (!(varkind(mp->kind) || checkvarmac(mp)) ||
+ mp->wasdeclared || mp->varstructflag != invarstruct ||
+ mp->refcount <= 0))
+ mp = mp->cnext;
+ if (!mp)
+ break;
+ flag = 1;
+ first = 1;
+ mp0 = mp2 = mp;
+ var_mixable = 1;
+ while (mp) {
+ if ((varkind(mp->kind) || checkvarmac(mp)) &&
+ !mp->wasdeclared && var_mixable &&
+ mp->dtype == mp0->dtype &&
+ varstorageclass(mp) == varstorageclass(mp0) &&
+ mp->varstructflag == invarstruct && mp->refcount > 0) {
+ if (mixable(mp2, mp, 0, 0) || first) {
+ if (!first)
+ if (spacecommas)
+ output(",\001 ");
+ else
+ output(",\001");
+ declarevar(mp, (first ? 0x3 : 0x2) |
+ (invarstruct ? 0x8 : 0));
+ mp2 = mp;
+ mp->wasdeclared = 1;
+ if (isfiletype(mp->type, 0)) {
+ fn = strlist_append(&fnames, mp->name);
+ fn->value = (long)mp;
+ }
+ first = 0;
+ } else
+ if (mixvars != 1)
+ break;
+ }
+ if (first) {
+ intwarning("declarevars",
+ format_s("Unable to declare %s [126]", mp->name));
+ mp->wasdeclared = 1;
+ first = 0;
+ }
+ if (mixvars == 0)
+ break;
+ mp = mp->cnext;
+ }
+ declarevar(mp2, 0x4);
+ }
+ declarefiles(fnames);
+ return flag;
+ }
+
+
+
+ void redeclarevars(ctx)
+ Meaning *ctx;
+ {
+ Meaning *mp;
+
+ for (mp = ctx->cbase; mp; mp = mp->cnext) {
+ if ((mp->kind == MK_VAR || mp->kind == MK_VARREF) &&
+ mp->constdefn) {
+ mp->wasdeclared = 0; /* mark for redeclaration, this time */
+ } /* with its initializer */
+ }
+ }
+
+
+
+
+
+ void out_argdecls(ftype)
+ Type *ftype;
+ {
+ Meaning *mp, *mp0;
+ Type *tp;
+ int done;
+ int flag = 1;
+ char *name;
+
+ done = 0;
+ do {
+ mp = ftype->fbase;
+ while (mp && mp->wasdeclared)
+ mp = mp->xnext;
+ if (mp) {
+ if (flag)
+ output("\n");
+ flag = 0;
+ mp0 = mp;
+ outbasetype(mp->othername ? mp->rectype : mp->type,
+ ODECL_CHARSTAR|ODECL_FREEARRAY);
+ output(" \005");
+ while (mp) {
+ if (!mp->wasdeclared) {
+ if (mp == mp0 ||
+ mixable(mp0, mp, 1, ODECL_CHARSTAR|ODECL_FREEARRAY)) {
+ if (mp != mp0)
+ if (spacecommas)
+ output(",\001 ");
+ else
+ output(",\001");
+ name = (mp->othername) ? mp->othername : mp->name;
+ tp = (mp->othername) ? mp->rectype : mp->type;
+ outdeclarator(tp, name,
+ ODECL_CHARSTAR|ODECL_FREEARRAY);
+ mp->wasdeclared = 1;
+ } else
+ if (mixvars != 1)
+ break;
+ }
+ mp = mp->xnext;
+ }
+ output(";\n");
+ } else
+ done = 1;
+ } while (!done);
+ for (mp0 = ftype->fbase; mp0 && (mp0->type != tp_strptr ||
+ !mp0->anyvarflag); mp0 = mp0->xnext) ;
+ if (mp0) {
+ output("int ");
+ for (mp = mp0; mp; mp = mp->xnext) {
+ if (mp->type == tp_strptr && mp->anyvarflag) {
+ if (mp != mp0) {
+ if (mixvars == 0)
+ output(";\nint ");
+ else if (spacecommas)
+ output(",\001 ");
+ else
+ output(",\001");
+ }
+ output(format_s(name_STRMAX, mp->name));
+ }
+ }
+ output(";\n");
+ }
+ if (ftype->meaning && ftype->meaning->ctx->kind == MK_FUNCTION &&
+ ftype->meaning->ctx->varstructflag) {
+ if (flag)
+ output("\n");
+ output("struct ");
+ output(format_s(name_LOC, ftype->meaning->ctx->name));
+ output(" *");
+ output(format_s(name_LINK, ftype->meaning->ctx->name));
+ output(";\n");
+ }
+ }
+
+
+
+
+ void makevarstruct(func)
+ Meaning *func;
+ {
+ int flag = 0;
+ int saveindent;
+
+ outsection(minfuncspace);
+ output(format_s("\n/* Local variables for %s: */\n", func->name));
+ output("struct ");
+ output(format_s(name_LOC, func->name));
+ output(" {\n");
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structindent);
+ if (func->ctx->kind == MK_FUNCTION && func->ctx->varstructflag) {
+ output("struct ");
+ output(format_s(name_LOC, func->ctx->name));
+ output(" *");
+ output(format_s(name_LINK, func->ctx->name));
+ output(";\n");
+ flag++;
+ }
+ flag += declarevars(func, 1);
+ if (!flag) /* Avoid generating an empty struct */
+ output("int _meef_;\n"); /* (I don't think this will ever happen) */
+ outindent = saveindent;
+ output("} ;\n");
+ outsection(minfuncspace);
+ strlist_insert(&varstructdecllist, func->name);
+ }
+
+
+
+
+
+
+ Type *maketype(kind)
+ enum typekind kind;
+ {
+ Type *tp;
+ tp = ALLOC(1, Type, types);
+ tp->kind = kind;
+ tp->basetype = NULL;
+ tp->indextype = NULL;
+ tp->pointertype = NULL;
+ tp->meaning = NULL;
+ tp->fbase = NULL;
+ tp->smin = NULL;
+ tp->smax = NULL;
+ tp->issigned = 0;
+ tp->dumped = 0;
+ tp->structdefd = 0;
+ tp->preserved = 0;
+ return tp;
+ }
+
+
+
+
+ Type *makesubrangetype(type, smin, smax)
+ Type *type;
+ Expr *smin, *smax;
+ {
+ Type *tp;
+
+ if (type->kind == TK_SUBR)
+ type = type->basetype;
+ tp = maketype(TK_SUBR);
+ tp->basetype = type;
+ tp->smin = smin;
+ tp->smax = smax;
+ return tp;
+ }
+
+
+
+ Type *makesettype(setof)
+ Type *setof;
+ {
+ Type *tp;
+ long smax;
+
+ if (ord_range(setof, NULL, &smax) && smax < setbits && smallsetconst >= 0)
+ tp = maketype(TK_SMALLSET);
+ else
+ tp = maketype(TK_SET);
+ tp->basetype = tp_integer;
+ tp->indextype = setof;
+ return tp;
+ }
+
+
+
+ Type *makestringtype(len)
+ int len;
+ {
+ Type *type;
+ int index;
+
+ len |= 1;
+ if (len >= stringceiling)
+ type = tp_str255;
+ else {
+ index = (len-1) / 2;
+ if (stringtypecache[index])
+ return stringtypecache[index];
+ type = maketype(TK_STRING);
+ type->basetype = tp_char;
+ type->indextype = makesubrangetype(tp_integer,
+ makeexpr_long(0),
+ makeexpr_long(len));
+ stringtypecache[index] = type;
+ }
+ return type;
+ }
+
+
+
+ Type *makepointertype(type)
+ Type *type;
+ {
+ Type *tp;
+
+ if (type->pointertype)
+ return type->pointertype;
+ tp = maketype(TK_POINTER);
+ tp->basetype = type;
+ type->pointertype = tp;
+ return tp;
+ }
+
+
+
+
+
+ Value p_constant(type)
+ Type *type;
+ {
+ Value val;
+ Expr *ex;
+
+ ex = p_expr(type);
+ if (type)
+ ex = gentle_cast(ex, type);
+ val = eval_expr(ex);
+ freeexpr(ex);
+ if (!val.type) {
+ warning("Expected a constant [127]");
+ val.type = (type) ? type : tp_integer;
+ }
+ return val;
+ }
+
+
+
+
+ int typebits(smin, smax)
+ long smin, smax;
+ {
+ unsigned long size;
+ int bits;
+
+ if (smin >= 0 || (smin == -1 && smax == 0)) {
+ bits = 1;
+ size = smax;
+ } else {
+ bits = 2;
+ smin = -1L - smin;
+ if (smin >= smax)
+ size = smin;
+ else
+ size = smax;
+ }
+ while (size > 1) {
+ bits++;
+ size >>= 1;
+ }
+ return bits;
+ }
+
+
+ int packedsize(fname, typep, sizep, mode)
+ char *fname;
+ Type **typep;
+ long *sizep;
+ int mode;
+ {
+ Type *tp = *typep;
+ long smin, smax;
+ int res, issigned;
+ short savefold;
+ long size;
+
+ if (packing == 0) /* suppress packing */
+ return 0;
+ if (tp->kind != TK_SUBR && tp->kind != TK_INTEGER && tp->kind != TK_ENUM &&
+ tp->kind != TK_CHAR && tp->kind != TK_BOOLEAN)
+ return 0;
+ if (tp == tp_unsigned)
+ return 0;
+ if (!ord_range(tp, &smin, &smax)) {
+ savefold = foldconsts;
+ foldconsts = 1;
+ res = ord_range(tp, &smin, &smax);
+ foldconsts = savefold;
+ if (res) {
+ note(format_s("Field width for %s is based on expansion of #defines [103]",
+ fname));
+ } else {
+ note(format_ss("Cannot compute size of field %s; assuming %s [104]",
+ fname, integername));
+ return 0;
+ }
+ } else {
+ if (tp->kind == TK_ENUM)
+ note(format_ssd("Field width for %s assumes enum%s has %d elements [105]",
+ fname,
+ (tp->meaning) ? format_s(" %s", tp->meaning->name) : "",
+ smax + 1));
+ }
+ issigned = (smin < 0);
+ size = typebits(smin, smax);
+ if (size >= ((sizeof_long > 0) ? sizeof_long : 32))
+ return 0;
+ if (packing != 1) {
+ if (size <= 8)
+ size = 8;
+ else if (size <= 16)
+ size = 16;
+ else
+ return 0;
+ }
+ if (!issigned) {
+ *typep = (mode == 0) ? tp_int : tp_uint;
+ } else {
+ if (mode == 2 && !hassignedchar && !*signextname)
+ return 0;
+ *typep = (mode == 1) ? tp_int : tp_sint;
+ }
+ *sizep = size;
+ return issigned;
+ }
+
+
+
+ Static void fielddecl(mp, type, tp2, val, ispacked, aligned)
+ Meaning *mp;
+ Type **type, **tp2;
+ long *val;
+ int ispacked, *aligned;
+ {
+ long smin, smax, smin2, smax2;
+
+ *tp2 = *type;
+ *val = 0;
+ if (ispacked && !mp->constdefn && *type != tp_unsigned) {
+ (void)packedsize(mp->sym->name, tp2, val, signedfield);
+ if (*aligned && *val &&
+ (ord_type(*type)->kind == TK_CHAR ||
+ ord_type(*type)->kind == TK_INTEGER) &&
+ ord_range(findbasetype(*type, 0), &smin, &smax)) {
+ if (ord_range(*type, &smin2, &smax2)) {
+ if (typebits(smin, smax) == 16 &&
+ typebits(smin2, smax2) == 8 && *val == 8) {
+ *tp2 = tp_abyte;
+ }
+ }
+ if (typebits(smin, smax) == *val &&
+ *val != 7) { /* don't be fooled by tp_abyte */
+ /* don't need to use a bit-field for this field */
+ /* so not specifying one may make it more efficient */
+ /* (and also helps to simulate HP's $allow_packed$ mode) */
+ *val = 0;
+ *tp2 = *type;
+ }
+ }
+ if (*aligned && *val == 8 &&
+ (ord_type(*type)->kind == TK_BOOLEAN ||
+ ord_type(*type)->kind == TK_ENUM)) {
+ *val = 0;
+ *tp2 = tp_ubyte;
+ }
+ }
+ if (*val != 8 && *val != 16)
+ *aligned = (*val == 0);
+ }
+
+
+
+ /* This function locates byte-sized fields which were unaligned, but which
+ are followed by aligned quantities so that they can be made aligned
+ with no loss in storage efficiency. */
+
+ Static void realignfields(firstmp, stopmp)
+ Meaning *firstmp, *stopmp;
+ {
+ Meaning *mp;
+
+ for (mp = firstmp; mp && mp != stopmp; mp = mp->cnext) {
+ if (mp->kind == MK_FIELD) {
+ if (mp->val.i == 16) {
+ if (mp->type == tp_uint)
+ mp->type = tp_ushort;
+ else
+ mp->type = tp_sshort;
+ mp->val.i = 0;
+ } else if (mp->val.i == 8) {
+ if (mp->type == tp_uint) {
+ mp->type = tp_ubyte;
+ mp->val.i = 0;
+ } else if (hassignedchar || signedchars == 1) {
+ mp->type = tp_sbyte;
+ mp->val.i = 0;
+ } else
+ mp->type = tp_abyte;
+ }
+ }
+ }
+ }
+
+ static void tryrealignfields(firstmp)
+ Meaning *firstmp;
+ {
+ Meaning *mp, *head;
+
+ head = NULL;
+ for (mp = firstmp; mp; mp = mp->cnext) {
+ if (mp->kind == MK_FIELD) {
+ if ((mp->val.i == 8 &&
+ (mp->type == tp_uint ||
+ hassignedchar || signedchars == 1)) ||
+ mp->val.i == 16) {
+ if (!head)
+ head = mp;
+ } else {
+ if (mp->val.i == 0)
+ realignfields(head, mp);
+ head = NULL;
+ }
+ }
+ }
+ realignfields(head, NULL);
+ }
+
+
+
+ void decl_comments(mp)
+ Meaning *mp;
+ {
+ Strlist *cmt;
+
+ if (spitcomments != 1) {
+ changecomments(curcomments, -1, -1, CMT_PRE, 0);
+ strlist_mix(&mp->comments, curcomments);
+ curcomments = NULL;
+ cmt = grabcomment(CMT_TRAIL);
+ if (cmt) {
+ changecomments(mp->comments, CMT_TRAIL, -1, CMT_PRE, -1);
+ strlist_mix(&mp->comments, cmt);
+ }
+ if (mp->comments)
+ mp->refcount++; /* force it to be included if it has comments */
+ }
+ }
+
+
+
+
+
+ Static void p_fieldlist(tp, flast, ispacked, tname)
+ Type *tp;
+ Meaning **flast;
+ int ispacked;
+ Meaning *tname;
+ {
+ Meaning *firstm, *lastm, *veryfirstm, *dtype;
+ Symbol *sym;
+ Type *type, *tp2;
+ long li1, li2;
+ int aligned, constflag, volatileflag;
+ short saveskipind;
+ Strlist *l1;
+
+ saveskipind = skipindices;
+ skipindices = 0;
+ aligned = 1;
+ lastm = NULL;
+ veryfirstm = NULL;
+ while (curtok == TOK_IDENT) {
+ firstm = addfield(curtoksym, &flast, tp, tname);
+ if (!veryfirstm)
+ veryfirstm = firstm;
+ lastm = firstm;
+ gettok();
+ decl_comments(lastm);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ if (wexpecttok(TOK_IDENT))
+ lastm = addfield(curtoksym, &flast, tp, tname);
+ gettok();
+ decl_comments(lastm);
+ }
+ if (wneedtok(TOK_COLON)) {
+ constflag = volatileflag = 0;
+ p_attributes();
+ if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
+ constflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
+ volatileflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+ type = p_type(firstm);
+ decl_comments(lastm);
+ fielddecl(firstm, &type, &tp2, &li1, ispacked, &aligned);
+ dtype = validatedtype(dtype, type);
+ for (;;) {
+ firstm->type = tp2;
+ firstm->dtype = dtype;
+ firstm->val.type = type;
+ firstm->val.i = li1;
+ firstm->constqual = constflag;
+ firstm->volatilequal = volatileflag;
+ tp->meaning = tname;
+ setupfilevar(firstm);
+ tp->meaning = NULL;
+ if (firstm == lastm)
+ break;
+ firstm = firstm->cnext;
+ }
+ } else
+ skiptotoken2(TOK_SEMI, TOK_CASE);
+ if (curtok == TOK_SEMI)
+ gettok();
+ }
+ if (curtok == TOK_CASE) {
+ gettok();
+ if (curtok == TOK_COLON)
+ gettok();
+ wexpecttok(TOK_IDENT);
+ sym = curtoksym;
+ if (curtokmeaning)
+ type = curtokmeaning->type;
+ gettok();
+ if (curtok == TOK_COLON) {
+ firstm = addfield(sym, &flast, tp, tname);
+ if (!veryfirstm)
+ veryfirstm = firstm;
+ gettok();
+ firstm->isforward = 1;
+ firstm->val.type = type = p_type(firstm);
+ fielddecl(firstm, &firstm->val.type, &firstm->type, &firstm->val.i,
+ ispacked, &aligned);
+ } else {
+ firstm = NULL;
+ }
+ if (!wneedtok(TOK_OF)) {
+ skiptotoken2(TOK_END, TOK_RPAR);
+ goto bounce;
+ }
+ if (firstm)
+ decl_comments(firstm);
+ while (curtok == TOK_VBAR)
+ gettok();
+ while (curtok != TOK_END && curtok != TOK_RPAR) {
+ firstm = NULL;
+ for (;;) {
+ lastm = addfield(NULL, &flast, tp, tname);
+ if (!firstm)
+ firstm = lastm;
+ checkkeyword(TOK_OTHERWISE);
+ if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
+ lastm->val = make_ord(type, 999);
+ break;
+ } else {
+ lastm->val = p_constant(type);
+ if (curtok == TOK_DOTS) {
+ gettok();
+ li1 = ord_value(lastm->val);
+ li2 = ord_value(p_constant(type));
+ while (++li1 <= li2) {
+ lastm = addfield(NULL, &flast, tp, tname);
+ lastm->val = make_ord(type, li1);
+ }
+ }
+ }
+ if (curtok == TOK_COMMA)
+ gettok();
+ else
+ break;
+ }
+ if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
+ gettok();
+ } else if (!wneedtok(TOK_COLON) ||
+ (!modula2 && !wneedtok(TOK_LPAR))) {
+ skiptotoken2(TOK_END, TOK_RPAR);
+ goto bounce;
+ }
+ p_fieldlist(tp, &lastm->ctx, ispacked, tname);
+ while (firstm != lastm) {
+ firstm->ctx = lastm->ctx;
+ firstm = firstm->cnext;
+ }
+ if (modula2) {
+ while (curtok == TOK_VBAR)
+ gettok();
+ } else {
+ if (!wneedtok(TOK_RPAR))
+ skiptotoken(TOK_RPAR);
+ }
+ if (curtok == TOK_SEMI)
+ gettok();
+ }
+ if (modula2) {
+ wneedtok(TOK_END);
+ if (curtok == TOK_IDENT) {
+ note("Record variants supported only at end of record [106]");
+ p_fieldlist(tp, &lastm->ctx, ispacked, tname);
+ }
+ }
+ }
+ tryrealignfields(veryfirstm);
+ if (lastm && curtok == TOK_END) {
+ strlist_mix(&lastm->comments, curcomments);
+ curcomments = NULL;
+ }
+
+ bounce:
+ skipindices = saveskipind;
+ }
+
+
+
+ Static Type *p_arraydecl(tname, ispacked, confp)
+ char *tname;
+ int ispacked;
+ Meaning ***confp;
+ {
+ Type *tp, *tp2;
+ Meaning *mp;
+ Expr *ex;
+ long size, smin, smax, bitsize, fullbitsize;
+ int issigned, bpower, hasrange;
+
+ tp = maketype(TK_ARRAY);
+ if (confp == NULL) {
+ tp->indextype = p_type(NULL);
+ if (tp->indextype->kind == TK_SUBR) {
+ if (ord_range(tp->indextype, &smin, NULL) &&
+ smin > 0 && smin <= skipindices && !ispacked) {
+ tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
+ ex = makeexpr_val(make_ord(tp->indextype->basetype, 0));
+ tp->indextype = makesubrangetype(tp->indextype->basetype,
+ ex,
+ copyexpr(tp->indextype->smax));
+ }
+ }
+ } else {
+ if (modula2) {
+ **confp = mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
+ mp->fakeparam = 1;
+ mp->constqual = 1;
+ mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
+ mp->xnext->fakeparam = 1;
+ mp->xnext->constqual = 1;
+ *confp = &mp->xnext->xnext;
+ tp2 = maketype(TK_SUBR);
+ tp2->basetype = tp_integer;
+ mp->type = tp_integer;
+ mp->xnext->type = mp->type;
+ tp2->smin = makeexpr_long(0);
+ tp2->smax = makeexpr_minus(makeexpr_var(mp->xnext),
+ makeexpr_var(mp));
+ tp->indextype = tp2;
+ tp->structdefd = 1;
+ } else {
+ wexpecttok(TOK_IDENT);
+ tp2 = maketype(TK_SUBR);
+ if (peeknextchar() != ',' &&
+ (!curtokmeaning || curtokmeaning->kind != MK_TYPE)) {
+ mp = addmeaning(curtoksym, MK_PARAM);
+ gettok();
+ wneedtok(TOK_DOTS);
+ wexpecttok(TOK_IDENT);
+ mp->xnext = addmeaning(curtoksym, MK_PARAM);
+ gettok();
+ if (wneedtok(TOK_COLON)) {
+ tp2->basetype = p_type(NULL);
+ } else {
+ tp2->basetype = tp_integer;
+ }
+ } else {
+ mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
+ mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
+ tp2->basetype = p_type(NULL);
+ }
+ mp->fakeparam = 1;
+ mp->constqual = 1;
+ mp->xnext->fakeparam = 1;
+ mp->xnext->constqual = 1;
+ **confp = mp;
+ *confp = &mp->xnext->xnext;
+ mp->type = tp2->basetype;
+ mp->xnext->type = tp2->basetype;
+ tp2->smin = makeexpr_var(mp);
+ tp2->smax = makeexpr_var(mp->xnext);
+ tp->indextype = tp2;
+ tp->structdefd = 1; /* conformant array flag */
+ }
+ }
+ if (curtok == TOK_COMMA || curtok == TOK_SEMI) {
+ gettok();
+ tp->basetype = p_arraydecl(tname, ispacked, confp);
+ return tp;
+ } else {
+ if (!modula2) {
+ if (!wneedtok(TOK_RBR))
+ skiptotoken(TOK_OF);
+ }
+ if (!wneedtok(TOK_OF))
+ skippasttotoken(TOK_OF, TOK_COMMA);
+ checkkeyword(TOK_VARYING);
+ if (confp != NULL &&
+ (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
+ curtok == TOK_VARYING)) {
+ tp->basetype = p_conformant_array(tname, confp);
+ } else {
+ tp->fbase = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+ tp->basetype = p_type(NULL);
+ tp->fbase = validatedtype(tp->fbase, tp->basetype);
+ }
+ if (!ispacked)
+ return tp;
+ size = 0;
+ tp2 = tp->basetype;
+ if (!tname)
+ tname = "array";
+ issigned = packedsize(tname, &tp2, &size, 1);
+ if (!size || size > 8 ||
+ (issigned && !packsigned) ||
+ (size > 4 &&
+ (!issigned || (signedchars == 1 || hassignedchar))))
+ return tp;
+ bpower = 0;
+ while ((1<<bpower) < size)
+ bpower++; /* round size up to power of two */
+ size = 1<<bpower; /* size = # bits in an array element */
+ tp->escale = bpower;
+ tp->issigned = issigned;
+ hasrange = ord_range(tp->indextype, &smin, &smax) &&
+ (smax < 100000); /* don't be confused by giant arrays */
+ if (hasrange &&
+ (bitsize = (smax - smin + 1) * size)
+ <= ((sizeof_integer > 0) ? sizeof_integer : 32)) {
+ if (bitsize > ((sizeof_short > 0) ? sizeof_short : 16)) {
+ tp2 = (issigned) ? tp_integer : tp_unsigned;
+ fullbitsize = ((sizeof_integer > 0) ? sizeof_integer : 32);
+ } else if (bitsize > ((sizeof_char > 0) ? sizeof_char : 8) ||
+ (issigned && !(signedchars == 1 || hassignedchar))) {
+ tp2 = (issigned) ? tp_sshort : tp_ushort;
+ fullbitsize = ((sizeof_short > 0) ? sizeof_short : 16);
+ } else {
+ tp2 = (issigned) ? tp_sbyte : tp_ubyte;
+ fullbitsize = ((sizeof_char > 0) ? sizeof_char : 8);
+ }
+ tp->kind = TK_SMALLARRAY;
+ if (ord_range(tp->indextype, &smin, NULL) &&
+ smin > 0 && smin <= fullbitsize - bitsize) {
+ tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
+ ex = makeexpr_val(make_ord(tp->indextype->basetype, 0));
+ tp->indextype = makesubrangetype(tp->indextype->basetype, ex,
+ copyexpr(tp->indextype->smax));
+ }
+ } else {
+ if (!issigned)
+ tp2 = tp_ubyte;
+ else if (signedchars == 1 || hassignedchar)
+ tp2 = tp_sbyte;
+ else
+ tp2 = tp_sshort;
+ }
+ tp->smax = makeexpr_type(tp->basetype);
+ tp->basetype = tp2;
+ return tp;
+ }
+ }
+
+
+
+ Static Type *p_conformant_array(tname, confp)
+ char *tname;
+ Meaning ***confp;
+ {
+ int ispacked;
+ Meaning *mp;
+ Type *tp, *tp2;
+
+ p_attributes();
+ ignore_attributes();
+ if (curtok == TOK_PACKED) {
+ ispacked = 1;
+ gettok();
+ } else
+ ispacked = 0;
+ checkkeyword(TOK_VARYING);
+ if (curtok == TOK_VARYING) {
+ gettok();
+ wneedtok(TOK_LBR);
+ wexpecttok(TOK_IDENT);
+ mp = addmeaning(curtoksym, MK_PARAM);
+ mp->fakeparam = 1;
+ mp->constqual = 1;
+ **confp = mp;
+ *confp = &mp->xnext;
+ mp->type = tp_integer;
+ tp2 = maketype(TK_SUBR);
+ tp2->basetype = tp_integer;
+ tp2->smin = makeexpr_long(1);
+ tp2->smax = makeexpr_var(mp);
+ tp = maketype(TK_STRING);
+ tp->indextype = tp2;
+ tp->basetype = tp_char;
+ tp->structdefd = 1; /* conformant array flag */
+ gettok();
+ wneedtok(TOK_RBR);
+ skippasttoken(TOK_OF);
+ tp->basetype = p_type(NULL);
+ return tp;
+ }
+ if (wneedtok(TOK_ARRAY) &&
+ (modula2 || wneedtok(TOK_LBR))) {
+ return p_arraydecl(tname, ispacked, confp);
+ } else {
+ return tp_integer;
+ }
+ }
+
+
+
+
+ /* VAX Pascal: */
+ void p_attributes()
+ {
+ Strlist *l1;
+
+ if (modula2)
+ return;
+ while (curtok == TOK_LBR) {
+ implementationmodules = 1; /* auto-detect VAX Pascal */
+ do {
+ gettok();
+ if (!wexpecttok(TOK_IDENT)) {
+ skippasttoken(TOK_RBR);
+ return;
+ }
+ l1 = strlist_append(&attrlist, strupper(curtokbuf));
+ l1->value = -1;
+ gettok();
+ if (curtok == TOK_LPAR) {
+ gettok();
+ if (!strcmp(l1->s, "CHECK") ||
+ !strcmp(l1->s, "OPTIMIZE") ||
+ !strcmp(l1->s, "KEY") ||
+ !strcmp(l1->s, "COMMON") ||
+ !strcmp(l1->s, "PSECT") ||
+ !strcmp(l1->s, "EXTERNAL") ||
+ !strcmp(l1->s, "GLOBAL") ||
+ !strcmp(l1->s, "WEAK_EXTERNAL") ||
+ !strcmp(l1->s, "WEAK_GLOBAL")) {
+ l1->value = (long)stralloc(curtokbuf);
+ gettok();
+ while (curtok == TOK_COMMA) {
+ gettok();
+ gettok();
+ }
+ } else if (!strcmp(l1->s, "INHERIT") ||
+ !strcmp(l1->s, "IDENT") ||
+ !strcmp(l1->s, "ENVIRONMENT")) {
+ p_expr(NULL);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ p_expr(NULL);
+ }
+ } else {
+ l1->value = ord_value(p_constant(tp_integer));
+ while (curtok == TOK_COMMA) {
+ gettok();
+ p_expr(NULL);
+ }
+ }
+ if (!wneedtok(TOK_RPAR)) {
+ skippasttotoken(TOK_RPAR, TOK_LBR);
+ }
+ }
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_RBR)) {
+ skippasttoken(TOK_RBR);
+ }
+ }
+ }
+
+
+ void ignore_attributes()
+ {
+ while (attrlist) {
+ if (strcmp(attrlist->s, "HIDDEN") &&
+ strcmp(attrlist->s, "INHERIT") &&
+ strcmp(attrlist->s, "ENVIRONMENT"))
+ warning(format_s("Type attribute %s ignored [128]", attrlist->s));
+ strlist_eat(&attrlist);
+ }
+ }
+
+
+ int size_attributes()
+ {
+ int size = -1;
+ Strlist *l1;
+
+ if ((l1 = strlist_find(attrlist, "BIT")) != NULL)
+ size = 1;
+ else if ((l1 = strlist_find(attrlist, "BYTE")) != NULL)
+ size = 8;
+ else if ((l1 = strlist_find(attrlist, "WORD")) != NULL)
+ size = 16;
+ else if ((l1 = strlist_find(attrlist, "LONG")) != NULL)
+ size = 32;
+ else if ((l1 = strlist_find(attrlist, "QUAD")) != NULL)
+ size = 64;
+ else if ((l1 = strlist_find(attrlist, "OCTA")) != NULL)
+ size = 128;
+ else
+ return -1;
+ if (l1->value >= 0)
+ size *= l1->value;
+ strlist_delete(&attrlist, l1);
+ return size;
+ }
+
+
+ void p_mech_spec(doref)
+ int doref;
+ {
+ if (curtok == TOK_IDENT && doref &&
+ !strcicmp(curtokbuf, "%REF")) {
+ note("Mechanism specified %REF treated like VAR [107]");
+ curtok = TOK_VAR;
+ return;
+ }
+ if (curtok == TOK_IDENT &&
+ (!strcicmp(curtokbuf, "%REF") ||
+ !strcicmp(curtokbuf, "%IMMED") ||
+ !strcicmp(curtokbuf, "%DESCR") ||
+ !strcicmp(curtokbuf, "%STDESCR"))) {
+ note(format_s("Mechanism specifier %s ignored [108]", curtokbuf));
+ gettok();
+ }
+ }
+
+
+ Type *p_modula_subrange(basetype)
+ Type *basetype;
+ {
+ Type *tp;
+ Value val;
+
+ wneedtok(TOK_LBR);
+ tp = maketype(TK_SUBR);
+ tp->smin = p_ord_expr();
+ if (basetype)
+ tp->smin = gentle_cast(tp->smin, basetype);
+ if (wexpecttok(TOK_DOTS)) {
+ gettok();
+ tp->smax = p_ord_expr();
+ if (tp->smax->val.type->kind == TK_REAL &&
+ tp->smax->kind == EK_CONST &&
+ strlen(tp->smax->val.s) == 12 &&
+ strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
+ strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
+ tp = tp_unsigned;
+ } else if (basetype) {
+ tp->smin = gentle_cast(tp->smin, basetype);
+ tp->basetype = basetype;
+ } else {
+ basetype = ord_type(tp->smin->val.type);
+ if (basetype->kind == TK_INTEGER) {
+ val = eval_expr(tp->smin);
+ if (val.type && val.i >= 0)
+ basetype = tp_unsigned;
+ else
+ basetype = tp_integer;
+ }
+ tp->basetype = basetype;
+ }
+ } else {
+ tp = tp_integer;
+ }
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ return tp;
+ }
+
+
+ void makefakestruct(tp, tname)
+ Type *tp;
+ Meaning *tname;
+ {
+ Symbol *sym;
+
+ if (!tname || blockkind == TOK_IMPORT)
+ return;
+ while (tp && (tp->kind == TK_ARRAY || tp->kind == TK_FILE))
+ tp = tp->basetype;
+ if (tp && tp->kind == TK_RECORD && !tp->meaning) {
+ sym = findsymbol(format_s(name_FAKESTRUCT, tname->name));
+ silentalreadydef++;
+ tp->meaning = addmeaning(sym, MK_TYPE);
+ silentalreadydef--;
+ tp->meaning->type = tp;
+ tp->meaning->refcount++;
+ declaretype(tp->meaning);
+ }
+ }
+
+
+ Type *p_type(tname)
+ Meaning *tname;
+ {
+ Type *tp;
+ int ispacked = 0;
+ Meaning **flast;
+ Meaning *mp;
+ Strlist *sl;
+ int num, isfunc, saveind, savenotephase, sizespec;
+ Expr *ex;
+ Value val;
+ static int proctypecount = 0;
+
+ p_attributes();
+ sizespec = size_attributes();
+ ignore_attributes();
+ tp = tp_integer;
+ if (curtok == TOK_PACKED) {
+ ispacked = 1;
+ gettok();
+ }
+ checkkeyword(TOK_VARYING);
+ if (modula2)
+ checkkeyword(TOK_POINTER);
+ switch (curtok) {
+
+ case TOK_RECORD:
+ gettok();
+ savenotephase = notephase;
+ notephase = 1;
+ tp = maketype(TK_RECORD);
+ p_fieldlist(tp, &(tp->fbase), ispacked, tname);
+ notephase = savenotephase;
+ if (!wneedtok(TOK_END)) {
+ skippasttoken(TOK_END);
+ }
+ break;
+
+ case TOK_ARRAY:
+ gettok();
+ if (!modula2) {
+ if (!wneedtok(TOK_LBR))
+ break;
+ }
+ tp = p_arraydecl(tname ? tname->name : NULL, ispacked, NULL);
+ makefakestruct(tp, tname);
+ break;
+
+ case TOK_VARYING:
+ gettok();
+ tp = maketype(TK_STRING);
+ if (wneedtok(TOK_LBR)) {
+ ex = p_ord_expr();
+ if (!wneedtok(TOK_RBR))
+ skippasttoken(TOK_RBR);
+ } else
+ ex = makeexpr_long(stringdefault);
+ if (wneedtok(TOK_OF))
+ tp->basetype = p_type(NULL);
+ else
+ tp->basetype = tp_char;
+ val = eval_expr(ex);
+ if (val.type) {
+ if (val.i > 255 && val.i > stringceiling) {
+ note(format_d("Strings longer than %d may have problems [109]",
+ stringceiling));
+ }
+ if (stringceiling != 255 &&
+ (val.i >= 255 || val.i > stringceiling)) {
+ freeexpr(ex);
+ ex = makeexpr_long(stringceiling);
+ }
+ }
+ tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
+ break;
+
+ case TOK_SET:
+ gettok();
+ if (!wneedtok(TOK_OF))
+ break;
+ tp = p_type(NULL);
+ if (tp == tp_integer || tp == tp_unsigned)
+ tp = makesubrangetype(tp, makeexpr_long(0),
+ makeexpr_long(defaultsetsize-1));
+ if (tp->kind == TK_ENUM && !tp->meaning && useenum) {
+ outbasetype(tp, 0);
+ output(";");
+ }
+ tp = makesettype(tp);
+ break;
+
+ case TOK_FILE:
+ gettok();
+ if (structfilesflag ||
+ (tname && strlist_cifind(structfiles, tname->name)))
+ tp = maketype(TK_BIGFILE);
+ else
+ tp = maketype(TK_FILE);
+ if (curtok == TOK_OF) {
+ gettok();
+ tp->basetype = p_type(NULL);
+ } else {
+ tp->basetype = tp_abyte;
+ }
+ if (tp->basetype->kind == TK_CHAR && charfiletext) {
+ if (tp->kind == TK_FILE)
+ tp = tp_text;
+ else
+ tp = tp_bigtext;
+ } else {
+ if (tp->kind == TK_FILE) {
+ makefakestruct(tp, tname);
+ tp = makepointertype(tp);
+ }
+ }
+ break;
+
+ case TOK_PROCEDURE:
+ case TOK_FUNCTION:
+ isfunc = (curtok == TOK_FUNCTION);
+ gettok();
+ if (curtok != TOK_LPAR && !isfunc && hasstaticlinks == 1) {
+ tp = tp_proc;
+ break;
+ }
+ proctypecount++;
+ mp = addmeaning(findsymbol(format_d("__PROCPTR%d",
+ proctypecount)),
+ MK_FUNCTION);
+ pushctx(mp);
+ tp = maketype((hasstaticlinks != 0) ? TK_PROCPTR : TK_CPROCPTR);
+ tp->basetype = p_funcdecl(&isfunc, 1);
+ tp->fbase = mp; /* (saved, but not currently used) */
+ tp->escale = hasstaticlinks;
+ popctx();
+ break;
+
+ case TOK_HAT:
+ case TOK_ADDR:
+ case TOK_POINTER:
+ if (curtok == TOK_POINTER) {
+ gettok();
+ wneedtok(TOK_TO);
+ if (curtok == TOK_IDENT && !strcmp(curtokbuf, "WORD")) {
+ tp = tp_anyptr;
+ gettok();
+ break;
+ }
+ } else
+ gettok();
+ p_attributes();
+ ignore_attributes();
+ tp = maketype(TK_POINTER);
+ if (curtok == TOK_IDENT &&
+ (!curtokmeaning || curtokmeaning->kind != MK_TYPE ||
+ (deferallptrs && curtokmeaning->ctx != curctx &&
+ curtokmeaning->ctx != nullctx))) {
+ struct ptrdesc *pd;
+ pd = ALLOC(1, struct ptrdesc, ptrdescs);
+ pd->sym = curtoksym;
+ pd->tp = tp;
+ pd->next = ptrbase;
+ ptrbase = pd;
+ tp->basetype = tp_abyte;
+ tp->smin = makeexpr_name(curtokcase, tp_integer);
+ anydeferredptrs = 1;
+ gettok();
+ } else {
+ tp->fbase = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+ tp->basetype = p_type(NULL);
+ tp->fbase = validatedtype(tp->fbase, tp->basetype);
+ if (!tp->basetype->pointertype)
+ tp->basetype->pointertype = tp;
+ }
+ break;
+
+ case TOK_LPAR:
+ if (!useenum)
+ outsection(minorspace);
+ enum_tname = tname;
+ tp = maketype(TK_ENUM);
+ flast = &(tp->fbase);
+ num = 0;
+ do {
+ gettok();
+ if (!wexpecttok(TOK_IDENT)) {
+ skiptotoken(TOK_RPAR);
+ break;
+ }
+ sl = strlist_find(constmacros, curtoksym->name);
+ mp = addmeaningas(curtoksym, MK_CONST, MK_VARIANT);
+ mp->val.type = tp;
+ mp->val.i = num++;
+ mp->type = tp;
+ if (sl) {
+ mp->constdefn = (Expr *)sl->value;
+ mp->anyvarflag = 1; /* Make sure constant is folded */
+ strlist_delete(&constmacros, sl);
+ if (mp->constdefn->kind == EK_NAME)
+ strchange(&mp->name, mp->constdefn->val.s);
+ } else {
+ if (!useenum) {
+ output(format_s("#define %s", mp->name));
+ mp->isreturn = 1;
+ out_spaces(constindent, 0, 0, 0);
+ saveind = outindent;
+ outindent = cur_column();
+ output(format_d("%d\n", mp->val.i));
+ outindent = saveind;
+ }
+ }
+ *flast = mp;
+ flast = &(mp->xnext);
+ gettok();
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_RPAR))
+ skippasttoken(TOK_RPAR);
+ tp->smin = makeexpr_long(0);
+ tp->smax = makeexpr_long(num-1);
+ if (!useenum)
+ outsection(minorspace);
+ break;
+
+ case TOK_LBR:
+ tp = p_modula_subrange(NULL);
+ break;
+
+ case TOK_IDENT:
+ if (!curtokmeaning) {
+ undefsym(curtoksym);
+ tp = tp_integer;
+ mp = addmeaning(curtoksym, MK_TYPE);
+ mp->type = tp;
+ gettok();
+ break;
+ } else if (curtokmeaning == mp_string) {
+ gettok();
+ tp = maketype(TK_STRING);
+ tp->basetype = tp_char;
+ if (curtok == TOK_LBR) {
+ gettok();
+ ex = p_ord_expr();
+ if (!wneedtok(TOK_RBR))
+ skippasttoken(TOK_RBR);
+ } else {
+ ex = makeexpr_long(stringdefault);
+ }
+ val = eval_expr(ex);
+ if (val.type && stringceiling != 255 &&
+ (val.i >= 255 || val.i > stringceiling)) {
+ freeexpr(ex);
+ ex = makeexpr_long(stringceiling);
+ }
+ tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
+ break;
+ } else if (curtokmeaning->kind == MK_TYPE) {
+ tp = curtokmeaning->type;
+ if (sizespec > 0) {
+ if (ord_type(tp)->kind == TK_INTEGER && sizespec <= 32) {
+ if (checkconst(tp->smin, 0)) {
+ if (sizespec == 32)
+ tp = tp_unsigned;
+ else
+ tp = makesubrangetype(tp_unsigned,
+ makeexpr_long(0),
+ makeexpr_long((1L << sizespec) - 1));
+ } else {
+ tp = makesubrangetype(tp_integer,
+ makeexpr_long(- ((1L << (sizespec-1)))),
+ makeexpr_long((1L << (sizespec-1)) - 1));
+ }
+ sizespec = -1;
+ }
+ }
+ gettok();
+ if (curtok == TOK_LBR) {
+ if (modula2) {
+ tp = p_modula_subrange(tp);
+ } else {
+ gettok();
+ ex = p_expr(tp_integer);
+ note("UCSD size spec ignored; using 'long int' [110]");
+ if (ord_type(tp)->kind == TK_INTEGER)
+ tp = tp_integer;
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ }
+ }
+ if (tp == tp_text &&
+ (structfilesflag ||
+ (tname && strlist_cifind(structfiles, tname->name))))
+ tp = tp_bigtext;
+ break;
+ }
+
+ /* fall through */
+ default:
+ tp = maketype(TK_SUBR);
+ tp->smin = p_ord_expr();
+ if (curtok == TOK_COLON)
+ curtok = TOK_DOTS; /* UCSD Pascal */
+ if (wexpecttok(TOK_DOTS)) {
+ gettok();
+ tp->smax = p_ord_expr();
+ if (tp->smax->val.type->kind == TK_REAL &&
+ tp->smax->kind == EK_CONST &&
+ strlen(tp->smax->val.s) == 12 &&
+ strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
+ strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
+ tp = tp_unsigned;
+ break;
+ }
+ tp->basetype = ord_type(tp->smin->val.type);
+ if (sizespec >= 0) {
+ long smin, smax;
+ if (ord_range(tp, &smin, &smax) &&
+ typebits(smin, smax) == sizespec)
+ sizespec = -1;
+ }
+ } else {
+ tp = tp_integer;
+ }
+ break;
+ }
+ if (sizespec >= 0)
+ note(format_d("Don't know how to interpret size = %d bits [111]", sizespec));
+ return tp;
+ }
+
+
+
+
+
+ Type *p_funcdecl(isfunc, istype)
+ int *isfunc, istype;
+ {
+ Meaning *retmp = NULL, *mp, *firstmp, *lastmp, **prevm, **oldprevm;
+ Type *type, *tp;
+ enum meaningkind parkind;
+ int anyvarflag, constflag, volatileflag, num = 0;
+ Symbol *sym;
+ Expr *defval;
+ Token savetok;
+ Strlist *l1;
+
+ if (*isfunc || modula2) {
+ sym = findsymbol(format_s(name_RETV, curctx->name));
+ retmp = addmeaning(sym, MK_VAR);
+ retmp->isreturn = 1;
+ }
+ type = maketype(TK_FUNCTION);
+ if (curtok == TOK_LPAR) {
+ prevm = &type->fbase;
+ do {
+ gettok();
+ if (curtok == TOK_RPAR)
+ break;
+ p_mech_spec(1);
+ p_attributes();
+ checkkeyword(TOK_ANYVAR);
+ if (curtok == TOK_VAR || curtok == TOK_ANYVAR) {
+ parkind = MK_VARPARAM;
+ anyvarflag = (curtok == TOK_ANYVAR);
+ gettok();
+ } else if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION) {
+ savetok = curtok;
+ gettok();
+ wexpecttok(TOK_IDENT);
+ *prevm = firstmp = addmeaning(curtoksym, MK_PARAM);
+ prevm = &firstmp->xnext;
+ firstmp->anyvarflag = 0;
+ curtok = savetok; /* rearrange tokens to a proc ptr type! */
+ firstmp->type = p_type(firstmp);
+ continue;
+ } else {
+ parkind = MK_PARAM;
+ anyvarflag = 0;
+ }
+ oldprevm = prevm;
+ if (modula2 && istype) {
+ firstmp = addmeaning(findsymbol(format_d("_A%d", ++num)), parkind);
+ } else {
+ wexpecttok(TOK_IDENT);
+ firstmp = addmeaning(curtoksym, parkind);
+ gettok();
+ }
+ *prevm = firstmp;
+ prevm = &firstmp->xnext;
+ firstmp->isactive = 0; /* nit-picking Turbo compatibility */
+ lastmp = firstmp;
+ while (curtok == TOK_COMMA) {
+ gettok();
+ if (wexpecttok(TOK_IDENT)) {
+ *prevm = lastmp = addmeaning(curtoksym, parkind);
+ prevm = &lastmp->xnext;
+ lastmp->isactive = 0;
+ }
+ gettok();
+ }
+ constflag = volatileflag = 0;
+ defval = NULL;
+ if (curtok != TOK_COLON && !modula2) {
+ if (parkind != MK_VARPARAM)
+ wexpecttok(TOK_COLON);
+ parkind = MK_VARPARAM;
+ tp = tp_anyptr;
+ anyvarflag = 1;
+ } else {
+ if (curtok == TOK_COLON)
+ gettok();
+ if (curtok == TOK_IDENT && !curtokmeaning &&
+ !strcicmp(curtokbuf, "UNIV")) {
+ if (parkind == MK_PARAM)
+ note("UNIV may not work for non-VAR parameters [112]");
+ anyvarflag = 1;
+ gettok();
+ }
+ p_attributes();
+ if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
+ constflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
+ volatileflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "UNSAFE")) != NULL &&
+ parkind == MK_VARPARAM) {
+ anyvarflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "REFERENCE")) != NULL) {
+ note("REFERENCE attribute treated like VAR [107]");
+ parkind = MK_VARPARAM;
+ strlist_delete(&attrlist, l1);
+ }
+ checkkeyword(TOK_VARYING);
+ if (curtok == TOK_IDENT && curtokmeaning == mp_string &&
+ !anyvarflag && parkind == MK_VARPARAM) {
+ anyvarflag = (varstrings > 0);
+ tp = tp_str255;
+ gettok();
+ if (curtok == TOK_LBR) {
+ wexpecttok(TOK_SEMI);
+ skipparens();
+ }
+ } else if (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
+ curtok == TOK_VARYING) {
+ prevm = oldprevm;
+ tp = p_conformant_array(firstmp->name, &prevm);
+ *prevm = firstmp;
+ while (*prevm)
+ prevm = &(*prevm)->xnext;
+ } else {
+ tp = p_type(firstmp);
+ }
+ if (!varfiles && isfiletype(tp, 0))
+ parkind = MK_PARAM;
+ if (parkind == MK_VARPARAM)
+ tp = makepointertype(tp);
+ }
+ if (curtok == TOK_ASSIGN) { /* check for parameter default */
+ gettok();
+ p_mech_spec(0);
+ defval = gentle_cast(p_expr(tp), tp);
+ if ((tp->kind == TK_STRING || tp->kind == TK_ARRAY) &&
+ tp->basetype->kind == TK_CHAR &&
+ tp->structdefd && /* conformant string */
+ defval->val.type->kind == TK_STRING) {
+ mp = *oldprevm;
+ if (tp->kind == TK_ARRAY) {
+ mp->constdefn = makeexpr_long(1);
+ mp = mp->xnext;
+ }
+ mp->constdefn = strmax_func(defval);
+ }
+ }
+ while (firstmp) {
+ firstmp->type = tp;
+ firstmp->kind = parkind; /* in case it changed */
+ firstmp->isactive = 1;
+ firstmp->anyvarflag = anyvarflag;
+ firstmp->constqual = constflag;
+ firstmp->volatilequal = volatileflag;
+ if (defval) {
+ if (firstmp == lastmp)
+ firstmp->constdefn = defval;
+ else
+ firstmp->constdefn = copyexpr(defval);
+ }
+ if (parkind == MK_PARAM &&
+ (tp->kind == TK_STRING ||
+ tp->kind == TK_ARRAY ||
+ tp->kind == TK_SET ||
+ ((tp->kind == TK_RECORD ||
+ tp->kind == TK_BIGFILE ||
+ tp->kind == TK_PROCPTR) && copystructs < 2))) {
+ firstmp->othername = stralloc(format_s(name_COPYPAR,
+ firstmp->name));
+ firstmp->rectype = makepointertype(tp);
+ }
+ if (firstmp == lastmp)
+ break;
+ firstmp = firstmp->xnext;
+ }
+ } while (curtok == TOK_SEMI || curtok == TOK_COMMA);
+ if (!wneedtok(TOK_RPAR))
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ }
+ if (modula2) {
+ if (curtok == TOK_COLON) {
+ *isfunc = 1;
+ } else {
+ unaddmeaning(retmp);
+ }
+ }
+ if (*isfunc) {
+ if (wneedtok(TOK_COLON)) {
+ retmp->type = type->basetype = p_type(NULL);
+ switch (retmp->type->kind) {
+
+ case TK_RECORD:
+ case TK_BIGFILE:
+ case TK_PROCPTR:
+ if (copystructs >= 3)
+ break;
+
+ /* fall through */
+ case TK_ARRAY:
+ case TK_STRING:
+ case TK_SET:
+ type->basetype = retmp->type = makepointertype(retmp->type);
+ retmp->kind = MK_VARPARAM;
+ retmp->anyvarflag = 0;
+ retmp->xnext = type->fbase;
+ type->fbase = retmp;
+ retmp->refcount++;
+ break;
+
+ default:
+ break;
+ }
+ } else
+ retmp->type = type->basetype = tp_integer;
+ } else
+ type->basetype = tp_void;
+ return type;
+ }
+
+
+
+
+
+ Symbol *findlabelsym()
+ {
+ if (curtok == TOK_IDENT &&
+ curtokmeaning && curtokmeaning->kind == MK_LABEL) {
+ #if 0
+ if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
+ curtokmeaning->val.i = --nonloclabelcount;
+ #endif
+ } else if (curtok == TOK_INTLIT) {
+ strcpy(curtokcase, curtokbuf);
+ curtoksym = findsymbol(curtokbuf);
+ curtokmeaning = curtoksym->mbase;
+ while (curtokmeaning && !curtokmeaning->isactive)
+ curtokmeaning = curtokmeaning->snext;
+ if (!curtokmeaning || curtokmeaning->kind != MK_LABEL)
+ return NULL;
+ #if 0
+ if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
+ if (curtokint == 0)
+ curtokmeaning->val.i = -1;
+ else
+ curtokmeaning->val.i = curtokint;
+ #endif
+ } else
+ return NULL;
+ return curtoksym;
+ }
+
+
+ void p_labeldecl()
+ {
+ Symbol *sp;
+ Meaning *mp;
+
+ do {
+ gettok();
+ if (curtok != TOK_IDENT)
+ wexpecttok(TOK_INTLIT);
+ sp = findlabelsym();
+ mp = addmeaning(curtoksym, MK_LABEL);
+ mp->val.i = 0;
+ mp->xnext = addmeaning(findsymbol(format_s(name_LABVAR,
+ mp->name)),
+ MK_VAR);
+ mp->xnext->type = tp_jmp_buf;
+ mp->xnext->refcount = 0;
+ gettok();
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ }
+
+
+
+
+
+ Meaning *findfieldname(sym, variants, nvars)
+ Symbol *sym;
+ Meaning **variants;
+ int *nvars;
+ {
+ Meaning *mp, *mp0;
+
+ mp = variants[*nvars-1];
+ while (mp && mp->kind == MK_FIELD) {
+ if (mp->sym == sym) {
+ return mp;
+ }
+ mp = mp->cnext;
+ }
+ while (mp) {
+ variants[(*nvars)++] = mp->ctx;
+ mp0 = findfieldname(sym, variants, nvars);
+ if (mp0)
+ return mp0;
+ (*nvars)--;
+ while (mp->cnext && mp->cnext->ctx == mp->ctx)
+ mp = mp->cnext;
+ mp = mp->cnext;
+ }
+ return NULL;
+ }
+
+
+
+
+ Expr *p_constrecord(type, style)
+ Type *type;
+ int style; /* 0=HP, 1=Turbo, 2=Oregon+VAX */
+ {
+ Meaning *mp, *mp0, *variants[20], *newvariants[20], *curfield;
+ Symbol *sym;
+ Value val;
+ Expr *ex, *cex;
+ int i, j, nvars, newnvars, varcounts[20];
+
+ if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
+ return makeexpr_long(0);
+ cex = makeexpr(EK_STRUCTCONST, 0);
+ nvars = 0;
+ varcounts[0] = 0;
+ curfield = type->fbase;
+ for (;;) {
+ if (style == 2) {
+ if (curfield) {
+ mp = curfield;
+ if (mp->kind == MK_VARIANT || mp->isforward) {
+ val = p_constant(mp->type);
+ if (mp->kind == MK_FIELD) {
+ insertarg(&cex, cex->nargs, makeexpr_val(val));
+ mp = mp->cnext;
+ }
+ val.type = mp->val.type;
+ if (!valuesame(val, mp->val)) {
+ while (mp && !valuesame(val, mp->val))
+ mp = mp->cnext;
+ if (mp) {
+ note("Attempting to initialize union member other than first [113]");
+ curfield = mp->ctx;
+ } else {
+ warning("Tag value does not exist in record [129]");
+ curfield = NULL;
+ }
+ } else
+ curfield = mp->ctx;
+ goto ignorefield;
+ } else {
+ i = cex->nargs;
+ insertarg(&cex, i, NULL);
+ if (mp->isforward && curfield->cnext)
+ curfield = curfield->cnext->ctx;
+ else
+ curfield = curfield->cnext;
+ }
+ } else {
+ warning("Too many fields in record constructor [130]");
+ ex = p_expr(NULL);
+ freeexpr(ex);
+ goto ignorefield;
+ }
+ } else {
+ if (!wexpecttok(TOK_IDENT)) {
+ skiptotoken2(TOK_RPAR, TOK_RBR);
+ break;
+ }
+ sym = curtoksym;
+ gettok();
+ if (!wneedtok(TOK_COLON)) {
+ skiptotoken2(TOK_RPAR, TOK_RBR);
+ break;
+ }
+ newnvars = 1;
+ newvariants[0] = type->fbase;
+ mp = findfieldname(sym, newvariants, &newnvars);
+ if (!mp) {
+ warning(format_s("Field %s not in record [131]", sym->name));
+ ex = p_expr(NULL); /* good enough */
+ freeexpr(ex);
+ goto ignorefield;
+ }
+ for (i = 0; i < nvars && i < newnvars; i++) {
+ if (variants[i] != newvariants[i]) {
+ warning("Fields are members of incompatible variants [132]");
+ ex = p_subconst(mp->type, style);
+ freeexpr(ex);
+ goto ignorefield;
+ }
+ }
+ while (nvars < newnvars) {
+ variants[nvars] = newvariants[nvars];
+ if (nvars > 0) {
+ for (mp0 = variants[nvars-1]; mp0->kind != MK_VARIANT; mp0 = mp0->cnext) ;
+ if (mp0->ctx != variants[nvars])
+ note("Attempting to initialize union member other than first [113]");
+ }
+ i = varcounts[nvars];
+ for (mp0 = variants[nvars]; mp0 && mp0->kind == MK_FIELD; mp0 = mp0->cnext)
+ i++;
+ nvars++;
+ varcounts[nvars] = i;
+ while (cex->nargs < i)
+ insertarg(&cex, cex->nargs, NULL);
+ }
+ i = varcounts[newnvars-1];
+ for (mp0 = variants[newnvars-1]; mp0->sym != sym; mp0 = mp0->cnext)
+ i++;
+ if (cex->args[i])
+ warning(format_s("Two constructors for %s [133]", mp->name));
+ }
+ ex = p_subconst(mp->type, style);
+ if (ex->kind == EK_CONST &&
+ (ex->val.type->kind == TK_RECORD ||
+ ex->val.type->kind == TK_ARRAY))
+ ex = (Expr *)ex->val.i;
+ cex->args[i] = ex;
+ ignorefield:
+ if (curtok == TOK_COMMA || curtok == TOK_SEMI)
+ gettok();
+ else
+ break;
+ }
+ if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
+ skippasttoken2(TOK_RPAR, TOK_RBR);
+ if (style != 2) {
+ j = 0;
+ mp = variants[0];
+ for (i = 0; i < cex->nargs; i++) {
+ while (!mp || mp->kind != MK_FIELD)
+ mp = variants[++j];
+ if (!cex->args[i]) {
+ warning(format_s("No constructor for %s [134]", mp->name));
+ cex->args[i] = makeexpr_name("<oops>", mp->type);
+ }
+ mp = mp->cnext;
+ }
+ }
+ val.type = type;
+ val.i = (long)cex;
+ val.s = NULL;
+ return makeexpr_val(val);
+ }
+
+
+
+
+ Expr *p_constarray(type, style)
+ Type *type;
+ int style;
+ {
+ Value val;
+ Expr *ex, *cex;
+ int nvals, skipped;
+ long smin, smax;
+
+ if (type->kind == TK_SMALLARRAY)
+ warning("Small-array constructors not yet implemented [135]");
+ if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
+ return makeexpr_long(0);
+ if (type->smin && type->smin->kind == EK_CONST)
+ skipped = type->smin->val.i;
+ else
+ skipped = 0;
+ cex = NULL;
+ for (;;) {
+ if (style && (curtok == TOK_LPAR || curtok == TOK_LBR)) {
+ ex = p_subconst(type->basetype, style);
+ nvals = 1;
+ } else if (curtok == TOK_REPEAT) {
+ gettok();
+ ex = p_expr(type->basetype);
+ if (ord_range(type->indextype, &smin, &smax)) {
+ nvals = smax - smin + 1;
+ if (cex)
+ nvals -= cex->nargs;
+ } else {
+ nvals = 1;
+ note("REPEAT not translatable for non-constant array bounds [114]");
+ }
+ ex = gentle_cast(ex, type->basetype);
+ } else {
+ ex = p_expr(type->basetype);
+ if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
+ ex->val.i > 1 && !skipped && style == 0 && !cex &&
+ type->basetype->kind == TK_CHAR &&
+ checkconst(type->indextype->smin, 1)) {
+ if (!wneedtok(TOK_RBR))
+ skippasttoken2(TOK_RBR, TOK_RPAR);
+ return ex; /* not quite right, but close enough */
+ }
+ if (curtok == TOK_OF) {
+ ex = gentle_cast(ex, tp_integer);
+ val = eval_expr(ex);
+ freeexpr(ex);
+ if (!val.type)
+ warning("Expected a constant [127]");
+ nvals = val.i;
+ gettok();
+ ex = p_expr(type->basetype);
+ } else
+ nvals = 1;
+ ex = gentle_cast(ex, type->basetype);
+ }
+ nvals += skipped;
+ skipped = 0;
+ if (ex->kind == EK_CONST &&
+ (ex->val.type->kind == TK_RECORD ||
+ ex->val.type->kind == TK_ARRAY))
+ ex = (Expr *)ex->val.i;
+ if (nvals != 1) {
+ ex = makeexpr_un(EK_STRUCTOF, type->basetype, ex);
+ ex->val.i = nvals;
+ }
+ if (cex)
+ insertarg(&cex, cex->nargs, ex);
+ else
+ cex = makeexpr_un(EK_STRUCTCONST, type, ex);
+ if (curtok == TOK_COMMA)
+ gettok();
+ else
+ break;
+ }
+ if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
+ skippasttoken2(TOK_RPAR, TOK_RBR);
+ val.type = type;
+ val.i = (long)cex;
+ val.s = NULL;
+ return makeexpr_val(val);
+ }
+
+
+
+
+ Expr *p_conststring(type, style)
+ Type *type;
+ int style;
+ {
+ Expr *ex;
+ Token close = (style ? TOK_RPAR : TOK_RBR);
+
+ if (curtok != (style ? TOK_LPAR : TOK_LBR))
+ return p_expr(type);
+ gettok();
+ ex = p_expr(tp_integer); /* should handle "OF" and "," for constructors */
+ if (curtok == TOK_OF || curtok == TOK_COMMA) {
+ warning("Multi-element string constructors not yet supported [136]");
+ skiptotoken(close);
+ }
+ if (!wneedtok(close))
+ skippasttoken(close);
+ return ex;
+ }
+
+
+
+
+ Expr *p_subconst(type, style)
+ Type *type;
+ int style;
+ {
+ Value val;
+
+ if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE) {
+ if (curtokmeaning->type != type)
+ warning("Type conflict in constant [137]");
+ gettok();
+ }
+ if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
+ !curtokmeaning) { /* VAX Pascal foolishness */
+ gettok();
+ if (type->kind == TK_STRING)
+ return makeexpr_string("");
+ if (type->kind == TK_REAL)
+ return makeexpr_real("0.0");
+ val.type = type;
+ if (type->kind == TK_RECORD || type->kind == TK_ARRAY ||
+ type->kind == TK_SET)
+ val.i = (long)makeexpr_un(EK_STRUCTCONST, type, makeexpr_long(0));
+ else
+ val.i = 0;
+ val.s = NULL;
+ return makeexpr_val(val);
+ }
+ switch (type->kind) {
+
+ case TK_RECORD:
+ if (curtok == (style ? TOK_LPAR : TOK_LBR))
+ return p_constrecord(type, style);
+ break;
+
+ case TK_SMALLARRAY:
+ case TK_ARRAY:
+ if (curtok == (style ? TOK_LPAR : TOK_LBR))
+ return p_constarray(type, style);
+ break;
+
+ case TK_SMALLSET:
+ case TK_SET:
+ if (curtok == TOK_LBR)
+ return p_setfactor(type, 1);
+ break;
+
+ default:
+ break;
+
+ }
+ return gentle_cast(p_expr(type), type);
+ }
+
+
+
+ void p_constdecl()
+ {
+ Meaning *mp;
+ Expr *ex, *ex2;
+ Type *oldtype;
+ char savetokcase[sizeof(curtokcase)];
+ Symbol *savetoksym;
+ Strlist *sl;
+ int i, saveindent, outflag = (blockkind != TOK_IMPORT);
+
+ if (outflag)
+ outsection(majorspace);
+ flushcomments(NULL, -1, -1);
+ gettok();
+ oldtype = NULL;
+ while (curtok == TOK_IDENT) {
+ strcpy(savetokcase, curtokcase);
+ savetoksym = curtoksym;
+ gettok();
+ strcpy(curtokcase, savetokcase); /* what a kludge! */
+ curtoksym = savetoksym;
+ if (curtok == TOK_COLON) { /* Turbo Pascal typed constant */
+ mp = addmeaning(curtoksym, MK_VAR);
+ decl_comments(mp);
+ gettok();
+ mp->type = p_type(mp);
+ if (wneedtok(TOK_EQ)) {
+ if (mp->kind == MK_VARMAC) {
+ freeexpr(p_subconst(mp->type, 1));
+ note("Initializer ignored for variable with VarMacro [115]");
+ } else {
+ mp->constdefn = p_subconst(mp->type, 1);
+ if (blockkind == TOK_EXPORT) {
+ /* nothing */
+ } else {
+ mp->isforward = 1; /* static variable */
+ }
+ }
+ }
+ decl_comments(mp);
+ } else {
+ sl = strlist_find(constmacros, curtoksym->name);
+ if (sl) {
+ mp = addmeaning(curtoksym, MK_VARMAC);
+ mp->constdefn = (Expr *)sl->value;
+ strlist_delete(&constmacros, sl);
+ } else {
+ mp = addmeaning(curtoksym, MK_CONST);
+ }
+ decl_comments(mp);
+ if (!wexpecttok(TOK_EQ)) {
+ skippasttoken(TOK_SEMI);
+ continue;
+ }
+ mp->isactive = 0; /* A fine point indeed (see below) */
+ gettok();
+ if (curtok == TOK_IDENT &&
+ curtokmeaning && curtokmeaning->kind == MK_TYPE &&
+ (curtokmeaning->type->kind == TK_RECORD ||
+ curtokmeaning->type->kind == TK_SMALLARRAY ||
+ curtokmeaning->type->kind == TK_ARRAY)) {
+ oldtype = curtokmeaning->type;
+ gettok();
+ ex = p_subconst(oldtype, (curtok == TOK_LBR) ? 0 : 2);
+ } else {
+ ex = p_expr(NULL);
+ if (charconsts)
+ ex = makeexpr_charcast(ex);
+ }
+ mp->isactive = 1; /* Re-enable visibility of the new constant */
+ if (mp->kind == MK_CONST)
+ mp->constdefn = ex;
+ if (ord_type(ex->val.type)->kind == TK_INTEGER) {
+ i = exprlongness(ex);
+ if (i > 0)
+ ex->val.type = tp_integer;
+ else if (i < 0)
+ ex->val.type = tp_int;
+ }
+ decl_comments(mp);
+ mp->type = ex->val.type;
+ mp->val = eval_expr(ex);
+ if (mp->kind == MK_CONST) {
+ switch (ex->val.type->kind) {
+
+ case TK_INTEGER:
+ case TK_BOOLEAN:
+ case TK_CHAR:
+ case TK_ENUM:
+ case TK_SUBR:
+ case TK_REAL:
+ if (foldconsts > 0)
+ mp->anyvarflag = 1;
+ break;
+
+ case TK_STRING:
+ if (foldstrconsts > 0)
+ mp->anyvarflag = 1;
+ break;
+
+ default:
+ break;
+ }
+ }
+ flushcomments(&mp->comments, CMT_PRE, -1);
+ if (ex->val.type->kind == TK_SET) {
+ mp->val.type = NULL;
+ if (mp->kind == MK_CONST) {
+ ex2 = makeexpr(EK_MACARG, 0);
+ ex2->val.type = ex->val.type;
+ mp->constdefn = makeexpr_assign(ex2, ex);
+ }
+ } else if (mp->kind == MK_CONST && outflag) {
+ if (ex->val.type != oldtype) {
+ outsection(minorspace);
+ oldtype = ex->val.type;
+ }
+ switch (ex->val.type->kind) {
+
+ case TK_ARRAY:
+ case TK_RECORD:
+ select_outfile(codef);
+ outsection(minorspace);
+ if (blockkind == TOK_IMPLEMENT || blockkind == TOK_PROGRAM)
+ output("static ");
+ if (useAnyptrMacros == 1 || useconsts == 2)
+ output("Const ");
+ else if (useconsts > 0)
+ output("const ");
+ outbasetype(mp->type, ODECL_CHARSTAR|ODECL_FREEARRAY);
+ output(" ");
+ outdeclarator(mp->type, mp->name,
+ ODECL_CHARSTAR|ODECL_FREEARRAY);
+ output(" = {");
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structinitindent);
+ /* if (mp->val.s)
+ output(mp->val.s);
+ else */
+ out_expr((Expr *)mp->val.i);
+ outindent = saveindent;
+ output("\n};\n");
+ outsection(minorspace);
+ if (blockkind == TOK_EXPORT) {
+ select_outfile(hdrf);
+ if (usevextern)
+ output("vextern ");
+ if (useAnyptrMacros == 1 || useconsts == 2)
+ output("Const ");
+ else if (useconsts > 0)
+ output("const ");
+ outbasetype(mp->type, ODECL_CHARSTAR);
+ output(" ");
+ outdeclarator(mp->type, mp->name, ODECL_CHARSTAR);
+ output(";\n");
+ }
+ break;
+
+ default:
+ if (foldconsts > 0) break;
+ output(format_s("#define %s", mp->name));
+ mp->isreturn = 1;
+ out_spaces(constindent, 0, 0, 0);
+ saveindent = outindent;
+ outindent = cur_column();
+ out_expr_factor(ex);
+ outindent = saveindent;
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ break;
+
+ }
+ }
+ flushcomments(&mp->comments, -1, -1);
+ if (mp->kind == MK_VARMAC)
+ freeexpr(ex);
+ mp->wasdeclared = 1;
+ }
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ }
+ if (outflag)
+ outsection(majorspace);
+ }
+
+
+
+
+ void declaresubtypes(mp)
+ Meaning *mp;
+ {
+ Meaning *mp2;
+ Type *tp;
+ struct ptrdesc *pd;
+
+ while (mp) {
+ if (mp->kind == MK_VARIANT) {
+ declaresubtypes(mp->ctx);
+ } else {
+ tp = mp->type;
+ while (tp->basetype && !tp->meaning && tp->kind != TK_POINTER)
+ tp = tp->basetype;
+ if (tp->meaning && !tp->meaning->wasdeclared &&
+ (tp->kind == TK_RECORD || tp->kind == TK_ENUM) &&
+ tp->meaning->ctx && tp->meaning->ctx != nullctx) {
+ pd = ptrbase; /* Do this now, just in case */
+ while (pd) {
+ if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
+ pd->tp->smin = NULL;
+ mp2 = pd->sym->mbase;
+ while (mp2 && !mp2->isactive)
+ mp2 = mp2->snext;
+ if (mp2 && mp2->kind == MK_TYPE) {
+ pd->tp->basetype = mp2->type;
+ pd->tp->fbase = mp2;
+ if (!mp2->type->pointertype)
+ mp2->type->pointertype = pd->tp;
+ }
+ }
+ pd = pd->next;
+ }
+ declaretype(tp->meaning);
+ }
+ }
+ mp = mp->cnext;
+ }
+ }
+
+
+ void declaretype(mp)
+ Meaning *mp;
+ {
+ int saveindent, pres;
+
+ switch (mp->type->kind) {
+
+ case TK_RECORD:
+ case TK_BIGFILE:
+ if (mp->type->meaning != mp) {
+ output(format_ss("typedef %s %s;",
+ mp->type->meaning->name,
+ mp->name));
+ } else {
+ declaresubtypes(mp->type->fbase);
+ outsection(minorspace);
+ if (record_is_union(mp->type))
+ output("typedef union ");
+ else
+ output("typedef struct ");
+ output(format_s("%s {\n", format_s(name_STRUCT, mp->name)));
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structindent);
+ if (mp->type->kind == TK_BIGFILE)
+ declarebigfile(mp->type);
+ else
+ outfieldlist(mp->type->fbase);
+ outindent = saveindent;
+ output(format_s("} %s;", mp->name));
+ }
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ mp->type->structdefd = 1;
+ if (mp->type->meaning == mp)
+ outsection(minorspace);
+ break;
+
+ case TK_ARRAY:
+ case TK_SMALLARRAY:
+ output("typedef ");
+ if (mp->type->meaning != mp) {
+ output(format_ss("%s %s",
+ mp->type->meaning->name,
+ mp->name));
+ } else {
+ outbasetype(mp->type, 0);
+ output(" ");
+ outdeclarator(mp->type, mp->name, 0);
+ }
+ output(";");
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ break;
+
+ case TK_ENUM:
+ if (useenum) {
+ output("typedef ");
+ if (mp->type->meaning != mp)
+ output(mp->type->meaning->name);
+ else
+ outbasetype(mp->type, 0);
+ output(" ");
+ output(mp->name);
+ output(";");
+ outtrailcomment(mp->comments, -1,
+ declcommentindent);
+ }
+ break;
+
+ default:
+ pres = preservetypes;
+ if (mp->type->kind == TK_POINTER && preservepointers >= 0)
+ pres = preservepointers;
+ if (mp->type->kind == TK_STRING && preservestrings >= 0)
+ if (preservestrings == 2)
+ pres = mp->type->indextype->smax->kind != EK_CONST;
+ else
+ pres = preservestrings;
+ if (pres) {
+ output("typedef ");
+ mp->type->preserved = 0;
+ outbasetype(mp->type, 0);
+ output(" ");
+ outdeclarator(mp->type, mp->name, 0);
+ output(";\n");
+ mp->type->preserved = 1;
+ outtrailcomment(mp->comments, -1, declcommentindent);
+ }
+ break;
+ }
+ mp->wasdeclared = 1;
+ }
+
+
+
+ void declaretypes(outflag)
+ int outflag;
+ {
+ Meaning *mp;
+
+ for (mp = curctx->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_TYPE && !mp->wasdeclared) {
+ if (outflag) {
+ flushcomments(&mp->comments, CMT_PRE, -1);
+ declaretype(mp);
+ flushcomments(&mp->comments, -1, -1);
+ }
+ mp->wasdeclared = 1;
+ }
+ }
+ }
+
+
+
+ void p_typedecl()
+ {
+ Meaning *mp;
+ int outflag = (blockkind != TOK_IMPORT);
+ struct ptrdesc *pd;
+
+ if (outflag)
+ outsection(majorspace);
+ flushcomments(NULL, -1, -1);
+ gettok();
+ outsection(minorspace);
+ deferallptrs = 1;
+ anydeferredptrs = 0;
+ notephase = 1;
+ while (curtok == TOK_IDENT) {
+ mp = addmeaning(curtoksym, MK_TYPE);
+ mp->type = tp_integer; /* in case of syntax errors */
+ gettok();
+ decl_comments(mp);
+ if (curtok == TOK_SEMI) {
+ mp->type = tp_anyptr; /* Modula-2 opaque type */
+ } else {
+ if (!wneedtok(TOK_EQ)) {
+ skippasttoken(TOK_SEMI);
+ continue;
+ }
+ mp->type = p_type(mp);
+ decl_comments(mp);
+ if (!mp->type->meaning)
+ mp->type->meaning = mp;
+ if (mp->type->kind == TK_RECORD ||
+ mp->type->kind == TK_BIGFILE)
+ mp->type->structdefd = 1;
+ if (!anydeferredptrs)
+ declaretypes(outflag);
+ }
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ }
+ notephase = 0;
+ deferallptrs = 0;
+ while (ptrbase) {
+ pd = ptrbase;
+ if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
+ pd->tp->smin = NULL;
+ mp = pd->sym->mbase;
+ while (mp && !mp->isactive)
+ mp = mp->snext;
+ if (!mp || mp->kind != MK_TYPE) {
+ warning(format_s("Unsatisfied forward reference to type %s [138]", pd->sym->name));
+ } else {
+ pd->tp->basetype = mp->type;
+ pd->tp->fbase = mp;
+ if (!mp->type->pointertype)
+ mp->type->pointertype = pd->tp;
+ }
+ }
+ ptrbase = ptrbase->next;
+ FREE(pd);
+ }
+ declaretypes(outflag);
+ outsection(minorspace);
+ flushcomments(NULL, -1, -1);
+ if (outflag)
+ outsection(majorspace);
+ }
+
+
+
+
+
+ Static void nameexternalvar(mp, name)
+ Meaning *mp;
+ char *name;
+ {
+ if (!wasaliased) {
+ if (*externalias && my_strchr(externalias, '%'))
+ strchange(&mp->name, format_s(externalias, name));
+ else
+ strchange(&mp->name, name);
+ }
+ }
+
+
+ Static void handlebrackets(mp, skip, wasaliased)
+ Meaning *mp;
+ int skip, wasaliased;
+ {
+ Expr *ex;
+
+ checkkeyword(TOK_ORIGIN);
+ if (curtok == TOK_ORIGIN) {
+ gettok();
+ ex = p_expr(tp_integer);
+ mp->kind = MK_VARREF;
+ mp->constdefn = gentle_cast(ex, tp_integer);
+ } else if (curtok == TOK_LBR) {
+ gettok();
+ ex = p_expr(tp_integer);
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ if (skip) {
+ freeexpr(ex);
+ return;
+ }
+ if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
+ nameexternalvar(mp, ex->val.s);
+ mp->isfunction = 1; /* make it extern */
+ } else {
+ note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
+ mp->kind = MK_VARREF;
+ mp->constdefn = gentle_cast(ex, tp_integer);
+ }
+ }
+ }
+
+
+
+ Static void handleabsolute(mp, skip)
+ Meaning *mp;
+ int skip;
+ {
+ Expr *ex;
+ Value val;
+ long i;
+
+ checkkeyword(TOK_ABSOLUTE);
+ if (curtok == TOK_ABSOLUTE) {
+ gettok();
+ if (skip) {
+ freeexpr(p_expr(tp_integer));
+ if (curtok == TOK_COLON) {
+ gettok();
+ freeexpr(p_expr(tp_integer));
+ }
+ return;
+ }
+ note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
+ mp->kind = MK_VARREF;
+ if (curtok == TOK_IDENT &&
+ curtokmeaning && (curtokmeaning->kind != MK_CONST ||
+ ord_type(curtokmeaning->type)->kind != TK_INTEGER)) {
+ mp->constdefn = makeexpr_addr(p_expr(NULL));
+ mp->isfunction = 1; /* make it extern */
+ } else {
+ ex = gentle_cast(p_expr(tp_integer), tp_integer);
+ if (curtok == TOK_COLON) {
+ val = eval_expr(ex);
+ if (!val.type)
+ warning("Expected a constant [127]");
+ i = val.i & 0xffff;
+ gettok();
+ val = p_constant(tp_integer);
+ i = (i<<16) | (val.i & 0xffff); /* as good a notation as any! */
+ ex = makeexpr_long(i);
+ insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ }
+ mp->constdefn = ex;
+ }
+ }
+ }
+
+
+
+ void setupfilevar(mp)
+ Meaning *mp;
+ {
+ if (mp->kind != MK_VARMAC) {
+ if (isfiletype(mp->type, 0)) {
+ if (storefilenames && *name_FNVAR)
+ mp->namedfile = 1;
+ if (checkvarinlists(bufferedfiles, unbufferedfiles, 0, mp))
+ mp->bufferedfile = 1;
+ } else if (isfiletype(mp->type, 1)) {
+ mp->namedfile = 1;
+ mp->bufferedfile = 1;
+ }
+ }
+ }
+
+
+
+ Meaning *validatedtype(dtype, type)
+ Meaning *dtype;
+ Type *type;
+ {
+ if (dtype &&
+ (!type->preserved || !type->meaning ||
+ dtype->kind != MK_TYPE || dtype->type != type ||
+ type->meaning == dtype))
+ return NULL;
+ return dtype;
+ }
+
+
+ void p_vardecl()
+ {
+ Meaning *firstmp, *lastmp, *dtype;
+ Type *tp;
+ int aliasflag, volatileflag, constflag, staticflag, globalflag, externflag;
+ Strlist *l1;
+ Expr *initexpr;
+
+ gettok();
+ notephase = 1;
+ while (curtok == TOK_IDENT) {
+ firstmp = lastmp = addmeaning(curtoksym, MK_VAR);
+ lastmp->type = tp_integer; /* in case of syntax errors */
+ aliasflag = wasaliased;
+ gettok();
+ handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
+ decl_comments(lastmp);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ if (wexpecttok(TOK_IDENT)) {
+ lastmp = addmeaning(curtoksym, MK_VAR);
+ lastmp->type = tp_integer;
+ aliasflag = wasaliased;
+ gettok();
+ handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
+ decl_comments(lastmp);
+ }
+ }
+ if (!wneedtok(TOK_COLON)) {
+ skippasttoken(TOK_SEMI);
+ continue;
+ }
+ p_attributes();
+ volatileflag = constflag = staticflag = globalflag = externflag = 0;
+ if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
+ constflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
+ volatileflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "STATIC")) != NULL) {
+ staticflag = 1;
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "AUTOMATIC")) != NULL) {
+ /* This is the default! */
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "AT")) != NULL) {
+ note(format_s("Absolute-addressed variable %s was generated [116]", lastmp->name));
+ lastmp->kind = MK_VARREF;
+ lastmp->constdefn = makeexpr_long(l1->value);
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "GLOBAL")) != NULL ||
+ (l1 = strlist_find(attrlist, "WEAK_GLOBAL")) != NULL) {
+ globalflag = 1;
+ if (l1->value != -1)
+ nameexternalvar(lastmp, (char *)l1->value);
+ if (l1->s[0] != 'W')
+ strlist_delete(&attrlist, l1);
+ }
+ if ((l1 = strlist_find(attrlist, "EXTERNAL")) != NULL ||
+ (l1 = strlist_find(attrlist, "WEAK_EXTERNAL")) != NULL) {
+ externflag = 1;
+ if (l1->value != -1)
+ nameexternalvar(lastmp, (char *)l1->value);
+ if (l1->s[0] != 'W')
+ strlist_delete(&attrlist, l1);
+ }
+ dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
+ tp = p_type(firstmp);
+ decl_comments(lastmp);
+ handleabsolute(lastmp, (lastmp->kind != MK_VAR));
+ initexpr = NULL;
+ if (curtok == TOK_ASSIGN) { /* VAX Pascal initializer */
+ gettok();
+ initexpr = p_subconst(tp, 2);
+ if (lastmp->kind == MK_VARMAC) {
+ freeexpr(initexpr);
+ initexpr = NULL;
+ note("Initializer ignored for variable with VarMacro [115]");
+ }
+ }
+ dtype = validatedtype(dtype, tp);
+ for (;;) {
+ if (firstmp->kind == MK_VARREF) {
+ firstmp->type = makepointertype(tp);
+ firstmp->constdefn = makeexpr_cast(firstmp->constdefn, firstmp->type);
+ } else {
+ firstmp->type = tp;
+ setupfilevar(firstmp);
+ if (initexpr) {
+ if (firstmp == lastmp)
+ firstmp->constdefn = initexpr;
+ else
+ firstmp->constdefn = copyexpr(initexpr);
+ }
+ }
+ firstmp->dtype = dtype;
+ firstmp->volatilequal = volatileflag;
+ firstmp->constqual = constflag;
+ firstmp->isforward |= staticflag;
+ firstmp->isfunction |= externflag;
+ firstmp->exported |= globalflag;
+ if (globalflag && (curctx->kind != MK_MODULE || mainlocals))
+ declarevar(firstmp, -1);
+ if (firstmp == lastmp)
+ break;
+ firstmp = firstmp->cnext;
+ }
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ }
+ notephase = 0;
+ }
+
+
+
+
+ void p_valuedecl()
+ {
+ Meaning *mp;
+
+ gettok();
+ while (curtok == TOK_IDENT) {
+ if (!curtokmeaning ||
+ curtokmeaning->kind != MK_VAR) {
+ warning(format_s("Initializer ignored for variable %s [139]",
+ curtokbuf));
+ skippasttoken(TOK_SEMI);
+ } else {
+ mp = curtokmeaning;
+ gettok();
+ if (curtok == TOK_DOT || curtok == TOK_LBR) {
+ note("Partial structure initialization not supported [117]");
+ skippasttoken(TOK_SEMI);
+ } else if (wneedtok(TOK_ASSIGN)) {
+ mp->constdefn = p_subconst(mp->type, 2);
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ } else
+ skippasttoken(TOK_SEMI);
+ }
+ }
+ }
+
+
+
+
+
+
+
+ /* Make a temporary variable that must be freed manually (or at the end of
+ the current function by default) */
+
+ Meaning *maketempvar(type, name)
+ Type *type;
+ char *name;
+ {
+ struct tempvarlist *tv, **tvp;
+ Symbol *sym;
+ Meaning *mp;
+ char *fullname;
+
+ tvp = &tempvars; /* find a freed but allocated temporary */
+ while ((tv = *tvp) && (!similartypes(tv->tvar->type, type) ||
+ tv->tvar->refcount == 0 ||
+ strcmp(tv->tvar->val.s, name)))
+ tvp = &(tv->next);
+ if (!tv) {
+ tvp = &tempvars; /* take over a now-cancelled temporary */
+ while ((tv = *tvp) && (tv->tvar->refcount > 0 ||
+ strcmp(tv->tvar->val.s, name)))
+ tvp = &(tv->next);
+ }
+ if (tv) {
+ tv->tvar->type = type;
+ *tvp = tv->next;
+ mp = tv->tvar;
+ FREE(tv);
+ mp->refcount++;
+ if (debug>1) { fprintf(outf,"maketempvar revives %s\n", mp->name); }
+ } else {
+ tempvarcount = 0; /***/ /* experimental... */
+ for (;;) {
+ if (tempvarcount)
+ fullname = format_s(name, format_d("%d", tempvarcount));
+ else
+ fullname = format_s(name, "");
+ ++tempvarcount;
+ sym = findsymbol(fullname);
+ mp = sym->mbase;
+ while (mp && !mp->isactive)
+ mp = mp->snext;
+ if (!mp)
+ break;
+ if (debug>1) { fprintf(outf,"maketempvar rejects %s\n", fullname); }
+ }
+ mp = addmeaning(sym, MK_VAR);
+ mp->istemporary = 1;
+ mp->type = type;
+ mp->refcount = 1;
+ mp->val.s = stralloc(name);
+ if (debug>1) { fprintf(outf,"maketempvar creates %s\n", mp->name); }
+ }
+ return mp;
+ }
+
+
+
+ /* Make a temporary variable that will be freed at the end of this statement
+ (rather than at the end of the function) by default */
+
+ Meaning *makestmttempvar(type, name)
+ Type *type;
+ char *name;
+ {
+ struct tempvarlist *tv;
+ Meaning *tvar;
+
+ tvar = maketempvar(type, name);
+ tv = ALLOC(1, struct tempvarlist, tempvars);
+ tv->tvar = tvar;
+ tv->active = 1;
+ tv->next = stmttempvars;
+ stmttempvars = tv;
+ return tvar;
+ }
+
+
+
+ Meaning *markstmttemps()
+ {
+ return (stmttempvars) ? stmttempvars->tvar : NULL;
+ }
+
+
+ void freestmttemps(mark)
+ Meaning *mark;
+ {
+ struct tempvarlist *tv;
+
+ while ((tv = stmttempvars) && tv->tvar != mark) {
+ if (tv->active)
+ freetempvar(tv->tvar);
+ stmttempvars = tv->next;
+ FREE(tv);
+ }
+ }
+
+
+
+ /* This temporary variable is no longer used */
+
+ void freetempvar(tvar)
+ Meaning *tvar;
+ {
+ struct tempvarlist *tv;
+
+ if (debug>1) { fprintf(outf,"freetempvar frees %s\n", tvar->name); }
+ tv = stmttempvars;
+ while (tv && tv->tvar != tvar)
+ tv = tv->next;
+ if (tv)
+ tv->active = 0;
+ tv = ALLOC(1, struct tempvarlist, tempvars);
+ tv->tvar = tvar;
+ tv->next = tempvars;
+ tempvars = tv;
+ }
+
+
+
+ /* The code that used this temporary variable has been deleted */
+
+ void canceltempvar(tvar)
+ Meaning *tvar;
+ {
+ if (debug>1) { fprintf(outf,"canceltempvar cancels %s\n", tvar->name); }
+ tvar->refcount--;
+ freetempvar(tvar);
+ }
+
+
+
+
+
+
+
+
+ /* End. */
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/dir.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/dir.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/dir.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,257 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define define_parameters
+ #define PROTO_DIR_C
+ #include "trans.h"
+
+
+ /* This file is user-modifiable. It is the "directory" of C functions
+ for compiling in-line various Pascal library routines. */
+
+
+
+ extern void setup_module_hp();
+ extern void setup_module_cit();
+ extern void setup_module_tanner();
+
+
+
+
+ /* This function is called once when p2c is starting up, before
+ the p2crc file has been read.
+ */
+
+ void init_dir()
+ {
+
+
+ }
+
+
+
+
+
+ /* This function is called once when p2c is starting up, after
+ the p2crc file has been read.
+ */
+
+ void setup_dir()
+ {
+
+
+ }
+
+
+
+
+
+ /* This procedure is called after reading the import text for a module,
+ where "name" is the module name, in upper-case letters. Calls to
+ "addmeaning", "makestandardfunc", etc. will annotate the context of
+ the module. Note that this will be called if the module is searched,
+ even if it is never actually imported.
+ */
+
+ #if 0
+ Static void _setup(name, defn)
+ char *name;
+ int defn;
+ {
+ /* this is a dummy procedure which may be called by setup_module */
+ }
+ #endif
+
+ #define _setup(a,b)
+
+ void setup_module(name, defn)
+ char *name;
+ int defn;
+ {
+ if (!strcicmp(name, "SYSTEM"))
+ decl_builtins();
+ #ifdef CUST1
+ CUST1(name, defn);
+ #endif
+ #ifdef CUST2
+ CUST2(name, defn);
+ #endif
+ #ifdef CUST3
+ CUST3(name, defn);
+ #endif
+ #ifdef CUST4
+ CUST4(name, defn);
+ #endif
+ #ifdef CUST5
+ CUST5(name, defn);
+ #endif
+ }
+
+
+
+
+
+ /* This procedure is called once after the p2crc file has been
+ read and the built-in parameters have been "fixed". It should
+ check ranges and add defaults for any newly introduced parameters
+ in the "rctable" (see "trans.h").
+ */
+
+ void fix_parameters()
+ {
+
+
+ }
+
+
+
+
+
+ /* This function is called during a traversal of the tree of statements for
+ a procedure. Ordinarily it returns its argument; it may instead return
+ an arbitrary other statement or sequence of statements, which will then
+ be spliced in to replace the original one. It may return NULL to delete
+ the statement altogether.
+ */
+
+ Stmt *fix_statement(sp)
+ Stmt *sp;
+ {
+ return sp;
+ }
+
+
+
+
+
+ /* This is the analogous function for expression traversals. It is
+ called after the arguments have been (recursively) fixed and all
+ built-in fixes have been performed.
+ */
+
+ Expr *fix_expression(ex, env)
+ Expr *ex;
+ int env;
+ {
+ return ex;
+ }
+
+
+
+
+
+ /* This procedure is called when fixing an expression of type
+ EK_BICALL. It is called before the arguments are fixed. If
+ it recognizes the BICALL, it should fix the arguments, then
+ return a (possibly modified) fixed expression, which may or
+ may not be a BICALL. That expression will then be sent to
+ fix_expression() as usual, but other standard fixes will not
+ automatically be performed on it. If the BICALL is not
+ recognized, the function should return NULL.
+ */
+
+ Expr *fix_bicall(ex, env)
+ Expr *ex;
+ int env;
+ {
+ return NULL;
+ }
+
+
+
+
+
+ /* This function returns nonzero if the built-in function "name"
+ should be written "if (f(x))" rather than "if (f(x) != 0)"
+ when used as a boolean. The call does *not* necessarily have
+ to return a 1-or-0 value.
+ */
+
+ int boolean_bicall(name)
+ char *name;
+ {
+ return (!strcmp(name, "strcmp") ||
+ !strcmp(name, "strncmp") ||
+ !strcmp(name, "memcmp") ||
+ !strcmp(name, "feof") ||
+ !strcmp(name, "feoln"));
+ }
+
+
+
+
+
+ /* The function "name" promises not to change certain of its
+ VAR-style parameters. For each of arguments i = 0 through 15,
+ if bit 1<<i of the return value of this function is set, and
+ the i'th parameter is a pointer to an object, then the function
+ guarantees not to change that object.
+ */
+
+ unsigned int safemask_bicall(name)
+ char *name;
+ {
+ Symbol *sp;
+
+ sp = findsymbol_opt(name);
+ if (sp) {
+ if (sp->flags & (STRUCTF|STRLAPF))
+ return ~1;
+ if (sp->flags & (NOSIDEEFF|DETERMF))
+ return ~0;
+ }
+ if (!strcmp(name, "fwrite") ||
+ !strcmp(name, "memchr"))
+ return 1;
+ if (!strcmp(name, "memcpy") ||
+ !strcmp(name, "memmove"))
+ return 2;
+ if (!strcmp(name, "memcmp"))
+ return 3;
+ if (!strcmp(name, "sprintf") ||
+ !strcmp(name, "fprintf"))
+ return ~1;
+ if (!strcmp(name, "printf"))
+ return ~0;
+ return 0;
+ }
+
+
+
+
+
+ /* The function "name" has side effects that could affect other variables
+ in the program besides those that are explicitly mentioned.
+ */
+
+ int sideeffects_bicall(name)
+ char *name;
+ {
+ return 0;
+ }
+
+
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/expr.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/expr.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/expr.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,5574 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_EXPR_C
+ #include "trans.h"
+
+
+
+
+
+ void free_value(val)
+ Value *val;
+ {
+ if (!val || !val->type)
+ return;
+ switch (val->type->kind) {
+
+ case TK_STRING:
+ case TK_REAL:
+ case TK_ARRAY:
+ case TK_RECORD:
+ case TK_SET:
+ if (val->s)
+ FREE(val->s);
+ break;
+
+ default:
+ break;
+ }
+ }
+
+
+ Value copyvalue(val)
+ Value val;
+ {
+ char *cp;
+
+ switch (val.type->kind) {
+
+ case TK_STRING:
+ case TK_SET:
+ if (val.s) {
+ cp = ALLOC(val.i+1, char, literals);
+ memcpy(cp, val.s, val.i);
+ cp[val.i] = 0;
+ val.s = cp;
+ }
+ break;
+
+ case TK_REAL:
+ case TK_ARRAY:
+ case TK_RECORD:
+ if (val.s)
+ val.s = stralloc(val.s);
+ break;
+
+ default:
+ break;
+ }
+ return val;
+ }
+
+
+ int valuesame(a, b)
+ Value a, b;
+ {
+ if (a.type != b.type)
+ return 0;
+ switch (a.type->kind) {
+
+ case TK_INTEGER:
+ case TK_CHAR:
+ case TK_BOOLEAN:
+ case TK_ENUM:
+ case TK_SMALLSET:
+ case TK_SMALLARRAY:
+ return (a.i == b.i);
+
+ case TK_STRING:
+ case TK_SET:
+ return (a.i == b.i && !memcmp(a.s, b.s, a.i));
+
+ case TK_REAL:
+ case TK_ARRAY:
+ case TK_RECORD:
+ return (!strcmp(a.s, b.s));
+
+ default:
+ return 1;
+ }
+ }
+
+
+
+ char *value_name(val, intfmt, islong)
+ Value val;
+ char *intfmt;
+ int islong;
+ {
+ Meaning *mp;
+ Type *type = val.type;
+
+ if (type->kind == TK_SUBR)
+ type = type->basetype;
+ switch (type->kind) {
+
+ case TK_INTEGER:
+ case TK_SMALLSET:
+ case TK_SMALLARRAY:
+ if (!intfmt)
+ intfmt = "%ld";
+ if (*intfmt == '\'') {
+ if (val.i >= -'~' && val.i <= -' ') {
+ intfmt = format_s("-%s", intfmt);
+ val.i = -val.i;
+ }
+ if (val.i < ' ' || val.i > '~' || islong)
+ intfmt = "%ld";
+ }
+ if (islong)
+ intfmt = format_s("%sL", intfmt);
+ return format_d(intfmt, val.i);
+
+ case TK_REAL:
+ return val.s;
+
+ case TK_ARRAY: /* obsolete */
+ case TK_RECORD: /* obsolete */
+ return val.s;
+
+ case TK_STRING:
+ return makeCstring(val.s, val.i);
+
+ case TK_BOOLEAN:
+ if (!intfmt)
+ if (val.i == 1 && *name_TRUE &&
+ strcmp(name_TRUE, "1") && !islong)
+ intfmt = name_TRUE;
+ else if (val.i == 0 && *name_FALSE &&
+ strcmp(name_FALSE, "0") && !islong)
+ intfmt = name_FALSE;
+ else
+ intfmt = "%ld";
+ if (islong)
+ intfmt = format_s("%sL", intfmt);
+ return format_d(intfmt, val.i);
+
+ case TK_CHAR:
+ if (islong)
+ return format_d("%ldL", val.i);
+ else if ((val.i < 0 || val.i > 127) && highcharints)
+ return format_d("%ld", val.i);
+ else
+ return makeCchar(val.i);
+
+ case TK_POINTER:
+ return (*name_NULL) ? name_NULL : "NULL";
+
+ case TK_ENUM:
+ mp = val.type->fbase;
+ while (mp && mp->val.i != val.i)
+ mp = mp->xnext;
+ if (!mp) {
+ intwarning("value_name", "bad enum value [152]");
+ return format_d("%ld", val.i);
+ }
+ return mp->name;
+
+ default:
+ intwarning("value_name", format_s("bad type for constant: %s [153]",
+ typekindname(type->kind)));
+ return "<spam>";
+ }
+ }
+
+
+
+
+ Value value_cast(val, type)
+ Value val;
+ Type *type;
+ {
+ char buf[20];
+
+ if (type->kind == TK_SUBR)
+ type = type->basetype;
+ if (val.type == type)
+ return val;
+ if (type && val.type) {
+ switch (type->kind) {
+
+ case TK_REAL:
+ if (ord_type(val.type)->kind == TK_INTEGER) {
+ sprintf(buf, "%d.0", val.i);
+ val.s = stralloc(buf);
+ val.type = tp_real;
+ return val;
+ }
+ break;
+
+ case TK_CHAR:
+ if (val.type->kind == TK_STRING) {
+ if (val.i != 1)
+ if (val.i > 0)
+ warning("Char constant with more than one character [154]");
+ else
+ warning("Empty char constant [155]");
+ val.i = val.s[0] & 0xff;
+ val.s = NULL;
+ val.type = tp_char;
+ return val;
+ }
+
+ case TK_POINTER:
+ if (val.type == tp_anyptr && castnull != 1) {
+ val.type = type;
+ return val;
+ }
+
+ default:
+ break;
+ }
+ }
+ val.type = NULL;
+ return val;
+ }
+
+
+
+ Type *ord_type(tp)
+ Type *tp;
+ {
+ if (!tp) {
+ warning("Expected a constant [127]");
+ return tp_integer;
+ }
+ switch (tp->kind) {
+
+ case TK_SUBR:
+ tp = tp->basetype;
+ break;
+
+ case TK_STRING:
+ if (!CHECKORDEXPR(tp->indextype->smax, 1))
+ tp = tp_char;
+ break;
+
+ default:
+ break;
+
+ }
+ return tp;
+ }
+
+
+
+ int long_type(tp)
+ Type *tp;
+ {
+ switch (tp->kind) {
+
+ case TK_INTEGER:
+ return (tp != tp_int && tp != tp_uint && tp != tp_sint);
+
+ case TK_SUBR:
+ return (findbasetype(tp, ODECL_NOPRES) == tp_integer);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ Value make_ord(type, i)
+ Type *type;
+ long i;
+ {
+ Value val;
+
+ if (type->kind == TK_ENUM)
+ type = findbasetype(type, ODECL_NOPRES);
+ if (type->kind == TK_SUBR)
+ type = type->basetype;
+ val.type = type;
+ val.i = i;
+ val.s = NULL;
+ return val;
+ }
+
+
+
+ long ord_value(val)
+ Value val;
+ {
+ switch (val.type->kind) {
+
+ case TK_INTEGER:
+ case TK_ENUM:
+ case TK_CHAR:
+ case TK_BOOLEAN:
+ return val.i;
+
+ case TK_STRING:
+ if (val.i == 1)
+ return val.s[0] & 0xff;
+
+ /* fall through */
+ default:
+ warning("Expected an ordinal type [156]");
+ return 0;
+ }
+ }
+
+
+
+ void ord_range_expr(type, smin, smax)
+ Type *type;
+ Expr **smin, **smax;
+ {
+ if (!type) {
+ warning("Expected a constant [127]");
+ type = tp_integer;
+ }
+ if (type->kind == TK_STRING)
+ type = tp_char;
+ switch (type->kind) {
+
+ case TK_SUBR:
+ case TK_INTEGER:
+ case TK_ENUM:
+ case TK_CHAR:
+ case TK_BOOLEAN:
+ if (smin) *smin = type->smin;
+ if (smax) *smax = type->smax;
+ break;
+
+ default:
+ warning("Expected an ordinal type [156]");
+ if (smin) *smin = makeexpr_long(0);
+ if (smax) *smax = makeexpr_long(1);
+ break;
+ }
+ }
+
+
+ int ord_range(type, smin, smax)
+ Type *type;
+ long *smin, *smax;
+ {
+ Expr *emin, *emax;
+ Value vmin, vmax;
+
+ ord_range_expr(type, &emin, &emax);
+ if (smin) {
+ vmin = eval_expr(emin);
+ if (!vmin.type)
+ return 0;
+ }
+ if (smax) {
+ vmax = eval_expr(emax);
+ if (!vmax.type)
+ return 0;
+ }
+ if (smin) *smin = ord_value(vmin);
+ if (smax) *smax = ord_value(vmax);
+ return 1;
+ }
+
+
+
+
+
+
+
+ void freeexpr(ex)
+ register Expr *ex;
+ {
+ register int i;
+
+ if (ex) {
+ for (i = 0; i < ex->nargs; i++)
+ freeexpr(ex->args[i]);
+ switch (ex->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ free_value(&ex->val);
+ break;
+
+ case EK_DOT:
+ case EK_NAME:
+ case EK_BICALL:
+ if (ex->val.s)
+ FREE(ex->val.s);
+ break;
+
+ default:
+ break;
+ }
+ FREE(ex);
+ }
+ }
+
+
+
+
+ Expr *makeexpr(kind, n)
+ enum exprkind kind;
+ int n;
+ {
+ Expr *ex;
+
+ ex = ALLOCV(sizeof(Expr) + (n-1)*sizeof(Expr *), Expr, exprs);
+ ex->val.i = 0;
+ ex->val.s = NULL;
+ ex->kind = kind;
+ ex->nargs = n;
+ return ex;
+ }
+
+
+ Expr *makeexpr_un(kind, type, arg1)
+ enum exprkind kind;
+ Type *type;
+ Expr *arg1;
+ {
+ Expr *ex;
+
+ ex = makeexpr(kind, 1);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ if (debug>2) { fprintf(outf,"makeexpr_un returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+ Expr *makeexpr_bin(kind, type, arg1, arg2)
+ enum exprkind kind;
+ Type *type;
+ Expr *arg1, *arg2;
+ {
+ Expr *ex;
+
+ ex = makeexpr(kind, 2);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ ex->args[1] = arg2;
+ if (debug>2) { fprintf(outf,"makeexpr_bin returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_val(val)
+ Value val;
+ {
+ Expr *ex;
+
+ if (val.type->kind == TK_INTEGER &&
+ (val.i < -32767 || val.i > 32767) &&
+ sizeof_int < 32)
+ ex = makeexpr(EK_LONGCONST, 0);
+ else
+ ex = makeexpr(EK_CONST, 0);
+ ex->val = val;
+ if (debug>2) { fprintf(outf,"makeexpr_val returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_char(c)
+ int c;
+ {
+ return makeexpr_val(make_ord(tp_char, c));
+ }
+
+
+ Expr *makeexpr_long(i)
+ long i;
+ {
+ return makeexpr_val(make_ord(tp_integer, i));
+ }
+
+
+ Expr *makeexpr_real(r)
+ char *r;
+ {
+ Value val;
+
+ val.type = tp_real;
+ val.i = 0;
+ val.s = stralloc(r);
+ return makeexpr_val(val);
+ }
+
+
+ Expr *makeexpr_lstring(msg, len)
+ char *msg;
+ int len;
+ {
+ Value val;
+
+ val.type = tp_str255;
+ val.i = len;
+ val.s = ALLOC(len+1, char, literals);
+ memcpy(val.s, msg, len);
+ val.s[len] = 0;
+ return makeexpr_val(val);
+ }
+
+
+ Expr *makeexpr_string(msg)
+ char *msg;
+ {
+ Value val;
+
+ val.type = tp_str255;
+ val.i = strlen(msg);
+ val.s = stralloc(msg);
+ return makeexpr_val(val);
+ }
+
+
+ int checkstring(ex, msg)
+ Expr *ex;
+ char *msg;
+ {
+ if (!ex || ex->val.type->kind != TK_STRING || ex->kind != EK_CONST)
+ return 0;
+ if (ex->val.i != strlen(msg))
+ return 0;
+ return memcmp(ex->val.s, msg, ex->val.i) == 0;
+ }
+
+
+
+ Expr *makeexpr_var(mp)
+ Meaning *mp;
+ {
+ Expr *ex;
+
+ ex = makeexpr(EK_VAR, 0);
+ ex->val.i = (long) mp;
+ ex->val.type = mp->type;
+ if (debug>2) { fprintf(outf,"makeexpr_var returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_name(name, type)
+ char *name;
+ Type *type;
+ {
+ Expr *ex;
+
+ ex = makeexpr(EK_NAME, 0);
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ if (debug>2) { fprintf(outf,"makeexpr_name returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_setbits()
+ {
+ if (*name_SETBITS)
+ return makeexpr_name(name_SETBITS, tp_integer);
+ else
+ return makeexpr_long(setbits);
+ }
+
+
+
+ /* Note: BICALL's to the following functions should obey the ANSI standard. */
+ /* Non-ANSI transformations occur while writing the expression. */
+ /* char *sprintf(buf, fmt, ...) [returns buf] */
+ /* void *memcpy(dest, src, size) [returns dest] */
+
+ Expr *makeexpr_bicall_0(name, type)
+ char *name;
+ Type *type;
+ {
+ Expr *ex;
+
+ if (!name || !*name) {
+ intwarning("makeexpr_bicall_0", "Required name of built-in procedure is missing [157]");
+ name = "MissingProc";
+ }
+ ex = makeexpr(EK_BICALL, 0);
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+ Expr *makeexpr_bicall_1(name, type, arg1)
+ char *name;
+ Type *type;
+ Expr *arg1;
+ {
+ Expr *ex;
+
+ if (!name || !*name) {
+ intwarning("makeexpr_bicall_1", "Required name of built-in procedure is missing [157]");
+ name = "MissingProc";
+ }
+ ex = makeexpr(EK_BICALL, 1);
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+ Expr *makeexpr_bicall_2(name, type, arg1, arg2)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2;
+ {
+ Expr *ex;
+
+ if (!name || !*name) {
+ intwarning("makeexpr_bicall_2", "Required name of built-in procedure is missing [157]");
+ name = "MissingProc";
+ }
+ ex = makeexpr(EK_BICALL, 2);
+ if (!strcmp(name, "~SETIO"))
+ name = (iocheck_flag) ? "~~SETIO" : name_SETIO;
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ ex->args[1] = arg2;
+ if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+ Expr *makeexpr_bicall_3(name, type, arg1, arg2, arg3)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2, *arg3;
+ {
+ Expr *ex;
+
+ if (!name || !*name) {
+ intwarning("makeexpr_bicall_3", "Required name of built-in procedure is missing [157]");
+ name = "MissingProc";
+ }
+ ex = makeexpr(EK_BICALL, 3);
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ ex->args[1] = arg2;
+ ex->args[2] = arg3;
+ if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+ Expr *makeexpr_bicall_4(name, type, arg1, arg2, arg3, arg4)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2, *arg3, *arg4;
+ {
+ Expr *ex;
+
+ if (!name || !*name) {
+ intwarning("makeexpr_bicall_4", "Required name of built-in procedure is missing [157]");
+ name = "MissingProc";
+ }
+ ex = makeexpr(EK_BICALL, 4);
+ if (!strcmp(name, "~CHKIO"))
+ name = (iocheck_flag) ? "~~CHKIO" : name_CHKIO;
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ ex->args[1] = arg2;
+ ex->args[2] = arg3;
+ ex->args[3] = arg4;
+ if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+ Expr *makeexpr_bicall_5(name, type, arg1, arg2, arg3, arg4, arg5)
+ char *name;
+ Type *type;
+ Expr *arg1, *arg2, *arg3, *arg4, *arg5;
+ {
+ Expr *ex;
+
+ if (!name || !*name) {
+ intwarning("makeexpr_bicall_5", "Required name of built-in procedure is missing [157]");
+ name = "MissingProc";
+ }
+ ex = makeexpr(EK_BICALL, 5);
+ ex->val.s = stralloc(name);
+ ex->val.type = type;
+ ex->args[0] = arg1;
+ ex->args[1] = arg2;
+ ex->args[2] = arg3;
+ ex->args[3] = arg4;
+ ex->args[4] = arg5;
+ if (debug>2) { fprintf(outf,"makeexpr_bicall returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+
+ Expr *copyexpr(ex)
+ register Expr *ex;
+ {
+ register int i;
+ register Expr *ex2;
+
+ if (ex) {
+ ex2 = makeexpr(ex->kind, ex->nargs);
+ for (i = 0; i < ex->nargs; i++)
+ ex2->args[i] = copyexpr(ex->args[i]);
+ switch (ex->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ ex2->val = copyvalue(ex->val);
+ break;
+
+ case EK_DOT:
+ case EK_NAME:
+ case EK_BICALL:
+ ex2->val.type = ex->val.type;
+ ex2->val.i = ex->val.i;
+ if (ex->val.s)
+ ex2->val.s = stralloc(ex->val.s);
+ break;
+
+ default:
+ ex2->val = ex->val;
+ break;
+ }
+ return ex2;
+ } else
+ return NULL;
+ }
+
+
+
+ int exprsame(a, b, strict)
+ register Expr *a, *b;
+ int strict;
+ {
+ register int i;
+
+ if (!a)
+ return (!b);
+ if (!b)
+ return 0;
+ if (a->val.type != b->val.type && strict != 2) {
+ if (strict ||
+ !((a->val.type->kind == TK_POINTER &&
+ a->val.type->basetype == b->val.type) ||
+ (b->val.type->kind == TK_POINTER &&
+ b->val.type->basetype == a->val.type)))
+ return 0;
+ }
+ if (a->kind != b->kind || a->nargs != b->nargs)
+ return 0;
+ switch (a->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ if (!valuesame(a->val, b->val))
+ return 0;
+ break;
+
+ case EK_BICALL:
+ case EK_NAME:
+ if (strcmp(a->val.s, b->val.s))
+ return 0;
+ break;
+
+ case EK_VAR:
+ case EK_FUNCTION:
+ case EK_CTX:
+ case EK_MACARG:
+ if (a->val.i != b->val.i)
+ return 0;
+ break;
+
+ case EK_DOT:
+ if (a->val.i != b->val.i ||
+ (!a->val.i && strcmp(a->val.s, b->val.s)))
+ return 0;
+ break;
+
+ default:
+ break;
+ }
+ i = a->nargs;
+ while (--i >= 0)
+ if (!exprsame(a->args[i], b->args[i], (strict == 2) ? 1 : strict))
+ return 0;
+ return 1;
+ }
+
+
+
+ int exprequiv(a, b)
+ register Expr *a, *b;
+ {
+ register int i, j, k;
+ enum exprkind kind2;
+
+ if (!a)
+ return (!b);
+ if (!b)
+ return 0;
+ switch (a->kind) {
+
+ case EK_PLUS:
+ case EK_TIMES:
+ case EK_BAND:
+ case EK_BOR:
+ case EK_BXOR:
+ case EK_EQ:
+ case EK_NE:
+ if (b->kind != a->kind || b->nargs != a->nargs ||
+ b->val.type != a->val.type)
+ return 0;
+ if (a->nargs > 3)
+ break;
+ for (i = 0; i < b->nargs; i++) {
+ if (exprequiv(a->args[0], b->args[i])) {
+ for (j = 0; j < b->nargs; j++) {
+ if (j != i &&
+ exprequiv(a->args[1], b->args[i])) {
+ if (a->nargs == 2)
+ return 1;
+ for (k = 0; k < b->nargs; k++) {
+ if (k != i && k != j &&
+ exprequiv(a->args[2], b->args[k]))
+ return 1;
+ }
+ }
+ }
+ }
+ }
+ break;
+
+ case EK_LT:
+ case EK_GT:
+ case EK_LE:
+ case EK_GE:
+ switch (a->kind) {
+ case EK_LT: kind2 = EK_GT; break;
+ case EK_GT: kind2 = EK_LT; break;
+ case EK_LE: kind2 = EK_GE; break;
+ default: kind2 = EK_LE; break;
+ }
+ if (b->kind != kind2 || b->val.type != a->val.type)
+ break;
+ if (exprequiv(a->args[0], b->args[1]) &&
+ exprequiv(a->args[1], b->args[0])) {
+ return 1;
+ }
+ break;
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ case EK_BICALL:
+ case EK_NAME:
+ case EK_VAR:
+ case EK_FUNCTION:
+ case EK_CTX:
+ case EK_DOT:
+ return exprsame(a, b, 0);
+
+ default:
+ break;
+ }
+ if (b->kind != a->kind || b->nargs != a->nargs ||
+ b->val.type != a->val.type)
+ return 0;
+ i = a->nargs;
+ while (--i >= 0)
+ if (!exprequiv(a->args[i], b->args[i]))
+ return 0;
+ return 1;
+ }
+
+
+
+ void deletearg(ex, n)
+ Expr **ex;
+ register int n;
+ {
+ register Expr *ex1 = *ex, *ex2;
+ register int i;
+
+ if (debug>2) { fprintf(outf,"deletearg("); dumpexpr(*ex); fprintf(outf,", %d)\n", n); }
+ if (n < 0 || n >= (*ex)->nargs) {
+ intwarning("deletearg", "argument number out of range [158]");
+ return;
+ }
+ ex2 = makeexpr(ex1->kind, ex1->nargs-1);
+ ex2->val = ex1->val;
+ for (i = 0; i < n; i++)
+ ex2->args[i] = ex1->args[i];
+ for (; i < ex2->nargs; i++)
+ ex2->args[i] = ex1->args[i+1];
+ *ex = ex2;
+ FREE(ex1);
+ if (debug>2) { fprintf(outf,"deletearg returns "); dumpexpr(*ex); fprintf(outf,"\n"); }
+ }
+
+
+
+ void insertarg(ex, n, arg)
+ Expr **ex;
+ Expr *arg;
+ register int n;
+ {
+ register Expr *ex1 = *ex, *ex2;
+ register int i;
+
+ if (debug>2) { fprintf(outf,"insertarg("); dumpexpr(*ex); fprintf(outf,", %d)\n", n); }
+ if (n < 0 || n > (*ex)->nargs) {
+ intwarning("insertarg", "argument number out of range [159]");
+ return;
+ }
+ ex2 = makeexpr(ex1->kind, ex1->nargs+1);
+ ex2->val = ex1->val;
+ for (i = 0; i < n; i++)
+ ex2->args[i] = ex1->args[i];
+ ex2->args[n] = arg;
+ for (; i < ex1->nargs; i++)
+ ex2->args[i+1] = ex1->args[i];
+ *ex = ex2;
+ FREE(ex1);
+ if (debug>2) { fprintf(outf,"insertarg returns "); dumpexpr(*ex); fprintf(outf,"\n"); }
+ }
+
+
+
+ Expr *grabarg(ex, n)
+ Expr *ex;
+ int n;
+ {
+ Expr *ex2;
+
+ if (n < 0 || n >= ex->nargs) {
+ intwarning("grabarg", "argument number out of range [160]");
+ return ex;
+ }
+ ex2 = ex->args[n];
+ ex->args[n] = makeexpr_long(0); /* placeholder */
+ freeexpr(ex);
+ return ex2;
+ }
+
+
+
+ void delsimparg(ep, n)
+ Expr **ep;
+ int n;
+ {
+ if (n < 0 || n >= (*ep)->nargs) {
+ intwarning("delsimparg", "argument number out of range [161]");
+ return;
+ }
+ deletearg(ep, n);
+ switch ((*ep)->kind) {
+
+ case EK_PLUS:
+ case EK_TIMES:
+ case EK_COMMA:
+ if ((*ep)->nargs == 1)
+ *ep = grabarg(*ep, 0);
+ break;
+
+ default:
+ break;
+
+ }
+ }
+
+
+
+
+ Expr *resimplify(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+ Type *type;
+ int i;
+
+ if (debug>2) { fprintf(outf,"resimplify("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (!ex)
+ return NULL;
+ type = ex->val.type;
+ switch (ex->kind) {
+
+ case EK_PLUS:
+ ex2 = ex->args[0];
+ for (i = 1; i < ex->nargs; i++)
+ ex2 = makeexpr_plus(ex2, ex->args[i]);
+ FREE(ex);
+ return ex2;
+
+ case EK_TIMES:
+ ex2 = ex->args[0];
+ for (i = 1; i < ex->nargs; i++)
+ ex2 = makeexpr_times(ex2, ex->args[i]);
+ FREE(ex);
+ return ex2;
+
+ case EK_NEG:
+ ex = makeexpr_neg(grabarg(ex, 0));
+ ex->val.type = type;
+ return ex;
+
+ case EK_NOT:
+ ex = makeexpr_not(grabarg(ex, 0));
+ ex->val.type = type;
+ return ex;
+
+ case EK_HAT:
+ ex = makeexpr_hat(grabarg(ex, 0), 0);
+ if (ex->kind == EK_HAT)
+ ex->val.type = type;
+ return ex;
+
+ case EK_ADDR:
+ ex = makeexpr_addr(grabarg(ex, 0));
+ ex->val.type = type;
+ return ex;
+
+ case EK_ASSIGN:
+ ex2 = makeexpr_assign(ex->args[0], ex->args[1]);
+ FREE(ex);
+ return ex2;
+
+ default:
+ break;
+ }
+ return ex;
+ }
+
+
+
+
+
+
+ int realzero(s)
+ register char *s;
+ {
+ if (*s == '-') s++;
+ while (*s == '0' || *s == '.') s++;
+ return (!isdigit(*s));
+ }
+
+ int realint(s, i)
+ register char *s;
+ int i;
+ {
+ if (i == 0)
+ return realzero(s);
+ if (*s == '-') {
+ s++;
+ i = -i;
+ }
+ if (i < 0 || i > 9) return 0; /* we don't care about large values here */
+ while (*s == '0') s++;
+ if (*s++ != i + '0') return 0;
+ if (*s == '.')
+ while (*++s == '0') ;
+ return (!isdigit(*s));
+ }
+
+
+ int checkconst(ex, val)
+ Expr *ex;
+ long val;
+ {
+ Meaning *mp;
+ Value exval;
+
+ if (!ex)
+ return 0;
+ if (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
+ ex = ex->args[0];
+ if (ex->kind == EK_CONST || ex->kind == EK_LONGCONST)
+ exval = ex->val;
+ else if (ex->kind == EK_VAR &&
+ (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
+ mp->val.type &&
+ foldconsts != 0)
+ exval = mp->val;
+ else
+ return 0;
+ switch (exval.type->kind) {
+
+ case TK_BOOLEAN:
+ case TK_INTEGER:
+ case TK_CHAR:
+ case TK_ENUM:
+ case TK_SUBR:
+ case TK_SMALLSET:
+ case TK_SMALLARRAY:
+ return exval.i == val;
+
+ case TK_POINTER:
+ case TK_STRING:
+ return (val == 0 && exval.i == 0);
+
+ case TK_REAL:
+ return realint(exval.s, val);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ int isliteralconst(ex, valp)
+ Expr *ex;
+ Value *valp;
+ {
+ Meaning *mp;
+
+ if (ex) {
+ switch (ex->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ if (valp)
+ *valp = ex->val;
+ return 2;
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ if (mp->kind == MK_CONST) {
+ if (valp) {
+ if (foldconsts == 0)
+ valp->type = NULL;
+ else
+ *valp = mp->val;
+ }
+ return 1;
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+ if (valp)
+ valp->type = NULL;
+ return 0;
+ }
+
+
+
+ int isconstexpr(ex, valp)
+ Expr *ex;
+ long *valp;
+ {
+ Value exval;
+
+ if (debug>2) { fprintf(outf,"isconstexpr("); dumpexpr(ex); fprintf(outf,")\n"); }
+ exval = eval_expr(ex);
+ if (exval.type) {
+ if (valp)
+ *valp = exval.i;
+ return 1;
+ } else
+ return 0;
+ }
+
+
+
+ int isconstantexpr(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ int i;
+
+ switch (ex->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ case EK_SIZEOF:
+ return 1;
+
+ case EK_ADDR:
+ if (ex->args[0]->kind == EK_VAR) {
+ mp = (Meaning *)ex->val.i;
+ return (!mp->ctx || mp->ctx->kind == MK_MODULE);
+ }
+ return 0;
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ return (mp->kind == MK_CONST);
+
+ case EK_BICALL:
+ case EK_FUNCTION:
+ if (!deterministic_func(ex))
+ return 0;
+
+ /* fall through */
+ case EK_EQ:
+ case EK_NE:
+ case EK_LT:
+ case EK_GT:
+ case EK_LE:
+ case EK_GE:
+ case EK_PLUS:
+ case EK_NEG:
+ case EK_TIMES:
+ case EK_DIVIDE:
+ case EK_DIV:
+ case EK_MOD:
+ case EK_AND:
+ case EK_OR:
+ case EK_NOT:
+ case EK_BAND:
+ case EK_BOR:
+ case EK_BXOR:
+ case EK_BNOT:
+ case EK_LSH:
+ case EK_RSH:
+ case EK_CAST:
+ case EK_ACTCAST:
+ case EK_COND:
+ for (i = 0; i < ex->nargs; i++) {
+ if (!isconstantexpr(ex->args[i]))
+ return 0;
+ }
+ return 1;
+
+ case EK_COMMA:
+ return isconstantexpr(ex->args[ex->nargs-1]);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+
+
+ Static Expr *docast(a, type)
+ Expr *a;
+ Type *type;
+ {
+ Value val;
+ Meaning *mp;
+ int i;
+ Expr *ex;
+
+ if (a->val.type->kind == TK_SMALLSET && type->kind == TK_SET) {
+ mp = makestmttempvar(type, name_SET);
+ return makeexpr_bicall_2(setexpandname, type,
+ makeexpr_var(mp),
+ makeexpr_arglong(a, 1));
+ } else if (a->val.type->kind == TK_SET && type->kind == TK_SMALLSET) {
+ return packset(a, type);
+ }
+ switch (a->kind) {
+
+ case EK_VAR:
+ mp = (Meaning *) a->val.i;
+ if (mp->kind == MK_CONST) {
+ if (mp->val.type && mp->val.type->kind == TK_STRING &&
+ type->kind == TK_CHAR) {
+ val = value_cast(mp->val, type);
+ a->kind = EK_CONST;
+ a->val = val;
+ return a;
+ }
+ }
+ break;
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ val = value_cast(a->val, type);
+ if (val.type) {
+ a->val = val;
+ return a;
+ }
+ break;
+
+ case EK_PLUS:
+ case EK_NEG:
+ case EK_TIMES:
+ if (type->kind == TK_REAL) {
+ for (i = 0; i < a->nargs; i++) {
+ ex = docast(a->args[i], type);
+ if (ex) {
+ a->args[i] = ex;
+ a->val.type = type;
+ return a;
+ }
+ }
+ }
+ break;
+
+ default:
+ break;
+ }
+ return NULL;
+ }
+
+
+
+ /* Make an "active" cast, i.e., one that performs an explicit operation */
+ Expr *makeexpr_actcast(a, type)
+ Expr *a;
+ Type *type;
+ {
+ if (debug>2) { fprintf(outf,"makeexpr_actcast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+
+ if (similartypes(a->val.type, type)) {
+ a->val.type = type;
+ return a;
+ }
+ return makeexpr_un(EK_ACTCAST, type, a);
+ }
+
+
+
+ Expr *makeexpr_cast(a, type)
+ Expr *a;
+ Type *type;
+ {
+ Expr *ex;
+
+ if (debug>2) { fprintf(outf,"makeexpr_cast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+ if (a->val.type == type)
+ return a;
+ ex = docast(a, type);
+ if (ex)
+ return ex;
+ if (a->kind == EK_CAST &&
+ a->args[0]->val.type->kind == TK_POINTER &&
+ similartypes(type, a->args[0]->val.type)) {
+ a = grabarg(a, 0);
+ a->val.type = type;
+ return a;
+ }
+ if ((a->kind == EK_CAST &&
+ ((a->val.type->kind == TK_POINTER && type->kind == TK_POINTER) ||
+ (ord_type(a->val.type)->kind == TK_INTEGER && ord_type(type)->kind == TK_INTEGER))) ||
+ similartypes(type, a->val.type)) {
+ a->val.type = type;
+ return a;
+ }
+ return makeexpr_un(EK_CAST, type, a);
+ }
+
+
+
+ Expr *gentle_cast(a, type)
+ Expr *a;
+ Type *type;
+ {
+ Expr *ex;
+ Type *btype;
+ long smin, smax;
+ Value val;
+ char c;
+
+ if (debug>2) { fprintf(outf,"gentle_cast("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+ if (!type) {
+ intwarning("gentle_cast", "type == NULL");
+ return a;
+ }
+ if (a->val.type->kind == TK_POINTER && type->kind == TK_POINTER) {
+ if (voidstar && (type == tp_anyptr || a->val.type == tp_anyptr)) {
+ if (type == tp_anyptr && a->kind == EK_CAST &&
+ a->args[0]->val.type->kind == TK_POINTER)
+ return a->args[0]; /* remove explicit cast since casting implicitly */
+ return a; /* casting to/from "void *" */
+ }
+ return makeexpr_cast(a, type);
+ }
+ if (type->kind == TK_STRING)
+ return makeexpr_stringify(a);
+ if (type->kind == TK_ARRAY &&
+ (a->val.type->kind == TK_STRING ||
+ a->val.type->kind == TK_CHAR) &&
+ isliteralconst(a, &val) && val.type &&
+ ord_range(type->indextype, &smin, &smax)) {
+ smax = smax - smin + 1;
+ if (a->val.type->kind == TK_CHAR) {
+ val.s = &c;
+ c = val.i;
+ val.i = 1;
+ }
+ if (val.i > smax) {
+ warning("Too many characters for packed array of char [162]");
+ } else if (val.i < smax || a->val.type->kind == TK_CHAR) {
+ ex = makeexpr_lstring(val.s, smax);
+ while (smax > val.i)
+ ex->val.s[--smax] = ' ';
+ freeexpr(a);
+ return ex;
+ }
+ }
+ btype = (type->kind == TK_SUBR) ? type->basetype : type;
+ if ((a->kind == EK_CAST || a->kind == EK_ACTCAST) &&
+ btype->kind == TK_INTEGER &&
+ ord_type(a->val.type)->kind == TK_INTEGER)
+ return makeexpr_longcast(a, long_type(type));
+ if (a->val.type == btype)
+ return a;
+ ex = docast(a, btype);
+ if (ex)
+ return ex;
+ if (btype->kind == TK_CHAR && a->val.type->kind == TK_STRING)
+ return makeexpr_hat(a, 0);
+ return a;
+ }
+
+
+
+ Expr *makeexpr_charcast(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
+ ex->val.i == 1) {
+ ex->val.type = tp_char;
+ ex->val.i = ex->val.s[0] & 0xff;
+ ex->val.s = NULL;
+ }
+ if (ex->kind == EK_VAR &&
+ (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
+ mp->val.type &&
+ mp->val.type->kind == TK_STRING &&
+ mp->val.i == 1) {
+ ex->kind = EK_CONST;
+ ex->val.type = tp_char;
+ ex->val.i = mp->val.s[0] & 0xff;
+ ex->val.s = NULL;
+ }
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_stringcast(ex)
+ Expr *ex;
+ {
+ char ch;
+
+ if (ex->kind == EK_CONST && ord_type(ex->val.type)->kind == TK_CHAR) {
+ ch = ex->val.i;
+ freeexpr(ex);
+ ex = makeexpr_lstring(&ch, 1);
+ }
+ return ex;
+ }
+
+
+
+
+
+ /* 0/1 = force to int/long, 2/3 = check if int/long */
+
+ Static Expr *dolongcast(a, tolong)
+ Expr *a;
+ int tolong;
+ {
+ Meaning *mp;
+ Expr *ex;
+ Type *type;
+ int i;
+
+ switch (a->kind) {
+
+ case EK_DOT:
+ if (!a->val.i) {
+ if (long_type(a->val.type) == (tolong&1))
+ return a;
+ break;
+ }
+
+ /* fall through */
+ case EK_VAR:
+ mp = (Meaning *)a->val.i;
+ if (mp->kind == MK_FIELD && mp->val.i) {
+ if (mp->val.i <= ((sizeof_int > 0) ? sizeof_int : 16) &&
+ !(tolong&1))
+ return a;
+ } else if (mp->kind == MK_VAR ||
+ mp->kind == MK_VARREF ||
+ mp->kind == MK_PARAM ||
+ mp->kind == MK_VARPARAM ||
+ mp->kind == MK_FIELD) {
+ if (long_type(mp->type) == (tolong&1))
+ return a;
+ }
+ break;
+
+ case EK_FUNCTION:
+ mp = (Meaning *)a->val.i;
+ if (long_type(mp->type->basetype) == (tolong&1))
+ return a;
+ break;
+
+ case EK_BICALL:
+ if (!strcmp(a->val.s, signextname) && *signextname) {
+ i = 0;
+ goto unary;
+ }
+ if (!strcmp(a->val.s, "strlen"))
+ goto size_t_case;
+ /* fall through */
+
+ case EK_HAT: /* get true type from a->val.type */
+ case EK_INDEX:
+ case EK_SPCALL:
+ case EK_NAME:
+ if (long_type(a->val.type) == (tolong&1))
+ return a;
+ break;
+
+ case EK_ASSIGN: /* destination determines type, */
+ case EK_POSTINC: /* but must not be changed */
+ case EK_POSTDEC:
+ return dolongcast(a->args[0], tolong|2);
+
+ case EK_CAST:
+ if (ord_type(a->val.type)->kind == TK_INTEGER &&
+ long_type(a->val.type) == (tolong&1))
+ return a;
+ if (tolong == 0) {
+ a->val.type = tp_int;
+ return a;
+ } else if (tolong == 1) {
+ a->val.type = tp_integer;
+ return a;
+ }
+ break;
+
+ case EK_ACTCAST:
+ if (ord_type(a->val.type)->kind == TK_INTEGER &&
+ long_type(a->val.type) == (tolong&1))
+ return a;
+ break;
+
+ case EK_CONST:
+ type = ord_type(a->val.type);
+ if (type->kind == TK_INTEGER || type->kind == TK_SMALLSET) {
+ if (tolong == 1)
+ a->kind = EK_LONGCONST;
+ if (tolong != 3)
+ return a;
+ }
+ break;
+
+ case EK_LONGCONST:
+ if (tolong == 0) {
+ if (a->val.i >= -32767 && a->val.i <= 32767)
+ a->kind = EK_CONST;
+ else
+ return NULL;
+ }
+ if (tolong != 2)
+ return a;
+ break;
+
+ case EK_SIZEOF:
+ size_t_case:
+ if (size_t_long > 0 && tolong&1)
+ return a;
+ if (size_t_long == 0 && !(tolong&1))
+ return a;
+ break;
+
+ case EK_PLUS: /* usual arithmetic conversions apply */
+ case EK_TIMES:
+ case EK_DIV:
+ case EK_MOD:
+ case EK_BAND:
+ case EK_BOR:
+ case EK_BXOR:
+ case EK_COND:
+ i = (a->kind == EK_COND) ? 1 : 0;
+ if (tolong&1) {
+ for (; i < a->nargs; i++) {
+ ex = dolongcast(a->args[i], tolong);
+ if (ex) {
+ a->args[i] = ex;
+ return a;
+ }
+ }
+ } else {
+ for (; i < a->nargs; i++) {
+ if (!dolongcast(a->args[i], tolong))
+ return NULL;
+ }
+ return a;
+ }
+ break;
+
+ case EK_BNOT: /* single argument defines result type */
+ case EK_NEG:
+ case EK_LSH:
+ case EK_RSH:
+ case EK_COMMA:
+ i = (a->kind == EK_COMMA) ? a->nargs-1 : 0;
+ unary:
+ if (tolong&1) {
+ ex = dolongcast(a->args[i], tolong);
+ if (ex) {
+ a->args[i] = ex;
+ return a;
+ }
+ } else {
+ if (dolongcast(a->args[i], tolong))
+ return a;
+ }
+ break;
+
+ case EK_AND: /* operators which always return int */
+ case EK_OR:
+ case EK_EQ:
+ case EK_NE:
+ case EK_LT:
+ case EK_GT:
+ case EK_LE:
+ case EK_GE:
+ if (tolong&1)
+ break;
+ return a;
+
+ default:
+ break;
+ }
+ return NULL;
+ }
+
+
+ /* Return -1 if short int or plain int, 1 if long, 0 if can't tell */
+ int exprlongness(ex)
+ Expr *ex;
+ {
+ if (sizeof_int >= 32)
+ return -1;
+ return (dolongcast(ex, 3) != NULL) -
+ (dolongcast(ex, 2) != NULL);
+ }
+
+
+ Expr *makeexpr_longcast(a, tolong)
+ Expr *a;
+ int tolong;
+ {
+ Expr *ex;
+ Type *type;
+
+ if (sizeof_int >= 32)
+ return a;
+ type = ord_type(a->val.type);
+ if (type->kind != TK_INTEGER && type->kind != TK_SMALLSET)
+ return a;
+ a = makeexpr_unlongcast(a);
+ if (tolong) {
+ ex = dolongcast(a, 1);
+ } else {
+ ex = dolongcast(copyexpr(a), 0);
+ if (ex) {
+ if (!dolongcast(ex, 2)) {
+ freeexpr(ex);
+ ex = NULL;
+ }
+ }
+ }
+ if (ex)
+ return ex;
+ return makeexpr_un(EK_CAST, (tolong) ? tp_integer : tp_int, a);
+ }
+
+
+ Expr *makeexpr_arglong(a, tolong)
+ Expr *a;
+ int tolong;
+ {
+ int cast = castlongargs;
+ if (cast < 0)
+ cast = castargs;
+ if (cast > 0 || (cast < 0 && prototypes == 0)) {
+ return makeexpr_longcast(a, tolong);
+ }
+ return a;
+ }
+
+
+
+ Expr *makeexpr_unlongcast(a)
+ Expr *a;
+ {
+ switch (a->kind) {
+
+ case EK_LONGCONST:
+ if (a->val.i >= -32767 && a->val.i <= 32767)
+ a->kind = EK_CONST;
+ break;
+
+ case EK_CAST:
+ if ((a->val.type == tp_integer ||
+ a->val.type == tp_int) &&
+ ord_type(a->args[0]->val.type)->kind == TK_INTEGER) {
+ a = grabarg(a, 0);
+ }
+ break;
+
+ default:
+ break;
+
+ }
+ return a;
+ }
+
+
+
+ Expr *makeexpr_forcelongness(a) /* force a to have a definite longness */
+ Expr *a;
+ {
+ Expr *ex;
+
+ ex = makeexpr_unlongcast(copyexpr(a));
+ if (exprlongness(ex)) {
+ freeexpr(a);
+ return ex;
+ }
+ freeexpr(ex);
+ if (exprlongness(a) == 0)
+ return makeexpr_longcast(a, 1);
+ else
+ return a;
+ }
+
+
+
+ Expr *makeexpr_ord(ex)
+ Expr *ex;
+ {
+ ex = makeexpr_charcast(ex);
+ switch (ord_type(ex->val.type)->kind) {
+
+ case TK_ENUM:
+ return makeexpr_cast(ex, tp_int);
+
+ case TK_CHAR:
+ if (ex->kind == EK_CONST &&
+ (ex->val.i >= 32 && ex->val.i < 127)) {
+ insertarg(&ex, 0, makeexpr_name("'%lc'", tp_integer));
+ }
+ ex->val.type = tp_int;
+ return ex;
+
+ case TK_BOOLEAN:
+ ex->val.type = tp_int;
+ return ex;
+
+ case TK_POINTER:
+ return makeexpr_cast(ex, tp_integer);
+
+ default:
+ return ex;
+ }
+ }
+
+
+
+
+ /* Tell whether an expression "looks" negative */
+ int expr_looks_neg(ex)
+ Expr *ex;
+ {
+ int i;
+
+ switch (ex->kind) {
+
+ case EK_NEG:
+ return 1;
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ switch (ord_type(ex->val.type)->kind) {
+ case TK_INTEGER:
+ case TK_CHAR:
+ return (ex->val.i < 0);
+ case TK_REAL:
+ return (ex->val.s && ex->val.s[0] == '-');
+ default:
+ return 0;
+ }
+
+ case EK_TIMES:
+ case EK_DIVIDE:
+ for (i = 0; i < ex->nargs; i++) {
+ if (expr_looks_neg(ex->args[i]))
+ return 1;
+ }
+ return 0;
+
+ case EK_CAST:
+ return expr_looks_neg(ex->args[0]);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ /* Tell whether an expression is probably negative */
+ int expr_is_neg(ex)
+ Expr *ex;
+ {
+ int i;
+
+ i = possiblesigns(ex) & (1|4);
+ if (i == 1)
+ return 1; /* if expression really is negative! */
+ if (i == 4)
+ return 0; /* if expression is definitely positive. */
+ return expr_looks_neg(ex);
+ }
+
+
+
+ int expr_neg_cost(a)
+ Expr *a;
+ {
+ int i, c;
+
+ switch (a->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ switch (ord_type(a->val.type)->kind) {
+ case TK_INTEGER:
+ case TK_CHAR:
+ case TK_REAL:
+ return 0;
+ default:
+ return 1;
+ }
+
+ case EK_NEG:
+ return -1;
+
+ case EK_TIMES:
+ case EK_DIVIDE:
+ for (i = 0; i < a->nargs; i++) {
+ c = expr_neg_cost(a->args[i]);
+ if (c <= 0)
+ return c;
+ }
+ return 1;
+
+ case EK_PLUS:
+ for (i = 0; i < a->nargs; i++) {
+ if (expr_looks_neg(a->args[i]))
+ return 0;
+ }
+ return 1;
+
+ default:
+ return 1;
+ }
+ }
+
+
+
+ Expr *enum_to_int(a)
+ Expr *a;
+ {
+ if (ord_type(a->val.type)->kind == TK_ENUM) {
+ if (a->kind == EK_CAST &&
+ ord_type(a->args[0]->val.type)->kind == TK_INTEGER)
+ return grabarg(a, 0);
+ else
+ return makeexpr_cast(a, tp_integer);
+ } else
+ return a;
+ }
+
+
+
+ Expr *neg_inside_sum(a)
+ Expr *a;
+ {
+ int i;
+
+ for (i = 0; i < a->nargs; i++)
+ a->args[i] = makeexpr_neg(a->args[i]);
+ return a;
+ }
+
+
+
+ Expr *makeexpr_neg(a)
+ Expr *a;
+ {
+ int i;
+
+ if (debug>2) { fprintf(outf,"makeexpr_neg("); dumpexpr(a); fprintf(outf,")\n"); }
+ a = enum_to_int(a);
+ switch (a->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ switch (ord_type(a->val.type)->kind) {
+
+ case TK_INTEGER:
+ case TK_CHAR:
+ if (a->val.i == MININT)
+ valrange();
+ else
+ a->val.i = - a->val.i;
+ return a;
+
+ case TK_REAL:
+ if (!realzero(a->val.s)) {
+ if (a->val.s[0] == '-')
+ strchange(&a->val.s, a->val.s+1);
+ else
+ strchange(&a->val.s, format_s("-%s", a->val.s));
+ }
+ return a;
+
+ default:
+ break;
+ }
+ break;
+
+ case EK_PLUS:
+ if (expr_neg_cost(a) <= 0)
+ return neg_inside_sum(a);
+ break;
+
+ case EK_TIMES:
+ case EK_DIVIDE:
+ for (i = 0; i < a->nargs; i++) {
+ if (expr_neg_cost(a->args[i]) <= 0) {
+ a->args[i] = makeexpr_neg(a->args[i]);
+ return a;
+ }
+ }
+ break;
+
+ case EK_CAST:
+ if (a->val.type != tp_unsigned &&
+ a->val.type != tp_uint &&
+ a->val.type != tp_ushort &&
+ a->val.type != tp_ubyte &&
+ a->args[0]->val.type != tp_unsigned &&
+ a->args[0]->val.type != tp_uint &&
+ a->args[0]->val.type != tp_ushort &&
+ a->args[0]->val.type != tp_ubyte &&
+ expr_looks_neg(a->args[0])) {
+ a->args[0] = makeexpr_neg(a->args[0]);
+ return a;
+ }
+ break;
+
+ case EK_NEG:
+ return grabarg(a, 0);
+
+ default:
+ break;
+ }
+ return makeexpr_un(EK_NEG, promote_type(a->val.type), a);
+ }
+
+
+
+
+ #define ISCONST(kind) ((kind)==EK_CONST || (kind)==EK_LONGCONST)
+ #define MOVCONST(ex) (ISCONST((ex)->kind) && (ex)->val.type->kind != TK_STRING)
+ #define COMMUTATIVE (kind != EK_COMMA && type->kind != TK_REAL)
+
+ Type *true_type(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ Type *type, *tp;
+
+ while (ex->kind == EK_CAST)
+ ex = ex->args[0];
+ type = ex->val.type;
+ if (ex->kind == EK_VAR || ex->kind == EK_FUNCTION || ex->kind == EK_DOT) {
+ mp = (Meaning *)ex->val.i;
+ if (mp && mp->type && mp->type->kind != TK_VOID)
+ type = mp->type;
+ }
+ if (ex->kind == EK_INDEX) {
+ tp = true_type(ex->args[0]);
+ if ((tp->kind == TK_ARRAY || tp->kind == TK_SMALLARRAY ||
+ tp->kind == TK_STRING) &&
+ tp->basetype && tp->basetype->kind != TK_VOID)
+ type = tp->basetype;
+ }
+ if (type->kind == TK_SUBR)
+ type = findbasetype(type, ODECL_NOPRES);
+ return type;
+ }
+
+ int ischartype(ex)
+ Expr *ex;
+ {
+ if (ord_type(ex->val.type)->kind == TK_CHAR)
+ return 1;
+ if (true_type(ex)->kind == TK_CHAR)
+ return 1;
+ if (ISCONST(ex->kind) && ex->nargs > 0 &&
+ ex->args[0]->kind == EK_NAME &&
+ ex->args[0]->val.s[0] == '\'')
+ return 1;
+ return 0;
+ }
+
+ Static Expr *commute(a, b, kind)
+ Expr *a, *b;
+ enum exprkind kind;
+ {
+ int i, di;
+ Type *type;
+
+ if (debug>2) { fprintf(outf,"commute("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ #if 1
+ type = promote_type_bin(a->val.type, b->val.type);
+ #else
+ type = a->val.type;
+ if (b->val.type->kind == TK_REAL)
+ type = b->val.type;
+ #endif
+ if (MOVCONST(a) && !MOVCONST(b) && COMMUTATIVE)
+ swapexprs(a, b); /* put constant last */
+ if (a->kind == kind) {
+ di = (MOVCONST(a->args[a->nargs-1]) && COMMUTATIVE) ? -1 : 0;
+ if (b->kind == kind) {
+ for (i = 0; i < b->nargs; i++)
+ insertarg(&a, a->nargs + di, b->args[i]);
+ FREE(b);
+ } else
+ insertarg(&a, a->nargs + di, b);
+ a->val.type = type;
+ } else if (b->kind == kind) {
+ if (MOVCONST(a) && COMMUTATIVE)
+ insertarg(&b, b->nargs, a);
+ else
+ insertarg(&b, 0, a);
+ a = b;
+ a->val.type = type;
+ } else {
+ a = makeexpr_bin(kind, type, a, b);
+ }
+ if (debug>2) { fprintf(outf,"commute returns "); dumpexpr(a); fprintf(outf,"\n"); }
+ return a;
+ }
+
+
+ Expr *makeexpr_plus(a, b)
+ Expr *a, *b;
+ {
+ int i, j, k, castdouble = 0;
+ Type *type;
+
+ if (debug>2) { fprintf(outf,"makeexpr_plus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ if (!a)
+ return b;
+ if (!b)
+ return a;
+ if (a->kind == EK_NEG && a->args[0]->kind == EK_PLUS)
+ a = neg_inside_sum(grabarg(a, 0));
+ if (b->kind == EK_NEG && b->args[0]->kind == EK_PLUS)
+ b = neg_inside_sum(grabarg(b, 0));
+ a = commute(enum_to_int(a), enum_to_int(b), EK_PLUS);
+ type = NULL;
+ for (i = 0; i < a->nargs; i++) {
+ if (ord_type(a->args[i]->val.type)->kind == TK_CHAR ||
+ a->args[i]->val.type->kind == TK_POINTER ||
+ a->args[i]->val.type->kind == TK_STRING) { /* for string literals */
+ if (type == ord_type(a->args[i]->val.type))
+ type = tp_integer; /* 'z'-'a' and p1-p2 are integers */
+ else
+ type = ord_type(a->args[i]->val.type);
+ }
+ }
+ if (type)
+ a->val.type = type;
+ for (i = 0; i < a->nargs && !ISCONST(a->args[i]->kind); i++) ;
+ if (i < a->nargs-1) {
+ for (j = i+1; j < a->nargs; j++) {
+ if (ISCONST(a->args[j]->kind)) {
+ if ((ord_type(a->args[i]->val.type) == ord_type(a->args[j]->val.type) ||
+ ord_type(a->args[i]->val.type)->kind == TK_INTEGER ||
+ ord_type(a->args[j]->val.type)->kind == TK_INTEGER) &&
+ (!(ischartype(a->args[i]) || ischartype(a->args[j])) ||
+ a->args[i]->val.i == - a->args[j]->val.i ||
+ a->args[i]->val.i == 0 || a->args[j]->val.i == 0) &&
+ (a->args[i]->val.type->kind != TK_REAL &&
+ a->args[i]->val.type->kind != TK_STRING &&
+ a->args[j]->val.type->kind != TK_REAL &&
+ a->args[j]->val.type->kind != TK_STRING)) {
+ a->args[i]->val.i += a->args[j]->val.i;
+ delfreearg(&a, j);
+ j--;
+ } else if (a->args[i]->val.type->kind == TK_STRING &&
+ ord_type(a->args[j]->val.type)->kind == TK_INTEGER &&
+ a->args[j]->val.i < 0 &&
+ a->args[j]->val.i >= -stringleaders) {
+ /* strictly speaking, the following is illegal pointer arithmetic */
+ a->args[i] = makeexpr_lstring(a->args[i]->val.s + a->args[j]->val.i,
+ a->args[i]->val.i - a->args[j]->val.i);
+ for (k = 0; k < - a->args[j]->val.i; k++)
+ a->args[i]->val.s[k] = '>';
+ delfreearg(&a, j);
+ j--;
+ }
+ }
+ }
+ }
+ if (checkconst(a->args[a->nargs-1], 0)) {
+ if (a->args[a->nargs-1]->val.type->kind == TK_REAL &&
+ a->args[0]->val.type->kind != TK_REAL)
+ castdouble = 1;
+ delfreearg(&a, a->nargs-1);
+ }
+ for (i = 0; i < a->nargs; i++) {
+ if (a->args[i]->kind == EK_NEG && nosideeffects(a->args[i], 1)) {
+ for (j = 0; j < a->nargs; j++) {
+ if (exprsame(a->args[j], a->args[i]->args[0], 1)) {
+ delfreearg(&a, i);
+ if (i < j) j--; else i--;
+ delfreearg(&a, j);
+ i--;
+ break;
+ }
+ }
+ }
+ }
+ if (a->nargs == 0) {
+ type = a->val.type;
+ FREE(a);
+ a = gentle_cast(makeexpr_long(0), type);
+ a->val.type = type;
+ return a;
+ } else if (a->nargs == 1) {
+ b = a->args[0];
+ FREE(a);
+ a = b;
+ } else {
+ if (a->nargs == 2 && ISCONST(a->args[1]->kind) &&
+ a->args[1]->val.i <= -127 &&
+ true_type(a->args[0]) == tp_char && signedchars != 0) {
+ a->args[0] = force_unsigned(a->args[0]);
+ }
+ if (a->nargs > 2 &&
+ ISCONST(a->args[a->nargs-1]->kind) &&
+ ISCONST(a->args[a->nargs-2]->kind) &&
+ ischartype(a->args[a->nargs-1]) &&
+ ischartype(a->args[a->nargs-2])) {
+ i = a->args[a->nargs-1]->val.i;
+ j = a->args[a->nargs-2]->val.i;
+ if ((i == 'a' || i == 'A' || i == -'a' || i == -'A') &&
+ (j == 'a' || j == 'A' || j == -'a' || j == -'A')) {
+ if (abs(i+j) == 32) {
+ delfreearg(&a, a->nargs-1);
+ delsimpfreearg(&a, a->nargs-1);
+ a = makeexpr_bicall_1((i+j > 0) ? "_tolower" : "_toupper",
+ tp_char, a);
+ }
+ }
+ }
+ }
+ if (castdouble)
+ a = makeexpr_cast(a, tp_real);
+ return a;
+ }
+
+
+ Expr *makeexpr_minus(a, b)
+ Expr *a, *b;
+ {
+ int okneg;
+
+ if (debug>2) { fprintf(outf,"makeexpr_minus("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ if (ISCONST(b->kind) && b->val.i == 0 && /* kludge for array indexing */
+ ord_type(b->val.type)->kind == TK_ENUM) {
+ b->val.type = tp_integer;
+ }
+ okneg = (a->kind != EK_PLUS && b->kind != EK_PLUS);
+ a = makeexpr_plus(a, makeexpr_neg(b));
+ if (okneg && a->kind == EK_PLUS)
+ a->val.i = 1; /* this flag says to write as "a-b" if possible */
+ return a;
+ }
+
+
+ Expr *makeexpr_inc(a, b)
+ Expr *a, *b;
+ {
+ Type *type;
+
+ type = a->val.type;
+ a = makeexpr_plus(makeexpr_charcast(a), b);
+ if (ord_type(type)->kind != TK_INTEGER &&
+ ord_type(type)->kind != TK_CHAR)
+ a = makeexpr_cast(a, type);
+ return a;
+ }
+
+
+
+ /* Apply the distributive law for a sum of products */
+ Expr *distribute_plus(ex)
+ Expr *ex;
+ {
+ int i, j, icom;
+ Expr *common, *outer, *ex2, **exp;
+
+ if (debug>2) { fprintf(outf,"distribute_plus("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (ex->kind != EK_PLUS)
+ return ex;
+ for (i = 0; i < ex->nargs; i++)
+ if (ex->args[i]->kind == EK_TIMES)
+ break;
+ if (i == ex->nargs)
+ return ex;
+ outer = NULL;
+ icom = 0;
+ for (;;) {
+ ex2 = ex->args[0];
+ if (ex2->kind == EK_NEG)
+ ex2 = ex2->args[0];
+ if (ex2->kind == EK_TIMES) {
+ if (icom >= ex2->nargs)
+ break;
+ common = ex2->args[icom];
+ if (common->kind == EK_NEG)
+ common = common->args[0];
+ } else {
+ if (icom > 0)
+ break;
+ common = ex2;
+ icom++;
+ }
+ for (i = 1; i < ex->nargs; i++) {
+ ex2 = ex->args[i];
+ if (ex2->kind == EK_NEG)
+ ex2 = ex2->args[i];
+ if (ex2->kind == EK_TIMES) {
+ for (j = ex2->nargs; --j >= 0; ) {
+ if (exprsame(ex2->args[j], common, 1) ||
+ (ex2->args[j]->kind == EK_NEG &&
+ exprsame(ex2->args[j]->args[0], common, 1)))
+ break;
+ }
+ if (j < 0)
+ break;
+ } else {
+ if (!exprsame(ex2, common, 1))
+ break;
+ }
+ }
+ if (i == ex->nargs) {
+ if (debug>2) { fprintf(outf,"distribute_plus does "); dumpexpr(common); fprintf(outf,"\n"); }
+ common = copyexpr(common);
+ for (i = 0; i < ex->nargs; i++) {
+ if (ex->args[i]->kind == EK_NEG)
+ ex2 = *(exp = &ex->args[i]->args[0]);
+ else
+ ex2 = *(exp = &ex->args[i]);
+ if (ex2->kind == EK_TIMES) {
+ for (j = ex2->nargs; --j >= 0; ) {
+ if (exprsame(ex2->args[j], common, 1)) {
+ delsimpfreearg(exp, j);
+ break;
+ } else if (ex2->args[j]->kind == EK_NEG &&
+ exprsame(ex2->args[j]->args[0], common,1)) {
+ freeexpr(ex2->args[j]);
+ ex2->args[j] = makeexpr_long(-1);
+ break;
+ }
+ }
+ } else {
+ freeexpr(ex2);
+ *exp = makeexpr_long(1);
+ }
+ ex->args[i] = resimplify(ex->args[i]);
+ }
+ outer = makeexpr_times(common, outer);
+ } else
+ icom++;
+ }
+ return makeexpr_times(resimplify(ex), outer);
+ }
+
+
+
+
+
+ Expr *makeexpr_times(a, b)
+ Expr *a, *b;
+ {
+ int i, n, castdouble = 0;
+ Type *type;
+
+ if (debug>2) { fprintf(outf,"makeexpr_times("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ if (!a)
+ return b;
+ if (!b)
+ return a;
+ a = commute(a, b, EK_TIMES);
+ if (a->val.type->kind == TK_INTEGER) {
+ i = a->nargs-1;
+ if (i > 0 && ISCONST(a->args[i-1]->kind)) {
+ a->args[i-1]->val.i *= a->args[i]->val.i;
+ delfreearg(&a, i);
+ }
+ }
+ for (i = n = 0; i < a->nargs; i++) {
+ if (expr_neg_cost(a->args[i]) < 0)
+ n++;
+ }
+ if (n & 1) {
+ for (i = 0; i < a->nargs; i++) {
+ if (ISCONST(a->args[i]->kind) &&
+ expr_neg_cost(a->args[i]) >= 0) {
+ a->args[i] = makeexpr_neg(a->args[i]);
+ n++;
+ break;
+ }
+ }
+ } else
+ n++;
+ for (i = 0; i < a->nargs && n >= 2; i++) {
+ if (expr_neg_cost(a->args[i]) < 0) {
+ a->args[i] = makeexpr_neg(a->args[i]);
+ n--;
+ }
+ }
+ if (checkconst(a->args[a->nargs-1], 1)) {
+ if (a->args[a->nargs-1]->val.type->kind == TK_REAL &&
+ a->args[0]->val.type->kind != TK_REAL)
+ castdouble = 1;
+ delfreearg(&a, a->nargs-1);
+ } else if (checkconst(a->args[a->nargs-1], -1)) {
+ if (a->args[a->nargs-1]->val.type->kind == TK_REAL &&
+ a->args[0]->val.type->kind != TK_REAL)
+ castdouble = 1;
+ delfreearg(&a, a->nargs-1);
+ a->args[0] = makeexpr_neg(a->args[0]);
+ } else if (checkconst(a->args[a->nargs-1], 0) && nosideeffects(a, 1)) {
+ if (a->args[a->nargs-1]->val.type->kind == TK_REAL)
+ type = a->args[a->nargs-1]->val.type;
+ else
+ type = a->val.type;
+ return makeexpr_cast(grabarg(a, a->nargs-1), type);
+ }
+ if (a->nargs < 2) {
+ if (a->nargs < 1) {
+ FREE(a);
+ a = makeexpr_long(1);
+ } else {
+ b = a->args[0];
+ FREE(a);
+ a = b;
+ }
+ }
+ if (castdouble)
+ a = makeexpr_cast(a, tp_real);
+ return a;
+ }
+
+
+
+ Expr *makeexpr_sqr(ex, cube)
+ Expr *ex;
+ int cube;
+ {
+ Expr *ex2;
+ Meaning *tvar;
+ Type *type;
+
+ if (exprspeed(ex) <= 2 && nosideeffects(ex, 0)) {
+ ex2 = NULL;
+ } else {
+ type = (ex->val.type->kind == TK_REAL) ? tp_longreal : tp_integer;
+ tvar = makestmttempvar(type, name_TEMP);
+ ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
+ ex = makeexpr_var(tvar);
+ }
+ if (cube)
+ ex = makeexpr_times(ex, makeexpr_times(copyexpr(ex), copyexpr(ex)));
+ else
+ ex = makeexpr_times(ex, copyexpr(ex));
+ return makeexpr_comma(ex2, ex);
+ }
+
+
+
+ Expr *makeexpr_divide(a, b)
+ Expr *a, *b;
+ {
+ Expr *ex;
+ int p;
+
+ if (debug>2) { fprintf(outf,"makeexpr_divide("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ if (a->val.type->kind != TK_REAL &&
+ b->val.type->kind != TK_REAL) { /* must do a real division */
+ ex = docast(a, tp_longreal);
+ if (ex)
+ a = ex;
+ else {
+ ex = docast(b, tp_longreal);
+ if (ex)
+ b = ex;
+ else
+ a = makeexpr_cast(a, tp_longreal);
+ }
+ }
+ if (a->kind == EK_TIMES) {
+ for (p = 0; p < a->nargs; p++)
+ if (exprsame(a->args[p], b, 1))
+ break;
+ if (p < a->nargs) {
+ delfreearg(&a, p);
+ freeexpr(b);
+ if (a->nargs == 1)
+ return grabarg(a, 0);
+ else
+ return a;
+ }
+ }
+ if (expr_neg_cost(a) < 0 && expr_neg_cost(b) < 0) {
+ a = makeexpr_neg(a);
+ b = makeexpr_neg(b);
+ }
+ if (checkconst(b, 0))
+ warning("Division by zero [163]");
+ return makeexpr_bin(EK_DIVIDE, tp_longreal, a, b);
+ }
+
+
+
+
+ int gcd(a, b)
+ int a, b;
+ {
+ if (a < 0) a = -a;
+ if (b < 0) b = -b;
+ while (a != 0) {
+ b %= a;
+ if (b != 0)
+ a %= b;
+ else
+ return a;
+ }
+ return b;
+ }
+
+
+
+ /* possible signs of ex: 1=may be neg, 2=may be zero, 4=may be pos */
+
+ int negsigns(mask)
+ int mask;
+ {
+ return (mask & 2) |
+ ((mask & 1) << 2) |
+ ((mask & 4) >> 2);
+ }
+
+
+ int possiblesigns(ex)
+ Expr *ex;
+ {
+ Value val;
+ Type *tp;
+ char *cp;
+ int i, mask, mask2;
+
+ if (isliteralconst(ex, &val) && val.type) {
+ if (val.type == tp_real || val.type == tp_longreal) {
+ if (realzero(val.s))
+ return 2;
+ if (*val.s == '-')
+ return 1;
+ return 4;
+ } else
+ return (val.i < 0) ? 1 : (val.i == 0) ? 2 : 4;
+ }
+ if (ex->kind == EK_CAST &&
+ similartypes(ex->val.type, ex->args[0]->val.type))
+ return possiblesigns(ex->args[0]);
+ if (ex->kind == EK_NEG)
+ return negsigns(possiblesigns(ex->args[0]));
+ if (ex->kind == EK_TIMES || ex->kind == EK_DIVIDE) {
+ mask = possiblesigns(ex->args[0]);
+ for (i = 1; i < ex->nargs; i++) {
+ mask2 = possiblesigns(ex->args[i]);
+ if (mask2 & 2)
+ mask |= 2;
+ if ((mask2 & (1|4)) == 1)
+ mask = negsigns(mask);
+ else if ((mask2 & (1|4)) != 4)
+ mask = 1|2|4;
+ }
+ return mask;
+ }
+ if (ex->kind == EK_DIV || ex->kind == EK_MOD) {
+ mask = possiblesigns(ex->args[0]);
+ mask2 = possiblesigns(ex->args[1]);
+ if (!((mask | mask2) & 1))
+ return 2|4;
+ }
+ if (ex->kind == EK_PLUS) {
+ mask = 0;
+ for (i = 0; i < ex->nargs; i++) {
+ mask2 = possiblesigns(ex->args[i]);
+ if ((mask & negsigns(mask2)) & (1|4))
+ mask |= (1|2|4);
+ else
+ mask |= mask2;
+ }
+ return mask;
+ }
+ if (ex->kind == EK_COND) {
+ return possiblesigns(ex->args[1]) | possiblesigns(ex->args[2]);
+ }
+ if (ex->kind == EK_EQ || ex->kind == EK_LT || ex->kind == EK_GT ||
+ ex->kind == EK_NE || ex->kind == EK_LE || ex->kind == EK_GE ||
+ ex->kind == EK_AND || ex->kind == EK_OR || ex->kind == EK_NOT)
+ return 2|4;
+ if (ex->kind == EK_BICALL) {
+ cp = ex->val.s;
+ if (!strcmp(cp, "strlen") ||
+ !strcmp(cp, "abs") ||
+ !strcmp(cp, "labs") ||
+ !strcmp(cp, "fabs"))
+ return 2|4;
+ }
+ tp = (ex->kind == EK_VAR) ? ((Meaning *)ex->val.i)->type : ex->val.type;
+ if (ord_range(ex->val.type, &val.i, NULL)) {
+ if (val.i > 0)
+ return 4;
+ if (val.i >= 0)
+ return 2|4;
+ }
+ if (ord_range(ex->val.type, NULL, &val.i)) {
+ if (val.i < 0)
+ return 1;
+ if (val.i <= 0)
+ return 1|2;
+ }
+ return 1|2|4;
+ }
+
+
+
+
+
+ Expr *dodivmod(funcname, ekind, a, b)
+ char *funcname;
+ enum exprkind ekind;
+ Expr *a, *b;
+ {
+ Meaning *tvar;
+ Type *type;
+ Expr *asn;
+ int sa, sb;
+
+ type = promote_type_bin(a->val.type, b->val.type);
+ tvar = NULL;
+ sa = possiblesigns(a);
+ sb = possiblesigns(b);
+ if ((sa & 1) || (sb & 1)) {
+ if (*funcname) {
+ asn = NULL;
+ if (*funcname == '*') {
+ if (exprspeed(a) >= 5 || !nosideeffects(a, 0)) {
+ tvar = makestmttempvar(a->val.type, name_TEMP);
+ asn = makeexpr_assign(makeexpr_var(tvar), a);
+ a = makeexpr_var(tvar);
+ }
+ if (exprspeed(b) >= 5 || !nosideeffects(b, 0)) {
+ tvar = makestmttempvar(b->val.type, name_TEMP);
+ asn = makeexpr_comma(asn,
+ makeexpr_assign(makeexpr_var(tvar),
+ b));
+ b = makeexpr_var(tvar);
+ }
+ }
+ return makeexpr_comma(asn,
+ makeexpr_bicall_2(funcname, type, a, b));
+ } else {
+ if ((sa & 1) && (ekind == EK_MOD))
+ note("Using % for possibly-negative arguments [317]");
+ return makeexpr_bin(ekind, type, a, b);
+ }
+ } else
+ return makeexpr_bin(ekind, type, a, b);
+ }
+
+
+
+ Expr *makeexpr_div(a, b)
+ Expr *a, *b;
+ {
+ Meaning *mp;
+ Type *type;
+ long i;
+ int p;
+
+ if (ISCONST(a->kind) && ISCONST(b->kind)) {
+ if (a->val.i >= 0 && b->val.i > 0) {
+ a->val.i /= b->val.i;
+ freeexpr(b);
+ return a;
+ }
+ i = gcd(a->val.i, b->val.i);
+ if (i >= 0) {
+ a->val.i /= i;
+ b->val.i /= i;
+ }
+ }
+ if (((b->kind == EK_CONST && (i = b->val.i)) ||
+ (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST &&
+ mp->val.type && (i = mp->val.i) && foldconsts != 0)) && i > 0) {
+ if (i == 1)
+ return a;
+ if (div_po2 > 0) {
+ p = 0;
+ while (!(i&1))
+ p++, i >>= 1;
+ if (i == 1) {
+ type = promote_type_bin(a->val.type, b->val.type);
+ return makeexpr_bin(EK_RSH, type, a, makeexpr_long(p));
+ }
+ }
+ }
+ if (a->kind == EK_TIMES) {
+ for (p = 0; p < a->nargs; p++) {
+ if (exprsame(a->args[p], b, 1)) {
+ delfreearg(&a, p);
+ freeexpr(b);
+ if (a->nargs == 1)
+ return grabarg(a, 0);
+ else
+ return a;
+ } else if (ISCONST(a->args[p]->kind) && ISCONST(b->kind)) {
+ i = gcd(a->args[p]->val.i, b->val.i);
+ if (i > 1) {
+ a->args[p]->val.i /= i;
+ b->val.i /= i;
+ i = a->args[p]->val.i;
+ delfreearg(&a, p);
+ a = makeexpr_times(a, makeexpr_long(i)); /* resimplify */
+ p = -1; /* start the loop over */
+ }
+ }
+ }
+ }
+ if (checkconst(b, 1)) {
+ freeexpr(b);
+ return a;
+ } else if (checkconst(b, -1)) {
+ freeexpr(b);
+ return makeexpr_neg(a);
+ } else {
+ if (checkconst(b, 0))
+ warning("Division by zero [163]");
+ return dodivmod(divname, EK_DIV, a, b);
+ }
+ }
+
+
+
+ Expr *makeexpr_mod(a, b)
+ Expr *a, *b;
+ {
+ Meaning *mp;
+ Type *type;
+ long i;
+
+ if (a->kind == EK_CONST && b->kind == EK_CONST &&
+ a->val.i >= 0 && b->val.i > 0) {
+ a->val.i %= b->val.i;
+ freeexpr(b);
+ return a;
+ }
+ if (((b->kind == EK_CONST && (i = b->val.i)) ||
+ (b->kind == EK_VAR && (mp = (Meaning *)b->val.i)->kind == MK_CONST &&
+ mp->val.type && (i = mp->val.i) && foldconsts != 0)) && i > 0) {
+ if (i == 1)
+ return makeexpr_long(0);
+ if (mod_po2 != 0) {
+ while (!(i&1))
+ i >>= 1;
+ if (i == 1) {
+ type = promote_type_bin(a->val.type, b->val.type);
+ return makeexpr_bin(EK_BAND, type, a,
+ makeexpr_minus(b, makeexpr_long(1)));
+ }
+ }
+ }
+ if (checkconst(b, 0))
+ warning("Division by zero [163]");
+ return dodivmod(modname, EK_MOD, a, b);
+ }
+
+
+
+ Expr *makeexpr_rem(a, b)
+ Expr *a, *b;
+ {
+ if (!(possiblesigns(a) & 1) && !(possiblesigns(b) & 1))
+ return makeexpr_mod(a, b);
+ if (checkconst(b, 0))
+ warning("Division by zero [163]");
+ if (!*remname)
+ note("Translating REM same as MOD [141]");
+ return dodivmod(*remname ? remname : modname, EK_MOD, a, b);
+ }
+
+
+
+
+
+ int expr_not_cost(a)
+ Expr *a;
+ {
+ int i, c;
+
+ switch (a->kind) {
+
+ case EK_CONST:
+ return 0;
+
+ case EK_NOT:
+ return -1;
+
+ case EK_EQ:
+ case EK_NE:
+ case EK_LT:
+ case EK_GT:
+ case EK_LE:
+ case EK_GE:
+ return 0;
+
+ case EK_AND:
+ case EK_OR:
+ c = 0;
+ for (i = 0; i < a->nargs; i++)
+ c += expr_not_cost(a->args[i]);
+ return (c > 1) ? 1 : c;
+
+ case EK_BICALL:
+ if (!strcmp(a->val.s, oddname) ||
+ !strcmp(a->val.s, evenname))
+ return 0;
+ return 1;
+
+ default:
+ return 1;
+ }
+ }
+
+
+
+ Expr *makeexpr_not(a)
+ Expr *a;
+ {
+ Expr *ex;
+ int i;
+
+ if (debug>2) { fprintf(outf,"makeexpr_not("); dumpexpr(a); fprintf(outf,")\n"); }
+ switch (a->kind) {
+
+ case EK_CONST:
+ if (a->val.type == tp_boolean) {
+ a->val.i = !a->val.i;
+ return a;
+ }
+ break;
+
+ case EK_EQ:
+ a->kind = EK_NE;
+ return a;
+
+ case EK_NE:
+ a->kind = EK_EQ;
+ return a;
+
+ case EK_LT:
+ a->kind = EK_GE;
+ return a;
+
+ case EK_GT:
+ a->kind = EK_LE;
+ return a;
+
+ case EK_LE:
+ a->kind = EK_GT;
+ return a;
+
+ case EK_GE:
+ a->kind = EK_LT;
+ return a;
+
+ case EK_AND:
+ case EK_OR:
+ if (expr_not_cost(a) > 0)
+ break;
+ a->kind = (a->kind == EK_OR) ? EK_AND : EK_OR;
+ for (i = 0; i < a->nargs; i++)
+ a->args[i] = makeexpr_not(a->args[i]);
+ return a;
+
+ case EK_NOT:
+ ex = a->args[0];
+ FREE(a);
+ ex->val.type = tp_boolean;
+ return ex;
+
+ case EK_BICALL:
+ if (!strcmp(a->val.s, oddname) && *evenname) {
+ strchange(&a->val.s, evenname);
+ return a;
+ } else if (!strcmp(a->val.s, evenname)) {
+ strchange(&a->val.s, oddname);
+ return a;
+ }
+ break;
+
+ default:
+ break;
+ }
+ return makeexpr_un(EK_NOT, tp_boolean, a);
+ }
+
+
+
+
+ Type *mixsets(ep1, ep2)
+ Expr **ep1, **ep2;
+ {
+ Expr *ex1 = *ep1, *ex2 = *ep2;
+ Meaning *tvar;
+ long min1, max1, min2, max2;
+ Type *type;
+
+ if (ex1->val.type->kind == TK_SMALLSET &&
+ ex2->val.type->kind == TK_SMALLSET)
+ return ex1->val.type;
+ if (ex1->val.type->kind == TK_SMALLSET) {
+ tvar = makestmttempvar(ex2->val.type, name_SET);
+ ex1 = makeexpr_bicall_2(setexpandname, ex2->val.type,
+ makeexpr_var(tvar),
+ makeexpr_arglong(ex1, 1));
+ }
+ if (ex2->val.type->kind == TK_SMALLSET) {
+ tvar = makestmttempvar(ex1->val.type, name_SET);
+ ex2 = makeexpr_bicall_2(setexpandname, ex1->val.type,
+ makeexpr_var(tvar),
+ makeexpr_arglong(ex2, 1));
+ }
+ if (ord_range(ex1->val.type->indextype, &min1, &max1) &&
+ ord_range(ex2->val.type->indextype, &min2, &max2)) {
+ if (min1 <= min2 && max1 >= max2)
+ type = ex1->val.type;
+ else if (min2 <= min1 && max2 >= max1)
+ type = ex2->val.type;
+ else {
+ if (min2 < min1) min1 = min2;
+ if (max2 > max1) max1 = max2;
+ type = maketype(TK_SET);
+ type->basetype = tp_integer;
+ type->indextype = maketype(TK_SUBR);
+ type->indextype->basetype = ord_type(ex1->val.type->indextype);
+ type->indextype->smin = makeexpr_long(min1);
+ type->indextype->smax = makeexpr_long(max1);
+ }
+ } else
+ type = ex1->val.type;
+ *ep1 = ex1, *ep2 = ex2;
+ return type;
+ }
+
+
+
+ Meaning *istempprocptr(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (debug>2) { fprintf(outf,"istempprocptr("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (ex->kind == EK_COMMA && ex->nargs == 3) {
+ if ((mp = istempvar(ex->args[2])) != NULL &&
+ mp->type->kind == TK_PROCPTR &&
+ ex->args[0]->kind == EK_ASSIGN &&
+ ex->args[0]->args[0]->kind == EK_DOT &&
+ exprsame(ex->args[0]->args[0]->args[0], ex->args[2], 1) &&
+ ex->args[1]->kind == EK_ASSIGN &&
+ ex->args[1]->args[0]->kind == EK_DOT &&
+ exprsame(ex->args[1]->args[0]->args[0], ex->args[2], 1))
+ return mp;
+ }
+ if (ex->kind == EK_COMMA && ex->nargs == 2) {
+ if ((mp = istempvar(ex->args[1])) != NULL &&
+ mp->type->kind == TK_CPROCPTR &&
+ ex->args[0]->kind == EK_ASSIGN &&
+ exprsame(ex->args[0]->args[0], ex->args[1], 1))
+ return mp;
+ }
+ return NULL;
+ }
+
+
+
+
+ Expr *makeexpr_stringify(ex)
+ Expr *ex;
+ {
+ ex = makeexpr_stringcast(ex);
+ if (ex->val.type->kind == TK_STRING)
+ return ex;
+ return makeexpr_sprintfify(ex);
+ }
+
+
+
+ Expr *makeexpr_rel(rel, a, b)
+ enum exprkind rel;
+ Expr *a, *b;
+ {
+ int i, sign;
+ Expr *ex, *ex2;
+ Meaning *mp;
+ char *name;
+
+ if (debug>2) { fprintf(outf,"makeexpr_rel(%s,", exprkindname(rel)); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+
+ a = makeexpr_unlongcast(a);
+ b = makeexpr_unlongcast(b);
+ if ((compenums == 0 || (compenums < 0 && ansiC <= 0)) &&
+ (rel != EK_EQ && rel != EK_NE)){
+ a = enum_to_int(a);
+ b = enum_to_int(b);
+ }
+ if (a->val.type != b->val.type) {
+ if (a->val.type->kind == TK_STRING &&
+ a->kind != EK_CONST) {
+ b = makeexpr_stringify(b);
+ } else if (b->val.type->kind == TK_STRING &&
+ b->kind != EK_CONST) {
+ a = makeexpr_stringify(a);
+ } else if (ord_type(a->val.type)->kind == TK_CHAR ||
+ a->val.type->kind == TK_ARRAY) {
+ b = gentle_cast(b, ord_type(a->val.type));
+ } else if (ord_type(b->val.type)->kind == TK_CHAR ||
+ b->val.type->kind == TK_ARRAY) {
+ a = gentle_cast(a, ord_type(b->val.type));
+ } else if (a->val.type == tp_anyptr && !voidstar) {
+ a = gentle_cast(a, b->val.type);
+ } else if (b->val.type == tp_anyptr && !voidstar) {
+ b = gentle_cast(b, a->val.type);
+ }
+ }
+ if (useisspace && b->val.type->kind == TK_CHAR && checkconst(b, ' ')) {
+ if (rel == EK_EQ) {
+ freeexpr(b);
+ return makeexpr_bicall_1("isspace", tp_boolean, a);
+ } else if (rel == EK_NE) {
+ freeexpr(b);
+ return makeexpr_not(makeexpr_bicall_1("isspace", tp_boolean, a));
+ }
+ }
+ if (rel == EK_LT || rel == EK_GE)
+ sign = 1;
+ else if (rel == EK_GT || rel == EK_LE)
+ sign = -1;
+ else
+ sign = 0;
+ if (ord_type(b->val.type)->kind == TK_INTEGER ||
+ ord_type(b->val.type)->kind == TK_CHAR) {
+ for (;;) {
+ if (a->kind == EK_PLUS && ISCONST(a->args[a->nargs-1]->kind) &&
+ a->args[a->nargs-1]->val.i &&
+ (ISCONST(b->kind) ||
+ (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind)))) {
+ b = makeexpr_minus(b, copyexpr(a->args[a->nargs-1]));
+ a = makeexpr_minus(a, copyexpr(a->args[a->nargs-1]));
+ continue;
+ }
+ if (b->kind == EK_PLUS && ISCONST(b->args[b->nargs-1]->kind) &&
+ b->args[b->nargs-1]->val.i &&
+ ISCONST(a->kind)) {
+ a = makeexpr_minus(a, copyexpr(b->args[b->nargs-1]));
+ b = makeexpr_minus(b, copyexpr(b->args[b->nargs-1]));
+ continue;
+ }
+ if (b->kind == EK_PLUS && sign &&
+ ISCONST(b->args[b->nargs-1]->kind) &&
+ checkconst(b->args[b->nargs-1], sign)) {
+ b = makeexpr_plus(b, makeexpr_long(-sign));
+ switch (rel) {
+ case EK_LT:
+ rel = EK_LE;
+ break;
+ case EK_GT:
+ rel = EK_GE;
+ break;
+ case EK_LE:
+ rel = EK_LT;
+ break;
+ case EK_GE:
+ rel = EK_GT;
+ break;
+ default:
+ break;
+ }
+ sign = -sign;
+ continue;
+ }
+ if (a->kind == EK_TIMES && checkconst(b, 0) && !sign) {
+ for (i = 0; i < a->nargs; i++) {
+ if (ISCONST(a->args[i]->kind) && a->args[i]->val.i)
+ break;
+ if (a->args[i]->kind == EK_SIZEOF)
+ break;
+ }
+ if (i < a->nargs) {
+ delfreearg(&a, i);
+ continue;
+ }
+ }
+ break;
+ }
+ if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen") &&
+ checkconst(b, 0)) {
+ if (rel == EK_LT || rel == EK_GE) {
+ note("Unusual use of STRLEN encountered [142]");
+ } else {
+ freeexpr(b);
+ a = makeexpr_hat(grabarg(a, 0), 0);
+ b = makeexpr_char(0); /* "strlen(a) = 0" => "*a == 0" */
+ if (rel == EK_EQ || rel == EK_LE)
+ return makeexpr_rel(EK_EQ, a, b);
+ else
+ return makeexpr_rel(EK_NE, a, b);
+ }
+ }
+ if (ISCONST(a->kind) && ISCONST(b->kind)) {
+ if ((a->val.i == b->val.i && (rel == EK_EQ || rel == EK_GE || rel == EK_LE)) ||
+ (a->val.i < b->val.i && (rel == EK_NE || rel == EK_LE || rel == EK_LT)) ||
+ (a->val.i > b->val.i && (rel == EK_NE || rel == EK_GE || rel == EK_GT)))
+ return makeexpr_val(make_ord(tp_boolean, 1));
+ else
+ return makeexpr_val(make_ord(tp_boolean, 0));
+ }
+ if ((a->val.type == tp_char || true_type(a) == tp_char) &&
+ ISCONST(b->kind) && signedchars != 0) {
+ i = (b->val.i == 128 && sign == 1) ||
+ (b->val.i == 127 && sign == -1);
+ if (highcharbits && (highcharbits > 0 || signedchars < 0) && i) {
+ if (highcharbits == 2)
+ b = makeexpr_long(128);
+ else
+ b = makeexpr_un(EK_BNOT, tp_integer, makeexpr_long(127));
+ return makeexpr_rel((rel == EK_GE || rel == EK_GT)
+ ? EK_NE : EK_EQ,
+ makeexpr_bin(EK_BAND, tp_integer,
+ eatcasts(a), b),
+ makeexpr_long(0));
+ } else if (signedchars == 1 && i) {
+ return makeexpr_rel((rel == EK_GE || rel == EK_GT)
+ ? EK_LT : EK_GE,
+ eatcasts(a), makeexpr_long(0));
+ } else if (signedchars == 1 && b->val.i >= 128 && sign == 0) {
+ b->val.i -= 256;
+ } else if (b->val.i >= 128 ||
+ (b->val.i == 127 && sign != 0)) {
+ if (highcharbits && (highcharbits > 0 || signedchars < 0))
+ a = makeexpr_bin(EK_BAND, a->val.type, eatcasts(a),
+ makeexpr_long(255));
+ else
+ a = force_unsigned(a);
+ }
+ }
+ } else if (a->val.type->kind == TK_STRING &&
+ b->val.type->kind == TK_STRING) {
+ if (b->kind == EK_CONST && b->val.i == 0 && !sign) {
+ a = makeexpr_hat(a, 0);
+ b = makeexpr_char(0); /* "a = ''" => "*a == 0" */
+ } else {
+ a = makeexpr_bicall_2("strcmp", tp_int, a, b);
+ b = makeexpr_long(0);
+ }
+ } else if ((a->val.type->kind == TK_ARRAY ||
+ a->val.type->kind == TK_STRING ||
+ a->val.type->kind == TK_RECORD) &&
+ (b->val.type->kind == TK_ARRAY ||
+ b->val.type->kind == TK_STRING ||
+ b->val.type->kind == TK_RECORD)) {
+ if (a->val.type->kind == TK_ARRAY) {
+ if (b->val.type->kind == TK_ARRAY) {
+ ex = makeexpr_sizeof(copyexpr(a), 0);
+ ex2 = makeexpr_sizeof(copyexpr(b), 0);
+ if (!exprsame(ex, ex2, 1))
+ warning("Incompatible array sizes [164]");
+ freeexpr(ex2);
+ } else {
+ ex = makeexpr_sizeof(copyexpr(a), 0);
+ }
+ } else
+ ex = makeexpr_sizeof(copyexpr(b), 0);
+ name = (usestrncmp &&
+ a->val.type->kind == TK_ARRAY &&
+ a->val.type->basetype->kind == TK_CHAR) ? "strncmp" : "memcmp";
+ a = makeexpr_bicall_3(name, tp_int,
+ makeexpr_addr(a),
+ makeexpr_addr(b), ex);
+ b = makeexpr_long(0);
+ } else if (a->val.type->kind == TK_SET ||
+ a->val.type->kind == TK_SMALLSET) {
+ if (rel == EK_GE) {
+ swapexprs(a, b);
+ rel = EK_LE;
+ }
+ if (mixsets(&a, &b)->kind == TK_SMALLSET) {
+ if (rel == EK_LE) {
+ a = makeexpr_bin(EK_BAND, tp_integer,
+ a, makeexpr_un(EK_BNOT, tp_integer, b));
+ b = makeexpr_long(0);
+ rel = EK_EQ;
+ }
+ } else if (b->kind == EK_BICALL &&
+ !strcmp(b->val.s, setexpandname) &&
+ (mp = istempvar(b->args[0])) != NULL &&
+ checkconst(b->args[1], 0)) {
+ canceltempvar(mp);
+ a = makeexpr_hat(a, 0);
+ b = grabarg(b, 1);
+ if (rel == EK_LE)
+ rel = EK_EQ;
+ } else {
+ ex = makeexpr_bicall_2((rel == EK_LE) ? subsetname : setequalname,
+ tp_boolean, a, b);
+ return (rel == EK_NE) ? makeexpr_not(ex) : ex;
+ }
+ } else if (a->val.type->kind == TK_PROCPTR ||
+ a->val.type->kind == TK_CPROCPTR) {
+ /* we compare proc only (not link) -- same as Pascal compiler! */
+ if (a->val.type->kind == TK_PROCPTR)
+ a = makeexpr_dotq(a, "proc", tp_anyptr);
+ if ((mp = istempprocptr(b)) != NULL) {
+ canceltempvar(mp);
+ b = grabarg(grabarg(b, 0), 1);
+ if (!voidstar)
+ b = makeexpr_cast(b, tp_anyptr);
+ } else if (b->val.type->kind == TK_PROCPTR)
+ b = makeexpr_dotq(b, "proc", tp_anyptr);
+ }
+ return makeexpr_bin(rel, tp_boolean, a, b);
+ }
+
+
+
+
+ Expr *makeexpr_and(a, b)
+ Expr *a, *b;
+ {
+ Expr *ex, **exp, *low;
+
+ if (!a)
+ return b;
+ if (!b)
+ return a;
+ for (exp = &a; (ex = *exp)->kind == EK_AND; exp = &ex->args[1]) ;
+ if ((b->kind == EK_LT || b->kind == EK_LE) &&
+ ((ex->kind == EK_LE && exprsame(ex->args[1], b->args[0], 1)) ||
+ (ex->kind == EK_GE && exprsame(ex->args[0], b->args[0], 1)))) {
+ low = (ex->kind == EK_LE) ? ex->args[0] : ex->args[1];
+ if (unsignedtrick && checkconst(low, 0)) {
+ freeexpr(ex);
+ b->args[0] = force_unsigned(b->args[0]);
+ *exp = b;
+ return a;
+ }
+ if (b->args[1]->val.type->kind == TK_CHAR && useisalpha) {
+ if (checkconst(low, 'A') && checkconst(b->args[1], 'Z')) {
+ freeexpr(ex);
+ *exp = makeexpr_bicall_1("isupper", tp_boolean, grabarg(b, 0));
+ return a;
+ }
+ if (checkconst(low, 'a') && checkconst(b->args[1], 'z')) {
+ freeexpr(ex);
+ *exp = makeexpr_bicall_1("islower", tp_boolean, grabarg(b, 0));
+ return a;
+ }
+ if (checkconst(low, '0') && checkconst(b->args[1], '9')) {
+ freeexpr(ex);
+ *exp = makeexpr_bicall_1("isdigit", tp_boolean, grabarg(b, 0));
+ return a;
+ }
+ }
+ }
+ return makeexpr_bin(EK_AND, tp_boolean, a, b);
+ }
+
+
+
+ Expr *makeexpr_or(a, b)
+ Expr *a, *b;
+ {
+ Expr *ex, **exp, *low;
+
+ if (!a)
+ return b;
+ if (!b)
+ return a;
+ for (exp = &a; (ex = *exp)->kind == EK_OR; exp = &ex->args[1]) ;
+ if (((b->kind == EK_BICALL && !strcmp(b->val.s, "isdigit") &&
+ ex->kind == EK_BICALL && !strcmp(ex->val.s, "isalpha")) ||
+ (b->kind == EK_BICALL && !strcmp(b->val.s, "isalpha") &&
+ ex->kind == EK_BICALL && !strcmp(ex->val.s, "isdigit"))) &&
+ exprsame(ex->args[0], b->args[0], 1)) {
+ strchange(&ex->val.s, "isalnum");
+ freeexpr(b);
+ return a;
+ }
+ if (((b->kind == EK_BICALL && !strcmp(b->val.s, "islower") &&
+ ex->kind == EK_BICALL && !strcmp(ex->val.s, "isupper")) ||
+ (b->kind == EK_BICALL && !strcmp(b->val.s, "isupper") &&
+ ex->kind == EK_BICALL && !strcmp(ex->val.s, "islower"))) &&
+ exprsame(ex->args[0], b->args[0], 1)) {
+ strchange(&ex->val.s, "isalpha");
+ freeexpr(b);
+ return a;
+ }
+ if ((b->kind == EK_GT || b->kind == EK_GE) &&
+ ((ex->kind == EK_GT && exprsame(ex->args[1], b->args[0], 1)) ||
+ (ex->kind == EK_LT && exprsame(ex->args[0], b->args[0], 1)))) {
+ low = (ex->kind == EK_GT) ? ex->args[0] : ex->args[1];
+ if (unsignedtrick && checkconst(low, 0)) {
+ freeexpr(ex);
+ b->args[0] = force_unsigned(b->args[0]);
+ *exp = b;
+ return a;
+ }
+ }
+ return makeexpr_bin(EK_OR, tp_boolean, a, b);
+ }
+
+
+
+ Expr *makeexpr_range(ex, exlow, exhigh, higheq)
+ Expr *ex, *exlow, *exhigh;
+ int higheq;
+ {
+ Expr *ex2;
+ enum exprkind rel = (higheq) ? EK_LE : EK_LT;
+
+ if (exprsame(exlow, exhigh, 1) && higheq)
+ return makeexpr_rel(EK_EQ, ex, exlow);
+ ex2 = makeexpr_rel(rel, copyexpr(ex), exhigh);
+ if (lelerange)
+ return makeexpr_and(makeexpr_rel(EK_LE, exlow, ex), ex2);
+ else
+ return makeexpr_and(makeexpr_rel(EK_GE, ex, exlow), ex2);
+ }
+
+
+
+
+ Expr *makeexpr_cond(c, a, b)
+ Expr *c, *a, *b;
+ {
+ Expr *ex;
+
+ ex = makeexpr(EK_COND, 3);
+ ex->val.type = a->val.type;
+ ex->args[0] = c;
+ ex->args[1] = a;
+ ex->args[2] = b;
+ if (debug>2) { fprintf(outf,"makeexpr_cond returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+
+ int expr_is_lvalue(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ switch (ex->kind) {
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ return (mp->kind == MK_VAR || mp->kind == MK_PARAM ||
+ mp->kind == MK_VARPARAM ||
+ (mp->kind == MK_CONST &&
+ (mp->type->kind == TK_ARRAY ||
+ mp->type->kind == TK_RECORD ||
+ mp->type->kind == TK_SET)));
+
+ case EK_HAT:
+ case EK_NAME:
+ return 1;
+
+ case EK_INDEX:
+ case EK_DOT:
+ return expr_is_lvalue(ex->args[0]);
+
+ case EK_COMMA:
+ return expr_is_lvalue(ex->args[ex->nargs-1]);
+
+ default:
+ return 0;
+ }
+ }
+
+
+ int expr_has_address(ex)
+ Expr *ex;
+ {
+ if (ex->kind == EK_DOT &&
+ ((Meaning *)ex->val.i)->val.i)
+ return 0; /* bit fields do not have an address */
+ return expr_is_lvalue(ex);
+ }
+
+
+
+ Expr *checknil(ex)
+ Expr *ex;
+ {
+ if (nilcheck == 1) {
+ if (singlevar(ex)) {
+ ex = makeexpr_un(EK_CHECKNIL, ex->val.type, ex);
+ } else {
+ ex = makeexpr_bin(EK_CHECKNIL, ex->val.type, ex,
+ makeexpr_var(makestmttempvar(ex->val.type,
+ name_PTR)));
+ }
+ }
+ return ex;
+ }
+
+
+ int checkvarinlists(yes, no, def, mp)
+ Strlist *yes, *no;
+ int def;
+ Meaning *mp;
+ {
+ char *cp;
+ Meaning *ctx;
+
+ if (mp->kind == MK_FIELD)
+ ctx = mp->rectype->meaning;
+ else
+ ctx = mp->ctx;
+ if (ctx && ctx->name)
+ cp = format_ss("%s.%s", ctx->name, mp->name);
+ else
+ cp = NULL;
+ if (strlist_cifind(yes, cp))
+ return 1;
+ if (strlist_cifind(no, cp))
+ return 0;
+ if (strlist_cifind(yes, mp->name))
+ return 1;
+ if (strlist_cifind(no, mp->name))
+ return 0;
+ if (strlist_cifind(yes, "1"))
+ return 1;
+ if (strlist_cifind(no, "1"))
+ return 0;
+ return def;
+ }
+
+
+ void requirefilebuffer(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (!isfiletype(ex->val.type, 0))
+ return;
+ mp = isfilevar(ex);
+ if (!mp) {
+ if (ex->kind == EK_HAT)
+ ex = ex->args[0];
+ if (ex->kind == EK_VAR) {
+ mp = (Meaning *)ex->val.i;
+ if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM)
+ note(format_s("File parameter %s can't access buffers (try StructFiles = 1) [318]",
+ mp->name));
+ }
+ } else if (!mp->bufferedfile &&
+ checkvarinlists(bufferedfiles, unbufferedfiles, 1, mp)) {
+ if (mp->wasdeclared)
+ note(format_s("Discovered too late that %s should be buffered [143]",
+ mp->name));
+ mp->bufferedfile = 1;
+ }
+ }
+
+
+ Expr *makeexpr_hat(a, check)
+ Expr *a;
+ int check;
+ {
+ Expr *ex;
+
+ if (debug>2) { fprintf(outf,"makeexpr_hat("); dumpexpr(a); fprintf(outf,")\n"); }
+ if (isfiletype(a->val.type, -1)) {
+ requirefilebuffer(a);
+ if (*chargetfbufname &&
+ filebasetype(a->val.type)->kind == TK_CHAR)
+ return makeexpr_bicall_1(chargetfbufname,
+ filebasetype(a->val.type),
+ filebasename(a));
+ else if (*arraygetfbufname &&
+ filebasetype(a->val.type)->kind == TK_ARRAY)
+ return makeexpr_bicall_2(arraygetfbufname,
+ filebasetype(a->val.type),
+ filebasename(a),
+ makeexpr_type(filebasetype(a->val.type)));
+ else
+ return makeexpr_bicall_2(getfbufname,
+ filebasetype(a->val.type),
+ filebasename(a),
+ makeexpr_type(filebasetype(a->val.type)));
+ }
+ if (a->kind == EK_PLUS &&
+ (ex = a->args[0])->val.type->kind == TK_POINTER &&
+ (ex->val.type->basetype->kind == TK_ARRAY ||
+ ex->val.type->basetype->kind == TK_STRING ||
+ ex->val.type->basetype->kind == TK_SET)) {
+ ex->val.type = ex->val.type->basetype; /* convert *(a+n) to a[n] */
+ deletearg(&a, 0);
+ if (a->nargs == 1)
+ a = grabarg(a, 0);
+ return makeexpr_bin(EK_INDEX, ex->val.type->basetype, ex, a);
+ }
+ if (a->val.type->kind == TK_STRING ||
+ a->val.type->kind == TK_ARRAY ||
+ a->val.type->kind == TK_SET) {
+ if (starindex == 0)
+ return makeexpr_bin(EK_INDEX, a->val.type->basetype, a, makeexpr_long(0));
+ else
+ return makeexpr_un(EK_HAT, a->val.type->basetype, a);
+ }
+ if (a->val.type->kind != TK_POINTER || !a->val.type->basetype) {
+ warning("bad pointer dereference [165]");
+ return a;
+ }
+ if (a->kind == EK_CAST &&
+ a->val.type->basetype->kind == TK_POINTER &&
+ a->args[0]->val.type->kind == TK_POINTER &&
+ a->args[0]->val.type->basetype->kind == TK_POINTER) {
+ return makeexpr_cast(makeexpr_hat(a->args[0], 0),
+ a->val.type->basetype);
+ }
+ switch (a->val.type->basetype->kind) {
+
+ case TK_ARRAY:
+ case TK_STRING:
+ case TK_SET:
+ if (a->kind != EK_HAT || 1 ||
+ a->val.type == a->args[0]->val.type->basetype) {
+ a->val.type = a->val.type->basetype;
+ return a;
+ }
+
+ default:
+ if (a->kind == EK_ADDR) {
+ ex = a->args[0];
+ FREE(a);
+ return ex;
+ } else {
+ if (check)
+ ex = checknil(a);
+ else
+ ex = a;
+ return makeexpr_un(EK_HAT, a->val.type->basetype, ex);
+ }
+ }
+ }
+
+
+
+ Expr *un_sign_extend(a)
+ Expr *a;
+ {
+ if (a->kind == EK_BICALL &&
+ !strcmp(a->val.s, signextname) && *signextname) {
+ return grabarg(a, 0);
+ }
+ return a;
+ }
+
+
+
+ Expr *makeexpr_addr(a)
+ Expr *a;
+ {
+ Expr *ex;
+ Type *type;
+ Meaning *mp;
+
+ a = un_sign_extend(a);
+ type = makepointertype(a->val.type);
+ if (debug>2) { fprintf(outf,"makeexpr_addr("); dumpexpr(a); fprintf(outf,", "); dumptypename(type, 1); fprintf(outf,")\n"); }
+ if (a->kind == EK_CONST && a->val.type->kind == TK_STRING) {
+ return a; /* kludge to help assignments */
+ } else if (a->kind == EK_INDEX &&
+ (a->val.type->kind != TK_ARRAY &&
+ a->val.type->kind != TK_SET &&
+ a->val.type->kind != TK_STRING) &&
+ (addindex == 1 ||
+ (addindex != 0 && checkconst(a->args[1], 0)))) {
+ ex = makeexpr_plus(makeexpr_addr(a->args[0]), a->args[1]);
+ FREE(a);
+ ex->val.type = type;
+ return ex;
+ } else if (a->kind == EK_CAST) {
+ return makeexpr_cast(makeexpr_addr(a->args[0]), type);
+ } else if (a->kind == EK_ACTCAST) {
+ return makeexpr_actcast(makeexpr_addr(a->args[0]), type);
+ } else if (a->kind == EK_LITCAST) {
+ if (a->args[0]->kind == EK_NAME) {
+ if (my_strchr(a->args[0]->val.s, '(') ||
+ my_strchr(a->args[0]->val.s, '['))
+ note("Constructing pointer type by adding '*' may be incorrect [322]");
+ return makeexpr_bin(EK_LITCAST, tp_integer,
+ makeexpr_name(format_s("%s*",
+ a->args[0]->val.s),
+ tp_integer),
+ makeexpr_addr(a->args[1]));
+ } else
+ return makeexpr_bin(EK_LITCAST, tp_integer, makeexpr_type(type),
+ makeexpr_addr(a->args[1]));
+ } else {
+ switch (a->val.type->kind) {
+
+ case TK_ARRAY:
+ case TK_STRING:
+ case TK_SET:
+ if (a->val.type->smin) {
+ return makeexpr_un(EK_ADDR, type,
+ makeexpr_index(a,
+ copyexpr(a->val.type->smin),
+ NULL));
+ }
+ a->val.type = type;
+ return a;
+
+ default:
+ if (a->kind == EK_HAT) {
+ ex = a->args[0];
+ FREE(a);
+ return ex;
+ } else if (a->kind == EK_ACTCAST)
+ return makeexpr_actcast(makeexpr_addr(grabarg(a, 0)), type);
+ else if (a->kind == EK_CAST)
+ return makeexpr_cast(makeexpr_addr(grabarg(a, 0)), type);
+ else {
+ if (a->kind == EK_VAR &&
+ (mp = (Meaning *)a->val.i)->kind == MK_PARAM &&
+ mp->type != promote_type(mp->type) &&
+ fixpromotedargs) {
+ note(format_s("Taking & of possibly promoted param %s [324]",
+ mp->name));
+ if (fixpromotedargs == 1) {
+ mp->varstructflag = 1;
+ mp->ctx->varstructflag = 1;
+ }
+ }
+ return makeexpr_un(EK_ADDR, type, a);
+ }
+ }
+ }
+ }
+
+
+
+ Expr *makeexpr_addrstr(a)
+ Expr *a;
+ {
+ if (debug>2) { fprintf(outf,"makeexpr_addrstr("); dumpexpr(a); fprintf(outf,")\n"); }
+ if (a->val.type->kind == TK_POINTER)
+ return a;
+ return makeexpr_addr(a);
+ }
+
+
+
+ Expr *makeexpr_addrf(a)
+ Expr *a;
+ {
+ Meaning *mp, *tvar;
+
+ mp = (Meaning *)a->val.i;
+ if (is_std_file(a)) {
+ if (addrstdfiles == 0) {
+ note(format_s("Taking address of %s; consider setting VarFiles = 0 [144]",
+ (a->kind == EK_VAR) ? ((Meaning *)a->val.i)->name
+ : a->val.s));
+ tvar = makestmttempvar(tp_text, name_TEMP);
+ return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), a),
+ makeexpr_addr(makeexpr_var(tvar)));
+ }
+ }
+ if ((a->kind == EK_VAR &&
+ mp->kind == MK_FIELD && mp->val.i) ||
+ (a->kind == EK_BICALL &&
+ !strcmp(a->val.s, getbitsname))) {
+ warning("Can't take the address of a bit-field [166]");
+ }
+ return makeexpr_addr(a);
+ }
+
+
+
+ Expr *makeexpr_index(a, b, offset)
+ Expr *a, *b, *offset;
+ {
+ Type *indextype, *btype;
+
+ if (debug>2) { fprintf(outf,"makeexpr_index("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b);
+ fprintf(outf,", "); dumpexpr(offset); fprintf(outf,")\n"); }
+ indextype = (a->val.type->kind == TK_ARRAY) ? a->val.type->indextype
+ : tp_integer;
+ b = gentle_cast(b, indextype);
+ if (!offset)
+ offset = makeexpr_long(0);
+ b = makeexpr_minus(b, gentle_cast(offset, indextype));
+ btype = a->val.type;
+ if (btype->basetype)
+ btype = btype->basetype;
+ if (checkconst(b, 0) && starindex == 1)
+ return makeexpr_un(EK_HAT, btype, a);
+ else
+ return makeexpr_bin(EK_INDEX, btype, a,
+ gentle_cast(b, indextype));
+ }
+
+
+
+ Expr *makeexpr_type(type)
+ Type *type;
+ {
+ Expr *ex;
+
+ ex = makeexpr(EK_TYPENAME, 0);
+ ex->val.type = type;
+ return ex;
+ }
+
+
+ Expr *makeexpr_sizeof(ex, incskipped)
+ Expr *ex;
+ int incskipped;
+ {
+ Expr *ex2, *ex3;
+ Type *btype;
+ char *name;
+
+ if (ex->val.type->meaning) {
+ name = find_special_variant(ex->val.type->meaning->name,
+ "SpecialSizeOf", specialsizeofs, 1);
+ if (name) {
+ freeexpr(ex);
+ return pc_expr_str(name);
+ }
+ }
+ switch (ex->val.type->kind) {
+
+ case TK_CHAR:
+ case TK_BOOLEAN:
+ freeexpr(ex);
+ return makeexpr_long(1);
+
+ case TK_SUBR:
+ btype = findbasetype(ex->val.type, ODECL_NOPRES);
+ if (btype->kind == TK_CHAR || btype == tp_abyte) {
+ freeexpr(ex);
+ return makeexpr_long(1);
+ }
+ break;
+
+ case TK_STRING:
+ case TK_ARRAY:
+ if (!ex->val.type->meaning || ex->val.type->kind == TK_STRING ||
+ (!incskipped && ex->val.type->smin)) {
+ ex3 = arraysize(ex->val.type, incskipped);
+ return makeexpr_times(ex3,
+ makeexpr_sizeof(makeexpr_type(
+ ex->val.type->basetype), 1));
+ }
+ break;
+
+ case TK_SET:
+ ord_range_expr(ex->val.type->indextype, NULL, &ex2);
+ freeexpr(ex);
+ return makeexpr_times(makeexpr_plus(makeexpr_div(copyexpr(ex2),
+ makeexpr_setbits()),
+ makeexpr_long(2)),
+ makeexpr_sizeof(makeexpr_type(tp_integer), 0));
+
+ default:
+ break;
+ }
+ if (ex->kind != EK_CONST &&
+ (findbasetype(ex->val.type,0)->meaning || /* if type has a name... */
+ ex->val.type->kind == TK_STRING || /* if C sizeof(expr) will give wrong answer */
+ ex->val.type->kind == TK_ARRAY ||
+ ex->val.type->kind == TK_SET)) {
+ ex2 = makeexpr_type(ex->val.type);
+ freeexpr(ex);
+ ex = ex2;
+ }
+ return makeexpr_un(EK_SIZEOF, tp_integer, ex);
+ }
+
+
+
+
+ /* Compute a measure of how fast or slow the expression is likely to be.
+ 0 is a constant, 1 is a variable, extra points added per "operation". */
+
+ int exprspeed(ex)
+ Expr *ex;
+ {
+ Meaning *mp, *mp2;
+ int i, cost, speed;
+
+ switch (ex->kind) {
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ if (mp->kind == MK_CONST)
+ return 0;
+ if (!mp->ctx || mp->ctx->kind == MK_FUNCTION)
+ return 1;
+ i = 1;
+ for (mp2 = curctx; mp2 && mp2 != mp->ctx; mp2 = mp2->ctx)
+ i++; /* cost of following static links */
+ return (i);
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ case EK_SIZEOF:
+ return 0;
+
+ case EK_ADDR:
+ speed = exprspeed(ex->args[0]);
+ return (speed > 1) ? speed : 0;
+
+ case EK_DOT:
+ return exprspeed(ex->args[0]);
+
+ case EK_NEG:
+ return exprspeed(ex->args[0]) + 1;
+
+ case EK_CAST:
+ case EK_ACTCAST:
+ i = (ord_type(ex->val.type)->kind == TK_REAL) !=
+ (ord_type(ex->args[0]->val.type)->kind == TK_REAL);
+ return (i + exprspeed(ex->args[0]));
+
+ case EK_COND:
+ return 2 + exprspeed(ex->args[0]) +
+ MAX(exprspeed(ex->args[1]), exprspeed(ex->args[2]));
+
+ case EK_AND:
+ case EK_OR:
+ case EK_COMMA:
+ speed = 2;
+ for (i = 0; i < ex->nargs; i++)
+ speed += exprspeed(ex->args[i]);
+ return speed;
+
+ case EK_FUNCTION:
+ case EK_BICALL:
+ case EK_SPCALL:
+ return 1000;
+
+ case EK_ASSIGN:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ return 100 + exprspeed(ex->args[0]) + exprspeed(ex->args[1]);
+
+ default:
+ cost = (ex->kind == EK_PLUS) ? 1 : 2;
+ if (ex->val.type->kind == TK_REAL)
+ cost *= 2;
+ speed = -cost;
+ for (i = 0; i < ex->nargs; i++) {
+ if (!isliteralconst(ex->args[i], NULL) ||
+ ex->val.type->kind == TK_REAL)
+ speed += exprspeed(ex->args[i]) + cost;
+ }
+ return MAX(speed, 0);
+ }
+ }
+
+
+
+
+ int noargdependencies(ex, vars)
+ Expr *ex;
+ int vars;
+ {
+ int i;
+
+ for (i = 0; i < ex->nargs; i++) {
+ if (!nodependencies(ex->args[i], vars))
+ return 0;
+ }
+ return 1;
+ }
+
+
+ int nodependencies(ex, vars)
+ Expr *ex;
+ int vars; /* 1 if explicit dependencies on vars count as dependencies */
+ { /* 2 if global but not local vars count as dependencies */
+ Meaning *mp;
+
+ if (debug>2) { fprintf(outf,"nodependencies("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (!noargdependencies(ex, vars))
+ return 0;
+ switch (ex->kind) {
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ if (mp->kind == MK_CONST)
+ return 1;
+ if (vars == 2 &&
+ mp->ctx == curctx &&
+ mp->ctx->kind == MK_FUNCTION &&
+ !mp->varstructflag)
+ return 1;
+ return (mp->kind == MK_CONST ||
+ (!vars &&
+ (mp->kind == MK_VAR || mp->kind == MK_VARREF ||
+ mp->kind == MK_PARAM || mp->kind == MK_VARPARAM)));
+
+ case EK_BICALL:
+ return nosideeffects_func(ex);
+
+ case EK_FUNCTION:
+ case EK_SPCALL:
+ case EK_ASSIGN:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ case EK_HAT:
+ case EK_INDEX:
+ return 0;
+
+ default:
+ return 1;
+ }
+ }
+
+
+
+ int exprdependsvar(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+ int i;
+
+ i = ex->nargs;
+ while (--i >= 0)
+ if (exprdependsvar(ex->args[i], mp))
+ return 1;
+ switch (ex->kind) {
+
+ case EK_VAR:
+ return ((Meaning *)ex->val.i == mp);
+
+ case EK_BICALL:
+ if (nodependencies(ex, 1))
+ return 0;
+
+ /* fall through */
+ case EK_FUNCTION:
+ case EK_SPCALL:
+ return (mp->ctx != curctx ||
+ mp->ctx->kind != MK_FUNCTION ||
+ mp->varstructflag);
+
+ case EK_HAT:
+ return 1;
+
+ default:
+ return 0;
+ }
+ }
+
+
+ int exprdepends(ex, ex2)
+ Expr *ex, *ex2; /* Expression ex somehow depends on value of ex2 */
+ {
+ switch (ex2->kind) {
+
+ case EK_VAR:
+ return exprdependsvar(ex, (Meaning *)ex2->val.i);
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ return 0;
+
+ case EK_INDEX:
+ case EK_DOT:
+ return exprdepends(ex, ex2->args[0]);
+
+ default:
+ return !nodependencies(ex, 1);
+ }
+ }
+
+
+ int nosideeffects_func(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ Symbol *sp;
+
+ switch (ex->kind) {
+
+ case EK_FUNCTION:
+ mp = (Meaning *)ex->val.i;
+ sp = findsymbol_opt(mp->name);
+ return sp && (sp->flags & (NOSIDEEFF|DETERMF));
+
+ case EK_BICALL:
+ sp = findsymbol_opt(ex->val.s);
+ return sp && (sp->flags & (NOSIDEEFF|DETERMF));
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ int deterministic_func(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ Symbol *sp;
+
+ switch (ex->kind) {
+
+ case EK_FUNCTION:
+ mp = (Meaning *)ex->val.i;
+ sp = findsymbol_opt(mp->name);
+ return sp && (sp->flags & DETERMF);
+
+ case EK_BICALL:
+ sp = findsymbol_opt(ex->val.s);
+ return sp && (sp->flags & DETERMF);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+
+ int noargsideeffects(ex, mode)
+ Expr *ex;
+ int mode;
+ {
+ int i;
+
+ for (i = 0; i < ex->nargs; i++) {
+ if (!nosideeffects(ex->args[i], mode))
+ return 0;
+ }
+ return 1;
+ }
+
+
+ /* mode=0: liberal about bicall's: safe unless sideeffects_bicall() */
+ /* mode=1: conservative about bicall's: must be explicitly NOSIDEEFF */
+
+ int nosideeffects(ex, mode)
+ Expr *ex;
+ int mode;
+ {
+ if (debug>2) { fprintf(outf,"nosideeffects("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (!noargsideeffects(ex, mode))
+ return 0;
+ switch (ex->kind) {
+
+ case EK_BICALL:
+ if (mode == 0)
+ return !sideeffects_bicall(ex->val.s);
+
+ /* fall through */
+ case EK_FUNCTION:
+ return nosideeffects_func(ex);
+
+ case EK_SPCALL:
+ case EK_ASSIGN:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ return 0;
+
+ default:
+ return 1;
+ }
+ }
+
+
+
+ int exproccurs(ex, ex2)
+ Expr *ex, *ex2;
+ {
+ int i, count = 0;
+
+ if (debug>2) { fprintf(outf,"exproccurs("); dumpexpr(ex); fprintf(outf,", "); dumpexpr(ex2); fprintf(outf,")\n"); }
+ for (i = 0; i < ex->nargs; i++)
+ count += exproccurs(ex->args[i], ex2);
+ if (exprsame(ex, ex2, 0))
+ count++;
+ return count;
+ }
+
+
+
+ Expr *singlevar(ex)
+ Expr *ex;
+ {
+ if (debug>2) { fprintf(outf,"singlevar("); dumpexpr(ex); fprintf(outf,")\n"); }
+ switch (ex->kind) {
+
+ case EK_VAR:
+ case EK_MACARG:
+ return ex;
+
+ case EK_HAT:
+ case EK_ADDR:
+ case EK_DOT:
+ return singlevar(ex->args[0]);
+
+ case EK_INDEX:
+ #if 0
+ if (!nodependencies(ex->args[1], 1))
+ return NULL;
+ #endif
+ return singlevar(ex->args[0]);
+
+ default:
+ return NULL;
+ }
+ }
+
+
+
+ /* Is "ex" a function which takes a return buffer pointer as its
+ first argument, and returns a copy of that pointer? */
+
+ int structuredfunc(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ Symbol *sp;
+
+ if (debug>2) { fprintf(outf,"structuredfunc("); dumpexpr(ex); fprintf(outf,")\n"); }
+ switch (ex->kind) {
+
+ case EK_FUNCTION:
+ mp = (Meaning *)ex->val.i;
+ if (mp->isfunction && mp->cbase && mp->cbase->kind == MK_VARPARAM)
+ return 1;
+ sp = findsymbol_opt(mp->name);
+ return sp && (sp->flags & (STRUCTF|STRLAPF));
+
+ case EK_BICALL:
+ sp = findsymbol_opt(ex->val.s);
+ return sp && (sp->flags & (STRUCTF|STRLAPF));
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ int strlapfunc(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ Symbol *sp;
+
+ switch (ex->kind) {
+
+ case EK_FUNCTION:
+ mp = (Meaning *)ex->val.i;
+ sp = findsymbol_opt(mp->name);
+ return sp && (sp->flags & STRLAPF);
+
+ case EK_BICALL:
+ sp = findsymbol_opt(ex->val.s);
+ return sp && (sp->flags & STRLAPF);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ Meaning *istempvar(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (debug>2) { fprintf(outf,"istempvar("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (ex->kind == EK_VAR) {
+ mp = (Meaning *)ex->val.i;
+ if (mp->istemporary)
+ return mp;
+ else
+ return NULL;
+ }
+ return NULL;
+ }
+
+
+ Meaning *totempvar(ex)
+ Expr *ex;
+ {
+ while (structuredfunc(ex))
+ ex = ex->args[0];
+ return istempvar(ex);
+ }
+
+
+
+ Meaning *isretvar(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+
+ if (debug>2) { fprintf(outf,"isretvar("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (ex->kind == EK_HAT)
+ ex = ex->args[0];
+ if (ex->kind == EK_VAR) {
+ mp = (Meaning *)ex->val.i;
+ if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
+ mp->ctx->isfunction && mp == mp->ctx->cbase)
+ return mp;
+ else
+ return NULL;
+ }
+ return NULL;
+ }
+
+
+
+ Expr *bumpstring(ex, index, offset)
+ Expr *ex, *index;
+ int offset;
+ {
+ if (checkconst(index, offset)) {
+ freeexpr(index);
+ return ex;
+ }
+ if (addindex != 0)
+ ex = makeexpr_plus(makeexpr_addrstr(ex),
+ makeexpr_minus(index, makeexpr_long(offset)));
+ else
+ ex = makeexpr_addr(makeexpr_index(ex, index, makeexpr_long(offset)));
+ ex->val.type = tp_str255;
+ return ex;
+ }
+
+
+
+ long po2m1(n)
+ int n;
+ {
+ if (n == 32)
+ return -1;
+ else if (n == 31)
+ return 0x7fffffff;
+ else
+ return (1<<n) - 1;
+ }
+
+
+
+ int isarithkind(kind)
+ enum exprkind kind;
+ {
+ return (kind == EK_EQ || kind == EK_LT || kind == EK_GT ||
+ kind == EK_NE || kind == EK_LE || kind == EK_GE ||
+ kind == EK_PLUS || kind == EK_TIMES || kind == EK_DIVIDE ||
+ kind == EK_DIV || kind == EK_MOD || kind == EK_NEG ||
+ kind == EK_AND || kind == EK_OR || kind == EK_NOT ||
+ kind == EK_BAND || kind == EK_BOR || kind == EK_BXOR ||
+ kind == EK_LSH || kind == EK_RSH || kind == EK_BNOT ||
+ kind == EK_FUNCTION || kind == EK_BICALL);
+ }
+
+
+ Expr *makeexpr_assign(a, b)
+ Expr *a, *b;
+ {
+ int i, j;
+ Expr *ex, *ex2, *ex3, **ep;
+ Meaning *mp;
+ Type *tp;
+
+ if (debug>2) { fprintf(outf,"makeexpr_assign("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ if (stringtrunclimit > 0 &&
+ a->val.type->kind == TK_STRING &&
+ (i = strmax(a)) <= stringtrunclimit &&
+ strmax(b) > i) {
+ note("Possible string truncation in assignment [145]");
+ }
+ a = un_sign_extend(a);
+ b = gentle_cast(b, a->val.type);
+ if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
+ (mp = istempvar(b->args[0])) != NULL &&
+ b->nargs >= 2 &&
+ b->args[1]->kind == EK_CONST && /* all this handles string appending */
+ b->args[1]->val.i > 2 && /* of the form, "s := s + ..." */
+ !strncmp(b->args[1]->val.s, "%s", 2) &&
+ exprsame(a, b->args[2], 1) &&
+ nosideeffects(a, 0) &&
+ (ex = singlevar(a)) != NULL) {
+ ex2 = copyexpr(b);
+ delfreearg(&ex2, 2);
+ freeexpr(ex2->args[1]);
+ ex2->args[1] = makeexpr_lstring(b->args[1]->val.s+2,
+ b->args[1]->val.i-2);
+ if (/*(ex = singlevar(a)) != NULL && */
+ /* noargdependencies(ex2) && */ !exproccurs(ex2, ex)) {
+ freeexpr(b);
+ if (ex2->args[1]->val.i == 2 && /* s := s + s2 */
+ !strncmp(ex2->args[1]->val.s, "%s", 2)) {
+ canceltempvar(mp);
+ tp = ex2->val.type;
+ return makeexpr_bicall_2("strcat", tp,
+ makeexpr_addrstr(a), grabarg(ex2, 2));
+ } else if (sprintflength(ex2, 0) >= 0) { /* s := s + 's2' */
+ tp = ex2->val.type;
+ return makeexpr_bicall_2("strcat", tp,
+ makeexpr_addrstr(a),
+ makeexpr_unsprintfify(ex2));
+ } else { /* general case */
+ canceltempvar(mp);
+ freeexpr(ex2->args[0]);
+ ex = makeexpr_bicall_1("strlen", tp_int, copyexpr(a));
+ ex2->args[0] = bumpstring(a, ex, 0);
+ return ex2;
+ }
+ } else
+ freeexpr(ex2);
+ }
+ if (b->kind == EK_BICALL && !strcmp(b->val.s, "sprintf") &&
+ istempvar(b->args[0]) &&
+ (ex = singlevar(a)) != NULL) {
+ j = -1; /* does lhs var appear exactly once on rhs? */
+ for (i = 2; i < b->nargs; i++) {
+ if (exprsame(b->args[i], ex, 1) && j < 0)
+ j = i;
+ else if (exproccurs(b->args[i], ex))
+ break;
+ }
+ if (i == b->nargs && j > 0) {
+ b->args[j] = makeexpr_bicall_2("strcpy", tp_str255,
+ makeexpr_addrstr(b->args[0]),
+ makeexpr_addrstr(b->args[j]));
+ b->args[0] = makeexpr_addrstr(a);
+ return b;
+ }
+ }
+ if (structuredfunc(b) && (ex2 = singlevar(a)) != NULL) {
+ ep = &b->args[0];
+ i = strlapfunc(b);
+ while (structuredfunc((ex = *ep))) {
+ i = i && strlapfunc(ex);
+ ep = &ex->args[0];
+ }
+ if ((mp = istempvar(ex)) != NULL &&
+ (i || !exproccurs(b, ex2))) {
+ canceltempvar(mp);
+ freeexpr(*ep);
+ *ep = makeexpr_addrstr(a);
+ return b;
+ }
+ }
+ if (a->val.type->kind == TK_PROCPTR &&
+ (mp = istempprocptr(b)) != NULL &&
+ nosideeffects(a, 0)) {
+ freeexpr(b->args[0]->args[0]->args[0]);
+ b->args[0]->args[0]->args[0] = copyexpr(a);
+ if (b->nargs == 3) {
+ freeexpr(b->args[1]->args[0]->args[0]);
+ b->args[1]->args[0]->args[0] = a;
+ delfreearg(&b, 2);
+ } else {
+ freeexpr(b->args[1]);
+ b->args[1] = makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
+ makeexpr_nil());
+ }
+ canceltempvar(mp);
+ return b;
+ }
+ if (a->val.type->kind == TK_PROCPTR &&
+ (b->val.type->kind == TK_CPROCPTR ||
+ checkconst(b, 0))) {
+ ex = makeexpr_dotq(copyexpr(a), "proc", tp_anyptr);
+ b = makeexpr_comma(makeexpr_assign(ex, b),
+ makeexpr_assign(makeexpr_dotq(a, "link", tp_anyptr),
+ makeexpr_nil()));
+ return b;
+ }
+ if (a->val.type->kind == TK_CPROCPTR &&
+ (mp = istempprocptr(b)) != NULL &&
+ nosideeffects(a, 0)) {
+ freeexpr(b->args[0]->args[0]);
+ b->args[0]->args[0] = a;
+ if (b->nargs == 3)
+ delfreearg(&b, 1);
+ delfreearg(&b, 1);
+ canceltempvar(mp);
+ return b;
+ }
+ if (a->val.type->kind == TK_CPROCPTR &&
+ b->val.type->kind == TK_PROCPTR) {
+ b = makeexpr_dotq(b, "proc", tp_anyptr);
+ }
+ if (a->val.type->kind == TK_STRING) {
+ if (b->kind == EK_CONST && b->val.i == 0 && !isretvar(a)) {
+ /* optimizing retvar would mess up "return" optimization */
+ return makeexpr_assign(makeexpr_hat(a, 0),
+ makeexpr_char(0));
+ }
+ a = makeexpr_addrstr(a);
+ b = makeexpr_addrstr(b);
+ return makeexpr_bicall_2("strcpy", a->val.type, a, b);
+ }
+ if (a->kind == EK_BICALL && !strcmp(a->val.s, "strlen")) {
+ if (b->kind == EK_CAST &&
+ ord_type(b->args[0]->val.type)->kind == TK_INTEGER) {
+ b = grabarg(b, 0);
+ }
+ j = (b->kind == EK_PLUS && /* handle "s[0] := xxx" */
+ b->args[0]->kind == EK_BICALL &&
+ !strcmp(b->args[0]->val.s, "strlen") &&
+ exprsame(a->args[0], b->args[0]->args[0], 0) &&
+ isliteralconst(b->args[1], NULL) == 2);
+ if (j && b->args[1]->val.i > 0 &&
+ b->args[1]->val.i <= 5) { /* lengthening the string */
+ a = grabarg(a, 0);
+ i = b->args[1]->val.i;
+ freeexpr(b);
+ if (i == 1)
+ b = makeexpr_string(" ");
+ else
+ b = makeexpr_lstring("12345", i);
+ return makeexpr_bicall_2("strcat", a->val.type, a, b);
+ } else { /* maybe shortening the string */
+ if (!j && !isconstexpr(b, NULL))
+ note("Modification of string length may translate incorrectly [146]");
+ a = grabarg(a, 0);
+ b = makeexpr_ord(b);
+ return makeexpr_assign(makeexpr_index(a, b, NULL),
+ makeexpr_char(0));
+ }
+ }
+ if (a->val.type->kind == TK_ARRAY ||
+ (a->val.type->kind == TK_PROCPTR && copystructs < 1) ||
+ (a->val.type->kind == TK_RECORD &&
+ (copystructs < 1 || a->val.type != b->val.type))) {
+ ex = makeexpr_sizeof(copyexpr(a), 0);
+ ex2 = makeexpr_sizeof(copyexpr(b), 0);
+ if (!exprsame(ex, ex2, 1)) {
+ if (a->val.type->kind == TK_ARRAY &&
+ b->val.type->kind == TK_ARRAY &&
+ a->val.type->basetype->kind == TK_CHAR &&
+ (!ISCONST(ex->kind) || !ISCONST(ex2->kind) ||
+ ex->val.i > ex2->val.i)) {
+ ex = makeexpr_arglong(ex, (size_t_long != 0));
+ ex2 = makeexpr_arglong(ex2, (size_t_long != 0));
+ a = makeexpr_addrstr(a);
+ b = makeexpr_addrstr(b);
+ b = makeexpr_bicall_3("memcpy", a->val.type,
+ copyexpr(a), b, copyexpr(ex2));
+ ex3 = copyexpr(ex2);
+ return makeexpr_comma(b,
+ makeexpr_bicall_3("memset", a->val.type,
+ makeexpr_plus(a, ex3),
+ makeexpr_char(' '),
+ makeexpr_minus(ex,
+ ex2)));
+ } else if (!(a->val.type->kind == TK_ARRAY &&
+ b->val.type->kind != TK_ARRAY))
+ warning("Incompatible types or sizes [167]");
+ }
+ freeexpr(ex2);
+ ex = makeexpr_arglong(ex, (size_t_long != 0));
+ a = makeexpr_addrstr(a);
+ b = makeexpr_addrstr(b);
+ return makeexpr_bicall_3("memcpy", a->val.type, a, b, ex);
+ }
+ if (a->val.type->kind == TK_SET) {
+ a = makeexpr_addrstr(a);
+ b = makeexpr_addrstr(b);
+ return makeexpr_bicall_2(setcopyname, a->val.type, a, b);
+ }
+ for (ep = &a; (ex3 = *ep); ) {
+ if (ex3->kind == EK_COMMA)
+ ep = &ex3->args[ex3->nargs-1];
+ else if (ex3->kind == EK_CAST || ex3->kind == EK_ACTCAST)
+ ep = &ex3->args[0];
+ else
+ break;
+ }
+ if (ex3->kind == EK_BICALL) {
+ if (!strcmp(ex3->val.s, getbitsname)) {
+ tp = ex3->args[0]->val.type;
+ if (tp->kind == TK_ARRAY)
+ ex3->args[0] = makeexpr_addr(ex3->args[0]);
+ ex3->val.type = tp_void;
+ if (checkconst(b, 0) && *clrbitsname) {
+ strchange(&ex3->val.s, clrbitsname);
+ } else if (*putbitsname &&
+ ((ISCONST(b->kind) &&
+ (b->val.i | ~((1 << (1 << tp->escale)) - 1)) == -1) ||
+ checkconst(b, (1 << (1 << tp->escale)) - 1))) {
+ strchange(&ex3->val.s, putbitsname);
+ insertarg(ep, 2, makeexpr_arglong(makeexpr_ord(b), 0));
+ } else {
+ b = makeexpr_arglong(makeexpr_ord(b), 0);
+ if (*storebitsname) {
+ strchange(&ex3->val.s, storebitsname);
+ insertarg(ep, 2, b);
+ } else {
+ if (exproccurs(b, ex3->args[0])) {
+ mp = makestmttempvar(b->val.type, name_TEMP);
+ ex2 = makeexpr_assign(makeexpr_var(mp), b);
+ b = makeexpr_var(mp);
+ } else
+ ex2 = NULL;
+ ex = copyexpr(ex3);
+ strchange(&ex3->val.s, putbitsname);
+ insertarg(&ex3, 2, b);
+ strchange(&ex->val.s, clrbitsname);
+ *ep = makeexpr_comma(ex2, makeexpr_comma(ex, ex3));
+ }
+ }
+ return a;
+ } else if (!strcmp(ex3->val.s, getfbufname)) {
+ ex3->val.type = tp_void;
+ strchange(&ex3->val.s, putfbufname);
+ insertarg(ep, 2, b);
+ return a;
+ } else if (!strcmp(ex3->val.s, chargetfbufname)) {
+ ex3->val.type = tp_void;
+ if (*charputfbufname) {
+ strchange(&ex3->val.s, charputfbufname);
+ insertarg(ep, 1, b);
+ } else {
+ strchange(&ex3->val.s, putfbufname);
+ insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
+ insertarg(ep, 2, b);
+ }
+ return a;
+ } else if (!strcmp(ex3->val.s, arraygetfbufname)) {
+ ex3->val.type = tp_void;
+ if (*arrayputfbufname) {
+ strchange(&ex3->val.s, arrayputfbufname);
+ insertarg(ep, 1, b);
+ } else {
+ strchange(&ex3->val.s, putfbufname);
+ insertarg(ep, 1, makeexpr_type(ex3->val.type->basetype->basetype));
+ insertarg(ep, 2, b);
+ }
+ return a;
+ }
+ }
+ while (a->kind == EK_CAST || a->kind == EK_ACTCAST ||
+ a->kind == EK_LITCAST) {
+ if (a->kind == EK_LITCAST) {
+ b = makeexpr_cast(b, a->args[1]->val.type);
+ a = grabarg(a, 1);
+ } else if (ansiC < 2 || /* in GNU C, a cast is an lvalue */
+ isarithkind(a->args[0]->kind) ||
+ (a->val.type->kind == TK_POINTER &&
+ a->args[0]->val.type->kind == TK_POINTER)) {
+ if (a->kind == EK_CAST)
+ b = makeexpr_cast(b, a->args[0]->val.type);
+ else
+ b = makeexpr_actcast(b, a->args[0]->val.type);
+ a = grabarg(a, 0);
+ } else
+ break;
+ }
+ if (a->kind == EK_NEG)
+ return makeexpr_assign(grabarg(a, 0), makeexpr_neg(b));
+ if (a->kind == EK_NOT)
+ return makeexpr_assign(grabarg(a, 0), makeexpr_not(b));
+ if (a->kind == EK_BNOT)
+ return makeexpr_assign(grabarg(a, 0),
+ makeexpr_un(EK_BNOT, b->val.type, b));
+ if (a->kind == EK_PLUS) {
+ for (i = 0; i < a->nargs && a->nargs > 1; ) {
+ if (isconstantexpr(a->args[i])) {
+ b = makeexpr_minus(b, a->args[i]);
+ deletearg(&a, i);
+ } else
+ i++;
+ }
+ if (a->nargs == 1)
+ return makeexpr_assign(grabarg(a, 0), b);
+ }
+ if (a->kind == EK_TIMES) {
+ for (i = 0; i < a->nargs && a->nargs > 1; ) {
+ if (isconstantexpr(a->args[i])) {
+ if (a->val.type->kind == TK_REAL)
+ b = makeexpr_divide(b, a->args[i]);
+ else {
+ if (ISCONST(b->kind) && ISCONST(a->args[i]->kind) &&
+ (b->val.i % a->args[i]->val.i) != 0) {
+ break;
+ }
+ b = makeexpr_div(b, a->args[i]);
+ }
+ deletearg(&a, i);
+ } else
+ i++;
+ }
+ if (a->nargs == 1)
+ return makeexpr_assign(grabarg(a, 0), b);
+ }
+ if ((a->kind == EK_DIVIDE || a->kind == EK_DIV) &&
+ isconstantexpr(a->args[1])) {
+ b = makeexpr_times(b, a->args[1]);
+ return makeexpr_assign(a->args[0], b);
+ }
+ if (a->kind == EK_LSH && isconstantexpr(a->args[1])) {
+ if (ISCONST(b->kind) && ISCONST(a->args[1]->kind)) {
+ if ((b->val.i & ((1L << a->args[1]->val.i)-1)) == 0) {
+ b->val.i >>= a->args[1]->val.i;
+ return makeexpr_assign(grabarg(a, 0), b);
+ }
+ } else {
+ b = makeexpr_bin(EK_RSH, b->val.type, b, a->args[1]);
+ return makeexpr_assign(a->args[0], b);
+ }
+ }
+ if (a->kind == EK_RSH && isconstantexpr(a->args[1])) {
+ if (ISCONST(b->kind) && ISCONST(a->args[1]->kind))
+ b->val.i <<= a->args[1]->val.i;
+ else
+ b = makeexpr_bin(EK_LSH, b->val.type, b, a->args[1]);
+ return makeexpr_assign(a->args[0], b);
+ }
+ if (isarithkind(a->kind))
+ warning("Invalid assignment [168]");
+ return makeexpr_bin(EK_ASSIGN, a->val.type, a, makeexpr_unlongcast(b));
+ }
+
+
+
+
+ Expr *makeexpr_comma(a, b)
+ Expr *a, *b;
+ {
+ Type *type;
+
+ if (!a || nosideeffects(a, 1))
+ return b;
+ if (!b)
+ return a;
+ type = b->val.type;
+ a = commute(a, b, EK_COMMA);
+ a->val.type = type;
+ return a;
+ }
+
+
+
+
+ int strmax(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ long smin, smax;
+ Value val;
+ Type *type;
+
+ type = ex->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ if (type->kind == TK_CHAR)
+ return 1;
+ if (type->kind == TK_ARRAY && type->basetype->kind == TK_CHAR) {
+ if (ord_range(type->indextype, &smin, &smax))
+ return smax - smin + 1;
+ else
+ return stringceiling;
+ }
+ if (type->kind != TK_STRING) {
+ intwarning("strmax", "strmax encountered a non-string value [169]");
+ return stringceiling;
+ }
+ if (ex->kind == EK_CONST)
+ return ex->val.i;
+ if (ex->kind == EK_VAR && foldstrconsts != 0 &&
+ (mp = (Meaning *)(ex->val.i))->kind == MK_CONST && mp->val.type)
+ return mp->val.i;
+ if (ex->kind == EK_BICALL) {
+ if (!strcmp(ex->val.s, strsubname)) {
+ if (isliteralconst(ex->args[3], &val) && val.type)
+ return val.i;
+ }
+ }
+ if (ord_range(type->indextype, NULL, &smax))
+ return smax;
+ else
+ return stringceiling;
+ }
+
+
+
+
+ int strhasnull(val)
+ Value val;
+ {
+ int i;
+
+ for (i = 0; i < val.i; i++) {
+ if (!val.s[i])
+ return (i == val.i-1) ? 1 : 2;
+ }
+ return 0;
+ }
+
+
+
+ int istempsprintf(ex)
+ Expr *ex;
+ {
+ return (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
+ ex->nargs >= 2 &&
+ istempvar(ex->args[0]) &&
+ ex->args[1]->kind == EK_CONST &&
+ ex->args[1]->val.type->kind == TK_STRING);
+ }
+
+
+
+ Expr *makeexpr_sprintfify(ex)
+ Expr *ex;
+ {
+ Meaning *tvar;
+ char stringbuf[500];
+ char *cp, ch;
+ int j, nnulls;
+ Expr *ex2;
+
+ if (debug>2) { fprintf(outf,"makeexpr_sprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (istempsprintf(ex))
+ return ex;
+ ex = makeexpr_stringcast(ex);
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
+ cp = stringbuf;
+ nnulls = 0;
+ for (j = 0; j < ex->val.i; j++) {
+ ch = ex->val.s[j];
+ if (!ch) {
+ if (j < ex->val.i-1)
+ note("Null character in sprintf control string [147]");
+ else
+ note("Null character at end of sprintf control string [148]");
+ if (keepnulls) {
+ *cp++ = '%';
+ *cp++ = 'c';
+ nnulls++;
+ }
+ } else {
+ *cp++ = ch;
+ if (ch == '%')
+ *cp++ = ch;
+ }
+ }
+ *cp = 0;
+ ex = makeexpr_bicall_2("sprintf", tp_str255,
+ makeexpr_var(tvar),
+ makeexpr_string(stringbuf));
+ while (--nnulls >= 0)
+ insertarg(&ex, 2, makeexpr_char(0));
+ return ex;
+ } else if (ex->val.type->kind == TK_ARRAY &&
+ ex->val.type->basetype->kind == TK_CHAR) {
+ ex2 = arraysize(ex->val.type, 0);
+ return cleansprintf(
+ makeexpr_bicall_4("sprintf", tp_str255,
+ makeexpr_var(tvar),
+ makeexpr_string("%.*s"),
+ ex2,
+ makeexpr_addrstr(ex)));
+ } else {
+ if (ord_type(ex->val.type)->kind == TK_CHAR)
+ cp = "%c";
+ else if (ex->val.type->kind == TK_STRING)
+ cp = "%s";
+ else {
+ warning("Mixing non-strings with strings [170]");
+ return ex;
+ }
+ return makeexpr_bicall_3("sprintf", tp_str255,
+ makeexpr_var(tvar),
+ makeexpr_string(cp),
+ ex);
+ }
+ }
+
+
+
+ Expr *makeexpr_unsprintfify(ex)
+ Expr *ex;
+ {
+ char stringbuf[500];
+ char *cp, ch;
+ int i;
+
+ if (debug>2) { fprintf(outf,"makeexpr_unsprintfify("); dumpexpr(ex); fprintf(outf,")\n"); }
+ if (!istempsprintf(ex))
+ return ex;
+ canceltempvar(istempvar(ex->args[0]));
+ for (i = 2; i < ex->nargs; i++) {
+ if (ex->args[i]->val.type->kind != TK_CHAR ||
+ !checkconst(ex, 0))
+ return ex;
+ }
+ cp = stringbuf;
+ for (i = 0; i < ex->args[1]->val.i; i++) {
+ ch = ex->args[1]->val.s[i];
+ *cp++ = ch;
+ if (ch == '%') {
+ if (++i == ex->args[1]->val.i)
+ return ex;
+ ch = ex->args[1]->val.s[i];
+ if (ch == 'c')
+ cp[-1] = 0;
+ else if (ch != '%')
+ return ex;
+ }
+ }
+ freeexpr(ex);
+ return makeexpr_lstring(stringbuf, cp - stringbuf);
+ }
+
+
+
+ /* Returns >= 0 iff unsprintfify would return a string constant */
+
+ int sprintflength(ex, allownulls)
+ Expr *ex;
+ int allownulls;
+ {
+ int i, len;
+
+ if (!istempsprintf(ex))
+ return -1;
+ for (i = 2; i < ex->nargs; i++) {
+ if (!allownulls ||
+ ex->args[i]->val.type->kind != TK_CHAR ||
+ !checkconst(ex, 0))
+ return -1;
+ }
+ len = 0;
+ for (i = 0; i < ex->args[1]->val.i; i++) {
+ len++;
+ if (ex->args[1]->val.s[i] == '%') {
+ if (++i == ex->args[1]->val.i)
+ return -1;
+ if (ex->args[1]->val.s[i] != 'c' &&
+ ex->args[1]->val.s[i] != '%')
+ return -1;
+ }
+ }
+ return len;
+ }
+
+
+
+ Expr *makeexpr_concat(a, b, usesprintf)
+ Expr *a, *b;
+ int usesprintf;
+ {
+ int i, ii, j, len, nargs;
+ Type *type;
+ Meaning *mp, *tvar;
+ Expr *ex, *args[2];
+ int akind[2];
+ Value val, val1, val2;
+ char formatstr[300];
+
+ if (debug>2) { fprintf(outf,"makeexpr_concat("); dumpexpr(a); fprintf(outf,", "); dumpexpr(b); fprintf(outf,")\n"); }
+ if (!a)
+ return b;
+ if (!b)
+ return a;
+ a = makeexpr_stringcast(a);
+ b = makeexpr_stringcast(b);
+ if (checkconst(a, 0)) {
+ freeexpr(a);
+ return b;
+ }
+ if (checkconst(b, 0)) {
+ freeexpr(b);
+ return a;
+ }
+ len = strmax(a) + strmax(b);
+ type = makestringtype(len);
+ if (a->kind == EK_CONST && b->kind == EK_CONST) {
+ val1 = a->val;
+ val2 = b->val;
+ val.i = val1.i + val2.i;
+ val.s = ALLOC(val.i+1, char, literals);
+ val.s[val.i] = 0;
+ val.type = type;
+ memcpy(val.s, val1.s, val1.i);
+ memcpy(val.s + val1.i, val2.s, val2.i);
+ freeexpr(a);
+ freeexpr(b);
+ return makeexpr_val(val);
+ }
+ tvar = makestmttempvar(type, name_STRING);
+ if (sprintf_value != 2 || usesprintf) {
+ nargs = 2; /* Generate a call to sprintf(), unfolding */
+ args[0] = a; /* nested sprintf()'s. */
+ args[1] = b;
+ *formatstr = 0;
+ for (i = 0; i < 2; i++) {
+ #if 1
+ ex = args[i] = makeexpr_sprintfify(args[i]);
+ if (!ex->args[1] || !ex->args[1]->val.s)
+ intwarning("makeexpr_concat", "NULL in ex->args[1]");
+ else
+ strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
+ canceltempvar(istempvar(ex->args[0]));
+ nargs += (ex->nargs - 2);
+ akind[i] = 0; /* now obsolete */
+ #else
+ ex = args[i];
+ if (ex->kind == EK_CONST)
+ ex = makeexpr_sprintfify(ex);
+ if (istempsprintf(ex)) {
+ strncat(formatstr, ex->args[1]->val.s, ex->args[1]->val.i);
+ canceltempvar(istempvar(ex->args[0]));
+ nargs += (ex->nargs - 2);
+ akind[i] = 0;
+ } else {
+ strcat(formatstr, "%s");
+ nargs++;
+ akind[i] = 1;
+ }
+ #endif
+ }
+ ex = makeexpr(EK_BICALL, nargs);
+ ex->val.type = type;
+ ex->val.s = stralloc("sprintf");
+ ex->args[0] = makeexpr_var(tvar);
+ ex->args[1] = makeexpr_string(formatstr);
+ j = 2;
+ for (i = 0; i < 2; i++) {
+ switch (akind[i]) {
+ case 0: /* flattened sub-sprintf */
+ for (ii = 2; ii < args[i]->nargs; ii++)
+ ex->args[j++] = copyexpr(args[i]->args[ii]);
+ freeexpr(args[i]);
+ break;
+ case 1: /* included string expr */
+ ex->args[j++] = args[i];
+ break;
+ }
+ }
+ } else {
+ ex = a;
+ while (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcat"))
+ ex = ex->args[0];
+ if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "strcpy") &&
+ (mp = istempvar(ex->args[0])) != NULL) {
+ canceltempvar(mp);
+ freeexpr(ex->args[0]);
+ ex->args[0] = makeexpr_var(tvar);
+ } else {
+ a = makeexpr_bicall_2("strcpy", type, makeexpr_var(tvar), a);
+ }
+ ex = makeexpr_bicall_2("strcat", type, a, b);
+ }
+ if (debug>2) { fprintf(outf,"makeexpr_concat returns "); dumpexpr(ex); fprintf(outf,"\n"); }
+ return ex;
+ }
+
+
+
+ Expr *cleansprintf(ex)
+ Expr *ex;
+ {
+ int fidx, i, j, k, len, changed = 0;
+ char *cp, *bp;
+ char fmtbuf[300];
+
+ if (ex->kind != EK_BICALL)
+ return ex;
+ if (!strcmp(ex->val.s, "printf"))
+ fidx = 0;
+ else if (!strcmp(ex->val.s, "sprintf") ||
+ !strcmp(ex->val.s, "fprintf"))
+ fidx = 1;
+ else
+ return ex;
+ len = ex->args[fidx]->val.i;
+ cp = ex->args[fidx]->val.s; /* printf("%*d",17,x) => printf("%17d",x) */
+ bp = fmtbuf;
+ j = fidx + 1;
+ for (i = 0; i < len; i++) {
+ *bp++ = cp[i];
+ if (cp[i] == '%') {
+ if (cp[i+1] == 's' && ex->args[j]->kind == EK_CONST) {
+ bp--;
+ for (k = 0; k < ex->args[j]->val.i; k++)
+ *bp++ = ex->args[j]->val.s[k];
+ delfreearg(&ex, j);
+ changed = 1;
+ i++;
+ continue;
+ }
+ for (i++; i < len &&
+ !(isalpha(cp[i]) && cp[i] != 'l'); i++) {
+ if (cp[i] == '*') {
+ if (isliteralconst(ex->args[j], NULL) == 2) {
+ sprintf(bp, "%ld", ex->args[j]->val.i);
+ bp += strlen(bp);
+ delfreearg(&ex, j);
+ changed = 1;
+ } else {
+ *bp++ = cp[i];
+ j++;
+ }
+ } else
+ *bp++ = cp[i];
+ }
+ if (i < len)
+ *bp++ = cp[i];
+ j++;
+ }
+ }
+ *bp = 0;
+ if (changed) {
+ freeexpr(ex->args[fidx]);
+ ex->args[fidx] = makeexpr_string(fmtbuf);
+ }
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_substring(vex, ex, exi, exj)
+ Expr *vex, *ex, *exi, *exj;
+ {
+ exi = makeexpr_unlongcast(exi);
+ exj = makeexpr_longcast(exj, 0);
+ ex = bumpstring(ex, exi, 1);
+ return cleansprintf(makeexpr_bicall_4("sprintf", tp_str255,
+ vex,
+ makeexpr_string("%.*s"),
+ exj,
+ ex));
+ }
+
+
+
+
+ Expr *makeexpr_dot(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+ Type *ot1, *ot2;
+ Expr *ex2, *ex3, *nex;
+ Meaning *tvar;
+
+ if (ex->kind == EK_FUNCTION && copystructfuncs > 0) {
+ tvar = makestmttempvar(ex->val.type, name_TEMP);
+ ex2 = makeexpr_assign(makeexpr_var(tvar), ex);
+ ex = makeexpr_var(tvar);
+ } else
+ ex2 = NULL;
+ if (mp->constdefn) {
+ nex = makeexpr(EK_MACARG, 0);
+ nex->val.type = tp_integer;
+ ex3 = replaceexprexpr(copyexpr(mp->constdefn), nex, ex, 0);
+ freeexpr(ex);
+ freeexpr(nex);
+ ex = gentle_cast(ex3, mp->val.type);
+ } else {
+ ex = makeexpr_un(EK_DOT, mp->type, ex);
+ ex->val.i = (long)mp;
+ ot1 = ord_type(mp->type);
+ ot2 = ord_type(mp->val.type);
+ if (ot1->kind != ot2->kind && ot2->kind == TK_ENUM && ot2->meaning && useenum)
+ ex = makeexpr_cast(ex, mp->val.type);
+ else if (mp->val.i && !hassignedchar &&
+ (mp->type == tp_sint || mp->type == tp_abyte)) {
+ if (*signextname) {
+ ex = makeexpr_bicall_2(signextname, tp_integer,
+ ex, makeexpr_long(mp->val.i));
+ } else
+ note(format_s("Unable to sign-extend field %s [149]", mp->name));
+ }
+ }
+ ex->val.type = mp->val.type;
+ return makeexpr_comma(ex2, ex);
+ }
+
+
+
+ Expr *makeexpr_dotq(ex, name, type)
+ Expr *ex;
+ char *name;
+ Type *type;
+ {
+ ex = makeexpr_un(EK_DOT, type, ex);
+ ex->val.s = stralloc(name);
+ return ex;
+ }
+
+
+
+ Expr *strmax_func(ex)
+ Expr *ex;
+ {
+ Meaning *mp;
+ Expr *ex2;
+ Type *type;
+
+ type = ex->val.type;
+ if (type->kind == TK_POINTER) {
+ intwarning("strmax_func", "got a pointer instead of a string [171]");
+ type = type->basetype;
+ }
+ if (type->kind == TK_CHAR)
+ return makeexpr_long(1);
+ if (type->kind != TK_STRING) {
+ warning("STRMAX of non-string value [172]");
+ return makeexpr_long(stringceiling);
+ }
+ if (ex->kind == EK_CONST)
+ return makeexpr_long(ex->val.i);
+ if (ex->kind == EK_VAR &&
+ (mp = (Meaning *)ex->val.i)->kind == MK_CONST &&
+ mp->type == tp_str255 && mp->val.type)
+ return makeexpr_long(mp->val.i);
+ if (ex->kind == EK_VAR &&
+ (mp = (Meaning *)ex->val.i)->kind == MK_VARPARAM &&
+ mp->type == tp_strptr) {
+ if (mp->anyvarflag) {
+ if (mp->ctx != curctx && mp->ctx->kind == MK_FUNCTION)
+ note(format_s("Reference to STRMAX of parent proc's \"%s\" must be fixed [150]",
+ mp->name));
+ return makeexpr_name(format_s(name_STRMAX, mp->name), tp_int);
+ } else
+ note(format_s("STRMAX of \"%s\" wants VarStrings=1 [151]", mp->name));
+ }
+ ord_range_expr(type->indextype, NULL, &ex2);
+ return copyexpr(ex2);
+ }
+
+
+
+
+ Expr *makeexpr_nil()
+ {
+ Expr *ex;
+
+ ex = makeexpr(EK_CONST, 0);
+ ex->val.type = tp_anyptr;
+ ex->val.i = 0;
+ ex->val.s = NULL;
+ return ex;
+ }
+
+
+
+ Expr *makeexpr_ctx(ctx)
+ Meaning *ctx;
+ {
+ Expr *ex;
+
+ ex = makeexpr(EK_CTX, 0);
+ ex->val.type = tp_text; /* handy pointer type */
+ ex->val.i = (long)ctx;
+ return ex;
+ }
+
+
+
+
+ Expr *force_signed(ex)
+ Expr *ex;
+ {
+ Type *tp;
+
+ if (isliteralconst(ex, NULL) == 2 && ex->nargs == 0)
+ return ex;
+ tp = true_type(ex);
+ if (tp == tp_ushort || tp == tp_ubyte || tp == tp_uchar)
+ return makeexpr_cast(ex, tp_sshort);
+ else if (tp == tp_unsigned || tp == tp_uint) {
+ if (exprlongness(ex) < 0)
+ return makeexpr_cast(ex, tp_sint);
+ else
+ return makeexpr_cast(ex, tp_integer);
+ }
+ return ex;
+ }
+
+
+
+ Expr *force_unsigned(ex)
+ Expr *ex;
+ {
+ Type *tp;
+
+ if (isliteralconst(ex, NULL) == 2 && !expr_is_neg(ex))
+ return ex;
+ tp = true_type(ex);
+ if (tp == tp_unsigned || tp == tp_uint || tp == tp_ushort ||
+ tp == tp_ubyte || tp == tp_uchar)
+ return ex;
+ if (tp->kind == TK_CHAR)
+ return makeexpr_actcast(ex, tp_uchar);
+ else if (exprlongness(ex) < 0)
+ return makeexpr_cast(ex, tp_uint);
+ else
+ return makeexpr_cast(ex, tp_unsigned);
+ }
+
+
+
+
+ #define CHECKSIZE(size) (((size) > 0 && (size)%charsize == 0) ? (size)/charsize : 0)
+
+ long type_sizeof(type, pasc)
+ Type *type;
+ int pasc;
+ {
+ long s1, smin, smax;
+ int charsize = (sizeof_char) ? sizeof_char : CHAR_BIT; /* from <limits.h> */
+
+ switch (type->kind) {
+
+ case TK_INTEGER:
+ if (type == tp_integer ||
+ type == tp_unsigned)
+ return pasc ? 4 : CHECKSIZE(sizeof_integer);
+ else
+ return pasc ? 2 : CHECKSIZE(sizeof_short);
+
+ case TK_CHAR:
+ case TK_BOOLEAN:
+ return 1;
+
+ case TK_SUBR:
+ type = findbasetype(type, ODECL_NOPRES);
+ if (pasc) {
+ if (type == tp_integer || type == tp_unsigned)
+ return 4;
+ else
+ return 2;
+ } else {
+ if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte)
+ return 1;
+ else if (type == tp_ushort || type == tp_sshort)
+ return CHECKSIZE(sizeof_short);
+ else
+ return CHECKSIZE(sizeof_integer);
+ }
+
+ case TK_POINTER:
+ return pasc ? 4 : CHECKSIZE(sizeof_pointer);
+
+ case TK_REAL:
+ if (type == tp_longreal)
+ return pasc ? (which_lang == LANG_TURBO ? 6 : 8) : CHECKSIZE(sizeof_double);
+ else
+ return pasc ? 4 : CHECKSIZE(sizeof_float);
+
+ case TK_ENUM:
+ if (!pasc)
+ return CHECKSIZE(sizeof_enum);
+ type = findbasetype(type, ODECL_NOPRES);
+ return type->kind != TK_ENUM ? type_sizeof(type, pasc)
+ : CHECKSIZE(pascalenumsize);
+
+ case TK_SMALLSET:
+ case TK_SMALLARRAY:
+ return pasc ? 0 : type_sizeof(type->basetype, pasc);
+
+ case TK_ARRAY:
+ s1 = type_sizeof(type->basetype, pasc);
+ if (s1 && ord_range(type->indextype, &smin, &smax))
+ return s1 * (smax - smin + 1);
+ else
+ return 0;
+
+ case TK_RECORD:
+ if (pasc && type->meaning) {
+ if (!strcmp(type->meaning->sym->name, "NA_WORD"))
+ return 2;
+ else if (!strcmp(type->meaning->sym->name, "NA_LONGWORD"))
+ return 4;
+ else if (!strcmp(type->meaning->sym->name, "NA_QUADWORD"))
+ return 8;
+ else
+ return 0;
+ } else
+ return 0;
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ Static Value eval_expr_either(ex, pasc)
+ Expr *ex;
+ int pasc;
+ {
+ Value val, val2;
+ Meaning *mp;
+ int i;
+
+ if (debug>2) { fprintf(outf,"eval_expr("); dumpexpr(ex); fprintf(outf,")\n"); }
+ switch (ex->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ return ex->val;
+
+ case EK_VAR:
+ mp = (Meaning *) ex->val.i;
+ if (mp->kind == MK_CONST &&
+ (foldconsts != 0 ||
+ mp == mp_maxint || mp == mp_minint))
+ return mp->val;
+ break;
+
+ case EK_SIZEOF:
+ i = type_sizeof(ex->args[0]->val.type, pasc);
+ if (i)
+ return make_ord(tp_integer, i);
+ break;
+
+ case EK_PLUS:
+ val = eval_expr_either(ex->args[0], pasc);
+ if (!val.type || ord_type(val.type)->kind != TK_INTEGER)
+ val.type = NULL;
+ for (i = 1; val.type && i < ex->nargs; i++) {
+ val2 = eval_expr_either(ex->args[i], pasc);
+ if (!val2.type || ord_type(val2.type)->kind != TK_INTEGER)
+ val.type = NULL;
+ else {
+ val.i += val2.i;
+ val.type = tp_integer;
+ }
+ }
+ return val;
+
+ case EK_TIMES:
+ val = eval_expr_either(ex->args[0], pasc);
+ if (!val.type || ord_type(val.type)->kind != TK_INTEGER)
+ val.type = NULL;
+ for (i = 1; val.type && i < ex->nargs; i++) {
+ val2 = eval_expr_either(ex->args[i], pasc);
+ if (!val2.type || ord_type(val2.type)->kind != TK_INTEGER)
+ val.type = NULL;
+ else {
+ val.i *= val2.i;
+ val.type = tp_integer;
+ }
+ }
+ return val;
+
+ case EK_DIV:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && ord_type(val.type)->kind == TK_INTEGER &&
+ val2.type && ord_type(val2.type)->kind == TK_INTEGER &&
+ val2.i) {
+ val.i /= val2.i;
+ val.type = tp_integer;
+ return val;
+ }
+ break;
+
+ case EK_MOD:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && ord_type(val.type)->kind == TK_INTEGER &&
+ val2.type && ord_type(val2.type)->kind == TK_INTEGER &&
+ val2.i) {
+ val.i %= val2.i;
+ val.type = tp_integer;
+ return val;
+ }
+ break;
+
+ case EK_NEG:
+ val = eval_expr_either(ex->args[0], pasc);
+ if (val.type) {
+ val.i = -val.i;
+ return val;
+ }
+ break;
+
+ case EK_LSH:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && val2.type) {
+ val.i <<= val2.i;
+ return val;
+ }
+ break;
+
+ case EK_RSH:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && val2.type) {
+ val.i >>= val2.i;
+ return val;
+ }
+ break;
+
+ case EK_BAND:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && val2.type) {
+ val.i &= val2.i;
+ return val;
+ }
+ break;
+
+ case EK_BOR:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && val2.type) {
+ val.i |= val2.i;
+ return val;
+ }
+ break;
+
+ case EK_BXOR:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type && val2.type) {
+ val.i ^= val2.i;
+ return val;
+ }
+ break;
+
+ case EK_BNOT:
+ val = eval_expr_either(ex->args[0], pasc);
+ if (val.type) {
+ val.i = ~val.i;
+ return val;
+ }
+ break;
+
+ case EK_EQ:
+ case EK_NE:
+ case EK_GT:
+ case EK_LT:
+ case EK_GE:
+ case EK_LE:
+ val = eval_expr_either(ex->args[0], pasc);
+ val2 = eval_expr_either(ex->args[1], pasc);
+ if (val.type) {
+ if (val.i == val2.i)
+ val.i = (ex->kind == EK_EQ || ex->kind == EK_GE || ex->kind == EK_LE);
+ else if (val.i < val2.i)
+ val.i = (ex->kind == EK_LT || ex->kind == EK_LE || ex->kind == EK_NE);
+ else
+ val.i = (ex->kind == EK_GT || ex->kind == EK_GE || ex->kind == EK_NE);
+ val.type = tp_boolean;
+ return val;
+ }
+ break;
+
+ case EK_NOT:
+ val = eval_expr_either(ex->args[0], pasc);
+ if (val.type)
+ val.i = !val.i;
+ return val;
+
+ case EK_AND:
+ for (i = 0; i < ex->nargs; i++) {
+ val = eval_expr_either(ex->args[i], pasc);
+ if (!val.type || !val.i)
+ return val;
+ }
+ return val;
+
+ case EK_OR:
+ for (i = 0; i < ex->nargs; i++) {
+ val = eval_expr_either(ex->args[i], pasc);
+ if (!val.type || val.i)
+ return val;
+ }
+ return val;
+
+ case EK_COMMA:
+ return eval_expr_either(ex->args[ex->nargs-1], pasc);
+
+ default:
+ break;
+ }
+ val.type = NULL;
+ return val;
+ }
+
+
+ Value eval_expr(ex)
+ Expr *ex;
+ {
+ return eval_expr_either(ex, 0);
+ }
+
+
+ Value eval_expr_consts(ex)
+ Expr *ex;
+ {
+ Value val;
+ short save_fold = foldconsts;
+
+ foldconsts = 1;
+ val = eval_expr_either(ex, 0);
+ foldconsts = save_fold;
+ return val;
+ }
+
+
+ Value eval_expr_pasc(ex)
+ Expr *ex;
+ {
+ return eval_expr_either(ex, 1);
+ }
+
+
+
+ int expr_is_const(ex)
+ Expr *ex;
+ {
+ int i;
+
+ switch (ex->kind) {
+
+ case EK_CONST:
+ case EK_LONGCONST:
+ case EK_SIZEOF:
+ return 1;
+
+ case EK_VAR:
+ return (((Meaning *)ex->val.i)->kind == MK_CONST);
+
+ case EK_HAT:
+ case EK_ASSIGN:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ return 0;
+
+ case EK_ADDR:
+ if (ex->args[0]->kind == EK_VAR)
+ return 1;
+ return 0; /* conservative */
+
+ case EK_FUNCTION:
+ if (!nosideeffects_func(ex))
+ return 0;
+ break;
+
+ case EK_BICALL:
+ if (!nosideeffects_func(ex))
+ return 0;
+ break;
+
+ default:
+ break;
+ }
+ for (i = 0; i < ex->nargs; i++) {
+ if (!expr_is_const(ex->args[i]))
+ return 0;
+ }
+ return 1;
+ }
+
+
+
+
+
+ Expr *eatcasts(ex)
+ Expr *ex;
+ {
+ while (ex->kind == EK_CAST)
+ ex = grabarg(ex, 0);
+ return ex;
+ }
+
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/funcs.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/funcs.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/funcs.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,5405 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_FUNCS_C
+ #include "trans.h"
+
+
+
+
+ Static Strlist *enumnames;
+ Static int enumnamecount;
+
+
+
+ void setup_funcs()
+ {
+ enumnames = NULL;
+ enumnamecount = 0;
+ }
+
+
+
+
+
+ int isvar(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+ return (ex->kind == EK_VAR && (Meaning *)ex->val.i == mp);
+ }
+
+
+
+
+ char *getstring(ex)
+ Expr *ex;
+ {
+ ex = makeexpr_stringify(ex);
+ if (ex->kind != EK_CONST || ex->val.type->kind != TK_STRING) {
+ intwarning("getstring", "Not a string literal [206]");
+ return "";
+ }
+ return ex->val.s;
+ }
+
+
+
+
+ Expr *p_parexpr(target)
+ Type *target;
+ {
+ Expr *ex;
+
+ if (wneedtok(TOK_LPAR)) {
+ ex = p_expr(target);
+ if (!wneedtok(TOK_RPAR))
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ } else
+ ex = p_expr(target);
+ return ex;
+ }
+
+
+
+ Type *argbasetype(ex)
+ Expr *ex;
+ {
+ if (ex->kind == EK_CAST)
+ ex = ex->args[0];
+ if (ex->val.type->kind == TK_POINTER)
+ return ex->val.type->basetype;
+ else
+ return ex->val.type;
+ }
+
+
+
+ Type *choosetype(t1, t2)
+ Type *t1, *t2;
+ {
+ if (t1 == tp_void ||
+ (type_sizeof(t2, 1) && !type_sizeof(t1, 1)))
+ return t2;
+ else
+ return t1;
+ }
+
+
+
+ Expr *convert_offset(type, ex2)
+ Type *type;
+ Expr *ex2;
+ {
+ long size;
+ int i;
+ Value val;
+ Expr *ex3;
+
+ if (type->kind == TK_POINTER ||
+ type->kind == TK_ARRAY ||
+ type->kind == TK_SET ||
+ type->kind == TK_STRING)
+ type = type->basetype;
+ size = type_sizeof(type, 1);
+ if (size == 1)
+ return ex2;
+ val = eval_expr_pasc(ex2);
+ if (val.type) {
+ if (val.i == 0)
+ return ex2;
+ if (size && val.i % size == 0) {
+ freeexpr(ex2);
+ return makeexpr_long(val.i / size);
+ }
+ } else { /* look for terms like "n*sizeof(foo)" */
+ while (ex2->kind == EK_CAST || ex2->kind == EK_ACTCAST)
+ ex2 = ex2->args[0];
+ if (ex2->kind == EK_TIMES) {
+ for (i = 0; i < ex2->nargs; i++) {
+ ex3 = convert_offset(type, ex2->args[i]);
+ if (ex3) {
+ ex2->args[i] = ex3;
+ return resimplify(ex2);
+ }
+ }
+ for (i = 0;
+ i < ex2->nargs && ex2->args[i]->kind != EK_SIZEOF;
+ i++) ;
+ if (i < ex2->nargs) {
+ if (ex2->args[i]->args[0]->val.type == type) {
+ delfreearg(&ex2, i);
+ if (ex2->nargs == 1)
+ return ex2->args[0];
+ else
+ return ex2;
+ }
+ }
+ } else if (ex2->kind == EK_PLUS) {
+ ex3 = copyexpr(ex2);
+ for (i = 0; i < ex2->nargs; i++) {
+ ex3->args[i] = convert_offset(type, ex3->args[i]);
+ if (!ex3->args[i]) {
+ freeexpr(ex3);
+ return NULL;
+ }
+ }
+ freeexpr(ex2);
+ return resimplify(ex3);
+ } else if (ex2->kind == EK_SIZEOF) {
+ if (ex2->args[0]->val.type == type) {
+ freeexpr(ex2);
+ return makeexpr_long(1);
+ }
+ } else if (ex2->kind == EK_NEG) {
+ ex3 = convert_offset(type, ex2->args[0]);
+ if (ex3)
+ return makeexpr_neg(ex3);
+ }
+ }
+ return NULL;
+ }
+
+
+
+ Expr *convert_size(type, ex, name)
+ Type *type;
+ Expr *ex;
+ char *name;
+ {
+ long size;
+ Expr *ex2;
+ int i, okay;
+ Value val;
+
+ if (debug>2) { fprintf(outf,"convert_size("); dumpexpr(ex); fprintf(outf,")\n"); }
+ while (type->kind == TK_ARRAY || type->kind == TK_STRING)
+ type = type->basetype;
+ if (type == tp_void)
+ return ex;
+ size = type_sizeof(type, 1);
+ if (size == 1)
+ return ex;
+ while (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
+ ex = ex->args[0];
+ switch (ex->kind) {
+
+ case EK_TIMES:
+ for (i = 0; i < ex->nargs; i++) {
+ ex2 = convert_size(type, ex->args[i], NULL);
+ if (ex2) {
+ ex->args[i] = ex2;
+ return resimplify(ex);
+ }
+ }
+ break;
+
+ case EK_PLUS:
+ okay = 1;
+ for (i = 0; i < ex->nargs; i++) {
+ ex2 = convert_size(type, ex->args[i], NULL);
+ if (ex2)
+ ex->args[i] = ex2;
+ else
+ okay = 0;
+ }
+ ex = distribute_plus(ex);
+ if ((ex->kind != EK_TIMES || !okay) && name)
+ note(format_s("Suspicious mixture of sizes in %s [173]", name));
+ return ex;
+
+ case EK_SIZEOF:
+ return ex;
+
+ default:
+ break;
+ }
+ val = eval_expr_pasc(ex);
+ if (val.type) {
+ if (val.i == 0)
+ return ex;
+ if (size && val.i % size == 0) {
+ freeexpr(ex);
+ return makeexpr_times(makeexpr_long(val.i / size),
+ makeexpr_sizeof(makeexpr_type(type), 0));
+ }
+ }
+ if (name) {
+ note(format_s("Can't interpret size in %s [174]", name));
+ return ex;
+ } else
+ return NULL;
+ }
+
+
+
+
+
+
+
+
+
+
+
+
+ Static Expr *func_abs()
+ {
+ Expr *ex;
+ Meaning *tvar;
+ int lness;
+
+ ex = p_parexpr(tp_integer);
+ if (ex->val.type->kind == TK_REAL)
+ return makeexpr_bicall_1("fabs", tp_longreal, ex);
+ else {
+ lness = exprlongness(ex);
+ if (lness < 0)
+ return makeexpr_bicall_1("abs", tp_int, ex);
+ else if (lness > 0 && *absname) {
+ if (ansiC > 0) {
+ return makeexpr_bicall_1("labs", tp_integer, ex);
+ } else if (*absname == '*' && (exprspeed(ex) >= 5 || !nosideeffects(ex, 0))) {
+ tvar = makestmttempvar(tp_integer, name_TEMP);
+ return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar),
+ ex),
+ makeexpr_bicall_1(absname, tp_integer,
+ makeexpr_var(tvar)));
+ } else {
+ return makeexpr_bicall_1(absname, tp_integer, ex);
+ }
+ } else if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
+ return makeexpr_cond(makeexpr_rel(EK_LT, copyexpr(ex),
+ makeexpr_long(0)),
+ makeexpr_neg(copyexpr(ex)),
+ ex);
+ } else {
+ tvar = makestmttempvar(tp_integer, name_TEMP);
+ return makeexpr_cond(makeexpr_rel(EK_LT, makeexpr_assign(makeexpr_var(tvar),
+ ex),
+ makeexpr_long(0)),
+ makeexpr_neg(makeexpr_var(tvar)),
+ makeexpr_var(tvar));
+ }
+ }
+ }
+
+
+
+ Static Expr *func_addr()
+ {
+ Expr *ex, *ex2, *ex3;
+ Type *type, *tp2;
+ int haspar;
+
+ haspar = wneedtok(TOK_LPAR);
+ ex = p_expr(tp_proc);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ ex2 = p_expr(tp_integer);
+ ex3 = convert_offset(ex->val.type, ex2);
+ if (checkconst(ex3, 0)) {
+ ex = makeexpr_addrf(ex);
+ } else {
+ ex = makeexpr_addrf(ex);
+ if (ex3) {
+ ex = makeexpr_plus(ex, ex3);
+ } else {
+ note("Don't know how to reduce offset for ADDR [175]");
+ type = makepointertype(tp_abyte);
+ tp2 = ex->val.type;
+ ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
+ }
+ }
+ } else {
+ if ((ex->val.type->kind != TK_PROCPTR &&
+ ex->val.type->kind != TK_CPROCPTR) ||
+ (ex->kind == EK_VAR &&
+ ex->val.type == ((Meaning *)ex->val.i)->type))
+ ex = makeexpr_addrf(ex);
+ }
+ if (haspar) {
+ if (!wneedtok(TOK_RPAR))
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ }
+ return ex;
+ }
+
+
+ Static Expr *func_iaddress()
+ {
+ return makeexpr_cast(func_addr(), tp_integer);
+ }
+
+
+
+ Static Expr *func_addtopointer()
+ {
+ Expr *ex, *ex2, *ex3;
+ Type *type, *tp2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_anyptr);
+ if (skipcomma()) {
+ ex2 = p_expr(tp_integer);
+ } else
+ ex2 = makeexpr_long(0);
+ skipcloseparen();
+ ex3 = convert_offset(ex->val.type, ex2);
+ if (!checkconst(ex3, 0)) {
+ if (ex3) {
+ ex = makeexpr_plus(ex, ex3);
+ } else {
+ note("Don't know how to reduce offset for ADDTOPOINTER [175]");
+ type = makepointertype(tp_abyte);
+ tp2 = ex->val.type;
+ ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
+ }
+ }
+ return ex;
+ }
+
+
+
+ Stmt *proc_assert()
+ {
+ Expr *ex;
+
+ ex = p_parexpr(tp_boolean);
+ return makestmt_call(makeexpr_bicall_1("assert", tp_void, ex));
+ }
+
+
+
+ Stmt *wrapopencheck(sp, fex)
+ Stmt *sp;
+ Expr *fex;
+ {
+ Stmt *sp2;
+
+ if (FCheck(checkfileisopen) && !is_std_file(fex)) {
+ sp2 = makestmt(SK_IF);
+ sp2->exp1 = makeexpr_rel(EK_NE, filebasename(fex), makeexpr_nil());
+ sp2->stm1 = sp;
+ if (iocheck_flag) {
+ sp2->stm2 = makestmt_call(makeexpr_bicall_1(name_ESCIO, tp_integer,
+ makeexpr_name(filenotopenname, tp_int)));
+ } else {
+ sp2->stm2 = makestmt_assign(makeexpr_var(mp_ioresult),
+ makeexpr_name(filenotopenname, tp_int));
+ }
+ return sp2;
+ } else {
+ freeexpr(fex);
+ return sp;
+ }
+ }
+
+
+
+ Static Expr *checkfilename(nex)
+ Expr *nex;
+ {
+ Expr *ex;
+
+ nex = makeexpr_stringcast(nex);
+ if (nex->kind == EK_CONST && nex->val.type->kind == TK_STRING) {
+ switch (which_lang) {
+
+ case LANG_HP:
+ if (!strncmp(nex->val.s, "#1:", 3) ||
+ !strncmp(nex->val.s, "console:", 8) ||
+ !strncmp(nex->val.s, "CONSOLE:", 8)) {
+ freeexpr(nex);
+ nex = makeexpr_string("/dev/tty");
+ } else if (!strncmp(nex->val.s, "#2:", 3) ||
+ !strncmp(nex->val.s, "systerm:", 8) ||
+ !strncmp(nex->val.s, "SYSTERM:", 8)) {
+ freeexpr(nex);
+ nex = makeexpr_string("/dev/tty"); /* should do more? */
+ } else if (!strncmp(nex->val.s, "#6:", 3) ||
+ !strncmp(nex->val.s, "printer:", 8) ||
+ !strncmp(nex->val.s, "PRINTER:", 8)) {
+ note("Opening a file named PRINTER: [176]");
+ } else if (my_strchr(nex->val.s, ':')) {
+ note("Opening a file whose name contains a ':' [177]");
+ }
+ break;
+
+ case LANG_TURBO:
+ if (checkstring(nex, "con") ||
+ checkstring(nex, "CON") ||
+ checkstring(nex, "")) {
+ freeexpr(nex);
+ nex = makeexpr_string("/dev/tty");
+ } else if (checkstring(nex, "nul") ||
+ checkstring(nex, "NUL")) {
+ freeexpr(nex);
+ nex = makeexpr_string("/dev/null");
+ } else if (checkstring(nex, "lpt1") ||
+ checkstring(nex, "LPT1") ||
+ checkstring(nex, "lpt2") ||
+ checkstring(nex, "LPT2") ||
+ checkstring(nex, "lpt3") ||
+ checkstring(nex, "LPT3") ||
+ checkstring(nex, "com1") ||
+ checkstring(nex, "COM1") ||
+ checkstring(nex, "com2") ||
+ checkstring(nex, "COM2")) {
+ note("Opening a DOS device file name [178]");
+ }
+ break;
+
+ default:
+ break;
+ }
+ } else {
+ if (*filenamefilter && strcmp(filenamefilter, "0")) {
+ ex = makeexpr_sizeof(copyexpr(nex), 0);
+ nex = makeexpr_bicall_2(filenamefilter, tp_str255, nex, ex);
+ } else
+ nex = makeexpr_stringify(nex);
+ }
+ return nex;
+ }
+
+
+
+ Static Stmt *assignfilename(fex, nex)
+ Expr *fex, *nex;
+ {
+ Meaning *mp;
+ Expr *nvex;
+
+ nvex = filenamepart(fex);
+ if (nvex) {
+ freeexpr(fex);
+ return makestmt_call(makeexpr_assign(nvex, nex));
+ } else {
+ mp = isfilevar(fex);
+ if (mp)
+ warning("Don't know how to ASSIGN to a non-explicit file variable [207]");
+ else
+ note("Encountered an ASSIGN statement [179]");
+ return makestmt_call(makeexpr_bicall_2("assign", tp_void, fex, nex));
+ }
+ }
+
+
+
+ Static Stmt *proc_assign()
+ {
+ Expr *fex, *nex;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ nex = checkfilename(p_expr(tp_str255));
+ skipcloseparen();
+ return assignfilename(fex, nex);
+ }
+
+
+
+ Static Stmt *handleopen(code)
+ int code;
+ {
+ Stmt *sp, *sp1, *sp2, *spassign;
+ Expr *fex, *nex, *ex, *truenex, *nvex;
+ Meaning *fmp;
+ int needcheckopen = 1;
+ char modebuf[5], *cp;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ fmp = isfilevar(fex);
+ nvex = filenamepart(fex);
+ truenex = NULL;
+ spassign = NULL;
+ if (curtok == TOK_COMMA) {
+ gettok();
+ ex = p_expr(tp_str255);
+ } else
+ ex = NULL;
+ if (ex && (ex->val.type->kind == TK_STRING ||
+ ex->val.type->kind == TK_ARRAY)) {
+ nex = checkfilename(ex);
+ if (nvex) {
+ spassign = assignfilename(copyexpr(fex), nex);
+ nex = nvex;
+ }
+ truenex = nex;
+ if (curtok == TOK_COMMA) {
+ gettok();
+ ex = p_expr(tp_str255);
+ } else
+ ex = NULL;
+ } else if (nvex) {
+ nex = nvex;
+ } else {
+ switch (code) {
+ case 0:
+ if (ex)
+ note("Can't interpret name argument in RESET [180]");
+ break;
+ case 1:
+ note("REWRITE does not specify a name [181]");
+ break;
+ case 2:
+ note("OPEN does not specify a name [181]");
+ break;
+ case 3:
+ note("APPEND does not specify a name [181]");
+ break;
+ }
+ nex = NULL;
+ }
+ if (ex) {
+ if (ord_type(ex->val.type)->kind == TK_INTEGER) {
+ if (!checkconst(ex, 1))
+ note("Ignoring block size in binary file [182]");
+ freeexpr(ex);
+ } else {
+ if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
+ cp = getstring(ex);
+ if (strcicmp(cp, "SHARED"))
+ note(format_s("Ignoring option string \"%s\" in open [183]", cp));
+ } else
+ note("Ignoring option string in open [183]");
+ }
+ }
+ switch (code) {
+
+ case 0: /* reset */
+ strcpy(modebuf, "r");
+ break;
+
+ case 1: /* rewrite */
+ strcpy(modebuf, "w");
+ break;
+
+ case 2: /* open */
+ strcpy(modebuf, openmode);
+ break;
+
+ case 3: /* append */
+ strcpy(modebuf, "a");
+ break;
+
+ }
+ if (!*modebuf) {
+ strcpy(modebuf, "r+");
+ }
+ if (readwriteopen == 2 ||
+ (readwriteopen &&
+ fex->val.type != tp_text &&
+ fex->val.type != tp_bigtext)) {
+ if (!my_strchr(modebuf, '+'))
+ strcat(modebuf, "+");
+ }
+ if (fex->val.type != tp_text &&
+ fex->val.type != tp_bigtext &&
+ binarymode != 0) {
+ if (binarymode == 1)
+ strcat(modebuf, "b");
+ else
+ note("Opening a binary file [184]");
+ }
+ if (!nex && fmp &&
+ !is_std_file(fex) &&
+ literalfilesflag > 0 &&
+ (literalfilesflag == 1 ||
+ strlist_cifind(literalfiles, fmp->name))) {
+ nex = makeexpr_string(fmp->name);
+ }
+ sp1 = NULL;
+ sp2 = NULL;
+ if (!nex || (isfiletype(fex->val.type, 1) && !truenex)) {
+ if (isvar(fex, mp_output)) {
+ note("RESET/REWRITE ignored for file OUTPUT [319]");
+ } else {
+ sp1 = makestmt_call(makeexpr_bicall_1("rewind", tp_void,
+ filebasename(copyexpr(fex))));
+ if (code == 0 || is_std_file(fex)) {
+ sp1 = wrapopencheck(sp1, copyexpr(fex));
+ needcheckopen = 0;
+ } else
+ sp1 = makestmt_if(makeexpr_rel(EK_NE,
+ filebasename(copyexpr(fex)),
+ makeexpr_nil()),
+ sp1,
+ makestmt_assign(filebasename(copyexpr(fex)),
+ makeexpr_bicall_0("tmpfile",
+ tp_text)));
+ }
+ }
+ if (nex || isfiletype(fex->val.type, 1)) {
+ needcheckopen = 1;
+ if (!strcmp(freopenname, "fclose") ||
+ !strcmp(freopenname, "fopen")) {
+ sp2 = makestmt_assign(filebasename(copyexpr(fex)),
+ makeexpr_bicall_2("fopen", tp_text,
+ copyexpr(nex),
+ makeexpr_string(modebuf)));
+ if (!strcmp(freopenname, "fclose")) {
+ sp2 = makestmt_seq(makestmt_if(makeexpr_rel(EK_NE,
+ filebasename(copyexpr(fex)),
+ makeexpr_nil()),
+ makestmt_call(makeexpr_bicall_1("fclose", tp_void,
+ filebasename(copyexpr(fex)))),
+ NULL),
+ sp2);
+ }
+ } else {
+ sp2 = makestmt_assign(filebasename(copyexpr(fex)),
+ makeexpr_bicall_3((*freopenname) ? freopenname : "freopen",
+ tp_text,
+ copyexpr(nex),
+ makeexpr_string(modebuf),
+ filebasename(copyexpr(fex))));
+ if (!*freopenname) {
+ sp2 = makestmt_if(makeexpr_rel(EK_NE, filebasename(copyexpr(fex)),
+ makeexpr_nil()),
+ sp2,
+ makestmt_assign(filebasename(copyexpr(fex)),
+ makeexpr_bicall_2("fopen", tp_text,
+ copyexpr(nex),
+ makeexpr_string(modebuf))));
+ }
+ }
+ }
+ if (!sp1)
+ sp = sp2;
+ else if (!sp2)
+ sp = sp1;
+ else {
+ sp = makestmt_if(makeexpr_rel(EK_NE, copyexpr(nex),
+ makeexpr_string("")),
+ sp2, sp1);
+ }
+ if (code == 2 && !*openmode && nex) {
+ sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
+ filebasename(copyexpr(fex)),
+ makeexpr_nil()),
+ makestmt_assign(filebasename(copyexpr(fex)),
+ makeexpr_bicall_2("fopen", tp_text,
+ copyexpr(nex),
+ makeexpr_string("w+"))),
+ NULL));
+ }
+ if (nex)
+ freeexpr(nex);
+ if (FCheck(checkfileopen) && needcheckopen) {
+ sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_NE, filebasename(copyexpr(fex)), makeexpr_nil()),
+ makeexpr_name(filenotfoundname, tp_int))));
+ }
+ sp = makestmt_seq(spassign, sp);
+ cp = (code == 0) ? resetbufname : setupbufname;
+ if (*cp && /* (may be eaten later, if buffering isn't needed) */
+ fileisbuffered(fex, 1))
+ sp = makestmt_seq(sp,
+ makestmt_call(
+ makeexpr_bicall_2(cp, tp_void, filebasename(fex),
+ makeexpr_type(filebasetype(fex->val.type)))));
+ else
+ freeexpr(fex);
+ skipcloseparen();
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_append()
+ {
+ return handleopen(3);
+ }
+
+
+
+ Static Expr *func_arccos(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("acos", tp_longreal, grabarg(ex, 0));
+ }
+
+
+ Static Expr *func_arcsin(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("asin", tp_longreal, grabarg(ex, 0));
+ }
+
+
+ Static Expr *func_arctan(ex)
+ Expr *ex;
+ {
+ ex = grabarg(ex, 0);
+ if (atan2flag && ex->kind == EK_DIVIDE)
+ return makeexpr_bicall_2("atan2", tp_longreal,
+ ex->args[0], ex->args[1]);
+ return makeexpr_bicall_1("atan", tp_longreal, ex);
+ }
+
+
+ Static Expr *func_arctanh(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("atanh", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Stmt *proc_argv()
+ {
+ Expr *ex, *aex, *lex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (skipcomma()) {
+ aex = p_expr(tp_str255);
+ } else
+ return NULL;
+ skipcloseparen();
+ lex = makeexpr_sizeof(copyexpr(aex), 0);
+ aex = makeexpr_addrstr(aex);
+ return makestmt_call(makeexpr_bicall_3("P_sun_argv", tp_void,
+ aex, lex, makeexpr_arglong(ex, 0)));
+ }
+
+
+ Static Expr *func_asr()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (skipcomma()) {
+ if (signedshift == 0 || signedshift == 2) {
+ ex = makeexpr_bicall_2("P_asr", ex->val.type, ex,
+ p_expr(tp_unsigned));
+ } else {
+ ex = force_signed(ex);
+ ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
+ if (signedshift != 1)
+ note("Assuming >> is an arithmetic shift [320]");
+ }
+ skipcloseparen();
+ }
+ return ex;
+ }
+
+
+ Static Expr *func_lsl()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (skipcomma()) {
+ ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_expr(tp_unsigned));
+ skipcloseparen();
+ }
+ return ex;
+ }
+
+
+ Static Expr *func_lsr()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (skipcomma()) {
+ ex = force_unsigned(ex);
+ ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
+ skipcloseparen();
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_bin()
+ {
+ note("Using %b for binary printf format [185]");
+ return handle_vax_hex(NULL, "b", 1);
+ }
+
+
+
+ Static Expr *func_binary(ex)
+ Expr *ex;
+ {
+ char *cp;
+
+ ex = grabarg(ex, 0);
+ if (ex->kind == EK_CONST) {
+ cp = getstring(ex);
+ ex = makeexpr_long(my_strtol(cp, NULL, 2));
+ insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ return ex;
+ } else {
+ return makeexpr_bicall_3("strtol", tp_integer,
+ ex, makeexpr_nil(), makeexpr_long(2));
+ }
+ }
+
+
+
+ Static Expr *handle_bitsize(next)
+ int next;
+ {
+ Expr *ex;
+ Type *type;
+ int lpar;
+ long psize;
+
+ lpar = (curtok == TOK_LPAR);
+ if (lpar)
+ gettok();
+ if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE) {
+ ex = makeexpr_type(curtokmeaning->type);
+ gettok();
+ } else
+ ex = p_expr(NULL);
+ type = ex->val.type;
+ if (lpar)
+ skipcloseparen();
+ psize = 0;
+ packedsize(NULL, &type, &psize, 0);
+ if (psize > 0 && psize < 32 && next) {
+ if (psize > 16)
+ psize = 32;
+ else if (psize > 8)
+ psize = 16;
+ else if (psize > 4)
+ psize = 8;
+ else if (psize > 2)
+ psize = 4;
+ else if (psize > 1)
+ psize = 2;
+ else
+ psize = 1;
+ }
+ if (psize)
+ return makeexpr_long(psize);
+ else
+ return makeexpr_times(makeexpr_sizeof(ex, 0),
+ makeexpr_long(sizeof_char ? sizeof_char : 8));
+ }
+
+
+ Static Expr *func_bitsize()
+ {
+ return handle_bitsize(0);
+ }
+
+
+ Static Expr *func_bitnext()
+ {
+ return handle_bitsize(1);
+ }
+
+
+
+ Static Expr *func_blockread()
+ {
+ Expr *ex, *ex2, *vex, *sex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ sex = p_expr(tp_integer);
+ sex = doseek(copyexpr(fex),
+ makeexpr_times(sex, makeexpr_long(512)))->exp1;
+ } else
+ sex = NULL;
+ skipcloseparen();
+ type = vex->val.type;
+ ex = makeexpr_bicall_4("fread", tp_integer,
+ makeexpr_addr(vex),
+ makeexpr_long(512),
+ convert_size(type, ex2, "BLOCKREAD"),
+ filebasename(copyexpr(fex)));
+ return makeexpr_comma(sex, ex);
+ }
+
+
+
+ Static Expr *func_blockwrite()
+ {
+ Expr *ex, *ex2, *vex, *sex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ sex = p_expr(tp_integer);
+ sex = doseek(copyexpr(fex),
+ makeexpr_times(sex, makeexpr_long(512)))->exp1;
+ } else
+ sex = NULL;
+ skipcloseparen();
+ type = vex->val.type;
+ ex = makeexpr_bicall_4("fwrite", tp_integer,
+ makeexpr_addr(vex),
+ makeexpr_long(512),
+ convert_size(type, ex2, "BLOCKWRITE"),
+ filebasename(copyexpr(fex)));
+ return makeexpr_comma(sex, ex);
+ }
+
+
+
+
+ Static Stmt *proc_blockread()
+ {
+ Expr *ex, *ex2, *vex, *rex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ rex = p_expr(tp_integer);
+ } else
+ rex = NULL;
+ skipcloseparen();
+ type = vex->val.type;
+ if (rex) {
+ ex = makeexpr_bicall_4("fread", tp_integer,
+ makeexpr_addr(vex),
+ makeexpr_long(1),
+ convert_size(type, ex2, "BLOCKREAD"),
+ filebasename(copyexpr(fex)));
+ ex = makeexpr_assign(rex, ex);
+ if (!iocheck_flag)
+ ex = makeexpr_comma(ex,
+ makeexpr_assign(makeexpr_var(mp_ioresult),
+ makeexpr_long(0)));
+ } else {
+ ex = makeexpr_bicall_4("fread", tp_integer,
+ makeexpr_addr(vex),
+ convert_size(type, ex2, "BLOCKREAD"),
+ makeexpr_long(1),
+ filebasename(copyexpr(fex)));
+ if (checkeof(fex)) {
+ ex = makeexpr_bicall_2(name_SETIO, tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ makeexpr_name(endoffilename, tp_int));
+ }
+ }
+ return wrapopencheck(makestmt_call(ex), fex);
+ }
+
+
+
+
+ Static Stmt *proc_blockwrite()
+ {
+ Expr *ex, *ex2, *vex, *rex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ rex = p_expr(tp_integer);
+ } else
+ rex = NULL;
+ skipcloseparen();
+ type = vex->val.type;
+ if (rex) {
+ ex = makeexpr_bicall_4("fwrite", tp_integer,
+ makeexpr_addr(vex),
+ makeexpr_long(1),
+ convert_size(type, ex2, "BLOCKWRITE"),
+ filebasename(copyexpr(fex)));
+ ex = makeexpr_assign(rex, ex);
+ if (!iocheck_flag)
+ ex = makeexpr_comma(ex,
+ makeexpr_assign(makeexpr_var(mp_ioresult),
+ makeexpr_long(0)));
+ } else {
+ ex = makeexpr_bicall_4("fwrite", tp_integer,
+ makeexpr_addr(vex),
+ convert_size(type, ex2, "BLOCKWRITE"),
+ makeexpr_long(1),
+ filebasename(copyexpr(fex)));
+ if (FCheck(checkfilewrite)) {
+ ex = makeexpr_bicall_2(name_SETIO, tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ makeexpr_name(filewriteerrorname, tp_int));
+ }
+ }
+ return wrapopencheck(makestmt_call(ex), fex);
+ }
+
+
+
+ Static Stmt *proc_bclr()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ return makestmt_assign(ex,
+ makeexpr_bin(EK_BAND, ex->val.type,
+ copyexpr(ex),
+ makeexpr_un(EK_BNOT, ex->val.type,
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_arglong(
+ makeexpr_long(1), 1),
+ ex2))));
+ }
+
+
+
+ Static Stmt *proc_bset()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ return makestmt_assign(ex,
+ makeexpr_bin(EK_BOR, ex->val.type,
+ copyexpr(ex),
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_arglong(
+ makeexpr_long(1), 1),
+ ex2)));
+ }
+
+
+
+ Static Expr *func_bsl()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ return makeexpr_bin(EK_LSH, tp_integer, ex, ex2);
+ }
+
+
+
+ Static Expr *func_bsr()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ return makeexpr_bin(EK_RSH, tp_integer, force_unsigned(ex), ex2);
+ }
+
+
+
+ Static Expr *func_btst()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ return makeexpr_rel(EK_NE,
+ makeexpr_bin(EK_BAND, tp_integer,
+ ex,
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_arglong(
+ makeexpr_long(1), 1),
+ ex2)),
+ makeexpr_long(0));
+ }
+
+
+
+ Static Expr *func_byteread()
+ {
+ Expr *ex, *ex2, *vex, *sex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ sex = p_expr(tp_integer);
+ sex = doseek(copyexpr(fex), sex)->exp1;
+ } else
+ sex = NULL;
+ skipcloseparen();
+ type = vex->val.type;
+ ex = makeexpr_bicall_4("fread", tp_integer,
+ makeexpr_addr(vex),
+ makeexpr_long(1),
+ convert_size(type, ex2, "BYTEREAD"),
+ filebasename(copyexpr(fex)));
+ return makeexpr_comma(sex, ex);
+ }
+
+
+
+ Static Expr *func_bytewrite()
+ {
+ Expr *ex, *ex2, *vex, *sex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ sex = p_expr(tp_integer);
+ sex = doseek(copyexpr(fex), sex)->exp1;
+ } else
+ sex = NULL;
+ skipcloseparen();
+ type = vex->val.type;
+ ex = makeexpr_bicall_4("fwrite", tp_integer,
+ makeexpr_addr(vex),
+ makeexpr_long(1),
+ convert_size(type, ex2, "BYTEWRITE"),
+ filebasename(copyexpr(fex)));
+ return makeexpr_comma(sex, ex);
+ }
+
+
+
+ Static Expr *func_byte_offset()
+ {
+ Type *tp;
+ Meaning *mp;
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ tp = p_type(NULL);
+ if (!skipcomma())
+ return NULL;
+ if (!wexpecttok(TOK_IDENT))
+ return NULL;
+ mp = curtoksym->fbase;
+ while (mp && mp->rectype != tp)
+ mp = mp->snext;
+ if (!mp)
+ ex = makeexpr_name(curtokcase, tp_integer);
+ else
+ ex = makeexpr_name(mp->name, tp_integer);
+ gettok();
+ skipcloseparen();
+ return makeexpr_bicall_2("OFFSETOF", (size_t_long) ? tp_integer : tp_int,
+ makeexpr_type(tp), ex);
+ }
+
+
+
+ Static Stmt *proc_call()
+ {
+ Expr *ex, *ex2, *ex3;
+ Type *type, *tp;
+ Meaning *mp;
+
+ if (!skipopenparen())
+ return NULL;
+ ex2 = p_expr(tp_proc);
+ type = ex2->val.type;
+ if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
+ warning("CALL requires a procedure variable [208]");
+ type = tp_proc;
+ }
+ ex = makeexpr(EK_SPCALL, 1);
+ ex->val.type = tp_void;
+ ex->args[0] = copyexpr(ex2);
+ if (type->escale != 0)
+ ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
+ makepointertype(type->basetype));
+ mp = type->basetype->fbase;
+ if (mp) {
+ if (wneedtok(TOK_COMMA))
+ ex = p_funcarglist(ex, mp, 0, 0);
+ }
+ skipcloseparen();
+ if (type->escale != 1 || hasstaticlinks == 2) {
+ freeexpr(ex2);
+ return makestmt_call(ex);
+ }
+ ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
+ ex3 = copyexpr(ex);
+ insertarg(&ex3, ex3->nargs, copyexpr(ex2));
+ tp = maketype(TK_FUNCTION);
+ tp->basetype = type->basetype->basetype;
+ tp->fbase = type->basetype->fbase;
+ tp->issigned = 1;
+ ex3->args[0]->val.type = makepointertype(tp);
+ return makestmt_if(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ makestmt_call(ex3),
+ makestmt_call(ex));
+ }
+
+
+
+ Static Expr *func_chr()
+ {
+ Expr *ex;
+
+ ex = p_expr(tp_integer);
+ if ((exprlongness(ex) < 0 || ex->kind == EK_CAST) && ex->kind != EK_ACTCAST)
+ ex->val.type = tp_char;
+ else
+ ex = makeexpr_cast(ex, tp_char);
+ return ex;
+ }
+
+
+
+ Static Stmt *proc_close()
+ {
+ Stmt *sp;
+ Expr *fex, *ex;
+ char *opt;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ sp = makestmt_if(makeexpr_rel(EK_NE, filebasename(copyexpr(fex)),
+ makeexpr_nil()),
+ makestmt_call(makeexpr_bicall_1("fclose", tp_void,
+ filebasename(copyexpr(fex)))),
+ (FCheck(checkfileisopen))
+ ? makestmt_call(
+ makeexpr_bicall_1(name_ESCIO,
+ tp_integer,
+ makeexpr_name(filenotopenname,
+ tp_int)))
+ : NULL);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ opt = "";
+ if (curtok == TOK_IDENT &&
+ (!strcicmp(curtokbuf, "LOCK") ||
+ !strcicmp(curtokbuf, "PURGE") ||
+ !strcicmp(curtokbuf, "NORMAL") ||
+ !strcicmp(curtokbuf, "CRUNCH"))) {
+ opt = stralloc(curtokbuf);
+ gettok();
+ } else {
+ ex = p_expr(tp_str255);
+ if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING)
+ opt = ex->val.s;
+ }
+ if (!strcicmp(opt, "PURGE")) {
+ note("File is being closed with PURGE option [186]");
+ }
+ }
+ sp = makestmt_seq(sp, makestmt_assign(filebasename(fex), makeexpr_nil()));
+ skipcloseparen();
+ return sp;
+ }
+
+
+
+ Static Expr *func_concat()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return makeexpr_string("oops");
+ ex = p_expr(tp_str255);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ ex = makeexpr_concat(ex, p_expr(tp_str255), 0);
+ }
+ skipcloseparen();
+ return ex;
+ }
+
+
+
+ Static Expr *func_copy(ex)
+ Expr *ex;
+ {
+ if (isliteralconst(ex->args[3], NULL) == 2 &&
+ ex->args[3]->val.i >= stringceiling) {
+ return makeexpr_bicall_3("sprintf", ex->val.type,
+ ex->args[0],
+ makeexpr_string("%s"),
+ bumpstring(ex->args[1],
+ makeexpr_unlongcast(ex->args[2]), 1));
+ }
+ if (checkconst(ex->args[2], 1)) {
+ return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1],
+ ex->args[2], ex->args[3]));
+ }
+ return makeexpr_bicall_4(strsubname, ex->val.type,
+ ex->args[0],
+ ex->args[1],
+ makeexpr_arglong(ex->args[2], 0),
+ makeexpr_arglong(ex->args[3], 0));
+ }
+
+
+
+ Static Expr *func_cos(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("cos", tp_longreal, grabarg(ex, 0));
+ }
+
+
+ Static Expr *func_cosh(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("cosh", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Stmt *proc_cycle()
+ {
+ return makestmt(SK_CONTINUE);
+ }
+
+
+
+ Static Stmt *proc_date()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_str255);
+ skipcloseparen();
+ return makestmt_call(makeexpr_bicall_1("VAXdate", tp_integer, ex));
+ }
+
+
+ Static Stmt *proc_dec()
+ {
+ Expr *vex, *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(NULL);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ ex = p_expr(tp_integer);
+ } else
+ ex = makeexpr_long(1);
+ skipcloseparen();
+ return makestmt_assign(vex, makeexpr_minus(copyexpr(vex), ex));
+ }
+
+
+
+ Static Expr *func_dec()
+ {
+ return handle_vax_hex(NULL, "d", 0);
+ }
+
+
+
+ Static Stmt *proc_delete(ex)
+ Expr *ex;
+ {
+ if (ex->nargs == 1) /* Kludge for Oregon Software Pascal's delete(f) */
+ return makestmt_call(makeexpr_bicall_1(strdeletename, tp_void, ex->args[0]));
+ return makestmt_call(makeexpr_bicall_3(strdeletename, tp_void,
+ ex->args[0],
+ makeexpr_arglong(ex->args[1], 0),
+ makeexpr_arglong(ex->args[2], 0)));
+ }
+
+
+
+ void parse_special_variant(tp, buf)
+ Type *tp;
+ char *buf;
+ {
+ char *cp;
+ Expr *ex;
+
+ if (!tp)
+ intwarning("parse_special_variant", "tp == NULL");
+ if (!tp || tp->meaning == NULL) {
+ *buf = 0;
+ if (curtok == TOK_COMMA) {
+ skiptotoken(TOK_RPAR);
+ }
+ return;
+ }
+ strcpy(buf, tp->meaning->name);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ cp = buf + strlen(buf);
+ *cp++ = '.';
+ if (curtok == TOK_MINUS) {
+ *cp++ = '-';
+ gettok();
+ }
+ if (curtok == TOK_INTLIT ||
+ curtok == TOK_HEXLIT ||
+ curtok == TOK_OCTLIT) {
+ sprintf(cp, "%ld", curtokint);
+ gettok();
+ } else if (curtok == TOK_HAT || curtok == TOK_STRLIT) {
+ ex = makeexpr_charcast(accumulate_strlit());
+ if (ex->kind == EK_CONST) {
+ if (ex->val.i <= 32 || ex->val.i > 126 ||
+ ex->val.i == '\'' || ex->val.i == '\\' ||
+ ex->val.i == '=' || ex->val.i == '}')
+ sprintf(cp, "%ld", ex->val.i);
+ else
+ strcpy(cp, makeCchar(ex->val.i));
+ } else {
+ *buf = 0;
+ *cp = 0;
+ }
+ freeexpr(ex);
+ } else {
+ if (!wexpecttok(TOK_IDENT)) {
+ skiptotoken(TOK_RPAR);
+ return;
+ }
+ if (curtokmeaning)
+ strcpy(cp, curtokmeaning->name);
+ else
+ strcpy(cp, curtokbuf);
+ gettok();
+ }
+ }
+ }
+
+
+ char *find_special_variant(buf, spname, splist, need)
+ char *buf, *spname;
+ Strlist *splist;
+ int need;
+ {
+ Strlist *best = NULL;
+ int len, bestlen = -1;
+ char *cp, *cp2;
+
+ if (!*buf)
+ return NULL;
+ while (splist) {
+ cp = splist->s;
+ cp2 = buf;
+ while (*cp && toupper(*cp) == toupper(*cp2))
+ cp++, cp2++;
+ len = cp2 - buf;
+ if (!*cp && (!*cp2 || *cp2 == '.') && len > bestlen) {
+ best = splist;
+ bestlen = len;
+ }
+ splist = splist->next;
+ }
+ if (bestlen != strlen(buf) && my_strchr(buf, '.')) {
+ if ((need & 1) || bestlen >= 0) {
+ if (need & 2)
+ return NULL;
+ if (spname)
+ note(format_ss("No %s form known for %s [187]",
+ spname, strupper(buf)));
+ }
+ }
+ if (bestlen >= 0)
+ return (char *)best->value;
+ else
+ return NULL;
+ }
+
+
+
+ Static char *choose_free_func(ex)
+ Expr *ex;
+ {
+ if (!*freename) {
+ if (!*freervaluename)
+ return "free";
+ else
+ return freervaluename;
+ }
+ if (!*freervaluename)
+ return freervaluename;
+ if (expr_is_lvalue(ex))
+ return freename;
+ else
+ return freervaluename;
+ }
+
+
+ Static Stmt *proc_dispose()
+ {
+ Expr *ex;
+ Type *type;
+ char *name, vbuf[1000];
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_anyptr);
+ type = ex->val.type->basetype;
+ parse_special_variant(type, vbuf);
+ skipcloseparen();
+ name = find_special_variant(vbuf, "SpecialFree", specialfrees, 0);
+ if (!name)
+ name = choose_free_func(ex);
+ return makestmt_call(makeexpr_bicall_1(name, tp_void, ex));
+ }
+
+
+
+ Static Expr *func_exp(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("exp", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_expo(ex)
+ Expr *ex;
+ {
+ Meaning *tvar;
+
+ tvar = makestmttempvar(tp_int, name_TEMP);
+ return makeexpr_comma(makeexpr_bicall_2("frexp", tp_longreal,
+ grabarg(ex, 0),
+ makeexpr_addr(makeexpr_var(tvar))),
+ makeexpr_var(tvar));
+ }
+
+
+
+ int is_std_file(ex)
+ Expr *ex;
+ {
+ return isvar(ex, mp_input) || isvar(ex, mp_output) ||
+ isvar(ex, mp_stderr);
+ }
+
+
+
+ Static Expr *iofunc(ex, code)
+ Expr *ex;
+ int code;
+ {
+ Expr *ex2 = NULL, *ex3 = NULL;
+ Meaning *tvar = NULL;
+
+ if (FCheck(checkfileisopen) && !is_std_file(ex)) {
+ if (isfiletype(ex->val.type, 1) ||
+ (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
+ ex2 = filebasename(copyexpr(ex));
+ } else {
+ ex3 = ex;
+ tvar = makestmttempvar(ex->val.type, name_TEMP);
+ ex2 = makeexpr_var(tvar);
+ ex = makeexpr_var(tvar);
+ }
+ }
+ ex = filebasename(ex);
+ switch (code) {
+
+ case 0: /* eof */
+ if (fileisbuffered(ex, 0) && *eofbufname)
+ ex = makeexpr_bicall_1(eofbufname, tp_boolean, ex);
+ else if (*eofname)
+ ex = makeexpr_bicall_1(eofname, tp_boolean, ex);
+ else
+ ex = makeexpr_rel(EK_NE, makeexpr_bicall_1("feof", tp_int, ex),
+ makeexpr_long(0));
+ break;
+
+ case 1: /* eoln */
+ ex = makeexpr_bicall_1(eolnname, tp_boolean, ex);
+ break;
+
+ case 2: /* position or filepos */
+ if (fileisbuffered(ex, 0) && *fileposbufname)
+ ex = makeexpr_bicall_1(fileposbufname, tp_integer, ex);
+ else
+ ex = makeexpr_bicall_1(fileposname, tp_integer, ex);
+ break;
+
+ case 3: /* maxpos or filesize */
+ ex = makeexpr_bicall_1(maxposname, tp_integer, ex);
+ break;
+
+ }
+ if (ex2) {
+ ex = makeexpr_bicall_4("~CHKIO",
+ (code == 0 || code == 1) ? tp_boolean : tp_integer,
+ makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ makeexpr_name("FileNotOpen", tp_int),
+ ex, makeexpr_long(0));
+ }
+ if (ex3)
+ ex = makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex3), ex);
+ return ex;
+ }
+
+
+
+ Static Expr *func_eof()
+ {
+ Expr *ex;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_input);
+ return iofunc(ex, 0);
+ }
+
+
+
+ Static Expr *func_eoln()
+ {
+ Expr *ex;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_input);
+ return iofunc(ex, 1);
+ }
+
+
+
+ Static Stmt *proc_escape()
+ {
+ Expr *ex;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_integer);
+ else
+ ex = makeexpr_long(0);
+ return makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int,
+ makeexpr_arglong(ex, 0)));
+ }
+
+
+
+ Static Stmt *proc_excl()
+ {
+ Expr *vex, *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(vex->val.type->indextype);
+ skipcloseparen();
+ if (vex->val.type->kind == TK_SMALLSET)
+ return makestmt_assign(vex, makeexpr_bin(EK_BAND, vex->val.type,
+ copyexpr(vex),
+ makeexpr_un(EK_BNOT, vex->val.type,
+ makeexpr_bin(EK_LSH, vex->val.type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ ex))));
+ else
+ return makestmt_call(makeexpr_bicall_2(setremname, tp_void, vex,
+ makeexpr_arglong(enum_to_int(ex), 0)));
+ }
+
+
+
+ Stmt *proc_exit()
+ {
+ Stmt *sp;
+
+ if (modula2) {
+ return makestmt(SK_BREAK);
+ }
+ if (curtok == TOK_LPAR) {
+ gettok();
+ if (curtok == TOK_PROGRAM ||
+ (curtok == TOK_IDENT && curtokmeaning->kind == MK_MODULE)) {
+ gettok();
+ skipcloseparen();
+ return makestmt_call(makeexpr_bicall_1("exit", tp_void,
+ makeexpr_name("EXIT_SUCCESS",
+ tp_integer)));
+ }
+ if (curtok != TOK_IDENT || !curtokmeaning || curtokmeaning != curctx)
+ note("Attempting to EXIT beyond this function [188]");
+ gettok();
+ skipcloseparen();
+ }
+ sp = makestmt(SK_RETURN);
+ if (curctx->kind == MK_FUNCTION && curctx->isfunction) {
+ sp->exp1 = makeexpr_var(curctx->cbase);
+ curctx->cbase->refcount++;
+ }
+ return sp;
+ }
+
+
+
+ Static Expr *file_iofunc(code, base)
+ int code;
+ long base;
+ {
+ Expr *ex;
+ Type *basetype;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_input);
+ if (!ex->val.type || !ex->val.type->basetype ||
+ !filebasetype(ex->val.type))
+ basetype = tp_char;
+ else
+ basetype = filebasetype(ex->val.type);
+ return makeexpr_plus(makeexpr_div(iofunc(ex, code),
+ makeexpr_sizeof(makeexpr_type(basetype), 0)),
+ makeexpr_long(base));
+ }
+
+
+
+ Static Expr *func_fcall()
+ {
+ Expr *ex, *ex2, *ex3;
+ Type *type, *tp;
+ Meaning *mp, *tvar = NULL;
+ int firstarg = 0;
+
+ if (!skipopenparen())
+ return NULL;
+ ex2 = p_expr(tp_proc);
+ type = ex2->val.type;
+ if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
+ warning("FCALL requires a function variable [209]");
+ type = tp_proc;
+ }
+ ex = makeexpr(EK_SPCALL, 1);
+ ex->val.type = type->basetype->basetype;
+ ex->args[0] = copyexpr(ex2);
+ if (type->escale != 0)
+ ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
+ makepointertype(type->basetype));
+ mp = type->basetype->fbase;
+ if (mp && mp->isreturn) { /* pointer to buffer for return value */
+ tvar = makestmttempvar(ex->val.type->basetype,
+ (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
+ insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
+ mp = mp->xnext;
+ firstarg++;
+ }
+ if (mp) {
+ if (wneedtok(TOK_COMMA))
+ ex = p_funcarglist(ex, mp, 0, 0);
+ }
+ if (tvar)
+ ex = makeexpr_hat(ex, 0); /* returns pointer to structured result */
+ skipcloseparen();
+ if (type->escale != 1 || hasstaticlinks == 2) {
+ freeexpr(ex2);
+ return ex;
+ }
+ ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
+ ex3 = copyexpr(ex);
+ insertarg(&ex3, ex3->nargs, copyexpr(ex2));
+ tp = maketype(TK_FUNCTION);
+ tp->basetype = type->basetype->basetype;
+ tp->fbase = type->basetype->fbase;
+ tp->issigned = 1;
+ ex3->args[0]->val.type = makepointertype(tp);
+ return makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ ex3, ex);
+ }
+
+
+
+ Static Expr *func_filepos()
+ {
+ return file_iofunc(2, seek_base);
+ }
+
+
+
+ Static Expr *func_filesize()
+ {
+ return file_iofunc(3, 1L);
+ }
+
+
+
+ Static Stmt *proc_fillchar()
+ {
+ Expr *vex, *ex, *cex;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = gentle_cast(makeexpr_addr(p_expr(NULL)), tp_anyptr);
+ if (!skipcomma())
+ return NULL;
+ ex = convert_size(argbasetype(vex), p_expr(tp_integer), "FILLCHAR");
+ if (!skipcomma())
+ return NULL;
+ cex = makeexpr_charcast(p_expr(tp_integer));
+ skipcloseparen();
+ return makestmt_call(makeexpr_bicall_3("memset", tp_void,
+ vex,
+ makeexpr_arglong(cex, 0),
+ makeexpr_arglong(ex, (size_t_long != 0))));
+ }
+
+
+
+ Static Expr *func_sngl()
+ {
+ Expr *ex;
+
+ ex = p_parexpr(tp_real);
+ return makeexpr_cast(ex, tp_real);
+ }
+
+
+
+ Static Expr *func_float()
+ {
+ Expr *ex;
+
+ ex = p_parexpr(tp_longreal);
+ return makeexpr_cast(ex, tp_longreal);
+ }
+
+
+
+ Static Stmt *proc_flush()
+ {
+ Expr *ex;
+ Stmt *sp;
+
+ ex = p_parexpr(tp_text);
+ sp = makestmt_call(makeexpr_bicall_1("fflush", tp_void, filebasename(ex)));
+ if (iocheck_flag)
+ sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(mp_ioresult),
+ makeexpr_long(0)));
+ return sp;
+ }
+
+
+
+ Static Expr *func_frac(ex)
+ Expr *ex;
+ {
+ Meaning *tvar;
+
+ tvar = makestmttempvar(tp_longreal, name_DUMMY);
+ return makeexpr_bicall_2("modf", tp_longreal,
+ grabarg(ex, 0),
+ makeexpr_addr(makeexpr_var(tvar)));
+ }
+
+
+
+ Static Stmt *proc_freemem(ex)
+ Expr *ex;
+ {
+ Stmt *sp;
+ Expr *vex;
+
+ vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+ sp = makestmt_call(makeexpr_bicall_1(choose_free_func(vex),
+ tp_void, copyexpr(vex)));
+ if (alloczeronil) {
+ sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
+ sp, NULL);
+ } else
+ freeexpr(vex);
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_get()
+ {
+ Expr *ex;
+ Type *type;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_input);
+ requirefilebuffer(ex);
+ type = ex->val.type;
+ if (isfiletype(type, -1) && *chargetname &&
+ filebasetype(type)->kind == TK_CHAR)
+ return makestmt_call(makeexpr_bicall_1(chargetname, tp_void,
+ filebasename(ex)));
+ else if (isfiletype(type, -1) && *arraygetname &&
+ filebasetype(type)->kind == TK_ARRAY)
+ return makestmt_call(makeexpr_bicall_2(arraygetname, tp_void,
+ filebasename(ex),
+ makeexpr_type(filebasetype(type))));
+ else
+ return makestmt_call(makeexpr_bicall_2(getname, tp_void,
+ filebasename(ex),
+ makeexpr_type(filebasetype(type))));
+ }
+
+
+
+ Static Stmt *proc_getmem(ex)
+ Expr *ex;
+ {
+ Expr *vex, *ex2, *sz = NULL;
+ Stmt *sp;
+
+ vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
+ ex2 = ex->args[1];
+ if (vex->val.type->kind == TK_POINTER)
+ ex2 = convert_size(vex->val.type->basetype, ex2, "GETMEM");
+ if (alloczeronil)
+ sz = copyexpr(ex2);
+ ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
+ sp = makestmt_assign(copyexpr(vex), ex2);
+ if (malloccheck) {
+ sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
+ makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
+ NULL));
+ }
+ if (sz && !isconstantexpr(sz)) {
+ if (alloczeronil == 2)
+ note("Called GETMEM with variable argument [189]");
+ sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
+ sp,
+ makestmt_assign(vex, makeexpr_nil()));
+ } else
+ freeexpr(vex);
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_gotoxy(ex)
+ Expr *ex;
+ {
+ return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void,
+ makeexpr_arglong(ex->args[0], 0),
+ makeexpr_arglong(ex->args[1], 0)));
+ }
+
+
+
+ Static Expr *handle_vax_hex(ex, fmt, scale)
+ Expr *ex;
+ char *fmt;
+ int scale;
+ {
+ Expr *lex, *dex, *vex;
+ Meaning *tvar;
+ Type *tp;
+ long smin, smax;
+ int bits;
+
+ if (!ex) {
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ }
+ tp = true_type(ex);
+ if (ord_range(tp, &smin, &smax))
+ bits = typebits(smin, smax);
+ else
+ bits = 32;
+ if (curtok == TOK_COMMA) {
+ gettok();
+ if (curtok != TOK_COMMA)
+ lex = makeexpr_arglong(p_expr(tp_integer), 0);
+ else
+ lex = NULL;
+ } else
+ lex = NULL;
+ if (!lex) {
+ if (!scale)
+ lex = makeexpr_long(11);
+ else
+ lex = makeexpr_long((bits+scale-1) / scale + 1);
+ }
+ if (curtok == TOK_COMMA) {
+ gettok();
+ dex = makeexpr_arglong(p_expr(tp_integer), 0);
+ } else {
+ if (!scale)
+ dex = makeexpr_long(10);
+ else
+ dex = makeexpr_long((bits+scale-1) / scale);
+ }
+ if (lex->kind == EK_CONST && dex->kind == EK_CONST &&
+ lex->val.i < dex->val.i)
+ lex = NULL;
+ skipcloseparen();
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ vex = makeexpr_var(tvar);
+ ex = makeexpr_forcelongness(ex);
+ if (exprlongness(ex) > 0)
+ fmt = format_s("l%s", fmt);
+ if (checkconst(lex, 0) || checkconst(lex, 1))
+ lex = NULL;
+ if (checkconst(dex, 0) || checkconst(dex, 1))
+ dex = NULL;
+ if (lex) {
+ if (dex)
+ ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
+ makeexpr_string(format_s("%%*.*%s", fmt)),
+ lex, dex, ex);
+ else
+ ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ makeexpr_string(format_s("%%*%s", fmt)),
+ lex, ex);
+ } else {
+ if (dex)
+ ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ makeexpr_string(format_s("%%.*%s", fmt)),
+ dex, ex);
+ else
+ ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ makeexpr_string(format_s("%%%s", fmt)),
+ ex);
+ }
+ return ex;
+ }
+
+
+
+
+ Static Expr *func_hex()
+ {
+ Expr *ex;
+ char *cp;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = makeexpr_stringcast(p_expr(tp_integer));
+ if ((ex->val.type->kind == TK_STRING ||
+ ex->val.type == tp_strptr) &&
+ curtok != TOK_COMMA) {
+ skipcloseparen();
+ if (ex->kind == EK_CONST) { /* HP Pascal */
+ cp = getstring(ex);
+ ex = makeexpr_long(my_strtol(cp, NULL, 16));
+ insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ return ex;
+ } else {
+ return makeexpr_bicall_3("strtol", tp_integer,
+ ex, makeexpr_nil(), makeexpr_long(16));
+ }
+ } else { /* VAX Pascal */
+ return handle_vax_hex(ex, "x", 4);
+ }
+ }
+
+
+
+ Static Expr *func_hi()
+ {
+ Expr *ex;
+
+ ex = force_unsigned(p_parexpr(tp_integer));
+ return makeexpr_bin(EK_RSH, tp_ubyte,
+ ex, makeexpr_long(8));
+ }
+
+
+
+ Static Expr *func_high()
+ {
+ Expr *ex;
+ Type *type;
+
+ ex = p_parexpr(tp_integer);
+ type = ex->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ if (type->kind == TK_ARRAY ||
+ type->kind == TK_SMALLARRAY) {
+ ex = makeexpr_minus(copyexpr(type->indextype->smax),
+ copyexpr(type->indextype->smin));
+ } else {
+ warning("HIGH requires an array name parameter [210]");
+ ex = makeexpr_bicall_1("HIGH", tp_int, ex);
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_hiword()
+ {
+ Expr *ex;
+
+ ex = force_unsigned(p_parexpr(tp_unsigned));
+ return makeexpr_bin(EK_RSH, tp_unsigned,
+ ex, makeexpr_long(16));
+ }
+
+
+
+ Static Stmt *proc_inc()
+ {
+ Expr *vex, *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(NULL);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ ex = p_expr(tp_integer);
+ } else
+ ex = makeexpr_long(1);
+ skipcloseparen();
+ return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex));
+ }
+
+
+
+ Static Stmt *proc_incl()
+ {
+ Expr *vex, *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(vex->val.type->indextype);
+ skipcloseparen();
+ if (vex->val.type->kind == TK_SMALLSET)
+ return makestmt_assign(vex, makeexpr_bin(EK_BOR, vex->val.type,
+ copyexpr(vex),
+ makeexpr_bin(EK_LSH, vex->val.type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ ex)));
+ else
+ return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex,
+ makeexpr_arglong(enum_to_int(ex), 0)));
+ }
+
+
+
+ Static Stmt *proc_insert(ex)
+ Expr *ex;
+ {
+ return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void,
+ ex->args[0],
+ ex->args[1],
+ makeexpr_arglong(ex->args[2], 0)));
+ }
+
+
+
+ Static Expr *func_int()
+ {
+ Expr *ex;
+ Meaning *tvar;
+
+ ex = p_parexpr(tp_integer);
+ if (ex->val.type->kind == TK_REAL) { /* Turbo Pascal INT */
+ tvar = makestmttempvar(tp_longreal, name_TEMP);
+ return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal,
+ grabarg(ex, 0),
+ makeexpr_addr(makeexpr_var(tvar))),
+ makeexpr_var(tvar));
+ } else { /* VAX Pascal INT */
+ return makeexpr_ord(ex);
+ }
+ }
+
+
+ Static Expr *func_uint()
+ {
+ Expr *ex;
+
+ ex = p_parexpr(tp_integer);
+ return makeexpr_cast(ex, tp_unsigned);
+ }
+
+
+
+ Static Stmt *proc_leave()
+ {
+ return makestmt(SK_BREAK);
+ }
+
+
+
+ Static Expr *func_lo()
+ {
+ Expr *ex;
+
+ ex = gentle_cast(p_parexpr(tp_integer), tp_ushort);
+ return makeexpr_bin(EK_BAND, tp_ubyte,
+ ex, makeexpr_long(255));
+ }
+
+
+ Static Expr *func_loophole()
+ {
+ Type *type;
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ type = p_type(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(tp_integer);
+ skipcloseparen();
+ return pascaltypecast(type, ex);
+ }
+
+
+
+ Static Expr *func_lower()
+ {
+ Expr *ex;
+ Value val;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ val = p_constant(tp_integer);
+ if (!val.type || val.i != 1)
+ note("LOWER(v,n) not supported for n>1 [190]");
+ }
+ skipcloseparen();
+ return copyexpr(ex->val.type->indextype->smin);
+ }
+
+
+
+ Static Expr *func_loword()
+ {
+ Expr *ex;
+
+ ex = p_parexpr(tp_integer);
+ return makeexpr_bin(EK_BAND, tp_ushort,
+ ex, makeexpr_long(65535));
+ }
+
+
+
+ Static Expr *func_ln(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("log", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_log(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("log10", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_max()
+ {
+ Type *tp;
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE) {
+ tp = curtokmeaning->type;
+ gettok();
+ skipcloseparen();
+ return copyexpr(tp->smax);
+ }
+ ex = p_expr(tp_integer);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ ex2 = p_expr(ex->val.type);
+ if (ex->val.type->kind == TK_REAL) {
+ tp = ex->val.type;
+ if (ex2->val.type->kind != TK_REAL)
+ ex2 = makeexpr_cast(ex2, tp);
+ } else {
+ tp = ex2->val.type;
+ if (ex->val.type->kind != TK_REAL)
+ ex = makeexpr_cast(ex, tp);
+ }
+ ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax",
+ tp, ex, ex2);
+ }
+ skipcloseparen();
+ return ex;
+ }
+
+
+
+ Static Expr *func_maxavail(ex)
+ Expr *ex;
+ {
+ freeexpr(ex);
+ return makeexpr_bicall_0("maxavail", tp_integer);
+ }
+
+
+
+ Static Expr *func_maxpos()
+ {
+ return file_iofunc(3, seek_base);
+ }
+
+
+
+ Static Expr *func_memavail(ex)
+ Expr *ex;
+ {
+ freeexpr(ex);
+ return makeexpr_bicall_0("memavail", tp_integer);
+ }
+
+
+
+ Static Expr *var_mem()
+ {
+ Expr *ex, *ex2;
+
+ if (!wneedtok(TOK_LBR))
+ return makeexpr_name("MEM", tp_integer);
+ ex = p_expr(tp_integer);
+ if (curtok == TOK_COLON) {
+ gettok();
+ ex2 = p_expr(tp_integer);
+ ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2);
+ } else {
+ ex = makeexpr_bicall_1("MEM", tp_ubyte, ex);
+ }
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ note("Reference to MEM [191]");
+ return ex;
+ }
+
+
+
+ Static Expr *var_memw()
+ {
+ Expr *ex, *ex2;
+
+ if (!wneedtok(TOK_LBR))
+ return makeexpr_name("MEMW", tp_integer);
+ ex = p_expr(tp_integer);
+ if (curtok == TOK_COLON) {
+ gettok();
+ ex2 = p_expr(tp_integer);
+ ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2);
+ } else {
+ ex = makeexpr_bicall_1("MEMW", tp_ushort, ex);
+ }
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ note("Reference to MEMW [191]");
+ return ex;
+ }
+
+
+
+ Static Expr *var_meml()
+ {
+ Expr *ex, *ex2;
+
+ if (!wneedtok(TOK_LBR))
+ return makeexpr_name("MEML", tp_integer);
+ ex = p_expr(tp_integer);
+ if (curtok == TOK_COLON) {
+ gettok();
+ ex2 = p_expr(tp_integer);
+ ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2);
+ } else {
+ ex = makeexpr_bicall_1("MEML", tp_integer, ex);
+ }
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ note("Reference to MEML [191]");
+ return ex;
+ }
+
+
+
+ Static Expr *func_min()
+ {
+ Type *tp;
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE) {
+ tp = curtokmeaning->type;
+ gettok();
+ skipcloseparen();
+ return copyexpr(tp->smin);
+ }
+ ex = p_expr(tp_integer);
+ while (curtok == TOK_COMMA) {
+ gettok();
+ ex2 = p_expr(ex->val.type);
+ if (ex->val.type->kind == TK_REAL) {
+ tp = ex->val.type;
+ if (ex2->val.type->kind != TK_REAL)
+ ex2 = makeexpr_cast(ex2, tp);
+ } else {
+ tp = ex2->val.type;
+ if (ex->val.type->kind != TK_REAL)
+ ex = makeexpr_cast(ex, tp);
+ }
+ ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin",
+ tp, ex, ex2);
+ }
+ skipcloseparen();
+ return ex;
+ }
+
+
+
+ Static Stmt *proc_move(ex)
+ Expr *ex;
+ {
+ ex->args[0] = gentle_cast(ex->args[0], tp_anyptr); /* source */
+ ex->args[1] = gentle_cast(ex->args[1], tp_anyptr); /* dest */
+ ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
+ argbasetype(ex->args[1])), ex->args[2], "MOVE");
+ return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
+ ex->args[1],
+ ex->args[0],
+ makeexpr_arglong(ex->args[2], (size_t_long != 0))));
+ }
+
+
+
+ Static Stmt *proc_move_fast()
+ {
+ Expr *ex, *ex2, *ex3, *ex4;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ord_range_expr(ex2->val.type->indextype, &ex4, NULL);
+ ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4));
+ if (!skipcomma())
+ return NULL;
+ ex3 = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ ord_range_expr(ex3->val.type->indextype, &ex4, NULL);
+ ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4));
+ skipcloseparen();
+ ex = convert_size(choosetype(argbasetype(ex2),
+ argbasetype(ex3)), ex, "MOVE_FAST");
+ return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
+ makeexpr_addr(ex3),
+ makeexpr_addr(ex2),
+ makeexpr_arglong(ex, (size_t_long != 0))));
+ }
+
+
+
+ Static Stmt *proc_new()
+ {
+ Expr *ex, *ex2;
+ Stmt *sp, **spp;
+ Type *type;
+ char *name, *name2 = NULL, vbuf[1000];
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_anyptr);
+ type = ex->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ parse_special_variant(type, vbuf);
+ skipcloseparen();
+ name = find_special_variant(vbuf, NULL, specialmallocs, 3);
+ if (!name) {
+ name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3);
+ if (!name2) {
+ name = find_special_variant(vbuf, NULL, specialmallocs, 1);
+ name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1);
+ if (name || !name2)
+ name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1);
+ else
+ name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
+ }
+ }
+ if (name) {
+ ex2 = makeexpr_bicall_0(name, ex->val.type);
+ } else if (name2) {
+ ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2));
+ } else {
+ ex2 = makeexpr_bicall_1(mallocname, tp_anyptr,
+ makeexpr_sizeof(makeexpr_type(type), 1));
+ }
+ sp = makestmt_assign(copyexpr(ex), ex2);
+ if (malloccheck) {
+ sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
+ copyexpr(ex),
+ makeexpr_nil()),
+ makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
+ NULL));
+ }
+ spp = &sp->next;
+ while (*spp)
+ spp = &(*spp)->next;
+ if (type->kind == TK_RECORD)
+ initfilevars(type->fbase, &spp, makeexpr_hat(ex, 0));
+ else if (isfiletype(type, -1))
+ sp = makestmt_seq(sp, makestmt_call(initfilevar(makeexpr_hat(ex, 0))));
+ else
+ freeexpr(ex);
+ return sp;
+ }
+
+
+
+ Static Expr *func_oct()
+ {
+ return handle_vax_hex(NULL, "o", 3);
+ }
+
+
+
+ Static Expr *func_octal(ex)
+ Expr *ex;
+ {
+ char *cp;
+
+ ex = grabarg(ex, 0);
+ if (ex->kind == EK_CONST) {
+ cp = getstring(ex);
+ ex = makeexpr_long(my_strtol(cp, NULL, 8));
+ insertarg(&ex, 0, makeexpr_name("0%lo", tp_integer));
+ return ex;
+ } else {
+ return makeexpr_bicall_3("strtol", tp_integer,
+ ex, makeexpr_nil(), makeexpr_long(8));
+ }
+ }
+
+
+
+ Static Expr *func_odd(ex)
+ Expr *ex;
+ {
+ ex = makeexpr_unlongcast(grabarg(ex, 0));
+ if (*oddname)
+ return makeexpr_bicall_1(oddname, tp_boolean, ex);
+ else
+ return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1));
+ }
+
+
+
+ Static Stmt *proc_open()
+ {
+ return handleopen(2);
+ }
+
+
+
+ Static Expr *func_ord()
+ {
+ Expr *ex;
+
+ if (wneedtok(TOK_LPAR)) {
+ ex = p_ord_expr();
+ skipcloseparen();
+ } else
+ ex = p_ord_expr();
+ return makeexpr_ord(ex);
+ }
+
+
+
+ Static Expr *func_ord4()
+ {
+ Expr *ex;
+
+ if (wneedtok(TOK_LPAR)) {
+ ex = p_ord_expr();
+ skipcloseparen();
+ } else
+ ex = p_ord_expr();
+ return makeexpr_longcast(makeexpr_ord(ex), 1);
+ }
+
+
+
+ Static Stmt *proc_pack()
+ {
+ Expr *exs, *exd, *exi, *mind;
+ Meaning *tvar;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ exs = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ exi = p_ord_expr();
+ if (!skipcomma())
+ return NULL;
+ exd = p_expr(NULL);
+ skipcloseparen();
+ if (exs->val.type->kind != TK_ARRAY ||
+ (exd->val.type->kind != TK_ARRAY &&
+ exd->val.type->kind != TK_SMALLARRAY)) {
+ warning("Bad argument types for PACK/UNPACK [325]");
+ return makestmt_call(makeexpr_bicall_3("pack", tp_void,
+ exs, exi, exd));
+ }
+ if (exs->val.type->smax || exd->val.type->smax) {
+ tvar = makestmttempvar(exd->val.type->indextype, name_TEMP);
+ sp = makestmt(SK_FOR);
+ if (exd->val.type->smin)
+ mind = exd->val.type->smin;
+ else
+ mind = exd->val.type->indextype->smin;
+ sp->exp1 = makeexpr_assign(makeexpr_var(tvar),
+ copyexpr(mind));
+ sp->exp2 = makeexpr_rel(EK_LE, makeexpr_var(tvar),
+ copyexpr(exd->val.type->indextype->smax));
+ sp->exp3 = makeexpr_assign(makeexpr_var(tvar),
+ makeexpr_plus(makeexpr_var(tvar),
+ makeexpr_long(1)));
+ exi = makeexpr_minus(exi, copyexpr(mind));
+ sp->stm1 = makestmt_assign(p_index(exd, makeexpr_var(tvar)),
+ p_index(exs,
+ makeexpr_plus(makeexpr_var(tvar),
+ exi)));
+ return sp;
+ } else {
+ exi = gentle_cast(exi, exs->val.type->indextype);
+ return makestmt_call(makeexpr_bicall_3("memcpy", exd->val.type,
+ exd,
+ makeexpr_addr(p_index(exs, exi)),
+ makeexpr_sizeof(copyexpr(exd), 0)));
+ }
+ }
+
+
+
+ Static Expr *func_pad(ex)
+ Expr *ex;
+ {
+ if (checkconst(ex->args[1], 0) || /* "s" is null string */
+ checkconst(ex->args[2], ' ')) {
+ return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
+ makeexpr_string("%*s"),
+ makeexpr_longcast(ex->args[3], 0),
+ makeexpr_string(""));
+ }
+ return makeexpr_bicall_4(strpadname, tp_strptr,
+ ex->args[0], ex->args[1], ex->args[2],
+ makeexpr_arglong(ex->args[3], 0));
+ }
+
+
+
+ Static Stmt *proc_page()
+ {
+ Expr *fex, *ex;
+
+ if (curtok == TOK_LPAR) {
+ fex = p_parexpr(tp_text);
+ ex = makeexpr_bicall_2("fprintf", tp_int,
+ filebasename(copyexpr(fex)),
+ makeexpr_string("\f"));
+ } else {
+ fex = makeexpr_var(mp_output);
+ ex = makeexpr_bicall_1("printf", tp_int,
+ makeexpr_string("\f"));
+ }
+ if (FCheck(checkfilewrite)) {
+ ex = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_GE, ex, makeexpr_long(0)),
+ makeexpr_name(filewriteerrorname, tp_int));
+ }
+ return wrapopencheck(makestmt_call(ex), fex);
+ }
+
+
+
+ Static Expr *func_paramcount(ex)
+ Expr *ex;
+ {
+ freeexpr(ex);
+ return makeexpr_minus(makeexpr_name(name_ARGC, tp_int),
+ makeexpr_long(1));
+ }
+
+
+
+ Static Expr *func_paramstr(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+
+ ex2 = makeexpr_index(makeexpr_name(name_ARGV,
+ makepointertype(tp_strptr)),
+ makeexpr_unlongcast(ex->args[1]),
+ makeexpr_long(0));
+ ex2->val.type = tp_str255;
+ return makeexpr_bicall_3("sprintf", tp_strptr,
+ ex->args[0],
+ makeexpr_string("%s"),
+ ex2);
+ }
+
+
+
+ Static Expr *func_pi()
+ {
+ return makeexpr_name("M_PI", tp_longreal);
+ }
+
+
+
+ Static Expr *var_port()
+ {
+ Expr *ex;
+
+ if (!wneedtok(TOK_LBR))
+ return makeexpr_name("PORT", tp_integer);
+ ex = p_expr(tp_integer);
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ note("Reference to PORT [191]");
+ return makeexpr_bicall_1("PORT", tp_ubyte, ex);
+ }
+
+
+
+ Static Expr *var_portw()
+ {
+ Expr *ex;
+
+ if (!wneedtok(TOK_LBR))
+ return makeexpr_name("PORTW", tp_integer);
+ ex = p_expr(tp_integer);
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ note("Reference to PORTW [191]");
+ return makeexpr_bicall_1("PORTW", tp_ushort, ex);
+ }
+
+
+
+ Static Expr *func_pos(ex)
+ Expr *ex;
+ {
+ char *cp;
+
+ cp = strposname;
+ if (!*cp) {
+ note("POS function used [192]");
+ cp = "POS";
+ }
+ return makeexpr_bicall_3(cp, tp_int,
+ ex->args[1],
+ ex->args[0],
+ makeexpr_long(1));
+ }
+
+
+
+ Static Expr *func_ptr(ex)
+ Expr *ex;
+ {
+ note("PTR function was used [193]");
+ return ex;
+ }
+
+
+
+ Static Expr *func_position()
+ {
+ return file_iofunc(2, seek_base);
+ }
+
+
+
+ Static Expr *func_pred()
+ {
+ Expr *ex;
+
+ if (wneedtok(TOK_LPAR)) {
+ ex = p_ord_expr();
+ skipcloseparen();
+ } else
+ ex = p_ord_expr();
+ #if 1
+ ex = makeexpr_inc(ex, makeexpr_long(-1));
+ #else
+ ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type);
+ #endif
+ return ex;
+ }
+
+
+
+ Static Stmt *proc_put()
+ {
+ Expr *ex;
+ Type *type;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_output);
+ requirefilebuffer(ex);
+ type = ex->val.type;
+ if (isfiletype(type, -1) && *charputname &&
+ filebasetype(type)->kind == TK_CHAR)
+ return makestmt_call(makeexpr_bicall_1(charputname, tp_void,
+ filebasename(ex)));
+ else if (isfiletype(type, -1) && *arrayputname &&
+ filebasetype(type)->kind == TK_ARRAY)
+ return makestmt_call(makeexpr_bicall_2(arrayputname, tp_void,
+ filebasename(ex),
+ makeexpr_type(filebasetype(type))));
+ else
+ return makestmt_call(makeexpr_bicall_2(putname, tp_void,
+ filebasename(ex),
+ makeexpr_type(filebasetype(type))));
+ }
+
+
+
+ Static Expr *func_pwroften(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_2("pow", tp_longreal,
+ makeexpr_real("10.0"), grabarg(ex, 0));
+ }
+
+
+
+ Static Stmt *proc_reset()
+ {
+ return handleopen(0);
+ }
+
+
+
+ Static Stmt *proc_rewrite()
+ {
+ return handleopen(1);
+ }
+
+
+
+
+ Stmt *doseek(fex, ex)
+ Expr *fex, *ex;
+ {
+ Expr *ex2;
+ Type *basetype = filebasetype(fex->val.type);
+
+ if (ansiC == 1)
+ ex2 = makeexpr_name("SEEK_SET", tp_int);
+ else
+ ex2 = makeexpr_long(0);
+ ex = makeexpr_bicall_3("fseek", tp_int,
+ filebasename(copyexpr(fex)),
+ makeexpr_arglong(
+ makeexpr_times(makeexpr_minus(ex,
+ makeexpr_long(seek_base)),
+ makeexpr_sizeof(makeexpr_type(basetype), 0)),
+ 1),
+ ex2);
+ if (FCheck(checkfileseek)) {
+ ex = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(0)),
+ makeexpr_name(endoffilename, tp_int));
+ }
+ return makestmt_call(ex);
+ }
+
+
+
+
+ Static Expr *makegetchar(fex)
+ Expr *fex;
+ {
+ if (isvar(fex, mp_input))
+ return makeexpr_bicall_0("getchar", tp_char);
+ else
+ return makeexpr_bicall_1("getc", tp_char, filebasename(copyexpr(fex)));
+ }
+
+
+
+ Static Stmt *fixscanf(sp, fex)
+ Stmt *sp;
+ Expr *fex;
+ {
+ int nargs, i, isstrread;
+ char *cp;
+ Expr *ex;
+ Stmt *sp2;
+
+ isstrread = (fex->val.type->kind == TK_STRING);
+ if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL &&
+ !strcmp(sp->exp1->val.s, "scanf")) {
+ if (sp->exp1->args[0]->kind == EK_CONST &&
+ !(sp->exp1->args[0]->val.i&1) && !isstrread) {
+ cp = sp->exp1->args[0]->val.s; /* scanf("%c%c") -> getchar;getchar */
+ for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) {
+ i += 2;
+ if (i == sp->exp1->args[0]->val.i) {
+ sp2 = NULL;
+ for (i = 1; i < sp->exp1->nargs; i++) {
+ ex = makeexpr_hat(sp->exp1->args[i], 0);
+ sp2 = makestmt_seq(sp2,
+ makestmt_assign(copyexpr(ex),
+ makegetchar(fex)));
+ if (checkeof(fex)) {
+ sp2 = makestmt_seq(sp2,
+ makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_NE,
+ ex,
+ makeexpr_name("EOF", tp_char)),
+ makeexpr_name(endoffilename, tp_int))));
+ } else
+ freeexpr(ex);
+ }
+ return sp2;
+ }
+ }
+ }
+ nargs = sp->exp1->nargs - 1;
+ if (isstrread) {
+ strchange(&sp->exp1->val.s, "sscanf");
+ insertarg(&sp->exp1, 0, copyexpr(fex));
+ } else if (!isvar(fex, mp_input)) {
+ strchange(&sp->exp1->val.s, "fscanf");
+ insertarg(&sp->exp1, 0, filebasename(copyexpr(fex)));
+ }
+ if (FCheck(checkreadformat)) {
+ if (checkeof(fex) && !isstrread)
+ ex = makeexpr_cond(makeexpr_rel(EK_NE,
+ makeexpr_bicall_1("feof",
+ tp_int,
+ filebasename(copyexpr(fex))),
+ makeexpr_long(0)),
+ makeexpr_name(endoffilename, tp_int),
+ makeexpr_name(badinputformatname, tp_int));
+ else
+ ex = makeexpr_name(badinputformatname, tp_int);
+ sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_EQ,
+ sp->exp1,
+ makeexpr_long(nargs)),
+ ex);
+ } else if (checkeof(fex) && !isstrread) {
+ sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_NE,
+ sp->exp1,
+ makeexpr_name("EOF", tp_int)),
+ makeexpr_name(endoffilename, tp_int));
+ }
+ }
+ return sp;
+ }
+
+
+
+ Static Expr *makefgets(vex, lex, fex)
+ Expr *vex, *lex, *fex;
+ {
+ Expr *ex;
+
+ ex = makeexpr_bicall_3("fgets", tp_strptr,
+ vex,
+ lex,
+ filebasename(copyexpr(fex)));
+ if (checkeof(fex)) {
+ ex = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_NE, ex, makeexpr_nil()),
+ makeexpr_name(endoffilename, tp_int));
+ }
+ return ex;
+ }
+
+
+
+ Static Stmt *skipeoln(fex)
+ Expr *fex;
+ {
+ Meaning *tvar;
+ Expr *ex;
+
+ if (!strcmp(readlnname, "fgets")) {
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ return makestmt_call(makefgets(makeexpr_var(tvar),
+ makeexpr_long(stringceiling+1),
+ filebasename(fex)));
+ } else if (!strcmp(readlnname, "scanf") || !*readlnname) {
+ if (checkeof(fex))
+ ex = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_NE,
+ makegetchar(fex),
+ makeexpr_name("EOF", tp_char)),
+ makeexpr_name(endoffilename, tp_int));
+ else
+ ex = makegetchar(fex);
+ return makestmt_seq(fixscanf(
+ makestmt_call(makeexpr_bicall_1("scanf", tp_int,
+ makeexpr_string("%*[^\n]"))), fex),
+ makestmt_call(ex));
+ } else {
+ return makestmt_call(makeexpr_bicall_1(readlnname, tp_void,
+ filebasename(copyexpr(fex))));
+ }
+ }
+
+
+
+ Static Stmt *handleread_text(fex, var, isreadln)
+ Expr *fex, *var;
+ int isreadln;
+ {
+ Stmt *spbase, *spafter, *sp;
+ Expr *ex = NULL, *exj = NULL;
+ Type *type;
+ Meaning *tvar, *tempcp, *mp;
+ int i, isstrread, scanfmode, readlnflag, varstring, maxstring;
+ int longstrsize = (longstringsize > 0) ? longstringsize : stringceiling;
+ long rmin, rmax;
+ char *fmt;
+
+ spbase = NULL;
+ spafter = NULL;
+ sp = NULL;
+ tempcp = NULL;
+ if (fex->val.type->kind == TK_ARRAY)
+ fex = makeexpr_sprintfify(fex);
+ isstrread = (fex->val.type->kind == TK_STRING);
+ if (isstrread) {
+ exj = var;
+ var = p_expr(NULL);
+ }
+ scanfmode = !strcmp(readlnname, "scanf") || !*readlnname || isstrread;
+ for (;;) {
+ readlnflag = isreadln && curtok == TOK_RPAR;
+ if (var->val.type->kind == TK_STRING && !isstrread) {
+ if (sp)
+ spbase = makestmt_seq(spbase, fixscanf(sp, fex));
+ spbase = makestmt_seq(spbase, spafter);
+ varstring = (varstrings && var->kind == EK_VAR &&
+ (mp = (Meaning *)var->val.i)->kind == MK_VARPARAM &&
+ mp->type == tp_strptr);
+ maxstring = (strmax(var) >= longstrsize && !varstring);
+ if (isvar(fex, mp_input) && maxstring && usegets && readlnflag) {
+ spbase = makestmt_seq(spbase,
+ makestmt_call(makeexpr_bicall_1("gets", tp_str255,
+ makeexpr_addr(var))));
+ isreadln = 0;
+ } else if (scanfmode && !varstring &&
+ (*readlnname || !isreadln)) {
+ spbase = makestmt_seq(spbase, makestmt_assign(makeexpr_hat(copyexpr(var), 0),
+ makeexpr_char(0)));
+ if (maxstring && usegets)
+ ex = makeexpr_string("%[^\n]");
+ else
+ ex = makeexpr_string(format_d("%%%d[^\n]", strmax(var)));
+ ex = makeexpr_bicall_2("scanf", tp_int, ex, makeexpr_addr(var));
+ spbase = makestmt_seq(spbase, fixscanf(makestmt_call(ex), fex));
+ if (readlnflag && maxstring && usegets) {
+ spbase = makestmt_seq(spbase, makestmt_call(makegetchar(fex)));
+ isreadln = 0;
+ }
+ } else {
+ ex = makeexpr_plus(strmax_func(var), makeexpr_long(1));
+ spbase = makestmt_seq(spbase,
+ makestmt_call(makefgets(makeexpr_addr(copyexpr(var)),
+ ex,
+ fex)));
+ if (!tempcp)
+ tempcp = makestmttempvar(tp_charptr, name_TEMP);
+ spbase = makestmt_seq(spbase,
+ makestmt_assign(makeexpr_var(tempcp),
+ makeexpr_bicall_2("strchr", tp_charptr,
+ makeexpr_addr(copyexpr(var)),
+ makeexpr_char('\n'))));
+ sp = makestmt_assign(makeexpr_hat(makeexpr_var(tempcp), 0),
+ makeexpr_long(0));
+ if (readlnflag)
+ isreadln = 0;
+ else
+ sp = makestmt_seq(sp,
+ makestmt_call(makeexpr_bicall_2("ungetc", tp_void,
+ makeexpr_char('\n'),
+ filebasename(copyexpr(fex)))));
+ spbase = makestmt_seq(spbase, makestmt_if(makeexpr_rel(EK_NE,
+ makeexpr_var(tempcp),
+ makeexpr_nil()),
+ sp,
+ NULL));
+ }
+ sp = NULL;
+ spafter = NULL;
+ } else if (var->val.type->kind == TK_ARRAY && !isstrread) {
+ if (sp)
+ spbase = makestmt_seq(spbase, fixscanf(sp, fex));
+ spbase = makestmt_seq(spbase, spafter);
+ ex = makeexpr_sizeof(copyexpr(var), 0);
+ if (readlnflag) {
+ spbase = makestmt_seq(spbase,
+ makestmt_call(
+ makeexpr_bicall_3("P_readlnpaoc", tp_void,
+ filebasename(copyexpr(fex)),
+ makeexpr_addr(var),
+ makeexpr_arglong(ex, 0))));
+ isreadln = 0;
+ } else {
+ spbase = makestmt_seq(spbase,
+ makestmt_call(
+ makeexpr_bicall_3("P_readpaoc", tp_void,
+ filebasename(copyexpr(fex)),
+ makeexpr_addr(var),
+ makeexpr_arglong(ex, 0))));
+ }
+ sp = NULL;
+ spafter = NULL;
+ } else {
+ switch (ord_type(var->val.type)->kind) {
+
+ case TK_INTEGER:
+ fmt = "d";
+ if (curtok == TOK_COLON) {
+ gettok();
+ if (curtok == TOK_IDENT &&
+ !strcicmp(curtokbuf, "HEX")) {
+ fmt = "x";
+ } else if (curtok == TOK_IDENT &&
+ !strcicmp(curtokbuf, "OCT")) {
+ fmt = "o";
+ } else if (curtok == TOK_IDENT &&
+ !strcicmp(curtokbuf, "BIN")) {
+ fmt = "b";
+ note("Using %b for binary format in scanf [194]");
+ } else
+ warning("Unrecognized format specified in READ [212]");
+ gettok();
+ }
+ type = findbasetype(var->val.type, ODECL_NOPRES);
+ if (exprlongness(var) > 0)
+ ex = makeexpr_string(format_s("%%l%s", fmt));
+ else if (type == tp_integer || type == tp_int ||
+ type == tp_uint || type == tp_sint)
+ ex = makeexpr_string(format_s("%%%s", fmt));
+ else if (type == tp_sshort || type == tp_ushort)
+ ex = makeexpr_string(format_s("%%h%s", fmt));
+ else {
+ tvar = makestmttempvar(tp_int, name_TEMP);
+ spafter = makestmt_seq(spafter,
+ makestmt_assign(var,
+ makeexpr_var(tvar)));
+ var = makeexpr_var(tvar);
+ ex = makeexpr_string(format_s("%%%s", fmt));
+ }
+ break;
+
+ case TK_CHAR:
+ ex = makeexpr_string("%c");
+ if (newlinespace && !isstrread) {
+ spafter = makestmt_seq(spafter,
+ makestmt_if(makeexpr_rel(EK_EQ,
+ copyexpr(var),
+ makeexpr_char('\n')),
+ makestmt_assign(copyexpr(var),
+ makeexpr_char(' ')),
+ NULL));
+ }
+ break;
+
+ case TK_BOOLEAN:
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ spafter = makestmt_seq(spafter,
+ makestmt_assign(var,
+ makeexpr_or(makeexpr_rel(EK_EQ,
+ makeexpr_hat(makeexpr_var(tvar), 0),
+ makeexpr_char('T')),
+ makeexpr_rel(EK_EQ,
+ makeexpr_hat(makeexpr_var(tvar), 0),
+ makeexpr_char('t')))));
+ var = makeexpr_var(tvar);
+ ex = makeexpr_string(" %[a-zA-Z]");
+ break;
+
+ case TK_ENUM:
+ warning("READ on enumerated types not yet supported [213]");
+ if (useenum)
+ ex = makeexpr_string("%d");
+ else
+ ex = makeexpr_string("%hd");
+ break;
+
+ case TK_REAL:
+ if (var->val.type == tp_longreal)
+ ex = makeexpr_string("%lg");
+ else
+ ex = makeexpr_string("%g");
+ break;
+
+ case TK_STRING: /* strread only */
+ ex = makeexpr_string(format_d("%%%lds", strmax(fex)));
+ break;
+
+ case TK_ARRAY: /* strread only */
+ if (!ord_range(ex->val.type->indextype, &rmin, &rmax)) {
+ rmin = 1;
+ rmax = 1;
+ note("Can't determine length of packed array of chars [195]");
+ }
+ ex = makeexpr_string(format_d("%%%ldc", rmax-rmin+1));
+ break;
+
+ default:
+ note("Element has wrong type for WRITE statement [196]");
+ ex = NULL;
+ break;
+
+ }
+ if (ex) {
+ var = makeexpr_addr(var);
+ if (sp) {
+ sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], ex, 0);
+ insertarg(&sp->exp1, sp->exp1->nargs, var);
+ } else {
+ sp = makestmt_call(makeexpr_bicall_2("scanf", tp_int, ex, var));
+ }
+ }
+ }
+ if (curtok == TOK_COMMA) {
+ gettok();
+ var = p_expr(NULL);
+ } else
+ break;
+ }
+ if (sp) {
+ if (isstrread && !FCheck(checkreadformat) &&
+ ((i=0, checkstring(sp->exp1->args[0], "%d")) ||
+ (i++, checkstring(sp->exp1->args[0], "%ld")) ||
+ (i++, checkstring(sp->exp1->args[0], "%hd")) ||
+ (i++, checkstring(sp->exp1->args[0], "%lg")))) {
+ if (fullstrread != 0 && exj) {
+ tvar = makestmttempvar(tp_strptr, name_STRING);
+ sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
+ (i == 3) ? makeexpr_bicall_2("strtod", tp_longreal,
+ copyexpr(fex),
+ makeexpr_addr(makeexpr_var(tvar)))
+ : makeexpr_bicall_3("strtol", tp_integer,
+ copyexpr(fex),
+ makeexpr_addr(makeexpr_var(tvar)),
+ makeexpr_long(10)));
+ spafter = makestmt_seq(spafter,
+ makestmt_assign(copyexpr(exj),
+ makeexpr_minus(makeexpr_var(tvar),
+ makeexpr_addr(copyexpr(fex)))));
+ } else {
+ sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
+ makeexpr_bicall_1((i == 1) ? "atol" : (i == 3) ? "atof" : "atoi",
+ (i == 1) ? tp_integer : (i == 3) ? tp_longreal : tp_int,
+ copyexpr(fex)));
+ }
+ } else if (isstrread && fullstrread != 0 && exj) {
+ sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
+ makeexpr_string(sizeof_int >= 32 ? "%n" : "%ln"), 0);
+ insertarg(&sp->exp1, sp->exp1->nargs, makeexpr_addr(copyexpr(exj)));
+ } else if (isreadln && scanfmode && !FCheck(checkreadformat)) {
+ isreadln = 0;
+ sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
+ makeexpr_string("%*[^\n]"), 0);
+ spafter = makestmt_seq(makestmt_call(makegetchar(fex)), spafter);
+ }
+ spbase = makestmt_seq(spbase, fixscanf(sp, fex));
+ }
+ spbase = makestmt_seq(spbase, spafter);
+ if (isreadln)
+ spbase = makestmt_seq(spbase, skipeoln(fex));
+ return spbase;
+ }
+
+
+
+ Static Stmt *handleread_bin(fex, var)
+ Expr *fex, *var;
+ {
+ Type *basetype;
+ Stmt *sp;
+ Expr *ex, *tvardef = NULL;
+
+ sp = NULL;
+ basetype = filebasetype(fex->val.type);
+ for (;;) {
+ ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var),
+ makeexpr_sizeof(makeexpr_type(basetype), 0),
+ makeexpr_long(1),
+ filebasename(copyexpr(fex)));
+ if (checkeof(fex)) {
+ ex = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ makeexpr_name(endoffilename, tp_int));
+ }
+ sp = makestmt_seq(sp, makestmt_call(ex));
+ if (curtok == TOK_COMMA) {
+ gettok();
+ var = p_expr(NULL);
+ } else
+ break;
+ }
+ freeexpr(tvardef);
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_read()
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(NULL);
+ if (isfiletype(ex->val.type, -1) && wneedtok(TOK_COMMA)) {
+ fex = ex;
+ ex = p_expr(NULL);
+ } else {
+ fex = makeexpr_var(mp_input);
+ }
+ if (fex->val.type == tp_text || fex->val.type == tp_bigtext)
+ sp = handleread_text(fex, ex, 0);
+ else
+ sp = handleread_bin(fex, ex);
+ skipcloseparen();
+ return wrapopencheck(sp, fex);
+ }
+
+
+
+ Static Stmt *proc_readdir()
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(tp_integer);
+ sp = doseek(fex, ex);
+ if (!skipopenparen())
+ return sp;
+ sp = makestmt_seq(sp, handleread_bin(fex, p_expr(NULL)));
+ skipcloseparen();
+ return wrapopencheck(sp, fex);
+ }
+
+
+
+ Static Stmt *proc_readln()
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+
+ if (curtok != TOK_LPAR) {
+ fex = makeexpr_var(mp_input);
+ return wrapopencheck(skipeoln(copyexpr(fex)), fex);
+ } else {
+ gettok();
+ ex = p_expr(NULL);
+ if (isfiletype(ex->val.type, -1)) {
+ fex = ex;
+ if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ return wrapopencheck(skipeoln(copyexpr(fex)), fex);
+ } else {
+ ex = p_expr(NULL);
+ }
+ } else {
+ fex = makeexpr_var(mp_input);
+ }
+ sp = handleread_text(fex, ex, 1);
+ skipcloseparen();
+ }
+ return wrapopencheck(sp, fex);
+ }
+
+
+
+ Static Stmt *proc_readv()
+ {
+ Expr *vex;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ sp = handleread_text(vex, NULL, 0);
+ skipcloseparen();
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_strread()
+ {
+ Expr *vex, *exi, *exj, *exjj, *ex;
+ Stmt *sp, *sp2;
+ Meaning *tvar, *jvar;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(tp_str255);
+ if (vex->kind != EK_VAR) {
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ sp = makestmt_assign(makeexpr_var(tvar), vex);
+ vex = makeexpr_var(tvar);
+ } else
+ sp = NULL;
+ if (!skipcomma())
+ return NULL;
+ exi = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ exj = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ if (exprspeed(exi) >= 5 || !nosideeffects(exi, 0)) {
+ sp = makestmt_seq(sp, makestmt_assign(copyexpr(exj), exi));
+ exi = copyexpr(exj);
+ }
+ if (fullstrread != 0 &&
+ ((ex = singlevar(exj)) == NULL || exproccurs(exi, ex))) {
+ jvar = makestmttempvar(exj->val.type, name_TEMP);
+ exjj = makeexpr_var(jvar);
+ } else {
+ exjj = copyexpr(exj);
+ jvar = (exj->kind == EK_VAR) ? (Meaning *)exj->val.i : NULL;
+ }
+ sp2 = handleread_text(bumpstring(copyexpr(vex),
+ copyexpr(exi), 1),
+ exjj, 0);
+ sp = makestmt_seq(sp, sp2);
+ skipcloseparen();
+ if (fullstrread == 0) {
+ sp = makestmt_seq(sp, makestmt_assign(exj,
+ makeexpr_plus(makeexpr_bicall_1("strlen", tp_int,
+ vex),
+ makeexpr_long(1))));
+ freeexpr(exjj);
+ freeexpr(exi);
+ } else {
+ sp = makestmt_seq(sp, makestmt_assign(exj,
+ makeexpr_plus(exjj, exi)));
+ if (fullstrread == 2)
+ note("STRREAD was used [197]");
+ freeexpr(vex);
+ }
+ return mixassignments(sp, jvar);
+ }
+
+
+
+
+ Static Expr *func_random()
+ {
+ Expr *ex;
+
+ if (curtok == TOK_LPAR) {
+ gettok();
+ ex = p_expr(tp_integer);
+ skipcloseparen();
+ return makeexpr_bicall_1(randintname, tp_integer, makeexpr_arglong(ex, 1));
+ } else {
+ return makeexpr_bicall_0(randrealname, tp_longreal);
+ }
+ }
+
+
+
+ Static Stmt *proc_randomize()
+ {
+ if (*randomizename)
+ return makestmt_call(makeexpr_bicall_0(randomizename, tp_void));
+ else
+ return NULL;
+ }
+
+
+
+ Static Expr *func_round(ex)
+ Expr *ex;
+ {
+ Meaning *tvar;
+
+ ex = grabarg(ex, 0);
+ if (ex->val.type->kind != TK_REAL)
+ return ex;
+ if (*roundname) {
+ if (*roundname != '*' || (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
+ return makeexpr_bicall_1(roundname, tp_integer, ex);
+ } else {
+ tvar = makestmttempvar(tp_longreal, name_TEMP);
+ return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex),
+ makeexpr_bicall_1(roundname, tp_integer, makeexpr_var(tvar)));
+ }
+ } else {
+ return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
+ makeexpr_plus(ex, makeexpr_real("0.5"))),
+ tp_integer);
+ }
+ }
+
+
+
+ Static Stmt *proc_unpack()
+ {
+ Expr *exs, *exd, *exi, *mins;
+ Meaning *tvar;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ exs = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ exd = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ exi = p_ord_expr();
+ skipcloseparen();
+ if (exd->val.type->kind != TK_ARRAY ||
+ (exs->val.type->kind != TK_ARRAY &&
+ exs->val.type->kind != TK_SMALLARRAY)) {
+ warning("Bad argument types for PACK/UNPACK [325]");
+ return makestmt_call(makeexpr_bicall_3("unpack", tp_void,
+ exs, exd, exi));
+ }
+ if (exs->val.type->smax || exd->val.type->smax) {
+ tvar = makestmttempvar(exs->val.type->indextype, name_TEMP);
+ sp = makestmt(SK_FOR);
+ if (exs->val.type->smin)
+ mins = exs->val.type->smin;
+ else
+ mins = exs->val.type->indextype->smin;
+ sp->exp1 = makeexpr_assign(makeexpr_var(tvar),
+ copyexpr(mins));
+ sp->exp2 = makeexpr_rel(EK_LE, makeexpr_var(tvar),
+ copyexpr(exs->val.type->indextype->smax));
+ sp->exp3 = makeexpr_assign(makeexpr_var(tvar),
+ makeexpr_plus(makeexpr_var(tvar),
+ makeexpr_long(1)));
+ exi = makeexpr_minus(exi, copyexpr(mins));
+ sp->stm1 = makestmt_assign(p_index(exd,
+ makeexpr_plus(makeexpr_var(tvar),
+ exi)),
+ p_index(exs, makeexpr_var(tvar)));
+ return sp;
+ } else {
+ exi = gentle_cast(exi, exs->val.type->indextype);
+ return makestmt_call(makeexpr_bicall_3("memcpy", exd->val.type,
+ exd,
+ makeexpr_addr(p_index(exs, exi)),
+ makeexpr_sizeof(copyexpr(exd), 0)));
+ }
+ }
+
+
+
+ Static Expr *func_uround(ex)
+ Expr *ex;
+ {
+ ex = grabarg(ex, 0);
+ if (ex->val.type->kind != TK_REAL)
+ return ex;
+ return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
+ makeexpr_plus(ex, makeexpr_real("0.5"))),
+ tp_unsigned);
+ }
+
+
+
+ Static Expr *func_scan()
+ {
+ Expr *ex, *ex2, *ex3;
+ char *name;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ if (curtok == TOK_EQ)
+ name = "P_scaneq";
+ else
+ name = "P_scanne";
+ gettok();
+ ex2 = p_expr(tp_char);
+ if (!skipcomma())
+ return NULL;
+ ex3 = p_expr(tp_str255);
+ skipcloseparen();
+ return makeexpr_bicall_3(name, tp_int,
+ makeexpr_arglong(ex, 0),
+ makeexpr_charcast(ex2), ex3);
+ }
+
+
+
+ Static Expr *func_scaneq(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_3("P_scaneq", tp_int,
+ makeexpr_arglong(ex->args[0], 0),
+ makeexpr_charcast(ex->args[1]),
+ ex->args[2]);
+ }
+
+
+ Static Expr *func_scanne(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_3("P_scanne", tp_int,
+ makeexpr_arglong(ex->args[0], 0),
+ makeexpr_charcast(ex->args[1]),
+ ex->args[2]);
+ }
+
+
+
+ Static Stmt *proc_seek()
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(tp_integer);
+ skipcloseparen();
+ sp = wrapopencheck(doseek(fex, ex), copyexpr(fex));
+ if (*setupbufname && fileisbuffered(fex, 1))
+ sp = makestmt_seq(sp,
+ makestmt_call(
+ makeexpr_bicall_2(setupbufname, tp_void,
+ filebasename(fex),
+ makeexpr_type(filebasetype(fex->val.type)))));
+ else
+ freeexpr(fex);
+ return sp;
+ }
+
+
+
+ Static Expr *func_seekeof()
+ {
+ Expr *ex;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_input);
+ if (*skipspacename)
+ ex = makeexpr_bicall_1(skipspacename, tp_text, filebasename(ex));
+ else
+ note("SEEKEOF was used [198]");
+ return iofunc(ex, 0);
+ }
+
+
+
+ Static Expr *func_seekeoln()
+ {
+ Expr *ex;
+
+ if (curtok == TOK_LPAR)
+ ex = p_parexpr(tp_text);
+ else
+ ex = makeexpr_var(mp_input);
+ if (*skipspacename)
+ ex = makeexpr_bicall_1(skipspacename, tp_text, filebasename(ex));
+ else
+ note("SEEKEOLN was used [199]");
+ return iofunc(ex, 1);
+ }
+
+
+
+ Static Stmt *proc_setstrlen()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ return makestmt_assign(makeexpr_bicall_1("strlen", tp_int, ex),
+ ex2);
+ }
+
+
+
+ Static Stmt *proc_settextbuf()
+ {
+ Expr *fex, *bex, *sex;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ bex = p_expr(NULL);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ sex = p_expr(tp_integer);
+ } else
+ sex = makeexpr_sizeof(copyexpr(bex), 0);
+ skipcloseparen();
+ note("Make sure setvbuf() call occurs when file is open [200]");
+ return makestmt_call(makeexpr_bicall_4("setvbuf", tp_void,
+ filebasename(fex),
+ makeexpr_addr(bex),
+ makeexpr_name("_IOFBF", tp_integer),
+ sex));
+ }
+
+
+
+ Static Expr *func_sin(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("sin", tp_longreal, grabarg(ex, 0));
+ }
+
+
+ Static Expr *func_sinh(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("sinh", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_sizeof()
+ {
+ Expr *ex;
+ Type *type;
+ char *name, vbuf[1000];
+ int lpar;
+
+ lpar = (curtok == TOK_LPAR);
+ if (lpar)
+ gettok();
+ if (curtok == TOK_IDENT && curtokmeaning && curtokmeaning->kind == MK_TYPE) {
+ ex = makeexpr_type(curtokmeaning->type);
+ gettok();
+ } else
+ ex = p_expr(NULL);
+ type = ex->val.type;
+ parse_special_variant(type, vbuf);
+ if (lpar)
+ skipcloseparen();
+ name = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
+ if (name) {
+ freeexpr(ex);
+ return pc_expr_str(name);
+ } else
+ return makeexpr_sizeof(ex, 0);
+ }
+
+
+
+ Static Expr *func_statusv()
+ {
+ return makeexpr_name(name_IORESULT, tp_integer);
+ }
+
+
+
+ Static Expr *func_str_hp(ex)
+ Expr *ex;
+ {
+ return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1],
+ ex->args[2], ex->args[3]));
+ }
+
+
+
+ Static Stmt *proc_strappend()
+ {
+ Expr *ex, *ex2;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_str255);
+ skipcloseparen();
+ return makestmt_assign(ex, makeexpr_concat(copyexpr(ex), ex2, 0));
+ }
+
+
+
+ Static Stmt *proc_strdelete()
+ {
+ Meaning *tvar = NULL, *tvari;
+ Expr *ex, *ex2, *ex3, *ex4, *exi, *exn;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ exi = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ exn = p_expr(tp_integer);
+ } else
+ exn = makeexpr_long(1);
+ skipcloseparen();
+ if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
+ sp = NULL;
+ else {
+ tvari = makestmttempvar(tp_int, name_TEMP);
+ sp = makestmt_assign(makeexpr_var(tvari), exi);
+ exi = makeexpr_var(tvari);
+ }
+ ex3 = bumpstring(copyexpr(ex), copyexpr(exi), 1);
+ ex4 = bumpstring(copyexpr(ex), makeexpr_plus(exi, exn), 1);
+ if (strcpyleft) {
+ ex2 = ex3;
+ } else {
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ ex2 = makeexpr_var(tvar);
+ }
+ sp = makestmt_seq(sp, makestmt_assign(ex2, ex4));
+ if (!strcpyleft)
+ sp = makestmt_seq(sp, makestmt_assign(ex3, makeexpr_var(tvar)));
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_strinsert()
+ {
+ Meaning *tvari;
+ Expr *exs, *exd, *exi;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ exs = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ exd = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ exi = p_expr(tp_integer);
+ skipcloseparen();
+ #if 0
+ if (checkconst(exi, 1)) {
+ freeexpr(exi);
+ return makestmt_assign(exd,
+ makeexpr_concat(exs, copyexpr(exd)));
+ }
+ #endif
+ if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
+ sp = NULL;
+ else {
+ tvari = makestmttempvar(tp_int, name_TEMP);
+ sp = makestmt_assign(makeexpr_var(tvari), exi);
+ exi = makeexpr_var(tvari);
+ }
+ exd = bumpstring(exd, exi, 1);
+ sp = makestmt_seq(sp, makestmt_assign(exd,
+ makeexpr_concat(exs, copyexpr(exd), 0)));
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_strmove()
+ {
+ Expr *exlen, *exs, *exsi, *exd, *exdi;
+
+ if (!skipopenparen())
+ return NULL;
+ exlen = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ exs = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ exsi = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ exd = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ exdi = p_expr(tp_integer);
+ skipcloseparen();
+ exsi = makeexpr_arglong(exsi, 0);
+ exdi = makeexpr_arglong(exdi, 0);
+ return makestmt_call(makeexpr_bicall_5(strmovename, tp_str255,
+ exlen, exs, exsi, exd, exdi));
+ }
+
+
+
+ Static Expr *func_strlen(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("strlen", tp_int, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_strltrim(ex)
+ Expr *ex;
+ {
+ return makeexpr_assign(makeexpr_hat(ex->args[0], 0),
+ makeexpr_bicall_1(strltrimname, tp_str255, ex->args[1]));
+ }
+
+
+
+ Static Expr *func_strmax(ex)
+ Expr *ex;
+ {
+ return strmax_func(grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_strpos(ex)
+ Expr *ex;
+ {
+ char *cp;
+
+ if (!switch_strpos)
+ swapexprs(ex->args[0], ex->args[1]);
+ cp = strposname;
+ if (!*cp) {
+ note("STRPOS function used [201]");
+ cp = "STRPOS";
+ }
+ return makeexpr_bicall_3(cp, tp_int,
+ ex->args[0],
+ ex->args[1],
+ makeexpr_long(1));
+ }
+
+
+
+ Static Expr *func_strrpt(ex)
+ Expr *ex;
+ {
+ if (ex->args[1]->kind == EK_CONST &&
+ ex->args[1]->val.i == 1 && ex->args[1]->val.s[0] == ' ') {
+ return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
+ makeexpr_string("%*s"),
+ makeexpr_longcast(ex->args[2], 0),
+ makeexpr_string(""));
+ } else
+ return makeexpr_bicall_3(strrptname, tp_strptr, ex->args[0], ex->args[1],
+ makeexpr_arglong(ex->args[2], 0));
+ }
+
+
+
+ Static Expr *func_strrtrim(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1(strrtrimname, tp_strptr,
+ makeexpr_assign(makeexpr_hat(ex->args[0], 0),
+ ex->args[1]));
+ }
+
+
+
+ Static Expr *func_succ()
+ {
+ Expr *ex;
+
+ if (wneedtok(TOK_LPAR)) {
+ ex = p_ord_expr();
+ skipcloseparen();
+ } else
+ ex = p_ord_expr();
+ #if 1
+ ex = makeexpr_inc(ex, makeexpr_long(1));
+ #else
+ ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(1)), ex->val.type);
+ #endif
+ return ex;
+ }
+
+
+
+ Static Expr *func_sqr()
+ {
+ return makeexpr_sqr(p_parexpr(tp_integer), 0);
+ }
+
+
+
+ Static Expr *func_sqrt(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("sqrt", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_swap(ex)
+ Expr *ex;
+ {
+ char *cp;
+
+ ex = grabarg(ex, 0);
+ cp = swapname;
+ if (!*cp) {
+ note("SWAP function was used [202]");
+ cp = "SWAP";
+ }
+ return makeexpr_bicall_1(swapname, tp_int, ex);
+ }
+
+
+
+ Static Expr *func_tan(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("tan", tp_longreal, grabarg(ex, 0));
+ }
+
+
+ Static Expr *func_tanh(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("tanh", tp_longreal, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_trunc(ex)
+ Expr *ex;
+ {
+ return makeexpr_actcast(grabarg(ex, 0), tp_integer);
+ }
+
+
+
+ Static Expr *func_utrunc(ex)
+ Expr *ex;
+ {
+ return makeexpr_actcast(grabarg(ex, 0), tp_unsigned);
+ }
+
+
+
+ Static Expr *func_uand()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_unsigned);
+ if (skipcomma()) {
+ ex = makeexpr_bin(EK_BAND, ex->val.type, ex, p_expr(tp_unsigned));
+ skipcloseparen();
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_udec()
+ {
+ return handle_vax_hex(NULL, "u", 0);
+ }
+
+
+
+ Static Expr *func_unot()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_unsigned);
+ ex = makeexpr_un(EK_BNOT, ex->val.type, ex);
+ skipcloseparen();
+ return ex;
+ }
+
+
+
+ Static Expr *func_uor()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_unsigned);
+ if (skipcomma()) {
+ ex = makeexpr_bin(EK_BOR, ex->val.type, ex, p_expr(tp_unsigned));
+ skipcloseparen();
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_upcase(ex)
+ Expr *ex;
+ {
+ return makeexpr_bicall_1("toupper", tp_char, grabarg(ex, 0));
+ }
+
+
+
+ Static Expr *func_upper()
+ {
+ Expr *ex;
+ Value val;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_integer);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ val = p_constant(tp_integer);
+ if (!val.type || val.i != 1)
+ note("UPPER(v,n) not supported for n>1 [190]");
+ }
+ skipcloseparen();
+ return copyexpr(ex->val.type->indextype->smax);
+ }
+
+
+
+ Static Expr *func_uxor()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_unsigned);
+ if (skipcomma()) {
+ ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, p_expr(tp_unsigned));
+ skipcloseparen();
+ }
+ return ex;
+ }
+
+
+
+ Static Expr *func_val_modula()
+ {
+ Expr *ex;
+ Type *tp;
+
+ if (!skipopenparen())
+ return NULL;
+ tp = p_type(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(tp);
+ skipcloseparen();
+ return pascaltypecast(tp, ex);
+ }
+
+
+
+ Static Stmt *proc_val_turbo()
+ {
+ Expr *ex, *vex, *code, *fmt;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = gentle_cast(p_expr(tp_str255), tp_str255);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (curtok == TOK_COMMA) {
+ gettok();
+ code = gentle_cast(p_expr(tp_integer), tp_integer);
+ } else
+ code = NULL;
+ skipcloseparen();
+ if (vex->val.type->kind == TK_REAL)
+ fmt = makeexpr_string("%lg");
+ else if (exprlongness(vex) > 0)
+ fmt = makeexpr_string("%ld");
+ else
+ fmt = makeexpr_string("%d");
+ ex = makeexpr_bicall_3("sscanf", tp_int,
+ ex, fmt, makeexpr_addr(vex));
+ if (code) {
+ ex = makeexpr_rel(EK_EQ, ex, makeexpr_long(0));
+ return makestmt_assign(code, makeexpr_ord(ex));
+ } else
+ return makestmt_call(ex);
+ }
+
+
+
+
+
+
+
+ Static Expr *writestrelement(ex, wid, vex, code, needboth)
+ Expr *ex, *wid, *vex;
+ int code, needboth;
+ {
+ if (formatstrings && needboth) {
+ return makeexpr_bicall_5("sprintf", tp_str255, vex,
+ makeexpr_string(format_d("%%*.*%c", code)),
+ copyexpr(wid),
+ wid,
+ ex);
+ } else {
+ return makeexpr_bicall_4("sprintf", tp_str255, vex,
+ makeexpr_string(format_d("%%*%c", code)),
+ wid,
+ ex);
+ }
+ }
+
+
+
+ Static char *makeenumnames(tp)
+ Type *tp;
+ {
+ Strlist *sp;
+ char *name;
+ Meaning *mp;
+ int saveindent;
+
+ for (sp = enumnames; sp && sp->value != (long)tp; sp = sp->next) ;
+ if (!sp) {
+ if (tp->meaning)
+ name = format_s(name_ENUM, tp->meaning->name);
+ else
+ name = format_s(name_ENUM, format_d("_%d", ++enumnamecount));
+ sp = strlist_insert(&enumnames, name);
+ sp->value = (long)tp;
+ outsection(2);
+ output(format_s("static %s *", charname));
+ output(sp->s);
+ output("[] = {\n");
+ saveindent = outindent;
+ moreindent(tabsize);
+ moreindent(structinitindent);
+ for (mp = tp->fbase; mp; mp = mp->xnext) {
+ output(makeCstring(mp->sym->name, strlen(mp->sym->name)));
+ if (mp->xnext)
+ output(",\002 ");
+ }
+ outindent = saveindent;
+ output("\n} ;\n");
+ outsection(2);
+ }
+ return sp->s;
+ }
+
+
+
+
+
+ /* This function must return a "tempsprintf" */
+
+ Expr *writeelement(ex, wid, prec, base)
+ Expr *ex, *wid, *prec;
+ int base;
+ {
+ Expr *vex, *ex1, *ex2;
+ Meaning *tvar;
+ char *fmtcode;
+ Type *type;
+
+ ex = makeexpr_charcast(ex);
+ if (ex->val.type->kind == TK_POINTER) {
+ ex = makeexpr_hat(ex, 0); /* convert char *'s to strings */
+ intwarning("writeelement", "got a char * instead of a string [214]");
+ }
+ if ((ex->val.type->kind == TK_STRING && !wid) ||
+ (ord_type(ex->val.type)->kind == TK_CHAR && (!wid || checkconst(wid, 1)))) {
+ return makeexpr_sprintfify(ex);
+ }
+ tvar = makestmttempvar(tp_str255, name_STRING);
+ vex = makeexpr_var(tvar);
+ if (wid)
+ wid = makeexpr_longcast(wid, 0);
+ if (prec)
+ prec = makeexpr_longcast(prec, 0);
+ #if 0
+ if (wid && (wid->kind == EK_CONST && wid->val.i < 0 ||
+ checkconst(wid, -1))) {
+ freeexpr(wid); /* P-system uses write(x:-1) to mean write(x) */
+ wid = NULL;
+ }
+ if (prec && (prec->kind == EK_CONST && prec->val.i < 0 ||
+ checkconst(prec, -1))) {
+ freeexpr(prec);
+ prec = NULL;
+ }
+ #endif
+ switch (ord_type(ex->val.type)->kind) {
+
+ case TK_INTEGER:
+ if (!wid) {
+ if (integerwidth < 0)
+ integerwidth = (which_lang == LANG_TURBO) ? 1 : 12;
+ wid = makeexpr_long(integerwidth);
+ }
+ type = findbasetype(ex->val.type, ODECL_NOPRES);
+ if (base == 16)
+ fmtcode = "x";
+ else if (base == 8)
+ fmtcode = "o";
+ else if ((possiblesigns(wid) & (1|4)) == 1) {
+ wid = makeexpr_neg(wid);
+ fmtcode = "x";
+ } else if (type == tp_unsigned ||
+ type == tp_uint ||
+ (type == tp_ushort && sizeof_int < 32))
+ fmtcode = "u";
+ else
+ fmtcode = "d";
+ ex = makeexpr_forcelongness(ex);
+ if (checkconst(wid, 0) || checkconst(wid, 1)) {
+ ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ makeexpr_string(format_ss("%%%s%s",
+ (exprlongness(ex) > 0) ? "l" : "",
+ fmtcode)),
+ ex);
+ } else {
+ ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ makeexpr_string(format_ss("%%*%s%s",
+ (exprlongness(ex) > 0) ? "l" : "",
+ fmtcode)),
+ wid,
+ ex);
+ }
+ break;
+
+ case TK_CHAR:
+ ex = writestrelement(ex, wid, vex, 'c',
+ (wid->kind != EK_CONST || wid->val.i < 1));
+ break;
+
+ case TK_BOOLEAN:
+ if (!wid) {
+ ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ makeexpr_string("%s"),
+ makeexpr_cond(ex,
+ makeexpr_string(" TRUE"),
+ makeexpr_string("FALSE")));
+ } else if (checkconst(wid, 1)) {
+ ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ makeexpr_string("%c"),
+ makeexpr_cond(ex,
+ makeexpr_char('T'),
+ makeexpr_char('F')));
+ } else {
+ ex = writestrelement(makeexpr_cond(ex,
+ makeexpr_string("TRUE"),
+ makeexpr_string("FALSE")),
+ wid, vex, 's',
+ (wid->kind != EK_CONST || wid->val.i < 5));
+ }
+ break;
+
+ case TK_ENUM:
+ ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ makeexpr_string("%s"),
+ makeexpr_index(makeexpr_name(makeenumnames(ex->val.type),
+ tp_strptr),
+ ex, NULL));
+ break;
+
+ case TK_REAL:
+ if (!wid)
+ wid = makeexpr_long(realwidth);
+ if (prec && (possiblesigns(prec) & (1|4)) != 1) {
+ ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
+ makeexpr_string("%*.*f"),
+ wid,
+ prec,
+ ex);
+ } else {
+ if (prec)
+ prec = makeexpr_neg(prec);
+ else
+ prec = makeexpr_minus(copyexpr(wid),
+ makeexpr_long(7));
+ if (prec->kind == EK_CONST) {
+ if (prec->val.i <= 0)
+ prec = makeexpr_long(1);
+ } else {
+ prec = makeexpr_bicall_2("P_max", tp_integer, prec,
+ makeexpr_long(1));
+ }
+ if (wid->kind == EK_CONST && wid->val.i > 21) {
+ ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
+ makeexpr_string("%*.*E"),
+ wid,
+ prec,
+ ex);
+ #if 0
+ } else if (checkconst(wid, 7)) {
+ ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
+ makeexpr_string("%E"),
+ ex);
+ #endif
+ } else {
+ ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ makeexpr_string("% .*E"),
+ prec,
+ ex);
+ }
+ }
+ break;
+
+ case TK_STRING:
+ ex = writestrelement(ex, wid, vex, 's', 1);
+ break;
+
+ case TK_ARRAY: /* assume packed array of char */
+ ord_range_expr(ex->val.type->indextype, &ex1, &ex2);
+ ex1 = makeexpr_plus(makeexpr_minus(copyexpr(ex2),
+ copyexpr(ex1)),
+ makeexpr_long(1));
+ ex1 = makeexpr_longcast(ex1, 0);
+ fmtcode = "%.*s";
+ if (!wid) {
+ wid = ex1;
+ } else {
+ if (isliteralconst(wid, NULL) == 2 &&
+ isliteralconst(ex1, NULL) == 2) {
+ if (wid->val.i > ex1->val.i) {
+ fmtcode = format_ds("%*s%%.*s",
+ wid->val.i - ex1->val.i, "");
+ wid = ex1;
+ }
+ } else
+ note("Format for packed-array-of-char will work only if width < length [321]");
+ }
+ ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
+ makeexpr_string(fmtcode),
+ wid,
+ makeexpr_addr(ex));
+ break;
+
+ default:
+ note("Element has wrong type for WRITE statement [196]");
+ ex = makeexpr_bicall_2("sprintf", tp_str255, vex, makeexpr_string("<meef>"));
+ break;
+
+ }
+ return ex;
+ }
+
+
+
+ Static Stmt *handlewrite_text(fex, ex, iswriteln)
+ Expr *fex, *ex;
+ int iswriteln;
+ {
+ Expr *print, *wid, *prec;
+ unsigned char *ucp;
+ int i, done, base;
+
+ print = NULL;
+ for (;;) {
+ wid = NULL;
+ prec = NULL;
+ base = 10;
+ if (curtok == TOK_COLON && iswriteln >= 0) {
+ gettok();
+ wid = p_expr(tp_integer);
+ if (curtok == TOK_COLON) {
+ gettok();
+ prec = p_expr(tp_integer);
+ }
+ }
+ if (curtok == TOK_IDENT &&
+ !strcicmp(curtokbuf, "OCT")) {
+ base = 8;
+ gettok();
+ } else if (curtok == TOK_IDENT &&
+ !strcicmp(curtokbuf, "HEX")) {
+ base = 16;
+ gettok();
+ }
+ ex = writeelement(ex, wid, prec, base);
+ print = makeexpr_concat(print, cleansprintf(ex), 1);
+ if (curtok == TOK_COMMA && iswriteln >= 0) {
+ gettok();
+ ex = p_expr(NULL);
+ } else
+ break;
+ }
+ if (fex->val.type->kind != TK_STRING) { /* not strwrite */
+ switch (iswriteln) {
+ case 1:
+ case -1:
+ print = makeexpr_concat(print, makeexpr_string("\n"), 1);
+ break;
+ case 2:
+ case -2:
+ print = makeexpr_concat(print, makeexpr_string("\r"), 1);
+ break;
+ }
+ if (isvar(fex, mp_output)) {
+ ucp = (unsigned char *)print->args[1]->val.s;
+ for (i = 0; i < print->args[1]->val.i; i++) {
+ if (ucp[i] >= 128 && ucp[i] < 144) {
+ note("WRITE statement contains color/attribute characters [203]");
+ break;
+ }
+ }
+ }
+ if ((i = sprintflength(print, 0)) > 0 && print->nargs == 2 && printfonly != 1) {
+ print = makeexpr_unsprintfify(print);
+ done = 1;
+ if (isvar(fex, mp_output)) {
+ if (i == 1) {
+ print = makeexpr_bicall_1("putchar", tp_int,
+ makeexpr_charcast(print));
+ } else {
+ if (printfonly == 0) {
+ if (print->val.s[print->val.i-1] == '\n') {
+ print->val.s[--(print->val.i)] = 0;
+ print = makeexpr_bicall_1("puts", tp_int, print);
+ } else {
+ print = makeexpr_bicall_2("fputs", tp_int,
+ print,
+ copyexpr(fex));
+ }
+ } else {
+ print = makeexpr_sprintfify(print);
+ done = 0;
+ }
+ }
+ } else {
+ if (i == 1) {
+ print = makeexpr_bicall_2("putc", tp_int,
+ makeexpr_charcast(print),
+ filebasename(copyexpr(fex)));
+ } else if (printfonly == 0) {
+ print = makeexpr_bicall_2("fputs", tp_int,
+ print,
+ filebasename(copyexpr(fex)));
+ } else {
+ print = makeexpr_sprintfify(print);
+ done = 0;
+ }
+ }
+ } else
+ done = 0;
+ if (!done) {
+ canceltempvar(istempvar(print->args[0]));
+ if (checkstring(print->args[1], "%s") && printfonly != 1) {
+ print = makeexpr_bicall_2("fputs", tp_int,
+ grabarg(print, 2),
+ filebasename(copyexpr(fex)));
+ } else if (checkstring(print->args[1], "%c") && printfonly != 1 &&
+ !nosideeffects(print->args[2], 0)) {
+ print = makeexpr_bicall_2("fputc", tp_int,
+ grabarg(print, 2),
+ filebasename(copyexpr(fex)));
+ } else if (isvar(fex, mp_output)) {
+ if (checkstring(print->args[1], "%s\n") && printfonly != 1) {
+ print = makeexpr_bicall_1("puts", tp_int, grabarg(print, 2));
+ } else if (checkstring(print->args[1], "%c") && printfonly != 1) {
+ print = makeexpr_bicall_1("putchar", tp_int, grabarg(print, 2));
+ } else {
+ strchange(&print->val.s, "printf");
+ delfreearg(&print, 0);
+ print->val.type = tp_int;
+ }
+ } else {
+ if (checkstring(print->args[1], "%c") && printfonly != 1) {
+ print = makeexpr_bicall_2("putc", tp_int,
+ grabarg(print, 2),
+ filebasename(copyexpr(fex)));
+ } else {
+ strchange(&print->val.s, "fprintf");
+ freeexpr(print->args[0]);
+ print->args[0] = filebasename(copyexpr(fex));
+ print->val.type = tp_int;
+ }
+ }
+ }
+ if (FCheck(checkfilewrite)) {
+ print = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_GE, print, makeexpr_long(0)),
+ makeexpr_name(filewriteerrorname, tp_int));
+ }
+ }
+ return makestmt_call(print);
+ }
+
+
+
+ Static Stmt *handlewrite_bin(fex, ex)
+ Expr *fex, *ex;
+ {
+ Type *basetype;
+ Stmt *sp;
+ Expr *tvardef = NULL;
+ Meaning *tvar = NULL;
+
+ sp = NULL;
+ basetype = filebasetype(fex->val.type);
+ for (;;) {
+ if (!expr_has_address(ex) || ex->val.type != basetype) {
+ if (!tvar)
+ tvar = makestmttempvar(basetype, name_TEMP);
+ if (!tvardef || !exprsame(tvardef, ex, 1)) {
+ freeexpr(tvardef);
+ tvardef = copyexpr(ex);
+ sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(tvar),
+ ex));
+ } else
+ freeexpr(ex);
+ ex = makeexpr_var(tvar);
+ }
+ ex = makeexpr_bicall_4("fwrite", tp_integer, makeexpr_addr(ex),
+ makeexpr_sizeof(makeexpr_type(basetype), 0),
+ makeexpr_long(1),
+ filebasename(copyexpr(fex)));
+ if (FCheck(checkfilewrite)) {
+ ex = makeexpr_bicall_2("~SETIO", tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ makeexpr_name(filewriteerrorname, tp_int));
+ }
+ sp = makestmt_seq(sp, makestmt_call(ex));
+ if (curtok == TOK_COMMA) {
+ gettok();
+ ex = p_expr(NULL);
+ } else
+ break;
+ }
+ freeexpr(tvardef);
+ return sp;
+ }
+
+
+
+ Static Stmt *proc_write()
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(NULL);
+ if (isfiletype(ex->val.type, -1) && wneedtok(TOK_COMMA)) {
+ fex = ex;
+ ex = p_expr(NULL);
+ } else {
+ fex = makeexpr_var(mp_output);
+ }
+ if (fex->val.type == tp_text || fex->val.type == tp_bigtext)
+ sp = handlewrite_text(fex, ex, 0);
+ else
+ sp = handlewrite_bin(fex, ex);
+ skipcloseparen();
+ return wrapopencheck(sp, fex);
+ }
+
+
+
+ Static Stmt *handle_modula_write(fmt)
+ char *fmt;
+ {
+ Expr *ex, *wid;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = makeexpr_forcelongness(p_expr(NULL));
+ if (skipcomma())
+ wid = p_expr(tp_integer);
+ else
+ wid = makeexpr_long(1);
+ if (checkconst(wid, 0) || checkconst(wid, 1))
+ ex = makeexpr_bicall_2("printf", tp_str255,
+ makeexpr_string(format_ss("%%%s%s",
+ (exprlongness(ex) > 0) ? "l" : "",
+ fmt)),
+ ex);
+ else
+ ex = makeexpr_bicall_3("printf", tp_str255,
+ makeexpr_string(format_ss("%%*%s%s",
+ (exprlongness(ex) > 0) ? "l" : "",
+ fmt)),
+ makeexpr_arglong(wid, 0),
+ ex);
+ skipcloseparen();
+ return makestmt_call(ex);
+ }
+
+
+ Static Stmt *proc_writecard()
+ {
+ return handle_modula_write("u");
+ }
+
+
+ Static Stmt *proc_writeint()
+ {
+ return handle_modula_write("d");
+ }
+
+
+ Static Stmt *proc_writehex()
+ {
+ return handle_modula_write("x");
+ }
+
+
+ Static Stmt *proc_writeoct()
+ {
+ return handle_modula_write("o");
+ }
+
+
+ Static Stmt *proc_writereal()
+ {
+ return handle_modula_write("f");
+ }
+
+
+
+ Static Stmt *proc_writedir()
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ ex = p_expr(tp_integer);
+ sp = doseek(fex, ex);
+ if (!skipcomma())
+ return sp;
+ sp = makestmt_seq(sp, handlewrite_bin(fex, p_expr(NULL)));
+ skipcloseparen();
+ return wrapopencheck(sp, fex);
+ }
+
+
+
+ Static Stmt *handlewriteln(iswriteln)
+ int iswriteln;
+ {
+ Expr *fex, *ex;
+ Stmt *sp;
+ Meaning *deffile = mp_output;
+
+ sp = NULL;
+ if (iswriteln == 3) {
+ iswriteln = 1;
+ if (messagestderr)
+ deffile = mp_stderr;
+ }
+ if (curtok != TOK_LPAR) {
+ fex = makeexpr_var(deffile);
+ if (iswriteln)
+ sp = handlewrite_text(fex, makeexpr_string(""), -iswriteln);
+ } else {
+ gettok();
+ ex = p_expr(NULL);
+ if (isfiletype(ex->val.type, -1)) {
+ fex = ex;
+ if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
+ if (iswriteln)
+ ex = makeexpr_string("");
+ else
+ ex = NULL;
+ } else {
+ ex = p_expr(NULL);
+ }
+ } else {
+ fex = makeexpr_var(deffile);
+ }
+ if (ex)
+ sp = handlewrite_text(fex, ex, iswriteln);
+ skipcloseparen();
+ }
+ if (iswriteln == 0) {
+ sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_1("fflush", tp_void,
+ filebasename(copyexpr(fex)))));
+ }
+ return wrapopencheck(sp, fex);
+ }
+
+
+
+ Static Stmt *proc_overprint()
+ {
+ return handlewriteln(2);
+ }
+
+
+
+ Static Stmt *proc_prompt()
+ {
+ return handlewriteln(0);
+ }
+
+
+
+ Static Stmt *proc_writeln()
+ {
+ return handlewriteln(1);
+ }
+
+
+ Static Stmt *proc_message()
+ {
+ return handlewriteln(3);
+ }
+
+
+
+ Static Stmt *proc_writev()
+ {
+ Expr *vex, *ex;
+ Stmt *sp;
+ Meaning *mp;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(tp_str255);
+ if (curtok == TOK_RPAR) {
+ gettok();
+ return makestmt_assign(vex, makeexpr_string(""));
+ }
+ if (!skipcomma())
+ return NULL;
+ sp = handlewrite_text(vex, p_expr(NULL), 0);
+ skipcloseparen();
+ ex = sp->exp1;
+ if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
+ (mp = istempvar(ex->args[0])) != NULL) {
+ canceltempvar(mp);
+ ex->args[0] = vex;
+ } else
+ sp->exp1 = makeexpr_assign(vex, ex);
+ return sp;
+ }
+
+
+ Static Stmt *proc_strwrite(mp_x, spbase)
+ Meaning *mp_x;
+ Stmt *spbase;
+ {
+ Expr *vex, *exi, *exj, *ex;
+ Stmt *sp;
+ Meaning *mp;
+
+ if (!skipopenparen())
+ return NULL;
+ vex = p_expr(tp_str255);
+ if (!skipcomma())
+ return NULL;
+ exi = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ exj = p_expr(tp_integer);
+ if (!skipcomma())
+ return NULL;
+ sp = handlewrite_text(vex, p_expr(NULL), 0);
+ skipcloseparen();
+ ex = sp->exp1;
+ FREE(sp);
+ if (checkconst(exi, 1)) {
+ sp = spbase;
+ while (sp && sp->next)
+ sp = sp->next;
+ if (sp && sp->kind == SK_ASSIGN && sp->exp1->kind == EK_ASSIGN &&
+ (sp->exp1->args[0]->kind == EK_HAT ||
+ sp->exp1->args[0]->kind == EK_INDEX) &&
+ exprsame(sp->exp1->args[0]->args[0], vex, 1) &&
+ checkconst(sp->exp1->args[1], 0)) {
+ nukestmt(sp); /* remove preceding bogus setstrlen */
+ }
+ }
+ if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
+ (mp = istempvar(ex->args[0])) != NULL) {
+ canceltempvar(mp);
+ ex->args[0] = bumpstring(copyexpr(vex), exi, 1);
+ sp = makestmt_call(ex);
+ } else
+ sp = makestmt_assign(bumpstring(copyexpr(vex), exi, 1), ex);
+ if (fullstrwrite != 0) {
+ sp = makestmt_seq(sp, makestmt_assign(exj,
+ makeexpr_plus(makeexpr_bicall_1("strlen", tp_int, vex),
+ makeexpr_long(1))));
+ if (fullstrwrite == 1)
+ note("FullStrWrite=1 not yet supported [204]");
+ if (fullstrwrite == 2)
+ note("STRWRITE was used [205]");
+ } else {
+ freeexpr(vex);
+ }
+ return mixassignments(sp, NULL);
+ }
+
+
+
+ Static Stmt *proc_str_turbo()
+ {
+ Expr *ex, *wid, *prec;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(NULL);
+ wid = NULL;
+ prec = NULL;
+ if (curtok == TOK_COLON) {
+ gettok();
+ wid = p_expr(tp_integer);
+ if (curtok == TOK_COLON) {
+ gettok();
+ prec = p_expr(tp_integer);
+ }
+ }
+ ex = writeelement(ex, wid, prec, 10);
+ if (!skipcomma())
+ return NULL;
+ wid = p_expr(tp_str255);
+ skipcloseparen();
+ return makestmt_assign(wid, ex);
+ }
+
+
+
+ Static Stmt *proc_time()
+ {
+ Expr *ex;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(tp_str255);
+ skipcloseparen();
+ return makestmt_call(makeexpr_bicall_1("VAXtime", tp_integer, ex));
+ }
+
+
+ Static Expr *func_xor()
+ {
+ Expr *ex, *ex2;
+ Type *type;
+ Meaning *tvar;
+
+ if (!skipopenparen())
+ return NULL;
+ ex = p_expr(NULL);
+ if (!skipcomma())
+ return ex;
+ ex2 = p_expr(ex->val.type);
+ skipcloseparen();
+ if (ex->val.type->kind != TK_SET &&
+ ex->val.type->kind != TK_SMALLSET) {
+ ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
+ } else {
+ type = mixsets(&ex, &ex2);
+ tvar = makestmttempvar(type, name_SET);
+ ex = makeexpr_bicall_3(setxorname, type,
+ makeexpr_var(tvar),
+ ex, ex2);
+ }
+ return ex;
+ }
+
+
+
+
+
+
+
+ void decl_builtins()
+ {
+ makespecialfunc( "ABS", func_abs);
+ makespecialfunc( "ADDR", func_addr);
+ if (!modula2)
+ makespecialfunc( "ADDRESS", func_addr);
+ makespecialfunc( "ADDTOPOINTER", func_addtopointer);
+ makespecialfunc( "ADR", func_addr);
+ makespecialfunc( "ASL", func_lsl);
+ makespecialfunc( "ASR", func_asr);
+ makespecialfunc( "BADDRESS", func_iaddress);
+ makespecialfunc( "BAND", func_uand);
+ makespecialfunc( "BIN", func_bin);
+ makespecialfunc( "BITNEXT", func_bitnext);
+ makespecialfunc( "BITSIZE", func_bitsize);
+ makespecialfunc( "BITSIZEOF", func_bitsize);
+ mp_blockread_ucsd =
+ makespecialfunc( "BLOCKREAD", func_blockread);
+ mp_blockwrite_ucsd =
+ makespecialfunc( "BLOCKWRITE", func_blockwrite);
+ makespecialfunc( "BNOT", func_unot);
+ makespecialfunc( "BOR", func_uor);
+ makespecialfunc( "BSL", func_bsl);
+ makespecialfunc( "BSR", func_bsr);
+ makespecialfunc( "BTST", func_btst);
+ makespecialfunc( "BXOR", func_uxor);
+ makespecialfunc( "BYTEREAD", func_byteread);
+ makespecialfunc( "BYTEWRITE", func_bytewrite);
+ makespecialfunc( "BYTE_OFFSET", func_byte_offset);
+ makespecialfunc( "CHR", func_chr);
+ makespecialfunc( "CONCAT", func_concat);
+ makespecialfunc( "DBLE", func_float);
+ mp_dec_dec =
+ makespecialfunc( "DEC", func_dec);
+ makespecialfunc( "EOF", func_eof);
+ makespecialfunc( "EOLN", func_eoln);
+ makespecialfunc( "FCALL", func_fcall);
+ makespecialfunc( "FILEPOS", func_filepos);
+ makespecialfunc( "FILESIZE", func_filesize);
+ makespecialfunc( "FLOAT", func_float);
+ makespecialfunc( "HEX", func_hex);
+ makespecialfunc( "HI", func_hi);
+ makespecialfunc( "HIWORD", func_hiword);
+ makespecialfunc( "HIWRD", func_hiword);
+ makespecialfunc( "HIGH", func_high);
+ makespecialfunc( "IADDRESS", func_iaddress);
+ makespecialfunc( "INT", func_int);
+ makespecialfunc( "LAND", func_uand);
+ makespecialfunc( "LNOT", func_unot);
+ makespecialfunc( "LO", func_lo);
+ makespecialfunc( "LOOPHOLE", func_loophole);
+ makespecialfunc( "LOR", func_uor);
+ makespecialfunc( "LOWER", func_lower);
+ makespecialfunc( "LOWORD", func_loword);
+ makespecialfunc( "LOWRD", func_loword);
+ makespecialfunc( "LSL", func_lsl);
+ makespecialfunc( "LSR", func_lsr);
+ makespecialfunc( "MAX", func_max);
+ makespecialfunc( "MAXPOS", func_maxpos);
+ makespecialfunc( "MIN", func_min);
+ makespecialfunc( "NEXT", func_sizeof);
+ makespecialfunc( "OCT", func_oct);
+ makespecialfunc( "ORD", func_ord);
+ makespecialfunc( "ORD4", func_ord4);
+ makespecialfunc( "PI", func_pi);
+ makespecialfunc( "POSITION", func_position);
+ makespecialfunc( "PRED", func_pred);
+ makespecialfunc( "QUAD", func_float);
+ makespecialfunc( "RANDOM", func_random);
+ makespecialfunc( "REF", func_addr);
+ makespecialfunc( "SCAN", func_scan);
+ makespecialfunc( "SEEKEOF", func_seekeof);
+ makespecialfunc( "SEEKEOLN", func_seekeoln);
+ makespecialfunc( "SIZE", func_sizeof);
+ makespecialfunc( "SIZEOF", func_sizeof);
+ makespecialfunc( "SNGL", func_sngl);
+ makespecialfunc( "SQR", func_sqr);
+ makespecialfunc( "STATUSV", func_statusv);
+ makespecialfunc( "SUCC", func_succ);
+ makespecialfunc( "TSIZE", func_sizeof);
+ makespecialfunc( "UAND", func_uand);
+ makespecialfunc( "UDEC", func_udec);
+ makespecialfunc( "UINT", func_uint);
+ makespecialfunc( "UNOT", func_unot);
+ makespecialfunc( "UOR", func_uor);
+ makespecialfunc( "UPPER", func_upper);
+ makespecialfunc( "UXOR", func_uxor);
+ mp_val_modula =
+ makespecialfunc( "VAL", func_val_modula);
+ makespecialfunc( "WADDRESS", func_iaddress);
+ makespecialfunc( "XOR", func_xor);
+
+ makestandardfunc("ARCTAN", func_arctan);
+ makestandardfunc("ARCTANH", func_arctanh);
+ makestandardfunc("BINARY", func_binary);
+ makestandardfunc("CAP", func_upcase);
+ makestandardfunc("COPY", func_copy);
+ makestandardfunc("COS", func_cos);
+ makestandardfunc("COSH", func_cosh);
+ makestandardfunc("EXP", func_exp);
+ makestandardfunc("EXP10", func_pwroften);
+ makestandardfunc("EXPO", func_expo);
+ makestandardfunc("FRAC", func_frac);
+ makestandardfunc("INDEX", func_strpos);
+ makestandardfunc("LASTPOS", NULL);
+ makestandardfunc("LINEPOS", NULL);
+ makestandardfunc("LENGTH", func_strlen);
+ makestandardfunc("LN", func_ln);
+ makestandardfunc("LOG", func_log);
+ makestandardfunc("LOG10", func_log);
+ makestandardfunc("MAXAVAIL", func_maxavail);
+ makestandardfunc("MEMAVAIL", func_memavail);
+ makestandardfunc("OCTAL", func_octal);
+ makestandardfunc("ODD", func_odd);
+ makestandardfunc("PAD", func_pad);
+ makestandardfunc("PARAMCOUNT", func_paramcount);
+ makestandardfunc("PARAMSTR", func_paramstr);
+ makestandardfunc("POS", func_pos);
+ makestandardfunc("PTR", func_ptr);
+ makestandardfunc("PWROFTEN", func_pwroften);
+ makestandardfunc("ROUND", func_round);
+ makestandardfunc("SCANEQ", func_scaneq);
+ makestandardfunc("SCANNE", func_scanne);
+ makestandardfunc("SIN", func_sin);
+ makestandardfunc("SINH", func_sinh);
+ makestandardfunc("SQRT", func_sqrt);
+ mp_str_hp =
+ makestandardfunc("STR", func_str_hp);
+ makestandardfunc("STRLEN", func_strlen);
+ makestandardfunc("STRLTRIM", func_strltrim);
+ makestandardfunc("STRMAX", func_strmax);
+ makestandardfunc("STRPOS", func_strpos);
+ makestandardfunc("STRRPT", func_strrpt);
+ makestandardfunc("STRRTRIM", func_strrtrim);
+ makestandardfunc("SUBSTR", func_str_hp);
+ makestandardfunc("SWAP", func_swap);
+ makestandardfunc("TAN", func_tan);
+ makestandardfunc("TANH", func_tanh);
+ makestandardfunc("TRUNC", func_trunc);
+ makestandardfunc("UPCASE", func_upcase);
+ makestandardfunc("UROUND", func_uround);
+ makestandardfunc("UTRUNC", func_utrunc);
+
+ makespecialproc( "APPEND", proc_append);
+ makespecialproc( "ARGV", proc_argv);
+ makespecialproc( "ASSERT", proc_assert);
+ makespecialproc( "ASSIGN", proc_assign);
+ makespecialproc( "BCLR", proc_bclr);
+ mp_blockread_turbo =
+ makespecialproc( "BLOCKREAD_TURBO", proc_blockread);
+ mp_blockwrite_turbo =
+ makespecialproc( "BLOCKWRITE_TURBO", proc_blockwrite);
+ makespecialproc( "BREAK", proc_flush);
+ makespecialproc( "BSET", proc_bset);
+ makespecialproc( "CALL", proc_call);
+ makespecialproc( "CLOSE", proc_close);
+ makespecialproc( "CONNECT", proc_assign);
+ makespecialproc( "CYCLE", proc_cycle);
+ makespecialproc( "DATE", proc_date);
+ mp_dec_turbo =
+ makespecialproc( "DEC_TURBO", proc_dec);
+ makespecialproc( "DISPOSE", proc_dispose);
+ makespecialproc( "ESCAPE", proc_escape);
+ makespecialproc( "EXCL", proc_excl);
+ makespecialproc( "EXIT", proc_exit);
+ makespecialproc( "FILLCHAR", proc_fillchar);
+ makespecialproc( "FLUSH", proc_flush);
+ makespecialproc( "GET", proc_get);
+ makespecialproc( "HALT", proc_escape);
+ makespecialproc( "INC", proc_inc);
+ makespecialproc( "INCL", proc_incl);
+ makespecialproc( "LEAVE", proc_leave);
+ makespecialproc( "LOCATE", proc_seek);
+ makespecialproc( "MESSAGE", proc_message);
+ makespecialproc( "MOVE_FAST", proc_move_fast);
+ makespecialproc( "MOVE_L_TO_R", proc_move_fast);
+ makespecialproc( "MOVE_R_TO_L", proc_move_fast);
+ makespecialproc( "NEW", proc_new);
+ if (which_lang != LANG_VAX)
+ makespecialproc( "OPEN", proc_open);
+ makespecialproc( "OVERPRINT", proc_overprint);
+ makespecialproc( "PACK", proc_pack);
+ makespecialproc( "PAGE", proc_page);
+ makespecialproc( "PUT", proc_put);
+ makespecialproc( "PROMPT", proc_prompt);
+ makespecialproc( "RANDOMIZE", proc_randomize);
+ makespecialproc( "READ", proc_read);
+ makespecialproc( "READDIR", proc_readdir);
+ makespecialproc( "READLN", proc_readln);
+ makespecialproc( "READV", proc_readv);
+ makespecialproc( "RESET", proc_reset);
+ makespecialproc( "REWRITE", proc_rewrite);
+ makespecialproc( "SEEK", proc_seek);
+ makespecialproc( "SETSTRLEN", proc_setstrlen);
+ makespecialproc( "SETTEXTBUF", proc_settextbuf);
+ mp_str_turbo =
+ makespecialproc( "STR_TURBO", proc_str_turbo);
+ makespecialproc( "STRAPPEND", proc_strappend);
+ makespecialproc( "STRDELETE", proc_strdelete);
+ makespecialproc( "STRINSERT", proc_strinsert);
+ makespecialproc( "STRMOVE", proc_strmove);
+ makespecialproc( "STRREAD", proc_strread);
+ makespecialproc( "STRWRITE", proc_strwrite);
+ makespecialproc( "TIME", proc_time);
+ makespecialproc( "UNPACK", proc_unpack);
+ makespecialproc( "WRITE", proc_write);
+ makespecialproc( "WRITEDIR", proc_writedir);
+ makespecialproc( "WRITELN", proc_writeln);
+ makespecialproc( "WRITEV", proc_writev);
+ mp_val_turbo =
+ makespecialproc( "VAL_TURBO", proc_val_turbo);
+
+ makestandardproc("DELETE", proc_delete);
+ makestandardproc("FREEMEM", proc_freemem);
+ makestandardproc("GETMEM", proc_getmem);
+ makestandardproc("GOTOXY", proc_gotoxy);
+ makestandardproc("INSERT", proc_insert);
+ makestandardproc("MARK", NULL);
+ makestandardproc("MOVE", proc_move);
+ makestandardproc("MOVELEFT", proc_move);
+ makestandardproc("MOVERIGHT", proc_move);
+ makestandardproc("RELEASE", NULL);
+
+ makespecialvar( "MEM", var_mem);
+ makespecialvar( "MEMW", var_memw);
+ makespecialvar( "MEML", var_meml);
+ makespecialvar( "PORT", var_port);
+ makespecialvar( "PORTW", var_portw);
+
+ /* Modula-2 standard I/O procedures (case-sensitive!) */
+ makespecialproc( "Read", proc_read);
+ makespecialproc( "ReadCard", proc_read);
+ makespecialproc( "ReadInt", proc_read);
+ makespecialproc( "ReadReal", proc_read);
+ makespecialproc( "ReadString", proc_read);
+ makespecialproc( "Write", proc_write);
+ makespecialproc( "WriteCard", proc_writecard);
+ makespecialproc( "WriteHex", proc_writehex);
+ makespecialproc( "WriteInt", proc_writeint);
+ makespecialproc( "WriteOct", proc_writeoct);
+ makespecialproc( "WriteLn", proc_writeln);
+ makespecialproc( "WriteReal", proc_writereal);
+ makespecialproc( "WriteString", proc_write);
+ }
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/hpmods.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/hpmods.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/hpmods.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,140 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_HPMODS_C
+ #include "trans.h"
+
+
+
+
+
+ /* FS functions */
+
+
+ Static Stmt *proc_freadbytes()
+ {
+ Expr *ex, *ex2, *vex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ type = vex->val.type;
+ ex = makeexpr_bicall_4("fread", tp_integer,
+ makeexpr_addr(vex),
+ convert_size(type, ex2, "FREADBYTES"),
+ makeexpr_long(1),
+ filebasename(copyexpr(fex)));
+ if (checkeof(fex)) {
+ ex = makeexpr_bicall_2(name_SETIO, tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ makeexpr_long(30));
+ }
+ return wrapopencheck(makestmt_call(ex), fex);
+ }
+
+
+
+
+ Static Stmt *proc_fwritebytes()
+ {
+ Expr *ex, *ex2, *vex, *fex;
+ Type *type;
+
+ if (!skipopenparen())
+ return NULL;
+ fex = p_expr(tp_text);
+ if (!skipcomma())
+ return NULL;
+ vex = p_expr(NULL);
+ if (!skipcomma())
+ return NULL;
+ ex2 = p_expr(tp_integer);
+ skipcloseparen();
+ type = vex->val.type;
+ ex = makeexpr_bicall_4("fwrite", tp_integer,
+ makeexpr_addr(vex),
+ convert_size(type, ex2, "FWRITEBYTES"),
+ makeexpr_long(1),
+ filebasename(copyexpr(fex)));
+ if (checkfilewrite) {
+ ex = makeexpr_bicall_2(name_SETIO, tp_void,
+ makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
+ makeexpr_long(3));
+ }
+ return wrapopencheck(makestmt_call(ex), fex);
+ }
+
+
+
+
+
+
+
+
+
+
+ /* SYSGLOBALS */
+
+
+ Static void setup_sysglobals()
+ {
+ Symbol *sym;
+
+ sym = findsymbol("SYSESCAPECODE");
+ if (sym->mbase)
+ strchange(&sym->mbase->name, name_ESCAPECODE);
+ sym = findsymbol("SYSIORESULT");
+ if (sym->mbase)
+ strchange(&sym->mbase->name, name_IORESULT);
+ }
+
+
+
+
+
+
+
+
+ void hpmods(name, defn)
+ char *name;
+ int defn;
+ {
+ if (!strcmp(name, "FS")) {
+ makespecialproc("freadbytes", proc_freadbytes);
+ makespecialproc("fwritebytes", proc_fwritebytes);
+ } else if (!strcmp(name, "SYSGLOBALS")) {
+ setup_sysglobals();
+ }
+ }
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/lex.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/lex.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/lex.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,3421 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_LEX_C
+ #include "trans.h"
+
+
+ /* Define LEXDEBUG for a token trace */
+ #define LEXDEBUG
+
+
+
+
+ #define EOFMARK 1
+
+
+ Static char dollar_flag, lex_initialized;
+ Static int if_flag, if_skip;
+ Static int commenting_flag;
+ Static char *commenting_ptr;
+ Static int skipflag;
+ Static char modulenotation;
+ Static short inputkind;
+ Static Strlist *instrlist;
+ Static char inbuf[300];
+ Static char *oldinfname, *oldctxname;
+ Static Strlist *endnotelist;
+
+
+
+ #define INP_FILE 0
+ #define INP_INCFILE 1
+ #define INP_STRLIST 2
+
+ Static struct inprec {
+ struct inprec *next;
+ short kind;
+ char *fname, *inbufptr;
+ int lnum;
+ FILE *filep;
+ Strlist *strlistp, *tempopts;
+ Token curtok, saveblockkind;
+ Symbol *curtoksym;
+ Meaning *curtokmeaning;
+ char *curtokbuf, *curtokcase;
+ } *topinput;
+
+
+
+
+
+
+ char *fixpascalname(name)
+ char *name;
+ {
+ char *cp, *cp2;
+
+ if (pascalsignif > 0) {
+ name = format_ds("%.*s", pascalsignif, name);
+ if (!pascalcasesens)
+ upc(name);
+ else if (pascalcasesens == 3)
+ lwc(name);
+ } else if (!pascalcasesens)
+ name = strupper(name);
+ else if (pascalcasesens == 3)
+ name = strlower(name);
+ if (ignorenonalpha) {
+ for (cp = cp2 = name; *cp; cp++)
+ if (isalnum(*cp))
+ *cp2++ = *cp;
+ }
+ return name;
+ }
+
+
+
+ Static void makekeyword(name)
+ char *name;
+ {
+ Symbol *sym;
+
+ if (*name) {
+ sym = findsymbol(name);
+ sym->flags |= AVOIDNAME;
+ }
+ }
+
+
+ Static void makeglobword(name)
+ char *name;
+ {
+ Symbol *sym;
+
+ if (*name) {
+ sym = findsymbol(name);
+ sym->flags |= AVOIDGLOB;
+ }
+ }
+
+
+
+ Static void makekeywords()
+ {
+ makekeyword("auto");
+ makekeyword("break");
+ makekeyword("char");
+ makekeyword("continue");
+ makekeyword("default");
+ makekeyword("defined"); /* is this one really necessary? */
+ makekeyword("double");
+ makekeyword("enum");
+ makekeyword("extern");
+ makekeyword("float");
+ makekeyword("int");
+ makekeyword("long");
+ makekeyword("noalias");
+ makekeyword("register");
+ makekeyword("return");
+ makekeyword("short");
+ makekeyword("signed");
+ makekeyword("sizeof");
+ makekeyword("static");
+ makekeyword("struct");
+ makekeyword("switch");
+ makekeyword("typedef");
+ makekeyword("union");
+ makekeyword("unsigned");
+ makekeyword("void");
+ makekeyword("volatile");
+ makekeyword("asm");
+ makekeyword("fortran");
+ makekeyword("entry");
+ makekeyword("pascal");
+ if (cplus != 0) {
+ makekeyword("class");
+ makekeyword("delete");
+ makekeyword("friend");
+ makekeyword("inline");
+ makekeyword("new");
+ makekeyword("operator");
+ makekeyword("overload");
+ makekeyword("public");
+ makekeyword("this");
+ makekeyword("virtual");
+ }
+ makekeyword(name_UCHAR);
+ makekeyword(name_SCHAR); /* any others? */
+ makekeyword(name_BOOLEAN);
+ makekeyword(name_PROCEDURE);
+ makekeyword(name_ESCAPE);
+ makekeyword(name_ESCIO);
+ makekeyword(name_CHKIO);
+ makekeyword(name_SETIO);
+ makeglobword("main");
+ makeglobword("vextern"); /* used in generated .h files */
+ makeglobword("argc");
+ makeglobword("argv");
+ makekeyword("TRY");
+ makekeyword("RECOVER");
+ makekeyword("RECOVER2");
+ makekeyword("ENDTRY");
+ }
+
+
+
+ Static Symbol *Pkeyword(name, tok)
+ char *name;
+ Token tok;
+ {
+ Symbol *sp = NULL;
+
+ if (pascalcasesens != 2) {
+ sp = findsymbol(strlower(name));
+ sp->kwtok = tok;
+ }
+ if (pascalcasesens != 3) {
+ sp = findsymbol(strupper(name));
+ sp->kwtok = tok;
+ }
+ return sp;
+ }
+
+
+ Static Symbol *Pkeywordposs(name, tok)
+ char *name;
+ Token tok;
+ {
+ Symbol *sp = NULL;
+
+ if (pascalcasesens != 2) {
+ sp = findsymbol(strlower(name));
+ sp->kwtok = tok;
+ sp->flags |= KWPOSS;
+ }
+ if (pascalcasesens != 3) {
+ sp = findsymbol(strupper(name));
+ sp->kwtok = tok;
+ sp->flags |= KWPOSS;
+ }
+ return sp;
+ }
+
+
+ Static void makePascalwords()
+ {
+ Pkeyword("AND", TOK_AND);
+ Pkeyword("ARRAY", TOK_ARRAY);
+ Pkeywordposs("ANYVAR", TOK_ANYVAR);
+ Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
+ Pkeyword("BEGIN", TOK_BEGIN);
+ Pkeywordposs("BY", TOK_BY);
+ Pkeyword("CASE", TOK_CASE);
+ Pkeyword("CONST", TOK_CONST);
+ Pkeyword("DIV", TOK_DIV);
+ Pkeywordposs("DEFINITION", TOK_DEFINITION);
+ Pkeyword("DO", TOK_DO);
+ Pkeyword("DOWNTO", TOK_DOWNTO);
+ Pkeyword("ELSE", TOK_ELSE);
+ Pkeywordposs("ELSIF", TOK_ELSIF);
+ Pkeyword("END", TOK_END);
+ Pkeywordposs("EXPORT", TOK_EXPORT);
+ Pkeyword("FILE", TOK_FILE);
+ Pkeyword("FOR", TOK_FOR);
+ Pkeywordposs("FROM", TOK_FROM);
+ Pkeyword("FUNCTION", TOK_FUNCTION);
+ Pkeyword("GOTO", TOK_GOTO);
+ Pkeyword("IF", TOK_IF);
+ Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
+ Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
+ Pkeywordposs("IMPORT", TOK_IMPORT);
+ Pkeyword("IN", TOK_IN);
+ Pkeywordposs("INLINE", TOK_INLINE);
+ Pkeywordposs("INTERFACE", TOK_EXPORT);
+ Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
+ Pkeyword("LABEL", TOK_LABEL);
+ Pkeywordposs("LOOP", TOK_LOOP);
+ Pkeyword("MOD", TOK_MOD);
+ Pkeywordposs("MODULE", TOK_MODULE);
+ Pkeyword("NIL", TOK_NIL);
+ Pkeyword("NOT", TOK_NOT);
+ Pkeyword("OF", TOK_OF);
+ Pkeyword("OR", TOK_OR);
+ Pkeywordposs("ORIGIN", TOK_ORIGIN);
+ Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
+ Pkeywordposs("OVERLAY", TOK_SEGMENT);
+ Pkeyword("PACKED", TOK_PACKED);
+ Pkeywordposs("POINTER", TOK_POINTER);
+ Pkeyword("PROCEDURE", TOK_PROCEDURE);
+ Pkeyword("PROGRAM", TOK_PROGRAM);
+ Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
+ Pkeyword("RECORD", TOK_RECORD);
+ Pkeywordposs("RECOVER", TOK_RECOVER);
+ Pkeywordposs("REM", TOK_REM);
+ Pkeyword("REPEAT", TOK_REPEAT);
+ Pkeywordposs("RETURN", TOK_RETURN);
+ if (which_lang == LANG_UCSD)
+ Pkeyword("SEGMENT", TOK_SEGMENT);
+ else
+ Pkeywordposs("SEGMENT", TOK_SEGMENT);
+ Pkeyword("SET", TOK_SET);
+ Pkeywordposs("SHL", TOK_SHL);
+ Pkeywordposs("SHR", TOK_SHR);
+ Pkeyword("THEN", TOK_THEN);
+ Pkeyword("TO", TOK_TO);
+ Pkeywordposs("TRY", TOK_TRY);
+ Pkeyword("TYPE", TOK_TYPE);
+ Pkeyword("UNTIL", TOK_UNTIL);
+ Pkeywordposs("USES", TOK_IMPORT);
+ Pkeywordposs("UNIT", TOK_MODULE);
+ if (which_lang == LANG_VAX)
+ Pkeyword("VALUE", TOK_VALUE);
+ else
+ Pkeywordposs("VALUE", TOK_VALUE);
+ Pkeyword("VAR", TOK_VAR);
+ Pkeywordposs("VARYING", TOK_VARYING);
+ Pkeyword("WHILE", TOK_WHILE);
+ Pkeyword("WITH", TOK_WITH);
+ Pkeywordposs("XOR", TOK_XOR);
+ Pkeyword("__MODULE", TOK_MODULE);
+ Pkeyword("__IMPORT", TOK_IMPORT);
+ Pkeyword("__EXPORT", TOK_EXPORT);
+ Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
+ }
+
+
+
+ Static void deterministic(name)
+ char *name;
+ {
+ Symbol *sym;
+
+ if (*name) {
+ sym = findsymbol(name);
+ sym->flags |= DETERMF;
+ }
+ }
+
+
+ Static void nosideeff(name)
+ char *name;
+ {
+ Symbol *sym;
+
+ if (*name) {
+ sym = findsymbol(name);
+ sym->flags |= NOSIDEEFF;
+ }
+ }
+
+
+
+ Static void recordsideeffects()
+ {
+ deterministic("abs");
+ deterministic("acos");
+ deterministic("asin");
+ deterministic("atan");
+ deterministic("atan2");
+ deterministic("atof");
+ deterministic("atoi");
+ deterministic("atol");
+ deterministic("ceil");
+ deterministic("cos");
+ deterministic("cosh");
+ deterministic("exp");
+ deterministic("fabs");
+ deterministic("feof");
+ deterministic("feoln");
+ deterministic("ferror");
+ deterministic("floor");
+ deterministic("fmod");
+ deterministic("ftell");
+ deterministic("isalnum");
+ deterministic("isalpha");
+ deterministic("isdigit");
+ deterministic("islower");
+ deterministic("isspace");
+ deterministic("isupper");
+ deterministic("labs");
+ deterministic("ldexp");
+ deterministic("log");
+ deterministic("log10");
+ deterministic("memcmp");
+ deterministic("memchr");
+ deterministic("pow");
+ deterministic("sin");
+ deterministic("sinh");
+ deterministic("sqrt");
+ deterministic("strchr");
+ deterministic("strcmp");
+ deterministic("strcspn");
+ deterministic("strlen");
+ deterministic("strncmp");
+ deterministic("strpbrk");
+ deterministic("strrchr");
+ deterministic("strspn");
+ deterministic("strstr");
+ deterministic("tan");
+ deterministic("tanh");
+ deterministic("tolower");
+ deterministic("toupper");
+ deterministic(setequalname);
+ deterministic(subsetname);
+ deterministic(signextname);
+ }
+
+
+
+
+
+ void init_lex()
+ {
+ int i;
+
+ inputkind = INP_FILE;
+ inf_lnum = 0;
+ inf_ltotal = 0;
+ *inbuf = 0;
+ inbufptr = inbuf;
+ keepingstrlist = NULL;
+ tempoptionlist = NULL;
+ switch_strpos = 0;
+ dollar_flag = 0;
+ if_flag = 0;
+ if_skip = 0;
+ commenting_flag = 0;
+ skipflag = 0;
+ inbufindent = 0;
+ modulenotation = 1;
+ notephase = 0;
+ endnotelist = NULL;
+ for (i = 0; i < SYMHASHSIZE; i++)
+ symtab[i] = 0;
+ C_lex = 0;
+ lex_initialized = 0;
+ }
+
+
+ void setup_lex()
+ {
+ lex_initialized = 1;
+ if (!strcmp(language, "MODCAL"))
+ sysprog_flag = 2;
+ else
+ sysprog_flag = 0;
+ if (shortcircuit < 0)
+ partial_eval_flag = (which_lang == LANG_TURBO ||
+ which_lang == LANG_VAX ||
+ which_lang == LANG_OREGON ||
+ modula2 ||
+ hpux_lang);
+ else
+ partial_eval_flag = shortcircuit;
+ iocheck_flag = 1;
+ range_flag = 1;
+ ovflcheck_flag = 1;
+ stackcheck_flag = 1;
+ fixedflag = 0;
+ withlevel = 0;
+ makekeywords();
+ makePascalwords();
+ recordsideeffects();
+ topinput = 0;
+ ignore_directives = 0;
+ skipping_module = 0;
+ blockkind = TOK_END;
+ gettok();
+ }
+
+
+
+
+ int checkeatnote(msg)
+ char *msg;
+ {
+ Strlist *lp;
+ char *cp;
+ int len;
+
+ for (lp = eatnotes; lp; lp = lp->next) {
+ if (!strcmp(lp->s, "1")) {
+ echoword("[*]", 0);
+ return 1;
+ }
+ if (!strcmp(lp->s, "0"))
+ return 0;
+ len = strlen(lp->s);
+ cp = msg;
+ while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
+ cp++;
+ if (*cp) {
+ cp = lp->s;
+ if (*cp != '[')
+ cp = format_s("[%s", cp);
+ if (cp[strlen(cp)-1] != ']')
+ cp = format_s("%s]", cp);
+ echoword(cp, 0);
+ return 1;
+ }
+ }
+ return 0;
+ }
+
+
+
+ void beginerror()
+ {
+ end_source();
+ if (showprogress) {
+ fprintf(stderr, "\r%60s\r", "");
+ clearprogress();
+ } else
+ echobreak();
+ }
+
+
+ void counterror()
+ {
+ if (maxerrors > 0) {
+ if (--maxerrors == 0) {
+ fprintf(outf, "\n/* Translation aborted: Too many errors. */\n");
+ fprintf(outf, "-------------------------------------------\n");
+ if (outf != stdout)
+ printf("Translation aborted: Too many errors.\n");
+ if (verbose)
+ fprintf(logf, "Translation aborted: Too many errors.\n");
+ closelogfile();
+ exit(EXIT_FAILURE);
+ }
+ }
+ }
+
+
+ void error(msg) /* does not return */
+ char *msg;
+ {
+ flushcomments(NULL, -1, -1);
+ beginerror();
+ fprintf(outf, "/* %s, line %d: %s */\n", infname, inf_lnum, msg);
+ fprintf(outf, "/* Translation aborted. */\n");
+ fprintf(outf, "--------------------------\n");
+ if (outf != stdout) {
+ printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
+ printf("Translation aborted.\n");
+ }
+ if (verbose) {
+ fprintf(logf, "%s, line %d/%d: %s\n",
+ infname, inf_lnum, outf_lnum, msg);
+ fprintf(logf, "Translation aborted.\n");
+ }
+ closelogfile();
+ exit(EXIT_FAILURE);
+ }
+
+
+ void interror(proc, msg) /* does not return */
+ char *proc, *msg;
+ {
+ error(format_ss("Internal error in %s: %s", proc, msg));
+ }
+
+
+ void warning(msg)
+ char *msg;
+ {
+ if (checkeatnote(msg)) {
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Omitted warning: %s\n",
+ infname, inf_lnum, outf_lnum, msg);
+ return;
+ }
+ beginerror();
+ addnote(format_s("Warning: %s", msg), curserial);
+ counterror();
+ }
+
+
+ void intwarning(proc, msg)
+ char *proc, *msg;
+ {
+ if (checkeatnote(msg)) {
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Omitted internal error in %s: %s\n",
+ infname, inf_lnum, outf_lnum, proc, msg);
+ return;
+ }
+ beginerror();
+ addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
+ if (error_crash)
+ exit(EXIT_FAILURE);
+ counterror();
+ }
+
+
+
+
+ void note(msg)
+ char *msg;
+ {
+ if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Omitted note: %s\n",
+ infname, inf_lnum, outf_lnum, msg);
+ return;
+ }
+ beginerror();
+ addnote(format_s("Note: %s", msg), curserial);
+ counterror();
+ }
+
+
+
+ void endnote(msg)
+ char *msg;
+ {
+ if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Omitted end-note: %s\n",
+ infname, inf_lnum, outf_lnum, msg);
+ return;
+ }
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Recorded end-note: %s\n",
+ infname, inf_lnum, outf_lnum, msg);
+ (void) strlist_add(&endnotelist, msg);
+ }
+
+
+ void showendnotes()
+ {
+ while (initialcalls) {
+ if (initialcalls->value)
+ endnote(format_s("Remember to call %s in main program [215]",
+ initialcalls->s));
+ strlist_eat(&initialcalls);
+ }
+ if (endnotelist) {
+ end_source();
+ while (endnotelist) {
+ if (outf != stdout) {
+ beginerror();
+ printf("Note: %s\n", endnotelist->s);
+ }
+ fprintf(outf, "/* p2c: Note: %s */\n", endnotelist->s);
+ outf_lnum++;
+ strlist_eat(&endnotelist);
+ }
+ }
+ }
+
+
+
+
+
+
+
+ char *tok_name(tok)
+ Token tok;
+ {
+ if (tok == TOK_END && inputkind == INP_STRLIST)
+ return "end of macro";
+ if (tok == curtok && tok == TOK_IDENT)
+ return format_s("'%s'", curtokcase);
+ if (!modulenotation) {
+ switch (tok) {
+ case TOK_MODULE: return "UNIT";
+ case TOK_IMPORT: return "USES";
+ case TOK_EXPORT: return "INTERFACE";
+ case TOK_IMPLEMENT: return "IMPLEMENTATION";
+ default: break;
+ }
+ }
+ return toknames[(int) tok];
+ }
+
+
+
+ void expected(msg)
+ char *msg;
+ {
+ error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
+ }
+
+
+ void expecttok(tok)
+ Token tok;
+ {
+ if (curtok != tok)
+ expected(tok_name(tok));
+ }
+
+
+ void needtok(tok)
+ Token tok;
+ {
+ if (curtok != tok)
+ expected(tok_name(tok));
+ gettok();
+ }
+
+
+ int wexpected(msg)
+ char *msg;
+ {
+ warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
+ return 0;
+ }
+
+
+ int wexpecttok(tok)
+ Token tok;
+ {
+ if (curtok != tok)
+ return wexpected(tok_name(tok));
+ else
+ return 1;
+ }
+
+
+ int wneedtok(tok)
+ Token tok;
+ {
+ if (wexpecttok(tok)) {
+ gettok();
+ return 1;
+ } else
+ return 0;
+ }
+
+
+ void alreadydef(sym)
+ Symbol *sym;
+ {
+ warning(format_s("Symbol '%s' was already defined [220]", sym->name));
+ }
+
+
+ void undefsym(sym)
+ Symbol *sym;
+ {
+ warning(format_s("Symbol '%s' is not defined [221]", sym->name));
+ }
+
+
+ void symclass(sym)
+ Symbol *sym;
+ {
+ warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
+ }
+
+
+ void badtypes()
+ {
+ warning("Type mismatch [223]");
+ }
+
+
+ void valrange()
+ {
+ warning("Value range error [224]");
+ }
+
+
+
+ void skipparens()
+ {
+ Token begintok;
+
+ if (curtok == TOK_LPAR) {
+ gettok();
+ while (curtok != TOK_RPAR)
+ skipparens();
+ } else if (curtok == TOK_LBR) {
+ gettok();
+ while (curtok != TOK_RBR)
+ skipparens();
+ } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
+ curtok == TOK_CASE) {
+ begintok = curtok;
+ gettok();
+ while (curtok != TOK_END)
+ if (curtok == TOK_CASE && begintok == TOK_RECORD)
+ gettok();
+ else
+ skipparens();
+ }
+ gettok();
+ }
+
+
+ void skiptotoken2(tok1, tok2)
+ Token tok1, tok2;
+ {
+ while (curtok != tok1 && curtok != tok2 &&
+ curtok != TOK_END && curtok != TOK_RPAR &&
+ curtok != TOK_RBR && curtok != TOK_EOF)
+ skipparens();
+ }
+
+
+ void skippasttoken2(tok1, tok2)
+ Token tok1, tok2;
+ {
+ skiptotoken2(tok1, tok2);
+ if (curtok == tok1 || curtok == tok2)
+ gettok();
+ }
+
+
+ void skippasttotoken(tok1, tok2)
+ Token tok1, tok2;
+ {
+ skiptotoken2(tok1, tok2);
+ if (curtok == tok1)
+ gettok();
+ }
+
+
+ void skiptotoken(tok)
+ Token tok;
+ {
+ skiptotoken2(tok, tok);
+ }
+
+
+ void skippasttoken(tok)
+ Token tok;
+ {
+ skippasttoken2(tok, tok);
+ }
+
+
+
+ int skipopenparen()
+ {
+ if (wneedtok(TOK_LPAR))
+ return 1;
+ skiptotoken(TOK_SEMI);
+ return 0;
+ }
+
+
+ int skipcloseparen()
+ {
+ if (curtok == TOK_COMMA)
+ warning("Too many arguments for built-in routine [225]");
+ else
+ if (wneedtok(TOK_RPAR))
+ return 1;
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ return 0;
+ }
+
+
+ int skipcomma()
+ {
+ if (curtok == TOK_RPAR)
+ warning("Too few arguments for built-in routine [226]");
+ else
+ if (wneedtok(TOK_COMMA))
+ return 1;
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ return 0;
+ }
+
+
+
+
+
+ char *findaltname(name, num)
+ char *name;
+ int num;
+ {
+ char *cp;
+
+ if (num <= 0)
+ return name;
+ if (num == 1 && *alternatename1)
+ return format_s(alternatename1, name);
+ if (num == 2 && *alternatename2)
+ return format_s(alternatename2, name);
+ if (*alternatename)
+ return format_sd(alternatename, name, num);
+ cp = name;
+ if (*alternatename1) {
+ while (--num >= 0)
+ cp = format_s(alternatename1, cp);
+ } else {
+ while (--num >= 0)
+ cp = format_s("%s_", cp);
+ }
+ return cp;
+ }
+
+
+
+
+ Symbol *findsymbol_opt(name)
+ char *name;
+ {
+ register int i;
+ register unsigned int hash;
+ register char *cp;
+ register Symbol *sp;
+
+ hash = 0;
+ for (cp = name; *cp; cp++)
+ hash = hash*3 + *cp;
+ sp = symtab[hash % SYMHASHSIZE];
+ while (sp && (i = strcmp(sp->name, name)) != 0) {
+ if (i < 0)
+ sp = sp->left;
+ else
+ sp = sp->right;
+ }
+ return sp;
+ }
+
+
+
+ Symbol *findsymbol(name)
+ char *name;
+ {
+ register int i;
+ register unsigned int hash;
+ register char *cp;
+ register Symbol **prev, *sp;
+
+ hash = 0;
+ for (cp = name; *cp; cp++)
+ hash = hash*3 + *cp;
+ prev = symtab + (hash % SYMHASHSIZE);
+ while ((sp = *prev) != 0 &&
+ (i = strcmp(sp->name, name)) != 0) {
+ if (i < 0)
+ prev = &(sp->left);
+ else
+ prev = &(sp->right);
+ }
+ if (!sp) {
+ sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
+ sp->mbase = sp->fbase = NULL;
+ sp->left = sp->right = NULL;
+ strcpy(sp->name, name);
+ sp->flags = 0;
+ sp->kwtok = TOK_NONE;
+ sp->symbolnames = NULL;
+ *prev = sp;
+ }
+ return sp;
+ }
+
+
+
+
+ void clearprogress()
+ {
+ oldinfname = NULL;
+ }
+
+
+ void progress()
+ {
+ char *ctxname;
+ int needrefr;
+ static int prevlen;
+
+ if (showprogress) {
+ if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
+ !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
+ ctxname = "";
+ else
+ ctxname = curctx->name;
+ needrefr = (inf_lnum & 15) == 0;
+ if (oldinfname != infname || oldctxname != ctxname) {
+ if (oldinfname != infname)
+ prevlen = 60;
+ fprintf(stderr, "\r%*s", prevlen + 2, "");
+ oldinfname = infname;
+ oldctxname = ctxname;
+ needrefr = 1;
+ }
+ if (needrefr) {
+ fprintf(stderr, "\r%5d %s %s", inf_lnum, infname, ctxname);
+ prevlen = 8 + strlen(infname) + strlen(ctxname);
+ } else {
+ fprintf(stderr, "\r%5d", inf_lnum);
+ prevlen = 5;
+ }
+ }
+ }
+
+
+
+ void p2c_getline()
+ {
+ char *cp, *cp2;
+
+ switch (inputkind) {
+
+ case INP_FILE:
+ case INP_INCFILE:
+ inf_lnum++;
+ inf_ltotal++;
+ if (fgets(inbuf, 300, inf)) {
+ cp = inbuf + strlen(inbuf);
+ if (*inbuf && cp[-1] == '\n')
+ cp[-1] = 0;
+ if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
+ cp = inbuf + 2; /* in case input text came */
+ inf_lnum = 0; /* from the C preprocessor */
+ while (isdigit(*cp))
+ inf_lnum = inf_lnum*10 + (*cp++) - '0';
+ inf_lnum--;
+ while (isspace(*cp)) cp++;
+ if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
+ cp++;
+ infname = stralloc(cp);
+ infname[cp2 - cp] = 0;
+ }
+ p2c_getline();
+ return;
+ }
+ if (copysource && *inbuf) {
+ start_source();
+ fprintf(outf, "%s\n", inbuf);
+ }
+ if (keepingstrlist) {
+ strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
+ }
+ if (showprogress && inf_lnum % showprogress == 0)
+ progress();
+ } else {
+ if (showprogress)
+ fprintf(stderr, "\n");
+ if (inputkind == INP_INCFILE) {
+ pop_input();
+ p2c_getline();
+ } else
+ strcpy(inbuf, "\001");
+ }
+ break;
+
+ case INP_STRLIST:
+ if (instrlist) {
+ strcpy(inbuf, instrlist->s);
+ if (instrlist->value)
+ inf_lnum = instrlist->value;
+ else
+ inf_lnum++;
+ instrlist = instrlist->next;
+ } else
+ strcpy(inbuf, "\001");
+ break;
+ }
+ inbufptr = inbuf;
+ inbufindent = 0;
+ }
+
+
+
+
+ Static void push_input()
+ {
+ struct inprec *inp;
+
+ inp = ALLOC(1, struct inprec, inprecs);
+ inp->kind = inputkind;
+ inp->fname = infname;
+ inp->lnum = inf_lnum;
+ inp->filep = inf;
+ inp->strlistp = instrlist;
+ inp->inbufptr = stralloc(inbufptr);
+ inp->curtok = curtok;
+ inp->curtoksym = curtoksym;
+ inp->curtokmeaning = curtokmeaning;
+ inp->curtokbuf = stralloc(curtokbuf);
+ inp->curtokcase = stralloc(curtokcase);
+ inp->saveblockkind = TOK_NIL;
+ inp->next = topinput;
+ topinput = inp;
+ inbufptr = inbuf + strlen(inbuf);
+ }
+
+
+
+ void push_input_file(fp, fname, isinclude)
+ FILE *fp;
+ char *fname;
+ int isinclude;
+ {
+ push_input();
+ inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
+ inf = fp;
+ inf_lnum = 0;
+ infname = fname;
+ *inbuf = 0;
+ inbufptr = inbuf;
+ topinput->tempopts = tempoptionlist;
+ tempoptionlist = NULL;
+ if (isinclude != 2)
+ gettok();
+ }
+
+
+ void include_as_import()
+ {
+ if (inputkind == INP_INCFILE) {
+ if (topinput->saveblockkind == TOK_NIL)
+ topinput->saveblockkind = blockkind;
+ blockkind = TOK_IMPORT;
+ } else
+ warning(format_s("%s ignored except in include files [228]",
+ interfacecomment));
+ }
+
+
+ void push_input_strlist(sp, fname)
+ Strlist *sp;
+ char *fname;
+ {
+ push_input();
+ inputkind = INP_STRLIST;
+ instrlist = sp;
+ if (fname) {
+ infname = fname;
+ inf_lnum = 0;
+ } else
+ inf_lnum--; /* adjust for extra p2c_getline() */
+ *inbuf = 0;
+ inbufptr = inbuf;
+ gettok();
+ }
+
+
+
+ void pop_input()
+ {
+ struct inprec *inp;
+
+ if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
+ while (tempoptionlist) {
+ undooption(tempoptionlist->value, tempoptionlist->s);
+ strlist_eat(&tempoptionlist);
+ }
+ tempoptionlist = topinput->tempopts;
+ if (inf)
+ fclose(inf);
+ }
+ inp = topinput;
+ topinput = inp->next;
+ if (inp->saveblockkind != TOK_NIL)
+ blockkind = inp->saveblockkind;
+ inputkind = inp->kind;
+ infname = inp->fname;
+ inf_lnum = inp->lnum;
+ inf = inp->filep;
+ curtok = inp->curtok;
+ curtoksym = inp->curtoksym;
+ curtokmeaning = inp->curtokmeaning;
+ strcpy(curtokbuf, inp->curtokbuf);
+ FREE(inp->curtokbuf);
+ strcpy(curtokcase, inp->curtokcase);
+ FREE(inp->curtokcase);
+ strcpy(inbuf, inp->inbufptr);
+ FREE(inp->inbufptr);
+ inbufptr = inbuf;
+ instrlist = inp->strlistp;
+ FREE(inp);
+ }
+
+
+
+
+ int undooption(i, name)
+ int i;
+ char *name;
+ {
+ char kind = rctable[i].kind;
+
+ switch (kind) {
+
+ case 'S':
+ case 'B':
+ if (rcprevvalues[i]) {
+ *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
+ strlist_eat(&rcprevvalues[i]);
+ return 1;
+ }
+ break;
+
+ case 'I':
+ case 'D':
+ if (rcprevvalues[i]) {
+ *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
+ strlist_eat(&rcprevvalues[i]);
+ return 1;
+ }
+ break;
+
+ case 'L':
+ if (rcprevvalues[i]) {
+ *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
+ strlist_eat(&rcprevvalues[i]);
+ return 1;
+ }
+ break;
+
+ case 'R':
+ if (rcprevvalues[i]) {
+ *((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
+ strlist_eat(&rcprevvalues[i]);
+ return 1;
+ }
+ break;
+
+ case 'C':
+ case 'U':
+ if (rcprevvalues[i]) {
+ strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
+ strlist_eat(&rcprevvalues[i]);
+ return 1;
+ }
+ break;
+
+ case 'A':
+ strlist_remove((Strlist **)rctable[i].ptr, name);
+ return 1;
+
+ case 'X':
+ if (rctable[i].def == 1) {
+ strlist_remove((Strlist **)rctable[i].ptr, name);
+ return 1;
+ }
+ break;
+
+ }
+ return 0;
+ }
+
+
+
+
+ void badinclude()
+ {
+ warning("Can't handle an \"include\" directive here [229]");
+ inputkind = INP_INCFILE; /* expand it in-line */
+ gettok();
+ }
+
+
+
+ int handle_include(fn)
+ char *fn;
+ {
+ FILE *fp = NULL;
+ Strlist *sl;
+
+ for (sl = includedirs; sl; sl = sl->next) {
+ fp = fopen(format_s(sl->s, fn), "r");
+ if (fp) {
+ fn = stralloc(format_s(sl->s, fn));
+ break;
+ }
+ }
+ if (!fp) {
+ perror(fn);
+ warning(format_s("Could not open include file %s [230]", fn));
+ return 0;
+ } else {
+ if (!quietmode && !showprogress)
+ if (outf == stdout)
+ fprintf(stderr, "Reading include file \"%s\"\n", fn);
+ else
+ printf("Reading include file \"%s\"\n", fn);
+ if (verbose)
+ fprintf(logf, "Reading include file \"%s\"\n", fn);
+ if (expandincludes == 0) {
+ push_input_file(fp, fn, 2);
+ curtok = TOK_INCLUDE;
+ strcpy(curtokbuf, fn);
+ } else {
+ push_input_file(fp, fn, 1);
+ }
+ return 1;
+ }
+ }
+
+
+
+ int turbo_directive(closing, after)
+ char *closing, *after;
+ {
+ char *cp, *cp2;
+ int i, result;
+
+ if (!strcincmp(inbufptr, "$double", 7)) {
+ cp = inbufptr + 7;
+ while (isspace(*cp)) cp++;
+ if (cp == closing) {
+ inbufptr = after;
+ doublereals = 1;
+ return 1;
+ }
+ } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
+ cp = inbufptr + 9;
+ while (isspace(*cp)) cp++;
+ if (cp == closing) {
+ inbufptr = after;
+ doublereals = 0;
+ return 1;
+ }
+ }
+ switch (inbufptr[2]) {
+
+ case '+':
+ case '-':
+ result = 1;
+ cp = inbufptr + 1;
+ for (;;) {
+ if (!isalpha(*cp++))
+ return 0;
+ if (*cp != '+' && *cp != '-')
+ return 0;
+ if (++cp == closing)
+ break;
+ if (*cp++ != ',')
+ return 0;
+ }
+ cp = inbufptr + 1;
+ do {
+ switch (*cp++) {
+
+ case 'b':
+ case 'B':
+ if (shortcircuit < 0 && which_lang != LANG_MPW)
+ partial_eval_flag = (*cp == '-');
+ break;
+
+ case 'i':
+ case 'I':
+ iocheck_flag = (*cp == '+');
+ break;
+
+ case 'r':
+ case 'R':
+ if (*cp == '+') {
+ if (!range_flag)
+ note("Range checking is ON [216]");
+ range_flag = 1;
+ } else {
+ if (range_flag)
+ note("Range checking is OFF [216]");
+ range_flag = 0;
+ }
+ break;
+
+ case 's':
+ case 'S':
+ if (*cp == '+') {
+ if (!stackcheck_flag)
+ note("Stack checking is ON [217]");
+ stackcheck_flag = 1;
+ } else {
+ if (stackcheck_flag)
+ note("Stack checking is OFF [217]");
+ stackcheck_flag = 0;
+ }
+ break;
+
+ default:
+ result = 0;
+ break;
+ }
+ cp++;
+ } while (*cp++ == ',');
+ if (result)
+ inbufptr = after;
+ return result;
+
+ case 'c':
+ case 'C':
+ if (toupper(inbufptr[1]) == 'S' &&
+ (inbufptr[3] == '+' || inbufptr[3] == '-') &&
+ inbufptr + 4 == closing) {
+ if (shortcircuit < 0)
+ partial_eval_flag = (inbufptr[3] == '+');
+ inbufptr = after;
+ return 1;
+ }
+ return 0;
+
+ case ' ':
+ switch (inbufptr[1]) {
+
+ case 'i':
+ case 'I':
+ if (skipping_module)
+ break;
+ cp = inbufptr + 3;
+ while (isspace(*cp)) cp++;
+ cp2 = cp;
+ i = 0;
+ while (*cp2 && cp2 != closing)
+ i++, cp2++;
+ if (cp2 != closing)
+ return 0;
+ while (isspace(cp[i-1]))
+ if (--i <= 0)
+ return 0;
+ inbufptr = after;
+ cp2 = ALLOC(i + 1, char, strings);
+ strncpy(cp2, cp, i);
+ cp2[i] = 0;
+ if (handle_include(cp2))
+ return 2;
+ break;
+
+ case 's':
+ case 'S':
+ cp = inbufptr + 3;
+ outsection(minorspace);
+ if (cp == closing) {
+ output("#undef __SEG__\n");
+ } else {
+ output("#define __SEG__ ");
+ while (*cp && cp != closing)
+ cp++;
+ if (*cp) {
+ i = *cp;
+ *cp = 0;
+ output(inbufptr + 3);
+ *cp = i;
+ }
+ output("\n");
+ }
+ outsection(minorspace);
+ inbufptr = after;
+ return 1;
+
+ }
+ return 0;
+
+ case '}':
+ case '*':
+ if (inbufptr + 2 == closing) {
+ switch (inbufptr[1]) {
+
+ case 's':
+ case 'S':
+ outsection(minorspace);
+ output("#undef __SEG__\n");
+ outsection(minorspace);
+ inbufptr = after;
+ return 1;
+
+ }
+ }
+ return 0;
+
+ case 'f': /* $ifdef etc. */
+ case 'F':
+ if (toupper(inbufptr[1]) == 'I' &&
+ ((toupper(inbufptr[3]) == 'O' &&
+ toupper(inbufptr[4]) == 'P' &&
+ toupper(inbufptr[5]) == 'T') ||
+ (toupper(inbufptr[3]) == 'D' &&
+ toupper(inbufptr[4]) == 'E' &&
+ toupper(inbufptr[5]) == 'F') ||
+ (toupper(inbufptr[3]) == 'N' &&
+ toupper(inbufptr[4]) == 'D' &&
+ toupper(inbufptr[5]) == 'E' &&
+ toupper(inbufptr[6]) == 'F'))) {
+ note("Turbo Pascal conditional compilation directive was ignored [218]");
+ }
+ return 0;
+
+ }
+ return 0;
+ }
+
+
+
+
+ extern Strlist *addmacros;
+
+ void defmacro(name, kind, fname, lnum)
+ char *name, *fname;
+ long kind;
+ int lnum;
+ {
+ Strlist *defsl, *sl, *sl2;
+ Symbol *sym, *sym2;
+ Meaning *mp;
+ Expr *ex;
+
+ defsl = NULL;
+ sl = strlist_append(&defsl, name);
+ C_lex++;
+ if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
+ fname = curtoksym->name;
+ push_input_strlist(defsl, fname);
+ if (fname)
+ inf_lnum = lnum;
+ switch (kind) {
+
+ case MAC_VAR:
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ for (mp = curtoksym->mbase; mp; mp = mp->snext) {
+ if (mp->kind == MK_VAR)
+ warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
+ }
+ sl = strlist_append(&varmacros, curtoksym->name);
+ gettok();
+ if (!wneedtok(TOK_EQ))
+ break;
+ sl->value = (long)pc_expr();
+ break;
+
+ case MAC_CONST:
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ for (mp = curtoksym->mbase; mp; mp = mp->snext) {
+ if (mp->kind == MK_CONST)
+ warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
+ }
+ sl = strlist_append(&constmacros, curtoksym->name);
+ gettok();
+ if (!wneedtok(TOK_EQ))
+ break;
+ sl->value = (long)pc_expr();
+ break;
+
+ case MAC_FIELD:
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ sym = curtoksym;
+ gettok();
+ if (!wneedtok(TOK_DOT))
+ break;
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ sym2 = curtoksym;
+ gettok();
+ if (!wneedtok(TOK_EQ))
+ break;
+ funcmacroargs = NULL;
+ sym->flags |= FMACREC;
+ ex = pc_expr();
+ sym->flags &= ~FMACREC;
+ for (mp = sym2->fbase; mp; mp = mp->snext) {
+ if (mp->rectype && mp->rectype->meaning &&
+ mp->rectype->meaning->sym == sym)
+ break;
+ }
+ if (mp) {
+ mp->constdefn = ex;
+ } else {
+ sl = strlist_append(&fieldmacros,
+ format_ss("%s.%s", sym->name, sym2->name));
+ sl->value = (long)ex;
+ }
+ break;
+
+ case MAC_FUNC:
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ sym = curtoksym;
+ if (sym->mbase &&
+ (sym->mbase->kind == MK_FUNCTION ||
+ sym->mbase->kind == MK_SPECIAL))
+ sl = NULL;
+ else
+ sl = strlist_append(&funcmacros, sym->name);
+ gettok();
+ funcmacroargs = NULL;
+ if (curtok == TOK_LPAR) {
+ do {
+ gettok();
+ if (curtok == TOK_RPAR && !funcmacroargs)
+ break;
+ if (!wexpecttok(TOK_IDENT)) {
+ skiptotoken2(TOK_COMMA, TOK_RPAR);
+ continue;
+ }
+ sl2 = strlist_append(&funcmacroargs, curtoksym->name);
+ sl2->value = (long)curtoksym;
+ curtoksym->flags |= FMACREC;
+ gettok();
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_RPAR))
+ skippasttotoken(TOK_RPAR, TOK_EQ);
+ }
+ if (!wneedtok(TOK_EQ))
+ break;
+ if (sl)
+ sl->value = (long)pc_expr();
+ else
+ sym->mbase->constdefn = pc_expr();
+ for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
+ sym2 = (Symbol *)sl2->value;
+ sym2->flags &= ~FMACREC;
+ }
+ strlist_empty(&funcmacroargs);
+ break;
+
+ }
+ if (curtok != TOK_EOF)
+ warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
+ pop_input();
+ C_lex--;
+ strlist_empty(&defsl);
+ }
+
+
+
+ void check_unused_macros()
+ {
+ Strlist *sl;
+
+ if (warnmacros) {
+ for (sl = varmacros; sl; sl = sl->next)
+ warning(format_s("VarMacro %s was never used [234]", sl->s));
+ for (sl = constmacros; sl; sl = sl->next)
+ warning(format_s("ConstMacro %s was never used [234]", sl->s));
+ for (sl = fieldmacros; sl; sl = sl->next)
+ warning(format_s("FieldMacro %s was never used [234]", sl->s));
+ for (sl = funcmacros; sl; sl = sl->next)
+ warning(format_s("FuncMacro %s was never used [234]", sl->s));
+ }
+ }
+
+
+
+
+
+ #define skipspc(cp) while (isspace(*cp)) cp++
+
+ Static int parsecomment(p2c_only, starparen)
+ int p2c_only, starparen;
+ {
+ char namebuf[302];
+ char *cp, *cp2 = namebuf, *closing, *after;
+ char kind, chgmode, upcflag;
+ long val, oldval, sign;
+ double dval;
+ int i, tempopt, hassign;
+ Strlist *sp;
+ Symbol *sym;
+
+ if (if_flag)
+ return 0;
+ if (!p2c_only) {
+ if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
+ *noskipcomment) {
+ inbufptr += strlen(noskipcomment);
+ if (skipflag < 0) {
+ if (skipflag < -1) {
+ skipflag++;
+ } else {
+ curtok = TOK_ENDIF;
+ skipflag = 1;
+ return 2;
+ }
+ } else {
+ skipflag = 1;
+ return 1;
+ }
+ }
+ }
+ closing = inbufptr;
+ while (*closing && (starparen
+ ? (closing[0] != '*' || closing[1] != ')')
+ : (closing[0] != '}')))
+ closing++;
+ if (!*closing)
+ return 0;
+ after = closing + (starparen ? 2 : 1);
+ cp = inbufptr;
+ while (cp < closing && (*cp != '#' || cp[1] != '#'))
+ cp++; /* Ignore comments */
+ if (cp < closing) {
+ while (isspace(cp[-1]))
+ cp--;
+ *cp = '#'; /* avoid skipping spaces past closing! */
+ closing = cp;
+ }
+ if (!p2c_only) {
+ if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
+ closing == inbufptr + 12) {
+ wrapup();
+ inbufptr = after;
+ return 1;
+ }
+ if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
+ *fixedcomment &&
+ inbufptr + strlen(fixedcomment) == closing) {
+ fixedflag++;
+ inbufptr = after;
+ return 1;
+ }
+ if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
+ *permanentcomment &&
+ inbufptr + strlen(permanentcomment) == closing) {
+ permflag = 1;
+ inbufptr = after;
+ return 1;
+ }
+ if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
+ *interfacecomment &&
+ inbufptr + strlen(interfacecomment) == closing) {
+ inbufptr = after;
+ curtok = TOK_INTFONLY;
+ return 2;
+ }
+ if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
+ *skipcomment &&
+ inbufptr + strlen(skipcomment) == closing) {
+ inbufptr = after;
+ skipflag--;
+ if (skipflag == -1) {
+ skipping_module++; /* eat comments in skipped portion */
+ do {
+ gettok();
+ } while (curtok != TOK_ENDIF);
+ skipping_module--;
+ }
+ return 1;
+ }
+ if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
+ *signedcomment && !p2c_only &&
+ inbufptr + strlen(signedcomment) == closing) {
+ inbufptr = after;
+ gettok();
+ if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE &&
+ curtokmeaning->type == tp_char) {
+ curtokmeaning = mp_schar;
+ } else
+ warning("{SIGNED} applied to type other than CHAR [314]");
+ return 2;
+ }
+ if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
+ *unsignedcomment && !p2c_only &&
+ inbufptr + strlen(unsignedcomment) == closing) {
+ inbufptr = after;
+ gettok();
+ if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE &&
+ curtokmeaning->type == tp_char) {
+ curtokmeaning = mp_uchar;
+ } else if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE &&
+ curtokmeaning->type == tp_integer) {
+ curtokmeaning = mp_unsigned;
+ } else if (curtok == TOK_IDENT && curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE &&
+ curtokmeaning->type == tp_int) {
+ curtokmeaning = mp_uint;
+ } else
+ warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
+ return 2;
+ }
+ if (*inbufptr == '$') {
+ i = turbo_directive(closing, after);
+ if (i)
+ return i;
+ }
+ }
+ tempopt = 0;
+ cp = inbufptr;
+ if (*cp == '*') {
+ cp++;
+ tempopt = 1;
+ }
+ if (!isalpha(*cp))
+ return 0;
+ while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
+ *cp2++ = toupper(*cp++);
+ *cp2 = 0;
+ i = numparams;
+ while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
+ if (i < 0)
+ return 0;
+ kind = rctable[i].kind;
+ chgmode = rctable[i].chgmode;
+ if (chgmode == ' ') /* allowed in p2crc only */
+ return 0;
+ if (chgmode == 'T' && lex_initialized) {
+ if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
+ warning(format_s("%s works only at top of program [235]",
+ rctable[i].name));
+ }
+ if (cp == closing) {
+ if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
+ kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
+ undooption(i, "");
+ inbufptr = after;
+ return 1;
+ }
+ }
+ switch (kind) {
+
+ case 'S':
+ case 'I':
+ case 'L':
+ val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
+ (kind == 'S') ? *((short *)rctable[i].ptr) :
+ *(( int *)rctable[i].ptr);
+ switch (*cp) {
+
+ case '=':
+ skipspc(cp);
+ hassign = (*++cp == '-' || *cp == '+');
+ sign = (*cp == '-') ? -1 : 1;
+ cp += hassign;
+ if (isdigit(*cp)) {
+ val = 0;
+ while (isdigit(*cp))
+ val = val * 10 + (*cp++) - '0';
+ val *= sign;
+ if (kind == 'D' && !hassign)
+ val += 10000;
+ } else if (toupper(cp[0]) == 'D' &&
+ toupper(cp[1]) == 'E' &&
+ toupper(cp[2]) == 'F') {
+ val = rctable[i].def;
+ cp += 3;
+ }
+ break;
+
+ case '+':
+ case '-':
+ if (chgmode != 'R')
+ return 0;
+ for (;;) {
+ if (*cp == '+')
+ val++;
+ else if (*cp == '-')
+ val--;
+ else
+ break;
+ cp++;
+ }
+ break;
+
+ }
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ strlist_insert(&rcprevvalues[i], "")->value = oldval;
+ if (tempopt)
+ strlist_insert(&tempoptionlist, "")->value = i;
+ if (kind == 'L')
+ *((long *)rctable[i].ptr) = val;
+ else if (kind == 'S')
+ *((short *)rctable[i].ptr) = val;
+ else
+ *((int *)rctable[i].ptr) = val;
+ inbufptr = after;
+ return 1;
+
+ case 'D':
+ val = oldval = *((int *)rctable[i].ptr);
+ if (*cp++ != '=')
+ return 0;
+ skipspc(cp);
+ if (toupper(cp[0]) == 'D' &&
+ toupper(cp[1]) == 'E' &&
+ toupper(cp[2]) == 'F') {
+ val = rctable[i].def;
+ cp += 3;
+ } else {
+ cp2 = namebuf;
+ while (*cp && cp != closing && !isspace(*cp))
+ *cp2++ = *cp++;
+ *cp2 = 0;
+ val = parsedelta(namebuf, -1);
+ if (!val)
+ return 0;
+ }
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ strlist_insert(&rcprevvalues[i], "")->value = oldval;
+ if (tempopt)
+ strlist_insert(&tempoptionlist, "")->value = i;
+ *((int *)rctable[i].ptr) = val;
+ inbufptr = after;
+ return 1;
+
+ case 'R':
+ if (*cp++ != '=')
+ return 0;
+ skipspc(cp);
+ if (toupper(cp[0]) == 'D' &&
+ toupper(cp[1]) == 'E' &&
+ toupper(cp[2]) == 'F') {
+ dval = rctable[i].def / 100.0;
+ cp += 3;
+ } else {
+ cp2 = cp;
+ while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
+ *cp == '.' || toupper(*cp) == 'E')
+ cp++;
+ if (cp == cp2)
+ return 0;
+ dval = atof(cp2);
+ }
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
+ strlist_insert(&rcprevvalues[i], namebuf);
+ if (tempopt)
+ strlist_insert(&tempoptionlist, namebuf)->value = i;
+ *((double *)rctable[i].ptr) = dval;
+ inbufptr = after;
+ return 1;
+
+ case 'B':
+ if (*cp++ != '=')
+ return 0;
+ skipspc(cp);
+ if (toupper(cp[0]) == 'D' &&
+ toupper(cp[1]) == 'E' &&
+ toupper(cp[2]) == 'F') {
+ val = rctable[i].def;
+ cp += 3;
+ } else {
+ val = parse_breakstr(cp);
+ while (*cp && cp != closing && !isspace(*cp))
+ cp++;
+ }
+ skipspc(cp);
+ if (cp != closing || val == -1)
+ return 0;
+ strlist_insert(&rcprevvalues[i], "")->value =
+ *((short *)rctable[i].ptr);
+ if (tempopt)
+ strlist_insert(&tempoptionlist, "")->value = i;
+ *((short *)rctable[i].ptr) = val;
+ inbufptr = after;
+ return 1;
+
+ case 'C':
+ case 'U':
+ if (*cp == '=') {
+ cp++;
+ skipspc(cp);
+ for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
+ if (!*cp2 || cp2-cp >= rctable[i].def)
+ return 0;
+ cp2 = (char *)rctable[i].ptr;
+ sp = strlist_insert(&rcprevvalues[i], cp2);
+ if (tempopt)
+ strlist_insert(&tempoptionlist, "")->value = i;
+ while (cp != closing && !isspace(*cp2))
+ *cp2++ = *cp++;
+ *cp2 = 0;
+ if (kind == 'U')
+ upc((char *)rctable[i].ptr);
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ inbufptr = after;
+ if (!strcmp(rctable[i].name, "LANGUAGE") &&
+ !strcmp((char *)rctable[i].ptr, "MODCAL"))
+ sysprog_flag |= 2;
+ return 1;
+ }
+ return 0;
+
+ case 'F':
+ case 'G':
+ if (*cp == '=' || *cp == '+' || *cp == '-') {
+ upcflag = (kind == 'F' && !pascalcasesens);
+ chgmode = *cp++;
+ skipspc(cp);
+ cp2 = namebuf;
+ while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
+ *cp2++ = *cp++;
+ *cp2++ = 0;
+ if (!*namebuf)
+ return 0;
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ if (upcflag)
+ upc(namebuf);
+ sym = findsymbol(namebuf);
+ if (rctable[i].def & FUNCBREAK)
+ sym->flags &= ~FUNCBREAK;
+ if (chgmode == '-')
+ sym->flags &= ~rctable[i].def;
+ else
+ sym->flags |= rctable[i].def;
+ inbufptr = after;
+ return 1;
+ }
+ return 0;
+
+ case 'A':
+ if (*cp == '=' || *cp == '+' || *cp == '-') {
+ chgmode = *cp++;
+ skipspc(cp);
+ cp2 = namebuf;
+ while (cp != closing && !isspace(*cp) && *cp)
+ *cp2++ = *cp++;
+ *cp2++ = 0;
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ if (chgmode != '+')
+ strlist_remove((Strlist **)rctable[i].ptr, namebuf);
+ if (chgmode != '-')
+ sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
+ if (tempopt)
+ strlist_insert(&tempoptionlist, namebuf)->value = i;
+ inbufptr = after;
+ return 1;
+ }
+ return 0;
+
+ case 'M':
+ if (!isspace(*cp))
+ return 0;
+ skipspc(cp);
+ if (!isalpha(*cp))
+ return 0;
+ for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
+ if (cp2 > cp && cp2 == closing) {
+ inbufptr = after;
+ cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
+ if (tp_integer != NULL) {
+ defmacro(cp2, rctable[i].def, NULL, 0);
+ } else {
+ sp = strlist_append(&addmacros, cp2);
+ sp->value = rctable[i].def;
+ }
+ return 1;
+ }
+ return 0;
+
+ case 'X':
+ switch (rctable[i].def) {
+
+ case 1: /* strlist with string values */
+ if (!isspace(*cp) && *cp != '=' &&
+ *cp != '+' && *cp != '-')
+ return 0;
+ chgmode = *cp++;
+ skipspc(cp);
+ cp2 = namebuf;
+ while (isalnum(*cp) || *cp == '_' ||
+ *cp == '$' || *cp == '%' ||
+ *cp == '.' || *cp == '-' ||
+ (*cp == '\'' && cp[1] && cp[2] == '\'' &&
+ cp+1 != closing && cp[1] != '=')) {
+ if (*cp == '\'') {
+ *cp2++ = *cp++;
+ *cp2++ = *cp++;
+ }
+ *cp2++ = *cp++;
+ }
+ *cp2++ = 0;
+ if (chgmode == '-') {
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ strlist_remove((Strlist **)rctable[i].ptr, namebuf);
+ } else {
+ if (!isspace(*cp) && *cp != '=')
+ return 0;
+ skipspc(cp);
+ if (*cp == '=') {
+ cp++;
+ skipspc(cp);
+ }
+ if (chgmode == '=' || isspace(chgmode))
+ strlist_remove((Strlist **)rctable[i].ptr, namebuf);
+ sp = strlist_append((Strlist **)rctable[i].ptr, namebuf);
+ if (tempopt)
+ strlist_insert(&tempoptionlist, namebuf)->value = i;
+ cp2 = namebuf;
+ while (*cp && cp != closing && !isspace(*cp))
+ *cp2++ = *cp++;
+ *cp2++ = 0;
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ sp->value = (long)stralloc(namebuf);
+ }
+ inbufptr = after;
+ if (lex_initialized)
+ handle_nameof(); /* as good a place to do this as any! */
+ return 1;
+
+ case 3: /* Synonym parameter */
+ if (isspace(*cp) || *cp == '=' ||
+ *cp == '+' || *cp == '-') {
+ chgmode = *cp++;
+ skipspc(cp);
+ cp2 = namebuf;
+ while (isalnum(*cp) || *cp == '_' ||
+ *cp == '$' || *cp == '%')
+ *cp2++ = *cp++;
+ *cp2++ = 0;
+ if (!*namebuf)
+ return 0;
+ skipspc(cp);
+ if (!pascalcasesens)
+ upc(namebuf);
+ sym = findsymbol(namebuf);
+ if (chgmode == '-') {
+ if (cp != closing)
+ return 0;
+ sym->flags &= ~SSYNONYM;
+ inbufptr = after;
+ return 1;
+ }
+ if (*cp == '=') {
+ cp++;
+ skipspc(cp);
+ }
+ cp2 = namebuf;
+ while (isalnum(*cp) || *cp == '_' ||
+ *cp == '$' || *cp == '%')
+ *cp2++ = *cp++;
+ *cp2++ = 0;
+ skipspc(cp);
+ if (cp != closing)
+ return 0;
+ sym->flags |= SSYNONYM;
+ if (!pascalcasesens)
+ upc(namebuf);
+ if (*namebuf)
+ strlist_append(&sym->symbolnames, "===")->value =
+ (long)findsymbol(namebuf);
+ else
+ strlist_append(&sym->symbolnames, "===")->value=0;
+ inbufptr = after;
+ return 1;
+ }
+ return 0;
+
+ }
+ return 0;
+
+ }
+ return 0;
+ }
+
+
+
+ Static void comment(starparen)
+ int starparen; /* 0={ }, 1=(* *), 2=C comments*/
+ {
+ register char ch;
+ int nestcount = 1, startlnum = inf_lnum, wasrel = 0, trailing;
+ int i, cmtindent, cmtindent2, saveeat = eatcomments;
+ char *cp;
+
+ if (!strncmp(inbufptr, embedcomment, strlen(embedcomment)) &&
+ *embedcomment)
+ eatcomments = 0;
+ cp = inbuf;
+ while (isspace(*cp))
+ cp++;
+ trailing = (*cp != '{' && ((*cp != '(' && *cp != '/') || cp[1] != '*'));
+ cmtindent = inbufindent;
+ cmtindent2 = cmtindent + 1 + (starparen != 0);
+ cp = inbufptr;
+ while (isspace(*cp))
+ cmtindent2++, cp++;
+ cp = curtokbuf;
+ for (;;) {
+ ch = *inbufptr++;
+ switch (ch) {
+
+ case '}':
+ if ((!starparen || nestedcomments == 0) &&
+ starparen != 2 &&
+ --nestcount <= 0) {
+ *cp = 0;
+ if (wasrel && !strcmp(curtokbuf, "\003"))
+ *curtokbuf = '\002';
+ if (!commenting_flag)
+ commentline(trailing ? CMT_TRAIL : CMT_POST);
+ eatcomments = saveeat;
+ return;
+ }
+ break;
+
+ case '{':
+ if (nestedcomments == 1 && starparen != 2)
+ nestcount++;
+ break;
+
+ case '*':
+ if ((*inbufptr == ((starparen == 2) ? '/' : ')') &&
+ (starparen || nestedcomments == 0)) &&
+ --nestcount <= 0) {
+ inbufptr++;
+ *cp = 0;
+ if (wasrel && !strcmp(curtokbuf, "\003"))
+ *curtokbuf = '\002';
+ if (!commenting_flag)
+ commentline(trailing ? CMT_TRAIL : CMT_POST);
+ eatcomments = saveeat;
+ return;
+ }
+ break;
+
+ case '(':
+ if (*inbufptr == '*' && nestedcomments == 1 &&
+ starparen != 2) {
+ *cp++ = ch;
+ ch = *inbufptr++;
+ nestcount++;
+ }
+ break;
+
+ case 0:
+ *cp = 0;
+ if (commenting_flag)
+ saveinputcomment(inbufptr-1);
+ else
+ commentline(CMT_POST);
+ trailing = 0;
+ p2c_getline();
+ i = 0;
+ for (;;) {
+ if (*inbufptr == ' ') {
+ inbufptr++;
+ i++;
+ } else if (*inbufptr == '\t') {
+ inbufptr++;
+ i++;
+ if (intabsize)
+ i = (i / intabsize + 1) * intabsize;
+ } else
+ break;
+ }
+ cp = curtokbuf;
+ if (*inbufptr) {
+ if (i == cmtindent2 && !starparen)
+ cmtindent--;
+ cmtindent2 = -1;
+ if (i >= cmtindent && i > 0) {
+ *cp++ = '\002';
+ i -= cmtindent;
+ wasrel = 1;
+ } else {
+ *cp++ = '\003';
+ }
+ while (--i >= 0)
+ *cp++ = ' ';
+ } else
+ *cp++ = '\003';
+ continue;
+
+ case EOFMARK:
+ error(format_d("Runaway comment from line %d", startlnum));
+ eatcomments = saveeat;
+ return; /* unnecessary */
+
+ }
+ *cp++ = ch;
+ }
+ }
+
+
+
+ char *getinlinepart()
+ {
+ char *cp, *buf;
+
+ for (;;) {
+ if (isspace(*inbufptr)) {
+ inbufptr++;
+ } else if (!*inbufptr) {
+ p2c_getline();
+ } else if (*inbufptr == '{') {
+ inbufptr++;
+ comment(0);
+ } else if (*inbufptr == '(' && inbufptr[1] == '*') {
+ inbufptr += 2;
+ comment(1);
+ } else
+ break;
+ }
+ cp = inbufptr;
+ while (isspace(*cp) || isalnum(*cp) ||
+ *cp == '_' || *cp == '$' ||
+ *cp == '+' || *cp == '-' ||
+ *cp == '<' || *cp == '>')
+ cp++;
+ if (cp == inbufptr)
+ return "";
+ while (isspace(cp[-1]))
+ cp--;
+ buf = format_s("%s", inbufptr);
+ buf[cp-inbufptr] = 0; /* truncate the string */
+ inbufptr = cp;
+ return buf;
+ }
+
+
+
+
+ Static int getflag()
+ {
+ int res = 1;
+
+ gettok();
+ if (curtok == TOK_IDENT) {
+ res = (strcmp(curtokbuf, "OFF") != 0);
+ gettok();
+ }
+ return res;
+ }
+
+
+
+
+ char getchartok()
+ {
+ if (!*inbufptr) {
+ warning("Unexpected end of line [236]");
+ return ' ';
+ }
+ if (isspace(*inbufptr)) {
+ warning("Whitespace not allowed here [237]");
+ return ' ';
+ }
+ return *inbufptr++;
+ }
+
+
+
+ char *getparenstr(buf)
+ char *buf;
+ {
+ int count = 0;
+ char *cp;
+
+ if (inbufptr < buf) /* this will get most bad cases */
+ error("Can't handle a line break here");
+ while (isspace(*buf))
+ buf++;
+ cp = buf;
+ for (;;) {
+ if (!*cp)
+ error("Can't handle a line break here");
+ if (*cp == '(')
+ count++;
+ if (*cp == ')')
+ if (--count < 0)
+ break;
+ cp++;
+ }
+ inbufptr = cp + 1;
+ while (cp > buf && isspace(cp[-1]))
+ cp--;
+ return format_ds("%.*s", (int)(cp - buf), buf);
+ }
+
+
+
+ void leadingcomments()
+ {
+ for (;;) {
+ switch (*inbufptr++) {
+
+ case 0:
+ p2c_getline();
+ break;
+
+ case ' ':
+ case '\t':
+ case 26:
+ /* ignore whitespace */
+ break;
+
+ case '{':
+ if (!parsecomment(1, 0)) {
+ inbufptr--;
+ return;
+ }
+ break;
+
+ case '(':
+ if (*inbufptr == '*') {
+ inbufptr++;
+ if (!parsecomment(1, 1)) {
+ inbufptr -= 2;
+ return;
+ }
+ break;
+ }
+ /* fall through */
+
+ default:
+ inbufptr--;
+ return;
+
+ }
+ }
+ }
+
+
+
+
+ void get_C_string(term)
+ int term;
+ {
+ char *cp = curtokbuf;
+ char ch;
+ int i;
+
+ while ((ch = *inbufptr++)) {
+ if (ch == term) {
+ *cp = 0;
+ curtokint = cp - curtokbuf;
+ return;
+ } else if (ch == '\\') {
+ if (isdigit(*inbufptr)) {
+ i = (*inbufptr++) - '0';
+ if (isdigit(*inbufptr))
+ i = i*8 + (*inbufptr++) - '0';
+ if (isdigit(*inbufptr))
+ i = i*8 + (*inbufptr++) - '0';
+ *cp++ = i;
+ } else {
+ ch = *inbufptr++;
+ switch (tolower(ch)) {
+ case 'n':
+ *cp++ = '\n';
+ break;
+ case 't':
+ *cp++ = '\t';
+ break;
+ case 'v':
+ *cp++ = '\v';
+ break;
+ case 'b':
+ *cp++ = '\b';
+ break;
+ case 'r':
+ *cp++ = '\r';
+ break;
+ case 'f':
+ *cp++ = '\f';
+ break;
+ case '\\':
+ *cp++ = '\\';
+ break;
+ case '\'':
+ *cp++ = '\'';
+ break;
+ case '"':
+ *cp++ = '"';
+ break;
+ case 'x':
+ if (isxdigit(*inbufptr)) {
+ if (isdigit(*inbufptr))
+ i = (*inbufptr++) - '0';
+ else
+ i = (toupper(*inbufptr++)) - 'A' + 10;
+ if (isdigit(*inbufptr))
+ i = i*16 + (*inbufptr++) - '0';
+ else if (isxdigit(*inbufptr))
+ i = i*16 + (toupper(*inbufptr++)) - 'A' + 10;
+ *cp++ = i;
+ break;
+ }
+ /* fall through */
+ default:
+ warning("Strange character in C string [238]");
+ }
+ }
+ } else
+ *cp++ = ch;
+ }
+ *cp = 0;
+ curtokint = cp - curtokbuf;
+ warning("Unterminated C string [239]");
+ }
+
+
+
+
+
+ void begincommenting(cp)
+ char *cp;
+ {
+ if (!commenting_flag) {
+ commenting_ptr = cp;
+ }
+ commenting_flag++;
+ }
+
+
+ void saveinputcomment(cp)
+ char *cp;
+ {
+ if (commenting_ptr)
+ sprintf(curtokbuf, "%.*s", (int)(cp - commenting_ptr), commenting_ptr);
+ else
+ sprintf(curtokbuf, "\003%.*s", (int)(cp - inbuf), inbuf);
+ commentline(CMT_POST);
+ commenting_ptr = NULL;
+ }
+
+
+ void endcommenting(cp)
+ char *cp;
+ {
+ commenting_flag--;
+ if (!commenting_flag) {
+ saveinputcomment(cp);
+ }
+ }
+
+
+
+
+ int peeknextchar()
+ {
+ char *cp;
+
+ cp = inbufptr;
+ while (isspace(*cp))
+ cp++;
+ return *cp;
+ }
+
+
+
+
+ #ifdef LEXDEBUG
+ Static void zgettok();
+ void gettok()
+ {
+ zgettok();
+ if (tokentrace) {
+ printf("gettok() found %s", tok_name(curtok));
+ switch (curtok) {
+ case TOK_HEXLIT:
+ case TOK_OCTLIT:
+ case TOK_INTLIT:
+ case TOK_MININT:
+ printf(", curtokint = %d", curtokint);
+ break;
+ case TOK_REALLIT:
+ case TOK_STRLIT:
+ printf(", curtokbuf = %s", makeCstring(curtokbuf, curtokint));
+ break;
+ default:
+ break;
+ }
+ putchar('\n');
+ }
+ }
+ Static void zgettok()
+ #else
+ void gettok()
+ #endif
+ {
+ register char ch;
+ register char *cp;
+ char ch2;
+ char *startcp;
+ int i;
+
+ debughook();
+ for (;;) {
+ switch ((ch = *inbufptr++)) {
+
+ case 0:
+ if (commenting_flag)
+ saveinputcomment(inbufptr-1);
+ p2c_getline();
+ cp = curtokbuf;
+ for (;;) {
+ inbufindent = 0;
+ for (;;) {
+ if (*inbufptr == '\t') {
+ inbufindent++;
+ if (intabsize)
+ inbufindent = (inbufindent / intabsize + 1) * intabsize;
+ } else if (*inbufptr == ' ')
+ inbufindent++;
+ else if (*inbufptr != 26)
+ break;
+ inbufptr++;
+ }
+ if (!*inbufptr && !commenting_flag) { /* blank line */
+ *cp++ = '\001';
+ p2c_getline();
+ } else
+ break;
+ }
+ if (cp > curtokbuf) {
+ *cp = 0;
+ commentline(CMT_POST);
+ }
+ break;
+
+ case '\t':
+ case ' ':
+ case 26: /* ignore ^Z's in Turbo files */
+ while (*inbufptr++ == ch) ;
+ inbufptr--;
+ break;
+
+ case '$':
+ if (dollar_idents)
+ goto ident;
+ if (dollar_flag) {
+ dollar_flag = 0;
+ curtok = TOK_DOLLAR;
+ return;
+ }
+ startcp = inbufptr-1;
+ while (isspace(*inbufptr))
+ inbufptr++;
+ cp = inbufptr;
+ while (isxdigit(*cp))
+ cp++;
+ if (cp > inbufptr && cp <= inbufptr+8 && !isalnum(*cp)) {
+ while (isspace(*cp))
+ cp++;
+ if (!isdigit(*cp) && *cp != '\'') {
+ cp = curtokbuf; /* Turbo hex constant */
+ while (isxdigit(*inbufptr))
+ *cp++ = *inbufptr++;
+ *cp = 0;
+ curtok = TOK_HEXLIT;
+ curtokint = my_strtol(curtokbuf, NULL, 16);
+ return;
+ }
+ }
+ dollar_flag++; /* HP Pascal compiler directive */
+ do {
+ gettok();
+ if (curtok == TOK_IF) { /* $IF expr$ */
+ Expr *ex;
+ Value val;
+ if (!skipping_module) {
+ if (!setup_complete)
+ error("$IF$ not allowed at top of program");
+
+ /* Even though HP Pascal doesn't let these nest,
+ there's no harm in supporting it. */
+ if (if_flag) {
+ skiptotoken(TOK_DOLLAR);
+ if_flag++;
+ break;
+ }
+ gettok();
+ ex = p_expr(tp_boolean);
+ val = eval_expr_consts(ex);
+ freeexpr(ex);
+ i = (val.type == tp_boolean && val.i);
+ free_value(&val);
+ if (!i) {
+ if (curtok != TOK_DOLLAR) {
+ warning("Syntax error in $IF$ expression [240]");
+ skiptotoken(TOK_DOLLAR);
+ }
+ begincommenting(startcp);
+ if_flag++;
+ while (if_flag > 0)
+ gettok();
+ endcommenting(inbufptr);
+ }
+ } else {
+ skiptotoken(TOK_DOLLAR);
+ }
+ } else if (curtok == TOK_END) { /* $END$ */
+ if (if_flag) {
+ gettok();
+ if (!wexpecttok(TOK_DOLLAR))
+ skiptotoken(TOK_DOLLAR);
+ curtok = TOK_ENDIF;
+ if_flag--;
+ return;
+ } else {
+ gettok();
+ if (!wexpecttok(TOK_DOLLAR))
+ skiptotoken(TOK_DOLLAR);
+ }
+ } else if (curtok == TOK_IDENT) {
+ if (!strcmp(curtokbuf, "INCLUDE") &&
+ !if_flag && !skipping_module) {
+ char *fn;
+ gettok();
+ if (curtok == TOK_IDENT) {
+ fn = stralloc(curtokcase);
+ gettok();
+ } else if (wexpecttok(TOK_STRLIT)) {
+ fn = stralloc(curtokbuf);
+ gettok();
+ } else
+ fn = "";
+ if (!wexpecttok(TOK_DOLLAR)) {
+ skiptotoken(TOK_DOLLAR);
+ } else {
+ if (handle_include(fn))
+ return;
+ }
+ } else if (ignore_directives ||
+ if_flag ||
+ !strcmp(curtokbuf, "SEARCH") ||
+ !strcmp(curtokbuf, "REF") ||
+ !strcmp(curtokbuf, "DEF")) {
+ skiptotoken(TOK_DOLLAR);
+ } else if (!strcmp(curtokbuf, "SWITCH_STRPOS")) {
+ switch_strpos = getflag();
+ } else if (!strcmp(curtokbuf, "SYSPROG")) {
+ if (getflag())
+ sysprog_flag |= 1;
+ else
+ sysprog_flag &= ~1;
+ } else if (!strcmp(curtokbuf, "MODCAL")) {
+ if (getflag())
+ sysprog_flag |= 2;
+ else
+ sysprog_flag &= ~2;
+ } else if (!strcmp(curtokbuf, "PARTIAL_EVAL")) {
+ if (shortcircuit < 0)
+ partial_eval_flag = getflag();
+ } else if (!strcmp(curtokbuf, "IOCHECK")) {
+ iocheck_flag = getflag();
+ } else if (!strcmp(curtokbuf, "RANGE")) {
+ if (getflag()) {
+ if (!range_flag)
+ note("Range checking is ON [216]");
+ range_flag = 1;
+ } else {
+ if (range_flag)
+ note("Range checking is OFF [216]");
+ range_flag = 0;
+ }
+ } else if (!strcmp(curtokbuf, "OVFLCHECK")) {
+ if (getflag()) {
+ if (!ovflcheck_flag)
+ note("Overflow checking is ON [219]");
+ ovflcheck_flag = 1;
+ } else {
+ if (ovflcheck_flag)
+ note("Overflow checking is OFF [219]");
+ ovflcheck_flag = 0;
+ }
+ } else if (!strcmp(curtokbuf, "STACKCHECK")) {
+ if (getflag()) {
+ if (!stackcheck_flag)
+ note("Stack checking is ON [217]");
+ stackcheck_flag = 1;
+ } else {
+ if (stackcheck_flag)
+ note("Stack checking is OFF [217]");
+ stackcheck_flag = 0;
+ }
+ }
+ skiptotoken2(TOK_DOLLAR, TOK_COMMA);
+ } else {
+ warning("Mismatched '$' signs [241]");
+ dollar_flag = 0; /* got out of sync */
+ return;
+ }
+ } while (curtok == TOK_COMMA);
+ break;
+
+ case '"':
+ if (C_lex) {
+ get_C_string(ch);
+ curtok = TOK_STRLIT;
+ return;
+ }
+ goto stringLiteral;
+
+ case '#':
+ if (modula2) {
+ curtok = TOK_NE;
+ return;
+ }
+ cp = inbufptr;
+ while (isspace(*cp)) cp++;
+ if (!strcincmp(cp, "INCLUDE", 7)) {
+ char *cp2, *cp3;
+ cp += 7;
+ while (isspace(*cp)) cp++;
+ cp2 = cp + strlen(cp) - 1;
+ while (isspace(*cp2)) cp2--;
+ if ((*cp == '"' && *cp2 == '"' && cp2 > cp) ||
+ (*cp == '<' && *cp2 == '>')) {
+ inbufptr = cp2 + 1;
+ cp3 = stralloc(cp + 1);
+ cp3[cp2 - cp - 1] = 0;
+ if (handle_include(cp3))
+ return;
+ else
+ break;
+ }
+ }
+ /* fall through */
+
+ case '\'':
+ if (C_lex && ch == '\'') {
+ get_C_string(ch);
+ if (curtokint != 1)
+ warning("Character constant has length != 1 [242]");
+ curtokint = *curtokbuf;
+ curtok = TOK_CHARLIT;
+ return;
+ }
+ stringLiteral:
+ cp = curtokbuf;
+ ch2 = (ch == '"') ? '"' : '\'';
+ do {
+ if (ch == ch2) {
+ while ((ch = *inbufptr++) != '\n' &&
+ ch != EOF) {
+ if (ch == ch2) {
+ if (*inbufptr != ch2 || modula2)
+ break;
+ else
+ inbufptr++;
+ }
+ *cp++ = ch;
+ }
+ if (ch != ch2)
+ warning("Error in string literal [243]");
+ } else {
+ ch = *inbufptr++;
+ if (isdigit(ch)) {
+ i = 0;
+ while (isdigit(ch)) {
+ i = i*10 + ch - '0';
+ ch = *inbufptr++;
+ }
+ inbufptr--;
+ *cp++ = i;
+ } else {
+ *cp++ = ch & 0x1f;
+ }
+ }
+ while (*inbufptr == ' ' || *inbufptr == '\t')
+ inbufptr++;
+ } while ((ch = *inbufptr++) == ch2 || ch == '#');
+ inbufptr--;
+ *cp = 0;
+ curtokint = cp - curtokbuf;
+ curtok = TOK_STRLIT;
+ return;
+
+ case '(':
+ if (*inbufptr == '*' && !C_lex) {
+ inbufptr++;
+ switch (commenting_flag ? 0 : parsecomment(0, 1)) {
+ case 0:
+ comment(1);
+ break;
+ case 2:
+ return;
+ }
+ break;
+ } else if (*inbufptr == '.') {
+ curtok = TOK_LBR;
+ inbufptr++;
+ } else {
+ curtok = TOK_LPAR;
+ }
+ return;
+
+ case '{':
+ if (C_lex || modula2) {
+ curtok = TOK_LBRACE;
+ return;
+ }
+ switch (commenting_flag ? 0 : parsecomment(0, 0)) {
+ case 0:
+ comment(0);
+ break;
+ case 2:
+ return;
+ }
+ break;
+
+ case '}':
+ if (C_lex || modula2) {
+ curtok = TOK_RBRACE;
+ return;
+ }
+ if (skipflag > 0) {
+ skipflag = 0;
+ } else
+ warning("Unmatched '}' in input file [244]");
+ break;
+
+ case ')':
+ curtok = TOK_RPAR;
+ return;
+
+ case '*':
+ if (*inbufptr == (C_lex ? '/' : ')')) {
+ inbufptr++;
+ if (skipflag > 0) {
+ skipflag = 0;
+ } else
+ warning("Unmatched '*)' in input file [245]");
+ break;
+ } else if (*inbufptr == '*' && !C_lex) {
+ curtok = TOK_STARSTAR;
+ inbufptr++;
+ } else
+ curtok = TOK_STAR;
+ return;
+
+ case '+':
+ if (C_lex && *inbufptr == '+') {
+ curtok = TOK_PLPL;
+ inbufptr++;
+ } else
+ curtok = TOK_PLUS;
+ return;
+
+ case ',':
+ curtok = TOK_COMMA;
+ return;
+
+ case '-':
+ if (C_lex && *inbufptr == '-') {
+ curtok = TOK_MIMI;
+ inbufptr++;
+ } else if (*inbufptr == '>') {
+ curtok = TOK_ARROW;
+ inbufptr++;
+ } else
+ curtok = TOK_MINUS;
+ return;
+
+ case '.':
+ if (*inbufptr == '.') {
+ curtok = TOK_DOTS;
+ inbufptr++;
+ } else if (*inbufptr == ')') {
+ curtok = TOK_RBR;
+ inbufptr++;
+ } else
+ curtok = TOK_DOT;
+ return;
+
+ case '/':
+ if (C_lex && *inbufptr == '*') {
+ inbufptr++;
+ comment(2);
+ break;
+ }
+ curtok = TOK_SLASH;
+ return;
+
+ case ':':
+ if (*inbufptr == '=') {
+ curtok = TOK_ASSIGN;
+ inbufptr++;
+ } else if (*inbufptr == ':') {
+ curtok = TOK_COLONCOLON;
+ inbufptr++;
+ } else
+ curtok = TOK_COLON;
+ return;
+
+ case ';':
+ curtok = TOK_SEMI;
+ return;
+
+ case '<':
+ if (*inbufptr == '=') {
+ curtok = TOK_LE;
+ inbufptr++;
+ } else if (*inbufptr == '>') {
+ curtok = TOK_NE;
+ inbufptr++;
+ } else if (*inbufptr == '<') {
+ curtok = TOK_LTLT;
+ inbufptr++;
+ } else
+ curtok = TOK_LT;
+ return;
+
+ case '>':
+ if (*inbufptr == '=') {
+ curtok = TOK_GE;
+ inbufptr++;
+ } else if (*inbufptr == '>') {
+ curtok = TOK_GTGT;
+ inbufptr++;
+ } else
+ curtok = TOK_GT;
+ return;
+
+ case '=':
+ if (*inbufptr == '=') {
+ curtok = TOK_EQEQ;
+ inbufptr++;
+ } else
+ curtok = TOK_EQ;
+ return;
+
+ case '[':
+ curtok = TOK_LBR;
+ return;
+
+ case ']':
+ curtok = TOK_RBR;
+ return;
+
+ case '^':
+ curtok = TOK_HAT;
+ return;
+
+ case '&':
+ if (*inbufptr == '&') {
+ curtok = TOK_ANDAND;
+ inbufptr++;
+ } else
+ curtok = TOK_AMP;
+ return;
+
+ case '|':
+ if (*inbufptr == '|') {
+ curtok = TOK_OROR;
+ inbufptr++;
+ } else
+ curtok = TOK_VBAR;
+ return;
+
+ case '~':
+ curtok = TOK_TWIDDLE;
+ return;
+
+ case '!':
+ if (*inbufptr == '=') {
+ curtok = TOK_BANGEQ;
+ inbufptr++;
+ } else
+ curtok = TOK_BANG;
+ return;
+
+ case '%':
+ if (C_lex) {
+ curtok = TOK_PERC;
+ return;
+ }
+ goto ident;
+
+ case '?':
+ curtok = TOK_QM;
+ return;
+
+ case '@':
+ curtok = TOK_ADDR;
+ return;
+
+ case EOFMARK:
+ if (curtok == TOK_EOF) {
+ if (inputkind == INP_STRLIST)
+ error("Unexpected end of macro");
+ else
+ error("Unexpected end of file");
+ }
+ curtok = TOK_EOF;
+ return;
+
+ default:
+ if (isdigit(ch)) {
+ cp = inbufptr;
+ while (isxdigit(*cp))
+ cp++;
+ if (*cp == '#' && isxdigit(cp[1])) {
+ i = atoi(inbufptr-1);
+ inbufptr = cp+1;
+ } else if (toupper(cp[-1]) == 'B' ||
+ toupper(cp[-1]) == 'C') {
+ inbufptr--;
+ i = 8;
+ } else if (toupper(*cp) == 'H') {
+ inbufptr--;
+ i = 16;
+ } else if ((ch == '0' && toupper(*inbufptr) == 'X' &&
+ isxdigit(inbufptr[1]))) {
+ inbufptr++;
+ i = 16;
+ } else {
+ i = 10;
+ }
+ if (i != 10) {
+ curtokint = 0;
+ while (isdigit(*inbufptr) ||
+ (i > 10 && isxdigit(*inbufptr))) {
+ ch = toupper(*inbufptr++);
+ curtokint *= i;
+ if (ch <= '9')
+ curtokint += ch - '0';
+ else
+ curtokint += ch - 'A' + 10;
+ }
+ sprintf(curtokbuf, "%ld", curtokint);
+ if ((toupper(*inbufptr) == 'B' && i == 8) ||
+ (toupper(*inbufptr) == 'H' && i == 16))
+ inbufptr++;
+ if (toupper(*inbufptr) == 'C' && i == 8) {
+ inbufptr++;
+ curtok = TOK_STRLIT;
+ curtokbuf[0] = curtokint;
+ curtokbuf[1] = 0;
+ curtokint = 1;
+ return;
+ }
+ if (toupper(*inbufptr) == 'L') {
+ strcat(curtokbuf, "L");
+ inbufptr++;
+ }
+ curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
+ return;
+ }
+ cp = curtokbuf;
+ i = 0;
+ while (ch == '0')
+ ch = *inbufptr++;
+ if (isdigit(ch)) {
+ while (isdigit(ch)) {
+ *cp++ = ch;
+ ch = *inbufptr++;
+ }
+ } else
+ *cp++ = '0';
+ if (ch == '.') {
+ if (isdigit(*inbufptr)) {
+ *cp++ = ch;
+ ch = *inbufptr++;
+ i = 1;
+ while (isdigit(ch)) {
+ *cp++ = ch;
+ ch = *inbufptr++;
+ }
+ }
+ }
+ if (ch == 'e' || ch == 'E' ||
+ ch == 'd' || ch == 'D' ||
+ ch == 'q' || ch == 'Q') {
+ ch = *inbufptr;
+ if (isdigit(ch) || ch == '+' || ch == '-') {
+ *cp++ = 'e';
+ inbufptr++;
+ i = 1;
+ do {
+ *cp++ = ch;
+ ch = *inbufptr++;
+ } while (isdigit(ch));
+ }
+ }
+ inbufptr--;
+ *cp = 0;
+ if (i) {
+ curtok = TOK_REALLIT;
+ curtokint = cp - curtokbuf;
+ } else {
+ if (cp >= curtokbuf+10) {
+ i = strcmp(curtokbuf, "2147483648");
+ if (cp > curtokbuf+10 || i > 0) {
+ curtok = TOK_REALLIT;
+ curtokint = cp - curtokbuf + 2;
+ strcat(curtokbuf, ".0");
+ return;
+ }
+ if (i == 0) {
+ curtok = TOK_MININT;
+ curtokint = -2147483648;
+ return;
+ }
+ }
+ curtok = TOK_INTLIT;
+ curtokint = atol(curtokbuf);
+ if (toupper(*inbufptr) == 'L') {
+ strcat(curtokbuf, "L");
+ inbufptr++;
+ }
+ }
+ return;
+ } else if (isalpha(ch) || ch == '_') {
+ ident:
+ {
+ register char *cp2;
+ curtoksym = NULL;
+ cp = curtokbuf;
+ cp2 = curtokcase;
+ *cp2++ = symcase ? ch : tolower(ch);
+ *cp++ = pascalcasesens ? ch : toupper(ch);
+ while (isalnum((ch = *inbufptr++)) ||
+ ch == '_' ||
+ (ch == '%' && !C_lex) ||
+ (ch == '$' && dollar_idents)) {
+ *cp2++ = symcase ? ch : tolower(ch);
+ if (!ignorenonalpha || isalnum(ch))
+ *cp++ = pascalcasesens ? ch : toupper(ch);
+ }
+ inbufptr--;
+ *cp2 = 0;
+ *cp = 0;
+ if (pascalsignif > 0)
+ curtokbuf[pascalsignif] = 0;
+ }
+ if (*curtokbuf == '%') {
+ if (!strcicmp(curtokbuf, "%INCLUDE")) {
+ char *cp2 = inbufptr;
+ while (isspace(*cp2)) cp2++;
+ if (*cp2 == '\'')
+ cp2++;
+ cp = curtokbuf;
+ while (*cp2 && *cp2 != '\'' &&
+ *cp2 != ';' && !isspace(*cp2)) {
+ *cp++ = *cp2++;
+ }
+ *cp = 0;
+ cp = my_strrchr(curtokbuf, '/');
+ if (cp && (!strcicmp(cp, "/LIST") ||
+ !strcicmp(cp, "/NOLIST")))
+ *cp = 0;
+ if (*cp2 == '\'')
+ cp2++;
+ while (isspace(*cp2)) cp2++;
+ if (*cp2 == ';')
+ cp2++;
+ while (isspace(*cp2)) cp2++;
+ if (!*cp2) {
+ inbufptr = cp2;
+ (void) handle_include(stralloc(curtokbuf));
+ return;
+ }
+ } else if (!strcicmp(curtokbuf, "%TITLE") ||
+ !strcicmp(curtokbuf, "%SUBTITLE")) {
+ gettok(); /* string literal */
+ break;
+ } else if (!strcicmp(curtokbuf, "%PAGE")) {
+ /* should store a special page-break comment? */
+ break; /* ignore token */
+ } else if ((i = 2, !strcicmp(curtokbuf, "%B")) ||
+ (i = 8, !strcicmp(curtokbuf, "%O")) ||
+ (i = 16, !strcicmp(curtokbuf, "%X"))) {
+ while (isspace(*inbufptr)) inbufptr++;
+ if (*inbufptr == '\'') {
+ inbufptr++;
+ curtokint = 0;
+ while (*inbufptr && *inbufptr != '\'') {
+ ch = toupper(*inbufptr++);
+ if (isxdigit(ch)) {
+ curtokint *= i;
+ if (ch <= '9')
+ curtokint += ch - '0';
+ else
+ curtokint += ch - 'A' + 10;
+ } else if (!isspace(ch))
+ warning("Bad digit in literal [246]");
+ }
+ if (*inbufptr)
+ inbufptr++;
+ sprintf(curtokbuf, "%ld", curtokint);
+ curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
+ return;
+ }
+ }
+ }
+ {
+ register unsigned int hash;
+ register Symbol *sp;
+
+ hash = 0;
+ for (cp = curtokbuf; *cp; cp++)
+ hash = hash*3 + *cp;
+ sp = symtab[hash % SYMHASHSIZE];
+ while (sp && (i = strcmp(sp->name, curtokbuf)) != 0) {
+ if (i < 0)
+ sp = sp->left;
+ else
+ sp = sp->right;
+ }
+ if (!sp)
+ sp = findsymbol(curtokbuf);
+ if (sp->flags & SSYNONYM) {
+ i = 100;
+ while (--i > 0 && sp && (sp->flags & SSYNONYM)) {
+ Strlist *sl;
+ sl = strlist_find(sp->symbolnames, "===");
+ if (sl)
+ sp = (Symbol *)sl->value;
+ else
+ sp = NULL;
+ }
+ if (!sp)
+ break; /* ignore token */
+ }
+ if (sp->kwtok && !(sp->flags & KWPOSS) &&
+ (pascalcasesens != 2 || !islower(*curtokbuf)) &&
+ (pascalcasesens != 3 || !isupper(*curtokbuf))) {
+ curtok = sp->kwtok;
+ return;
+ }
+ curtok = TOK_IDENT;
+ curtoksym = sp;
+ if ((i = withlevel) != 0 && sp->fbase) {
+ while (--i >= 0) {
+ curtokmeaning = sp->fbase;
+ while (curtokmeaning) {
+ if (curtokmeaning->rectype == withlist[i]) {
+ curtokint = i;
+ return;
+ }
+ curtokmeaning = curtokmeaning->snext;
+ }
+ }
+ }
+ curtokmeaning = sp->mbase;
+ while (curtokmeaning && !curtokmeaning->isactive)
+ curtokmeaning = curtokmeaning->snext;
+ if (!curtokmeaning)
+ return;
+ while (curtokmeaning->kind == MK_SYNONYM)
+ curtokmeaning = curtokmeaning->xnext;
+ /* look for unit.ident notation */
+ if (curtokmeaning->kind == MK_MODULE ||
+ curtokmeaning->kind == MK_FUNCTION) {
+ for (cp = inbufptr; isspace(*cp); cp++) ;
+ if (*cp == '.') {
+ for (cp++; isspace(*cp); cp++) ;
+ if (isalpha(*cp)) {
+ Meaning *mp = curtokmeaning;
+ Symbol *sym = curtoksym;
+ char *saveinbufptr = inbufptr;
+ gettok();
+ if (curtok == TOK_DOT)
+ gettok();
+ else
+ curtok = TOK_END;
+ if (curtok == TOK_IDENT) {
+ curtokmeaning = curtoksym->mbase;
+ while (curtokmeaning &&
+ curtokmeaning->ctx != mp)
+ curtokmeaning = curtokmeaning->snext;
+ if (!curtokmeaning &&
+ !strcmp(sym->name, "SYSTEM")) {
+ curtokmeaning = curtoksym->mbase;
+ while (curtokmeaning &&
+ curtokmeaning->ctx != nullctx)
+ curtokmeaning = curtokmeaning->snext;
+ }
+ } else
+ curtokmeaning = NULL;
+ if (!curtokmeaning) {
+ /* oops, was probably funcname.field */
+ inbufptr = saveinbufptr;
+ curtokmeaning = mp;
+ curtoksym = sym;
+ }
+ }
+ }
+ }
+ return;
+ }
+ } else {
+ warning(format_d("Unrecognized character 0%o in file [247]",
+ ch));
+ }
+ }
+ }
+ }
+
+
+
+ void checkkeyword(tok)
+ Token tok;
+ {
+ if (curtok == TOK_IDENT &&
+ curtoksym->kwtok == tok) {
+ curtoksym->flags &= ~KWPOSS;
+ curtok = tok;
+ }
+ }
+
+
+ void checkmodulewords()
+ {
+ if (modula2) {
+ checkkeyword(TOK_FROM);
+ checkkeyword(TOK_DEFINITION);
+ checkkeyword(TOK_IMPLEMENT);
+ checkkeyword(TOK_MODULE);
+ checkkeyword(TOK_IMPORT);
+ checkkeyword(TOK_EXPORT);
+ } else if (curtok == TOK_IDENT &&
+ (curtoksym->kwtok == TOK_MODULE ||
+ curtoksym->kwtok == TOK_IMPORT ||
+ curtoksym->kwtok == TOK_EXPORT ||
+ curtoksym->kwtok == TOK_IMPLEMENT)) {
+ if (!strcmp(curtokbuf, "UNIT") ||
+ !strcmp(curtokbuf, "USES") ||
+ !strcmp(curtokbuf, "INTERFACE") ||
+ !strcmp(curtokbuf, "IMPLEMENTATION")) {
+ modulenotation = 0;
+ findsymbol("UNIT")->flags &= ~KWPOSS;
+ findsymbol("USES")->flags &= ~KWPOSS;
+ findsymbol("INTERFACE")->flags &= ~KWPOSS;
+ findsymbol("IMPLEMENTATION")->flags &= ~KWPOSS;
+ } else {
+ modulenotation = 1;
+ findsymbol("MODULE")->flags &= ~KWPOSS;
+ findsymbol("EXPORT")->flags &= ~KWPOSS;
+ findsymbol("IMPORT")->flags &= ~KWPOSS;
+ findsymbol("IMPLEMENT")->flags &= ~KWPOSS;
+ }
+ curtok = curtoksym->kwtok;
+ }
+ }
+
+
+
+
+
+
+
+
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/libp2c.a
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/loc.p2clib.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/loc.p2clib.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/loc.p2clib.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,6 ----
+
+ /* Put p2c runtime features local to your system here.
+ * In particular, additional initialization may be provided by defining
+ * the symbol LOCAL_INIT when you compile p2clib.c.
+ */
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/makeproto
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/out.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/out.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/out.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,1580 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+
+ /* This needs to go before trans.h (and thus p2c.proto) is read */
+
+ typedef struct S_paren {
+ struct S_paren *next;
+ int pos, indent, qmindent, flags;
+ } Paren;
+
+
+
+ #define PROTO_OUT_C
+ #include "trans.h"
+
+
+ #ifndef USETIME
+ # if defined(BSD) || defined(hpux)
+ # define USETIME 1
+ # else
+ # define USETIME 0
+ # endif
+ #endif
+
+ #if USETIME
+ # include <sys/time.h>
+ #else
+ # include <time.h>
+ #endif
+
+
+
+
+ /* Output control characters:
+
+ \001 \B Possible break point
+ \002 \X Break point in parentheses
+ \003 \( Invisible open paren
+ \004 \) Invisible close paren
+ \005 \T Set left margin
+ \006 \F Forced break point
+ \007 \A Preceding paren requires all-or-none breaking
+ \010 \[ Invisible open paren, becomes visible if not all on one line
+ \011 \S Break point after last "special argument" of a function
+ \012 \n (newline)
+ \013 \E Preceding break has extra penalty
+ \014 \f (form-feed)
+ \015 \H Hang-indent the preceding operator
+ \016 \. (unused)
+ \017 \C Break point for last : of a ?: construct
+
+ */
+
+ char spchars[] = ".BX()TFA[SnEfH.C................";
+
+
+
+ Static int testinglinebreaker = 0;
+
+ Static int deltaindent, thisindent, thisfutureindent;
+ Static int sectionsize, blanklines, codesectsize, hdrsectsize;
+ Static int codelnum, hdrlnum;
+
+ #define MAXBREAKS 200
+ Static int numbreaks, bestnumbreaks;
+ Static double bestbadness;
+ Static int breakpos[MAXBREAKS], breakindent[MAXBREAKS];
+ Static int breakcount[MAXBREAKS], breakparen[MAXBREAKS];
+ Static int bestbreakpos[MAXBREAKS], bestbreakindent[MAXBREAKS];
+ Static int breakerrorflag;
+
+ #define MAXEDITS 200
+ Static int numedits, bestnumedits;
+ Static int editpos[MAXEDITS], besteditpos[MAXEDITS];
+ Static char editold[MAXEDITS], editnew[MAXEDITS];
+ Static char besteditold[MAXEDITS], besteditnew[MAXEDITS];
+
+ Static Paren *parenlist;
+
+ Static long numalts, bestnumalts;
+ Static int randombreaks;
+
+ Static char *outbuf;
+ Static int outbufpos, outbufcount, outbufsize;
+ Static int suppressnewline, lastlinelength;
+ Static int eatblanks;
+ Static int embeddedcode;
+ Static int showingsourcecode = 0;
+
+ #define BIGBADNESS (1e20)
+
+
+
+ void setup_out()
+ {
+ end_source();
+ if (!nobanner)
+ fprintf(outf, "/* From input file \"%s\" */\n", infname);
+ outf_lnum++;
+ hdrlnum = 1;
+ outindent = 0;
+ deltaindent = 0;
+ thisindent = 0;
+ thisfutureindent = -1;
+ sectionsize = 2;
+ blanklines = 0;
+ dontbreaklines = 0;
+ embeddedcode = 0;
+ outputmode = 0;
+ suppressnewline = 0;
+ eatblanks = 0;
+ outbufsize = 1000;
+ outbuf = ALLOC(outbufsize, char, misc);
+ outbufpos = 0;
+ outbufcount = 0;
+ srand(17);
+ }
+
+
+
+ void select_outfile(fp)
+ FILE *fp;
+ {
+ if (outf == codef) {
+ codesectsize = sectionsize;
+ codelnum = outf_lnum;
+ } else {
+ hdrsectsize = sectionsize;
+ hdrlnum = outf_lnum;
+ }
+ outf = fp;
+ if (outf == codef) {
+ sectionsize = codesectsize;
+ outf_lnum = codelnum;
+ } else {
+ sectionsize = hdrsectsize;
+ outf_lnum = hdrlnum;
+ }
+ }
+
+
+
+ void start_source()
+ {
+ if (!showingsourcecode) {
+ fprintf(outf, "\n#ifdef Pascal\n");
+ showingsourcecode = 1;
+ }
+ }
+
+ void end_source()
+ {
+ if (showingsourcecode) {
+ fprintf(outf, "#endif /*Pascal*/\n\n");
+ showingsourcecode = 0;
+ }
+ }
+
+
+
+ int line_start()
+ {
+ return (outbufcount == 0);
+ }
+
+
+ int cur_column()
+ {
+ if (outbufpos == 0)
+ return outindent;
+ else
+ return thisindent + outbufcount;
+ }
+
+
+
+ int lookback(n)
+ int n;
+ {
+ if (n <= 0 || n > outbufpos)
+ return 0;
+ else
+ return outbuf[outbufpos - n];
+ }
+
+
+ int lookback_prn(n)
+ int n;
+ {
+ for (;;) {
+ if (n <= 0 || n > outbufpos)
+ return 0;
+ else if (outbuf[outbufpos - n] >= ' ')
+ return outbuf[outbufpos - n];
+ else
+ n++;
+ }
+ }
+
+
+
+ /* Combine two indentation adjustments */
+ int adddeltas(d1, d2)
+ int d1, d2;
+ {
+ if (d2 >= 1000)
+ return d2;
+ else
+ return d1 + d2;
+ }
+
+
+ /* Apply an indentation delta */
+ int applydelta(i, d)
+ int i, d;
+ {
+ if (d >= 1000)
+ return d - 1000;
+ else
+ return i + d;
+ }
+
+
+ /* Adjust the current indentation by delta */
+ void moreindent(delta)
+ int delta;
+ {
+ outindent = applydelta(outindent, delta);
+ }
+
+
+ /* Adjust indentation for just this line */
+ void singleindent(delta)
+ int delta;
+ {
+ deltaindent = adddeltas(deltaindent, delta);
+ }
+
+
+ /* Predict indentation for next line */
+ void futureindent(num)
+ int num;
+ {
+ thisfutureindent = applydelta(applydelta(outindent, deltaindent), num);
+ }
+
+
+ int parsedelta(cp, def)
+ char *cp;
+ int def;
+ {
+ if (!cp || !*cp)
+ return def;
+ if ((*cp == '+' || *cp == '-') && isdigit(cp[1]))
+ return atoi(cp);
+ if (*cp == '*' && isdigit(cp[1]))
+ return 2000 + atoi(cp+1);
+ else
+ return 1000 + atoi(cp);
+ }
+
+
+
+
+ Static void leading_tab(col)
+ int col;
+ {
+ if (col > maxlinewidth)
+ return; /* something wrong happened! */
+ if (phystabsize > 0) {
+ while (col >= phystabsize) {
+ putc('\t', outf);
+ col -= phystabsize;
+ }
+ }
+ while (col > 0) {
+ putc(' ', outf);
+ col--;
+ }
+ }
+
+
+
+ void eatblanklines()
+ {
+ eatblanks = 1;
+ }
+
+
+
+ Static void flush_outbuf(numbreaks, breakpos, breakindent,
+ numedits, editpos, editold, editnew)
+ int numbreaks, *breakpos, *breakindent, numedits, *editpos;
+ char *editold, *editnew;
+ {
+ unsigned char ch, ch2;
+ char *cp;
+ int i, j, linelen = 0, spaces, hashline;
+ int editsaves[MAXEDITS];
+
+ end_source();
+ if (outbufcount > 0) {
+ for (i = 0; i < numedits; i++) {
+ editsaves[i] = outbuf[editpos[i]];
+ outbuf[editpos[i]] = editnew[i];
+ }
+ leading_tab(thisindent);
+ cp = outbuf;
+ hashline = (*cp == '#'); /* a preprocessor directive */
+ spaces = 0;
+ j = 1;
+ for (i = 0; i < outbufpos; ) {
+ if (j < numbreaks && i == breakpos[j]) {
+ if (hashline)
+ fprintf(outf, " \\"); /* trailing backslash required */
+ putc('\n', outf);
+ outf_lnum++;
+ leading_tab(breakindent[j]);
+ linelen = breakindent[j];
+ j++;
+ while (i < outbufpos && *cp == ' ')
+ i++, cp++; /* eat leading spaces */
+ spaces = 0; /* eat trailing spaces */
+ } else {
+ ch = *cp++;
+ if (ch == ' ') {
+ spaces++;
+ } else if (ch > ' ') {
+ linelen += spaces;
+ while (spaces > 0)
+ putc(' ', outf), spaces--;
+ linelen++;
+ if (ch == '\\' && embeddedcode) {
+ if (*cp == '[') {
+ putc('{', outf);
+ cp++, i++;
+ } else if (*cp == ']') {
+ putc('}', outf);
+ cp++, i++;
+ } else
+ putc(ch, outf);
+ } else
+ putc(ch, outf);
+ } else if (testinglinebreaker >= 3) {
+ linelen += spaces;
+ while (spaces > 0)
+ putc(' ', outf), spaces--;
+ linelen++;
+ putc('\\', outf);
+ ch2 = spchars[ch];
+ if (ch2 != '.')
+ putc(ch2, outf);
+ else {
+ putc('0' + ((ch >> 6) & 7), outf);
+ putc('0' + ((ch >> 3) & 7), outf);
+ putc('0' + (ch & 7), outf);
+ }
+ }
+ i++;
+ }
+ }
+ for (i = 0; i < numedits; i++)
+ outbuf[editpos[i]] = editsaves[i];
+ eatblanks = 0;
+ } else if (eatblanks) {
+ return;
+ }
+ if (suppressnewline) {
+ lastlinelength = linelen;
+ } else
+ putc('\n', outf);
+ outf_lnum++;
+ }
+
+
+
+ #define ISQUOTE(ch) ((ch)=='"' || (ch)=='\'')
+ #define ISOPENP(ch) ((ch)=='(' || (ch)=='[' || (ch)=='\003' || (ch)=='\010')
+ #define ISCLOSEP(ch) ((ch)==')' || (ch)==']' || (ch)=='\004')
+ #define ISBREAK(ch) ((ch)=='\001' || (ch)=='\002' || (ch)=='\006' || (ch)=='\011' || (ch)=='\017')
+
+ Static int readquotes(posp, err)
+ int *posp, err;
+ {
+ int pos;
+ char quote;
+
+ pos = *posp;
+ quote = outbuf[pos++];
+ while (pos < outbufpos && outbuf[pos] != quote) {
+ if (outbuf[pos] == '\\')
+ pos++;
+ pos++;
+ }
+ if (pos >= outbufpos) {
+ if (err && breakerrorflag) {
+ intwarning("output", "Mismatched quotes [248]");
+ breakerrorflag = 0;
+ }
+ return 0;
+ } else {
+ *posp = pos;
+ return 1;
+ }
+ }
+
+
+ Static int maxdepth;
+
+ Static int readparens(posp, err)
+ int *posp, err;
+ {
+ char ch, closing;
+ int pos, level;
+
+ pos = *posp;
+ switch (outbuf[pos]) {
+ case '(':
+ closing = ')';
+ break;
+ case '[':
+ closing = ']';
+ break;
+ case '\003':
+ case '\010':
+ closing = '\004';
+ break;
+ default:
+ closing = 0;
+ break;
+ }
+ level = 0;
+ for (;;) {
+ pos++;
+ if (pos >= outbufpos)
+ break;
+ ch = outbuf[pos];
+ if (ISOPENP(ch)) {
+ level++;
+ if (level > maxdepth)
+ maxdepth = level;
+ } else if (ISCLOSEP(ch)) {
+ level--;
+ if (level < 0) {
+ if (closing && outbuf[pos] != closing)
+ break;
+ *posp = pos;
+ return 1;
+ }
+ } else if (ISQUOTE(ch)) {
+ if (!readquotes(&pos, err))
+ return 0;
+ }
+ }
+ if (err && breakerrorflag) {
+ switch (closing) {
+ case ')':
+ intwarning("output", "Mismatched parentheses [249]");
+ break;
+ case ']':
+ intwarning("output", "Mismatched brackets [249]");
+ break;
+ default:
+ intwarning("output", "Mismatched clauses [250]");
+ break;
+ }
+ breakerrorflag = 0;
+ }
+ return 0;
+ }
+
+
+
+ Static int measurechars(first, last)
+ int first, last;
+ {
+ int count = 0;
+
+ while (first <= last) {
+ if (outbuf[first] >= ' ')
+ count++;
+ first++;
+ }
+ return count;
+ }
+
+
+
+ Static void makeedit(pos, ch)
+ int pos, ch;
+ {
+ editpos[numedits] = pos;
+ editold[numedits] = outbuf[pos];
+ editnew[numedits] = ch;
+ outbuf[pos] = ch;
+ numedits++;
+ }
+
+ Static void unedit()
+ {
+ numedits--;
+ outbuf[editpos[numedits]] = editold[numedits];
+ }
+
+
+ Static int parencount(par)
+ Paren *par;
+ {
+ int count = 0;
+
+ while (par) {
+ count++;
+ par = par->next;
+ }
+ return count;
+ }
+
+
+
+
+
+ /* The following routine explores the tree of all possible line breaks,
+ pruning according to the fact that "badness" and "extra" are
+ increasing functions. The object is to find the set of breaks and
+ indentation with the least total badness.
+ (The basic idea was borrowed from Donald Knuth's "TeX".)
+ */
+
+ /* As an additional optimization, the concept of a "simple" line is used,
+ i.e., a line with a structure such that the best break is sure to be
+ the straightforward left-to-right fill used by a simple word processor.
+ (For example, a long line with nothing but comma-breakpoints is simple.)
+
+ Also, if the line is very long a few initial random passes are made just
+ to scope out an estimate of the eventual badness of the line. This
+ combined with the badness cull helps keep the breaker from using up its
+ quota of tries before even considering a key break point! Note that
+ when randombreaks==1, each call to trybreakline is fast since only one
+ branch is taken at each decision point.
+ */
+
+
+ #define randtest(lim) (!randombreaks ? -1 \
+ : randombreaks > 0 \
+ ? parencount(parens) < randombreaks-1 \
+ : randombreaks == -2 \
+ ? 0 \
+ : (rand() & 0xfff) < (lim))
+
+ #define TB_BRKCOUNT 0x0ff
+ #define TB_FORCEBRK 0x100
+ #define TB_NOBREAK 0x200
+ #define TB_ALREADYBRK 0x400
+ #define TB_ALLORNONE 0x800
+ #define TB_EXTRAIND 0x1000
+ #define TB_EXTRAIND2 0x2000
+
+ #define TBR_ABORT 0x1
+ #define TBR_SIMPLE 0x2
+ #define TBR_REACHED 0x4
+
+ Static int trybreakline(pos, count, indent, badness, flags, parens)
+ int pos, count, indent, flags;
+ double badness;
+ Paren *parens;
+ {
+ int edited;
+ int i, j, jmask, f, pos2, r;
+ char ch, ch2, closing;
+ double extra, penalty;
+ Paren *pp;
+
+ #if 0
+ { static double save = -1;
+ if (showbadlimit != save) printf("Showbadlimit = %g\n", showbadlimit);
+ save = showbadlimit;
+ }
+ #endif
+
+ if (numalts >= maxalts)
+ return TBR_ABORT;
+ jmask = -1;
+ for (;;) {
+ if (numbreaks >= MAXBREAKS) { /* must leave rest of line alone */
+ count += measurechars(pos, outbufpos-1);
+ pos = outbufpos;
+ }
+ i = count - breakcount[numbreaks-1] +
+ breakindent[numbreaks-1] - linewidth;
+ if (i <= 0)
+ extra = 0;
+ else {
+ if (i + linewidth >= maxlinewidth || randombreaks == -2)
+ return 0; /* absolutely too long! */
+ extra = overwidepenalty + ((long)i*i)*overwideextrapenalty;
+ jmask &= ~TBR_SIMPLE;
+ if (extra < 0)
+ extra = 0;
+ }
+ if ((testinglinebreaker > 1 && showbadlimit > 0) ?
+ (badness + extra >= showbadlimit) :
+ (badness + extra >= bestbadness)) {
+ numalts++;
+ return 0; /* no point in going on, badness will only increase */
+ }
+ if (pos >= outbufpos)
+ break;
+ if (parens && pos >= parens->pos) {
+ indent = parens->indent;
+ flags = parens->flags;
+ parens = parens->next;
+ }
+ ch = outbuf[pos++];
+ if (ch >= ' ')
+ count++;
+ switch (ch) {
+
+ case '(':
+ case '[':
+ case '\003': /* "invisible open paren" */
+ case '\010': /* "semi-invisible open paren" */
+ pos2 = pos - 1;
+ if (!readparens(&pos2, 1))
+ break;
+ i = measurechars(pos, pos2);
+ if (count + i - breakcount[numbreaks-1] +
+ breakindent[numbreaks-1] <= linewidth) {
+ /* it fits, so leave it on one line */
+ #if 0 /* I don't think this is necessary */
+ while (pos <= pos2) {
+ if (outbuf[pos] == '\002') {
+ jmask &= ~TBR_SIMPLE;
+ pos = pos2 + 1;
+ break;
+ }
+ pos++;
+ }
+ #else
+ pos = pos2 + 1;
+ #endif
+ count += i;
+ break;
+ }
+ pp = ALLOC(1, Paren, parens); /* doesn't fit, try poss breaks */
+ pp->next = parens;
+ pp->pos = pos2;
+ pp->indent = indent;
+ pp->qmindent = indent;
+ pp->flags = flags;
+ parens = pp;
+ flags = 0;
+ if (ch == '\010' && /* change to real parens when broken */
+ numedits+1 < MAXEDITS) { /* (assume it will be broken!) */
+ makeedit(pos-1, '(');
+ makeedit(pos2, ')');
+ count++; /* count the new open paren */
+ edited = 1;
+ } else
+ edited = 0;
+ i = breakindent[numbreaks-1] + count - breakcount[numbreaks-1];
+ if (i <= thisindent)
+ r = 0; /* e.g., don't break top-level assignments */
+ else if (i == indent + extraindent)
+ r = 1; /* don't waste time on identical operations */
+ else
+ r = randtest(0xc00);
+ if (r != 0) {
+ j = trybreakline(pos, count, i,
+ badness + MAX(- extraindentpenalty,0),
+ flags, parens);
+ } else
+ j = 0;
+ if (r != 1) {
+ j &= trybreakline(pos, count, indent + extraindent,
+ badness + MAX(extraindentpenalty,0),
+ flags | TB_EXTRAIND, parens);
+ }
+ if (!randombreaks && bumpindent != 0) {
+ if (i == thisfutureindent) {
+ j &= trybreakline(pos, count, i + bumpindent,
+ badness + MAX(- extraindentpenalty,0)
+ + bumpindentpenalty,
+ flags, parens);
+ } else if (indent + extraindent == thisfutureindent) {
+ j &= trybreakline(pos, count,
+ indent + extraindent + bumpindent,
+ badness + MAX(extraindentpenalty,0)
+ + bumpindentpenalty,
+ flags | TB_EXTRAIND, parens);
+ }
+ }
+ if (edited) {
+ unedit();
+ unedit();
+ }
+ FREE(pp);
+ return j & jmask;
+
+ case '\005': /* "set left margin" */
+ indent = breakindent[numbreaks-1] +
+ count - breakcount[numbreaks-1];
+ break;
+
+ case '\007': /* "all-or-none breaking" */
+ flags |= TB_ALLORNONE;
+ break;
+
+ case '\001': /* "possible break point" */
+ case '\002': /* "break point in parens" */
+ case '\006': /* "forced break point" */
+ case '\011': /* "break point after special args" */
+ case '\017': /* "break point for final : operator" */
+ /* first try the non-breaking case */
+ if (ch != '\001' && ch != '\006')
+ jmask &= ~TBR_SIMPLE;
+ if ((flags & TB_BRKCOUNT) != TB_BRKCOUNT)
+ flags++; /* increment TB_BRKCOUNT field */
+ if (outbuf[pos] == '?' && parens)
+ parens->qmindent = breakindent[numbreaks-1] +
+ count - breakcount[numbreaks-1];
+ j = TBR_REACHED;
+ if (ch == '\006' || (flags & TB_FORCEBRK)) {
+ /* don't try the non-breaking case */
+ } else {
+ if (ch == '\011') {
+ i = breakindent[numbreaks-1] +
+ count - breakcount[numbreaks-1] + 2;
+ } else {
+ i = indent;
+ }
+ f = flags;
+ if (f & TB_ALLORNONE)
+ f |= TB_NOBREAK;
+ r = randtest(0x800);
+ if (r != 1 || (flags & TB_NOBREAK)) {
+ j = trybreakline(pos, count, i, badness, f, parens) &
+ jmask;
+ if (randombreaks == -2 && !(j & TBR_REACHED)) {
+ r = -1;
+ j |= TBR_REACHED;
+ }
+ if (r == 0 || (j & TBR_SIMPLE))
+ flags |= TB_NOBREAK;
+ }
+ }
+ if (flags & TB_NOBREAK)
+ return j;
+ if (flags & TB_ALLORNONE)
+ flags |= TB_FORCEBRK;
+ if (flags & TB_EXTRAIND) {
+ flags &= ~TB_EXTRAIND;
+ flags |= TB_EXTRAIND2;
+ }
+ /* now try breaking here */
+ if (ch == '\017')
+ indent = parens->qmindent;
+ if (indent < 0)
+ indent = 0;
+ breakpos[numbreaks] = pos;
+ breakcount[numbreaks] = count;
+ breakindent[numbreaks] = indent;
+ breakparen[numbreaks] = parens ? parens->pos : 0;
+ numbreaks++;
+ penalty = extra;
+ if (indent == thisfutureindent) {
+ i = pos;
+ while (i < outbufpos-1 && outbuf[i] <= ' ')
+ i++;
+ ch2 = outbuf[i]; /* first character on next line */
+ if (ch2 != '(' && ch2 != '!' && ch2 != '~' && ch2 != '-')
+ penalty += nobumpindentpenalty;
+ }
+ switch (ch) {
+ case '\001':
+ penalty += commabreakpenalty;
+ if (flags & TB_ALREADYBRK)
+ penalty += morebreakpenalty;
+ break;
+ case '\011':
+ i = parencount(parens);
+ penalty += specialargbreakpenalty + commabreakextrapenalty*i;
+ break;
+ case '\002':
+ case '\017':
+ i = parencount(parens);
+ if (outbuf[pos-2] == '(')
+ penalty += parenbreakpenalty + parenbreakextrapenalty*i;
+ else if (outbuf[pos-2] == ',')
+ penalty += commabreakpenalty + commabreakextrapenalty*i;
+ else if (((outbuf[pos] == '&' || outbuf[pos] == '|') &&
+ outbuf[pos+1] == outbuf[pos]) ||
+ ((outbuf[pos-3] == '&' || outbuf[pos-3] == '|') &&
+ outbuf[pos-3] == outbuf[pos-2]))
+ penalty += logbreakpenalty + logbreakextrapenalty*i;
+ else if (((outbuf[pos] == '<' || outbuf[pos] == '>') &&
+ outbuf[pos+1] != outbuf[pos]) ||
+ ((outbuf[pos] == '=' || outbuf[pos] == '!') &&
+ outbuf[pos+1] == '=') ||
+ ((outbuf[pos-2] == '<' || outbuf[pos-2] == '>') &&
+ outbuf[pos-3] != outbuf[pos-2]) ||
+ ((outbuf[pos-3] == '<' || outbuf[pos-3] == '>' ||
+ outbuf[pos-3] == '=' || outbuf[pos-3] == '!') &&
+ outbuf[pos-2] == '='))
+ penalty += relbreakpenalty + relbreakextrapenalty*i;
+ else if (outbuf[pos-2] == '=')
+ penalty += assignbreakpenalty + assignbreakextrapenalty*i;
+ else if (outbuf[pos] == '?') {
+ penalty += qmarkbreakpenalty + qmarkbreakextrapenalty*i;
+ if (parens)
+ parens->qmindent = breakindent[numbreaks-1] +
+ count - breakcount[numbreaks-1];
+ } else
+ penalty += opbreakpenalty + opbreakextrapenalty*i;
+ if (outbuf[pos-2] == '-')
+ penalty += exhyphenpenalty;
+ if (flags & TB_ALREADYBRK)
+ penalty += morebreakpenalty + morebreakextrapenalty*i;
+ break;
+ default:
+ break;
+ }
+ while (pos < outbufpos && outbuf[pos] == '\013') {
+ penalty += wrongsidepenalty;
+ pos++;
+ }
+ penalty -= earlybreakpenalty*(flags & TB_BRKCOUNT);
+ /* the following test is not quite right, but it's not too bad. */
+ if (breakindent[numbreaks-2] == breakindent[numbreaks-1] &&
+ breakparen[numbreaks-2] != breakparen[numbreaks-1])
+ penalty += sameindentpenalty;
+ #if 0
+ else if (ch == '\002' && parens && /*don't think this is needed*/
+ parens->indent == breakindent[numbreaks-1] &&
+ parens->pos != breakparen[numbreaks-1])
+ penalty += sameindentpenalty + 0.001; /***/
+ #endif
+ penalty += (breakindent[numbreaks-1] - thisindent) *
+ indentamountpenalty;
+ if (penalty < 1) penalty = 1;
+ pos2 = pos;
+ while (pos2 < outbufpos && outbuf[pos2] == ' ')
+ pos2++;
+ flags |= TB_ALREADYBRK;
+ j = trybreakline(pos2, count, indent, badness + penalty,
+ flags, parens) & jmask;
+ numbreaks--;
+ return j;
+
+ case '\015': /* "hang-indent operator" */
+ if (count <= breakcount[numbreaks-1] + 2 &&
+ !(flags & TB_EXTRAIND2)) {
+ breakindent[numbreaks-1] -= count - breakcount[numbreaks-1];
+ pos2 = pos;
+ while (pos2 < outbufpos && outbuf[pos2] <= ' ') {
+ if (outbuf[pos2] == ' ')
+ breakindent[numbreaks-1]--;
+ pos2++;
+ }
+ }
+ break;
+
+ case '"':
+ case '\'':
+ closing = ch;
+ while (pos < outbufpos && outbuf[pos] != closing) {
+ if (outbuf[pos] == '\\')
+ pos++, count++;
+ pos++;
+ count++;
+ }
+ if (pos >= outbufpos) {
+ intwarning("output", "Mismatched quotes [248]");
+ continue;
+ }
+ pos++;
+ count++;
+ break;
+
+ case '/':
+ if (pos < outbufpos && (outbuf[pos] == '*' ||
+ (outbuf[pos] == '/' && cplus > 0))) {
+ count += measurechars(pos, outbufpos-1);
+ pos = outbufpos; /* assume comment is at end of line */
+ }
+ break;
+
+ }
+ }
+ numalts++;
+ badness += extra;
+ if (testinglinebreaker > 1) {
+ if (badness >= bestbadness &&
+ (badness < showbadlimit || showbadlimit == 0)) {
+ fprintf(outf, "\n#if 0 /* rejected #%ld, badness = %g >= %g */\n", numalts, badness, bestbadness);
+ flush_outbuf(numbreaks, breakpos, breakindent,
+ numedits, editpos, editold, editnew);
+ fprintf(outf, "#endif\n");
+ return TBR_SIMPLE & jmask;
+ } else if ((bestbadness < showbadlimit || showbadlimit == 0) &&
+ bestnumalts > 0) {
+ fprintf(outf, "\n#if 0 /* rejected #%ld, badness = %g > %g */\n", bestnumalts, bestbadness, badness);
+ flush_outbuf(bestnumbreaks, bestbreakpos, bestbreakindent,
+ bestnumedits, besteditpos,
+ besteditold, besteditnew);
+ fprintf(outf, "#endif\n");
+ }
+ }
+ bestbadness = badness;
+ bestnumbreaks = numbreaks;
+ bestnumalts = numalts;
+ for (i = 0; i < numbreaks; i++) {
+ bestbreakpos[i] = breakpos[i];
+ bestbreakindent[i] = breakindent[i];
+ }
+ bestnumedits = numedits;
+ for (i = 0; i < numedits; i++) {
+ besteditpos[i] = editpos[i];
+ besteditold[i] = editold[i];
+ besteditnew[i] = editnew[i];
+ }
+ return TBR_SIMPLE & jmask;
+ }
+
+
+
+
+ int parse_breakstr(cp)
+ char *cp;
+ {
+ short val = 0;
+
+ if (isdigit(*cp))
+ return atoi(cp);
+ while (*cp && !isspace(*cp) && *cp != '}') {
+ switch (toupper(*cp++)) {
+
+ case 'N':
+ case '=':
+ break;
+
+ case 'L':
+ val |= BRK_LEFT;
+ break;
+
+ case 'R':
+ val |= BRK_RIGHT;
+ break;
+
+ case 'H':
+ val |= BRK_HANG | BRK_LEFT;
+ break;
+
+ case '>':
+ if (val & BRK_LEFT)
+ val |= BRK_LPREF;
+ else if (val & BRK_RIGHT)
+ val |= BRK_RPREF;
+ else
+ return -1;
+ break;
+
+ case '<':
+ if (val & BRK_LEFT)
+ val |= BRK_RPREF;
+ else if (val & BRK_RIGHT)
+ val |= BRK_LPREF;
+ else
+ return -1;
+ break;
+
+ case 'A':
+ val |= BRK_ALLNONE;
+ break;
+
+ default:
+ return -1;
+
+ }
+ }
+ return val;
+ }
+
+
+
+
+ long getcurtime()
+ {
+ #if USETIME
+ static unsigned long starttime = 0;
+ struct timeval t;
+ struct timezone tz;
+
+ gettimeofday(&t, &tz);
+ if (starttime == 0)
+ starttime = t.tv_sec;
+ t.tv_sec -= starttime;
+ return (t.tv_sec*1000 + t.tv_usec/1000);
+ #else
+ static unsigned long starttime = 0;
+ if (!starttime) starttime = time(NULL);
+ return (time(NULL) - starttime) * 1000;
+ #endif
+ }
+
+
+
+ void output(msg)
+ register char *msg;
+ {
+ unsigned char ch;
+ double savelimit;
+ int i, savemaxlw, maxdp;
+ long alts;
+ long time0, time0a, time1;
+
+ debughook();
+ if (outputmode) {
+ end_source();
+ while ((ch = *msg++) != 0) {
+ if (ch >= ' ') {
+ putc(ch, outf);
+ } else if (ch == '\n') {
+ putc('\n', outf);
+ outf_lnum++;
+ }
+ }
+ return;
+ }
+ while ((ch = *msg++) != 0) {
+ if (ch == '\n') {
+ if (outbufpos == 0) { /* blank line */
+ thisfutureindent = -1;
+ blanklines++;
+ continue;
+ }
+ if (sectionsize > blanklines)
+ blanklines = sectionsize;
+ sectionsize = 0;
+ if (eatblanks)
+ blanklines = 0;
+ while (blanklines > 0) {
+ blanklines--;
+ end_source();
+ putc('\n', outf);
+ outf_lnum++;
+ }
+ if (thisindent + outbufcount >= linewidth && !dontbreaklines) {
+ numbreaks = 1;
+ bestnumbreaks = 0;
+ bestbadness = BIGBADNESS;
+ breakpos[0] = 0;
+ breakindent[0] = thisindent;
+ breakcount[0] = 0;
+ breakerrorflag = 1;
+ numedits = 0;
+ bestnumedits = 0;
+ savelimit = showbadlimit;
+ numalts = 0;
+ bestnumalts = 0;
+ savemaxlw = maxlinewidth;
+ time0 = time0a = getcurtime();
+ if (regression)
+ srand(17);
+ if (thisindent + outbufcount > linewidth*3/2) {
+ i = 0;
+ maxdepth = 0;
+ readparens(&i, 0);
+ maxdp = maxdepth;
+ for (;;) { /* try some simple fixed methods first... */
+ for (i = 1; i <= 20; i++) {
+ randombreaks = -1;
+ trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ }
+ randombreaks = -2;
+ trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ for (i = 0; i <= maxdp+1; i++) {
+ randombreaks = i+1;
+ trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ }
+ if (bestbadness == BIGBADNESS && maxlinewidth < 9999) {
+ maxlinewidth = 9999; /* no choice but to relax */
+ numalts = 0;
+ } else
+ break;
+ }
+ time0a = getcurtime();
+ }
+ randombreaks = 0;
+ trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ if (bestbadness == BIGBADNESS && maxlinewidth < 9999) {
+ numalts = 0;
+ maxlinewidth = 9999; /* no choice but to relax this */
+ trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ }
+ time1 = getcurtime() - time0;
+ alts = numalts;
+ if (testinglinebreaker) {
+ if (savelimit < 0 && testinglinebreaker > 1) {
+ showbadlimit = bestbadness * (-savelimit);
+ numalts = 0;
+ bestnumalts = 0;
+ trybreakline(0, 0, thisindent, 0.0, 0, NULL);
+ }
+ fprintf(outf, "\n#if 1 /* accepted #%ld, badness = %g, tried %ld in %.3f sec */\n", bestnumalts, bestbadness, alts, time1/1000.0);
+ }
+ showbadlimit = savelimit;
+ maxlinewidth = savemaxlw;
+ flush_outbuf(bestnumbreaks, bestbreakpos, bestbreakindent,
+ bestnumedits, besteditpos,
+ besteditold, besteditnew);
+ if (((USETIME && time1 > 1000) || alts >= maxalts) &&
+ !regression) {
+ sprintf(outbuf, "Line breaker spent %.1f",
+ (time1 + time0 - time0a) / 1000.0);
+ if (time0 != time0a)
+ sprintf(outbuf + strlen(outbuf),
+ "+%.2f", (time0a - time0) / 1000.0);
+ sprintf(outbuf + strlen(outbuf),
+ " seconds, %ld tries on line %d [251]", alts, outf_lnum);
+ note(outbuf);
+ } else if (verbose) {
+ fprintf(logf, "%s, %d/%d: Line breaker spent %ld tries\n",
+ infname, inf_lnum, outf_lnum, alts);
+ }
+ if (testinglinebreaker)
+ fprintf(outf, "#endif\n\n");
+ } else {
+ if (testinglinebreaker < 2)
+ flush_outbuf(0, NULL, NULL, 0, NULL, NULL, NULL);
+ }
+ thisfutureindent = -1;
+ outbufpos = 0;
+ outbufcount = 0;
+ } else {
+ if (outbufpos == 0) {
+ if (ch == ' ' && !dontbreaklines) /* eat leading spaces */
+ continue;
+ thisindent = applydelta(outindent, deltaindent);
+ deltaindent = 0;
+ }
+ if (outbufpos == outbufsize) {
+ outbufsize *= 2;
+ outbuf = REALLOC(outbuf, outbufsize, char);
+ }
+ outbuf[outbufpos++] = ch;
+ if (ch >= ' ')
+ outbufcount++;
+ }
+ }
+ }
+
+
+
+ void out_n_spaces(n)
+ int n;
+ {
+ while (--n >= 0)
+ output(" ");
+ }
+
+
+
+ void out_spaces(spc, over, len, delta)
+ int spc, over, len, delta;
+ {
+ int n;
+
+ if (spc == -999)
+ spc = commentindent;
+ if (spc < 0) { /* right-justify */
+ n = (-spc) - cur_column() - len;
+ if (n < minspcthresh)
+ n = minspacing;
+ else
+ over = 1000;
+ } else if (spc >= 2000) { /* tab to multiple */
+ spc -= 2000;
+ n = (spc-1) - ((cur_column()+spc-1) % spc);
+ if (n < minspcthresh)
+ n += spc;
+ } else if (spc >= 1000) { /* absolute column */
+ spc -= 1000;
+ n = spc - cur_column();
+ if (n < minspcthresh)
+ n = minspacing;
+ } else /* relative spacing */
+ n = spc;
+ if (line_start()) {
+ singleindent(n);
+ } else if (len > 0 && over != 1000 && cur_column() + n + len > linewidth) {
+ output("\n");
+ out_spaces(over, 1000, len, 0);
+ singleindent(delta);
+ } else {
+ out_n_spaces(n);
+ }
+ }
+
+
+
+
+ void testlinebreaker(lev, fn)
+ int lev;
+ char *fn;
+ {
+ char buf[256], *bp, *cp;
+ int first, indent;
+
+ testinglinebreaker = lev;
+ if (!fn)
+ return;
+ inf = fopen(fn, "r");
+ if (!inf) {
+ perror(fn);
+ exit(1);
+ }
+ sprintf(buf, "%s.br", fn);
+ outf = fopen(buf, "w");
+ if (!outf) {
+ perror(buf);
+ exit(1);
+ }
+ setup_out();
+ outindent = 4;
+ first = 1;
+ while (fgets(buf, 256, inf)) {
+ cp = buf + strlen(buf) - 2;
+ if (cp >= buf) {
+ bp = buf;
+ indent = 0;
+ while (isspace(*bp))
+ if (*bp++ == '\t')
+ indent += 8;
+ else
+ indent++;
+ if (first) {
+ first = 0;
+ outindent = indent;
+ }
+ if (!(*cp == '{' ||
+ *cp == ')' ||
+ *cp == ';') ||
+ (*cp == '/' && cp[-1] == '*')) {
+ cp[1] = '\001'; /* eat the \n */
+ } else {
+ first = 1;
+ }
+ output(bp);
+ }
+ }
+ fclose(outf);
+ fclose(inf);
+ }
+
+
+
+
+
+ void outsection(size)
+ int size;
+ {
+ if (size > sectionsize)
+ sectionsize = size;
+ }
+
+
+
+ int isembedcomment(cmt)
+ Strlist *cmt;
+ {
+ int len = strlen(embedcomment);
+ return (cmt && len > 0 && !strncmp(cmt->s, embedcomment, len) &&
+ (isspace(cmt->s[len]) ||
+ (!cmt->s[len] && cmt->next &&
+ (*cmt->next->s == '\002' || *cmt->next->s == '\003'))));
+ }
+
+
+ Strlist *outcomments(cmt)
+ Strlist *cmt;
+ {
+ char *cp;
+ int saveindent = outindent, savesingle = deltaindent, theindent;
+ int saveeat = eatcomments;
+ int i = 0;
+
+ if (!cmt)
+ return NULL;
+ if (!commentvisible(cmt)) {
+ setcommentkind(cmt, CMT_DONE);
+ return cmt->next;
+ }
+ if (*cmt->s == '\001') {
+ if (cmtdebug)
+ output(format_sd("[] [%s:%d]",
+ CMT_NAMES[getcommentkind(cmt)],
+ cmt->value & CMT_MASK));
+ for (cp = cmt->s; *cp; cp++) {
+ output("\n");
+ if (cmtdebug && cp[1])
+ output("[]");
+ }
+ setcommentkind(cmt, CMT_DONE);
+ return cmt->next;
+ }
+ dontbreaklines++;
+ if (isembedcomment(cmt)) {
+ embeddedcode = 1;
+ eatcomments = 0;
+ if (!strcmp(cmt->s, embedcomment)) {
+ cmt = cmt->next;
+ theindent = 0;
+ cp = cmt/*->next*/->s + 1;
+ while (*cp++ == ' ')
+ theindent++;
+ } else {
+ strcpy(cmt->s, cmt->s + strlen(embedcomment) + 1);
+ moreindent(deltaindent);
+ theindent = outindent;
+ deltaindent = 0;
+ }
+ } else {
+ moreindent(deltaindent);
+ if (cmt->s[0] == '\004')
+ outindent = 0;
+ theindent = outindent;
+ deltaindent = 0;
+ output("/*");
+ }
+ cp = cmt->s;
+ for (;;) {
+ if (*cp == '\002')
+ cp++;
+ else if (*cp == '\003' || *cp == '\004') {
+ outindent = 0;
+ cp++;
+ }
+ if (embeddedcode) {
+ for (i = 0; *cp == ' ' && i < theindent; i++)
+ cp++;
+ i = *cp;
+ if (*cp == '#')
+ outindent = 0;
+ }
+ output(cp);
+ if (cmtdebug)
+ output(format_sd(" [%s:%d] ",
+ CMT_NAMES[getcommentkind(cmt)],
+ cmt->value & CMT_MASK));
+ setcommentkind(cmt, CMT_DONE);
+ cmt = cmt->next;
+ if (!cmt || !commentvisible(cmt))
+ break;
+ cp = cmt->s;
+ if (*cp != '\002' && *cp != '\003')
+ break;
+ output("\n");
+ if (!embeddedcode) {
+ outindent = (*cp == '\002') ? theindent : 0;
+ deltaindent = 0;
+ }
+ }
+ if (embeddedcode) {
+ embeddedcode = 0;
+ if (i) { /* eat final blank line */
+ output("\n");
+ }
+ } else {
+ output("*/\n");
+ }
+ outindent = saveindent;
+ deltaindent = savesingle;
+ dontbreaklines--;
+ eatcomments = saveeat;
+ return cmt;
+ }
+
+
+
+ void outcomment(cmt)
+ Strlist *cmt;
+ {
+ Strlist *savenext;
+
+ if (cmt) {
+ savenext = cmt->next;
+ cmt->next = NULL;
+ outcomments(cmt);
+ cmt->next = savenext;
+ }
+ }
+
+
+
+ void outtrailcomment(cmt, serial, indent)
+ Strlist *cmt;
+ int serial, indent;
+ {
+ int savedelta = deltaindent;
+
+ #if 0
+ suppressnewline = 1;
+ output("\n");
+ suppressnewline = 0;
+ #endif
+ cmt = findcomment(cmt, CMT_TRAIL, serial);
+ if (commentvisible(cmt)) {
+ out_spaces(indent, commentoverindent, commentlen(cmt), 0);
+ outcomment(cmt);
+ deltaindent = savedelta;
+ } else
+ output("\n");
+ }
+
+
+
+ void flushcomments(cmt, kind, serial)
+ Strlist **cmt;
+ int kind, serial;
+ {
+ Strlist *cmt2, *cmt3;
+ int saveindent, savesingle, saveeat;
+
+ if (!cmt)
+ cmt = &curcomments;
+ cmt2 = extractcomment(cmt, kind, serial);
+ saveindent = outindent;
+ savesingle = deltaindent;
+ moreindent(deltaindent);
+ deltaindent = 0;
+ saveeat = eatcomments;
+ if (eatcomments == 2)
+ eatcomments = 0;
+ cmt3 = cmt2;
+ while (cmt3)
+ cmt3 = outcomments(cmt3);
+ eatcomments = saveeat;
+ outindent = saveindent;
+ deltaindent = savesingle;
+ strlist_empty(&cmt2);
+ }
+
+
+
+
+
+ char *rawCstring(fmt, s, len, special)
+ char *fmt;
+ register char *s;
+ int len, special;
+ {
+ char buf[500];
+ register char *cp;
+ register unsigned char ch;
+
+ cp = buf;
+ while (--len >= 0) {
+ ch = *((unsigned char *) s);
+ s++;
+ if (ch == 0 && (len == 0 || !isdigit(*s))) {
+ *cp++ = '\\';
+ *cp++ = '0';
+ } else if (ch == '\n') {
+ *cp++ = '\\';
+ *cp++ = 'n';
+ } else if (ch == '\b') {
+ *cp++ = '\\';
+ *cp++ = 'b';
+ } else if (ch == '\t') {
+ *cp++ = '\\';
+ *cp++ = 't';
+ } else if (ch == '\f') {
+ *cp++ = '\\';
+ *cp++ = 'f';
+ #if 0
+ } else if (ch == '\r') {
+ *cp++ = '\\';
+ *cp++ = 'r';
+ #endif
+ } else if (ch < ' ' || ch >= 127) {
+ *cp++ = '\\';
+ *cp++ = '0' + (ch>>6);
+ *cp++ = '0' + ((ch>>3) & 7);
+ *cp++ = '0' + (ch & 7);
+ } else if (ch == special) {
+ switch (ch) {
+ case '%':
+ *cp++ = ch;
+ *cp++ = ch;
+ break;
+ }
+ } else {
+ if (ch == '"' || ch == '\\')
+ *cp++ = '\\';
+ *cp++ = ch;
+ }
+ }
+ *cp = 0;
+ return format_s(fmt, buf);
+ }
+
+
+ char *makeCstring(s, len)
+ register char *s;
+ int len;
+ {
+ return rawCstring("\"%s\"", s, len, 0);
+ }
+
+
+
+ char *makeCchar(ich)
+ int ich;
+ {
+ char buf[500];
+ register char *cp;
+ register unsigned char ch = (ich & 0xff);
+
+ if (ich < 0 || ich > 255 || (ich == 0 && !nullcharconst))
+ return format_d("%d", ich);
+ cp = buf;
+ if (ch == 0) {
+ *cp++ = '\\';
+ *cp++ = '0';
+ } else if (ch == '\n') {
+ *cp++ = '\\';
+ *cp++ = 'n';
+ } else if (ch == '\b') {
+ *cp++ = '\\';
+ *cp++ = 'b';
+ } else if (ch == '\t') {
+ *cp++ = '\\';
+ *cp++ = 't';
+ } else if (ch == '\f') {
+ *cp++ = '\\';
+ *cp++ = 'f';
+ #if 0
+ } else if (ch == '\r') {
+ *cp++ = '\\';
+ *cp++ = 'r';
+ #endif
+ } else if (ch < ' ' || ch >= 127) {
+ *cp++ = '\\';
+ *cp++ = '0' + (ch>>6);
+ *cp++ = '0' + ((ch>>3) & 7);
+ *cp++ = '0' + (ch & 7);
+ } else {
+ if (ch == '\'' || ch == '\\')
+ *cp++ = '\\';
+ *cp++ = ch;
+ }
+ *cp = 0;
+ return format_s("'%s'", buf);
+ }
+
+
+
+
+
+
+ /* End. */
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/p2c.h
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/p2c.h:1.1.2.1
*** /dev/null Mon Mar 1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/p2c.h Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,511 ----
+ #ifndef P2C_H
+ #define P2C_H
+
+
+ /* Header file for code generated by "p2c", the Pascal-to-C translator */
+
+ /* "p2c" Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ * By Dave Gillespie, daveg at csvax.cs.caltech.edu. Version 1.20.
+ * This file may be copied, modified, etc. in any way. It is not restricted
+ * by the licence agreement accompanying p2c itself.
+ */
+
+
+ #include <stdio.h>
+
+
+
+ /* If the following heuristic fails, compile -DBSD=0 for non-BSD systems,
+ or -DBSD=1 for BSD systems. */
+
+ #ifdef M_XENIX
+ # define BSD 0
+ #endif
+
+ #ifdef vms
+ # define BSD 0
+ # ifndef __STDC__
+ # define __STDC__ 1
+ # endif
+ #endif
+
+ #ifdef __TURBOC__
+ # define MSDOS 1
+ #endif
+
+ #ifdef MSDOS
+ # define BSD 0
+ #endif
+
+ #ifdef FILE /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
+ # ifndef BSD /* (a convenient, but horrible kludge!) */
+ # define BSD 1
+ # endif
+ #endif
+
+ #ifdef BSD
+ # if !BSD
+ # undef BSD
+ # endif
+ #endif
+
+
+ #if (defined(__STDC__) && !defined(M_XENIX)) || defined(__TURBOC__)
+ /*# include <stddef.h>*/
+ # include <stdlib.h>
+ # define HAS_STDLIB
+ # if defined(vms) || defined(__TURBOC__)
+ # define __ID__(a)a
+ # endif
+ #else
+ # ifndef BSD
+ # ifndef __TURBOC__
+ # include <memory.h>
+ # endif
+ # endif
+ # ifdef hpux
+ # ifdef _INCLUDE__STDC__
+ # include <stddef.h>
+ # include <stdlib.h>
+ # endif
+ # endif
+ # include <sys/types.h>
+ # if !defined(MSDOS) || defined(__TURBOC__)
+ # define __ID__(a)a
+ # endif
+ #endif
+
+ #ifdef __ID__
+ # define __CAT__(a,b)__ID__(a)b
+ #else
+ # define __CAT__(a,b)a##b
+ #endif
+
+
+ #ifdef BSD
+ # include <strings.h>
+ # define memcpy(a,b,n) (bcopy(b,a,n),a)
+ # define memcmp(a,b,n) bcmp(a,b,n)
+ # define strchr(s,c) index(s,c)
+ # define strrchr(s,c) rindex(s,c)
+ #else
+ # include <string.h>
+ #endif
+
+ #include <ctype.h>
+ #include <math.h>
+ #include <setjmp.h>
+ #include <assert.h>
+
+
+ #ifndef NO_LACK
+ #ifdef vms
+
+ #define LACK_LABS
+ #define LACK_MEMMOVE
+ #define LACK_MEMCPY
+
+ #else
+
+ #define LACK_LABS /* Undefine these if your library has these */
+ #define LACK_MEMMOVE
+
+ #endif
+ #endif
+
+
+ typedef struct __p2c_jmp_buf {
+ struct __p2c_jmp_buf *next;
+ jmp_buf jbuf;
+ } __p2c_jmp_buf;
+
+
+ /* Warning: The following will not work if setjmp is used simultaneously.
+ This also violates the ANSI restriction about using vars after longjmp,
+ but a typical implementation of longjmp will get it right anyway. */
+
+ #ifndef FAKE_TRY
+ # define TRY(x) do { __p2c_jmp_buf __try_jb; \
+ __try_jb.next = __top_jb; \
+ if (!setjmp((__top_jb = &__try_jb)->jbuf)) {
+ # define RECOVER(x) __top_jb = __try_jb.next; } else {
+ # define RECOVER2(x,L) __top_jb = __try_jb.next; } else { \
+ if (0) { L: __top_jb = __try_jb.next; }
+ # define ENDTRY(x) } } while (0)
+ #else
+ # define TRY(x) if (1) {
+ # define RECOVER(x) } else do {
+ # define RECOVER2(x,L) } else do { L: ;
+ # define ENDTRY(x) } while (0)
+ #endif
+
+
+
+ #ifdef M_XENIX /* avoid compiler bug */
+ # define SHORT_MAX (32767)
+ # define SHORT_MIN (-32768)
+ #endif
+
+
+ /* The following definitions work only on twos-complement machines */
+ #ifndef SHORT_MAX
+ # define SHORT_MAX ((short)(((unsigned short) -1) >> 1))
+ # define SHORT_MIN (~SHORT_MAX)
+ #endif
+
+ #ifndef INT_MAX
+ # define INT_MAX ((int)(((unsigned int) -1) >> 1))
+ # define INT_MIN (~INT_MAX)
+ #endif
+
+ #ifndef LONG_MAX
+ # define LONG_MAX ((long)(((unsigned long) -1) >> 1))
+ # define LONG_MIN (~LONG_MAX)
+ #endif
+
+ #ifndef SEEK_SET
+ # define SEEK_SET 0
+ # define SEEK_CUR 1
+ # define SEEK_END 2
+ #endif
+
+ #ifndef EXIT_SUCCESS
+ # ifdef vms
+ # define EXIT_SUCCESS 1
+ # define EXIT_FAILURE (02000000000L)
+ # else
+ # define EXIT_SUCCESS 0
+ # define EXIT_FAILURE 1
+ # endif
+ #endif
+
+
+ #define SETBITS 32
+
+
+ #if defined(__STDC__) || defined(__TURBOC__)
+ # if !defined(vms) && !defined(M_LINT)
+ # define Signed signed
+ # else
+ # define Signed
+ # endif
+ # define Void void /* Void f() = procedure */
+ # ifndef Const
+ # define Const const
+ # endif
+ # ifndef Volatile
+ # define Volatile volatile
+ # endif
+ # ifdef M_LINT
+ # define PP(x) ()
+ # define PV() ()
+ typedef char *Anyptr;
+ # else
+ # define PP(x) x /* function prototype */
+ # define PV() (void) /* null function prototype */
+ typedef void *Anyptr;
+ # endif
+ #else
+ # define Signed
+ # define Void void
+ # ifndef Const
+ # define Const
+ # endif
+ # ifndef Volatile
+ # define Volatile
+ # endif
+ # define PP(x) ()
+ # define PV() ()
+ typedef char *Anyptr;
+ #endif
+
+ #ifdef __GNUC__
+ # define Inline inline
+ #else
+ # define Inline
+ #endif
+
+ #define Register register /* Register variables */
+ #define Char char /* Characters (not bytes) */
+
+ #ifndef Static
+ # define Static static /* Private global funcs and vars */
+ #endif
+
+ #ifndef Local
+ # define Local static /* Nested functions */
+ #endif
+
+ typedef Signed char schar;
+ typedef unsigned char uchar;
+ typedef unsigned char boolean;
+
+ #ifndef true
+ # define true 1
+ # define false 0
+ #endif
+
+ #ifndef TRUE
+ # define TRUE 1
+ # define FALSE 0
+ #endif
+
+
+ typedef struct {
+ Anyptr proc, link;
+ } _PROCEDURE;
+
+ #ifndef _FNSIZE
+ # define _FNSIZE 120
+ #endif
+
+
+ extern Void PASCAL_MAIN PP( (int, Char **) );
+ extern Char **P_argv;
+ extern int P_argc;
+ extern short P_escapecode;
+ extern int P_ioresult;
+ extern __p2c_jmp_buf *__top_jb;
+
+
+ #ifdef P2C_H_PROTO /* if you have Ansi C but non-prototyped header files */
+ extern Char *strcat PP( (Char *, Const Char *) );
+ extern Char *strchr PP( (Const Char *, int) );
+ extern int strcmp PP( (Const Char *, Const Char *) );
+ extern Char *strcpy PP( (Char *, Const Char *) );
+ extern size_t strlen PP( (Const Char *) );
+ extern Char *strncat PP( (Char *, Const Char *, size_t) );
+ extern int strncmp PP( (Const Char *, Const Char *, size_t) );
+ extern Char *strncpy PP( (Char *, Const Char *, size_t) );
+ extern Char *strrchr PP( (Const Char *, int) );
+
+ extern Anyptr memchr PP( (Const Anyptr, int, size_t) );
+ extern Anyptr memmove PP( (Anyptr, Const Anyptr, size_t) );
+ extern Anyptr memset PP( (Anyptr, int, size_t) );
+ #ifndef memcpy
+ extern Anyptr memcpy PP( (Anyptr, Const Anyptr, size_t) );
+ extern int memcmp PP( (Const Anyptr, Const Anyptr, size_t) );
+ #endif
+
+ extern int atoi PP( (Const Char *) );
+ extern double atof PP( (Const Char *) );
+ extern long atol PP( (Const Char *) );
+ extern double strtod PP( (Const Char *, Char **) );
+ extern long strtol PP( (Const Char *, Char **, int) );
+ #endif /*P2C_H_PROTO*/
+
+ #ifndef HAS_STDLIB
+ extern Anyptr malloc PP( (size_t) );
+ extern Void free PP( (Anyptr) );
+ #endif
+
+ extern int _OutMem PV();
+ extern int _CaseCheck PV();
+ extern int _NilCheck PV();
+ extern int _Escape PP( (int) );
+ extern int _EscIO PP( (int) );
+
+ extern long ipow PP( (long, long) );
+ extern Char *strsub PP( (Char *, Char *, int, int) );
+ extern Char *strltrim PP( (Char *) );
+ extern Char *strrtrim PP( (Char *) );
+ extern Char *strrpt PP( (Char *, Char *, int) );
+ extern Char *strpad PP( (Char *, Char *, int, int) );
+ extern int strpos2 PP( (Char *, Char *, int) );
+ extern long memavail PV();
+ extern int P_peek PP( (FILE *) );
+ extern int P_eof PP( (FILE *) );
+ extern int P_eoln PP( (FILE *) );
+ extern Void P_readpaoc PP( (FILE *, Char *, int) );
+ extern Void P_readlnpaoc PP( (FILE *, Char *, int) );
+ extern long P_maxpos PP( (FILE *) );
+ extern Char *P_trimname PP( (Char *, int) );
+ extern long *P_setunion PP( (long *, long *, long *) );
+ extern long *P_setint PP( (long *, long *, long *) );
+ extern long *P_setdiff PP( (long *, long *, long *) );
+ extern long *P_setxor PP( (long *, long *, long *) );
+ extern int P_inset PP( (unsigned, long *) );
+ extern int P_setequal PP( (long *, long *) );
+ extern int P_subset PP( (long *, long *) );
+ extern long *P_addset PP( (long *, unsigned) );
+ extern long *P_addsetr PP( (long *, unsigned, unsigned) );
+ extern long *P_remset PP( (long *, unsigned) );
+ extern long *P_setcpy PP( (long *, long *) );
+ extern long *P_expset PP( (long *, long) );
+ extern long P_packset PP( (long *) );
+ extern int P_getcmdline PP( (int, int, Char *) );
+ extern Void TimeStamp PP( (int *, int *, int *,
+ int *, int *, int *) );
+ extern Void P_sun_argv PP( (char *, int, int) );
+
+
+ /* I/O error handling */
+ #define _CHKIO(cond,ior,val,def) ((cond) ? P_ioresult=0,(val) \
+ : P_ioresult=(ior),(def))
+ #define _SETIO(cond,ior) (P_ioresult = (cond) ? 0 : (ior))
+
+ /* Following defines are suitable for the HP Pascal operating system */
+ #define FileNotFound 10
+ #define FileNotOpen 13
+ #define FileWriteError 38
+ #define BadInputFormat 14
+ #define EndOfFile 30
+
+ #define FILENOTFOUND 10
+ #define FILENOTOPEN 13
+ #define FILEWRITEERROR 38
+ #define BADINPUTFORMAT 14
+ #define ENDOFFILE 30
+
+ /* Creating temporary files */
+ #if (defined(BSD) || defined(NO_TMPFILE)) && !defined(HAVE_TMPFILE)
+ # define tmpfile() (fopen(tmpnam(NULL), "w+"))
+ #endif
+
+ /* File buffers */
+ #define FILEBUF(f,sc,type) sc int __CAT__(f,_BFLAGS); \
+ sc type __CAT__(f,_BUFFER)
+ #define FILEBUFNC(f,type) int __CAT__(f,_BFLAGS); \
+ type __CAT__(f,_BUFFER)
+
+ #define RESETBUF(f,type) (__CAT__(f,_BFLAGS) = 1)
+ #define SETUPBUF(f,type) (__CAT__(f,_BFLAGS) = 0)
+
+ #define GETFBUF(f,type) (*((__CAT__(f,_BFLAGS) == 1 && \
+ ((__CAT__(f,_BFLAGS) = 2), \
+ fread(&__CAT__(f,_BUFFER), \
+ sizeof(type),1,(f)))),\
+ &__CAT__(f,_BUFFER)))
+ #define AGETFBUF(f,type) ((__CAT__(f,_BFLAGS) == 1 && \
+ ((__CAT__(f,_BFLAGS) = 2), \
+ fread(__CAT__(f,_BUFFER), \
+ sizeof(type),1,(f)))),\
+ __CAT__(f,_BUFFER))
+
+ #define PUTFBUF(f,type,v) (GETFBUF(f,type) = (v))
+ #define CPUTFBUF(f,v) (PUTFBUF(f,char,v))
+ #define APUTFBUF(f,type,v) (memcpy(AGETFBUF(f,type), (v), \
+ sizeof(__CAT__(f,_BUFFER))))
+
+ #define GET(f,type) (__CAT__(f,_BFLAGS) == 1 ? \
+ fread(&__CAT__(f,_BUFFER),sizeof(type),1,(f)) : \
+ (__CAT__(f,_BFLAGS) = 1))
+
+ #define PUT(f,type) (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)), \
+ (__CAT__(f,_BFLAGS) = 0))
+ #define CPUT(f) (PUT(f,char))
+
+ #define BUFEOF(f) (__CAT__(f,_BFLAGS) != 2 && P_eof(f))
+ #define BUFFPOS(f) (ftell(f) - (__CAT__(f,_BFLAGS) == 2))
+
+ typedef struct {
+ FILE *f;
+ FILEBUFNC(f,Char);
+ Char name[_FNSIZE];
+ } _TEXT;
+
+ /* Memory allocation */
+ #ifdef __GCC__
+ # define Malloc(n) (malloc(n) ?: (Anyptr)_OutMem())
+ #else
+ extern Anyptr __MallocTemp__;
+ # define Malloc(n) ((__MallocTemp__ = malloc(n)) ? __MallocTemp__ : (Anyptr)_OutMem())
+ #endif
+ #define FreeR(p) (free((Anyptr)(p))) /* used if arg is an rvalue */
+ #define Free(p) (free((Anyptr)(p)), (p)=NULL)
+
+ /* sign extension */
+ #define SEXT(x,n) ((x) | -(((x) & (1L<<((n)-1))) << 1))
+
+ /* packed arrays */ /* BEWARE: these are untested! */
+ #define P_getbits_UB(a,i,n,L) ((int)((a)[(i)>>(L)-(n)] >> \
+ (((~(i))&((1<<(L)-(n))-1)) << (n)) & \
+ (1<<(1<<(n)))-1))
+
+ #define P_getbits_SB(a,i,n,L) ((int)((a)[(i)>>(L)-(n)] << \
+ (16 - ((((~(i))&((1<<(L)-(n))-1))+1) <<\
+ (n)) >> (16-(1<<(n))))))
+
+ #define P_putbits_UB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |= \
+ (x) << (((~(i))&((1<<(L)-(n))-1)) << (n)))
+
+ #define P_putbits_SB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |= \
+ ((x) & (1<<(1<<(n)))-1) << \
+ (((~(i))&((1<<(L)-(n))-1)) << (n)))
+
+ #define P_clrbits_B(a,i,n,L) ((a)[(i)>>(L)-(n)] &= \
+ ~( ((1<<(1<<(n)))-1) << \
+ (((~(i))&((1<<(L)-(n))-1)) << (n))) )
+
+ /* small packed arrays */
+ #define P_getbits_US(v,i,n) ((int)((v) >> ((i)<<(n)) & (1<<(1<<(n)))-1))
+ #define P_getbits_SS(v,i,n) ((int)((long)(v) << (SETBITS - (((i)+1) << (n))) >> (SETBITS-(1<<(n)))))
+ #define P_putbits_US(v,i,x,n) ((v) |= (x) << ((i) << (n)))
+ #define P_putbits_SS(v,i,x,n) ((v) |= ((x) & (1<<(1<<(n)))-1) << ((i)<<(n)))
+ #define P_clrbits_S(v,i,n) ((v) &= ~( ((1<<(1<<(n)))-1) << ((i)<<(n)) ))
+
+ #define P_max(a,b) ((a) > (b) ? (a) : (b))
+ #define P_min(a,b) ((a) < (b) ? (a) : (b))
+
+
+ /* Fix ANSI-isms */
+
+ #ifdef LACK_LABS
+ # ifndef labs
+ # define labs my_labs
+ extern long my_labs PP( (long) );
+ # endif
+ #endif
+
+ #ifdef LACK_MEMMOVE
+ # ifndef memmove
+ # define memmove my_memmove
+ extern Anyptr my_memmove PP( (Anyptr, Const Anyptr, size_t) );
+ # endif
+ #endif
+
+ #ifdef LACK_MEMCPY
+ # ifndef memcpy
+ # define memcpy my_memcpy
+ extern Anyptr my_memcpy PP( (Anyptr, Const Anyptr, size_t) );
+ # endif
+ # ifndef memcmp
+ # define memcmp my_memcmp
+ extern int my_memcmp PP( (Const Anyptr, Const Anyptr, size_t) );
+ # endif
+ # ifndef memset
+ # define memset my_memset
+ extern Anyptr my_memset PP( (Anyptr, int, size_t) );
+ # endif
+ #endif
+
+ /* Fix toupper/tolower on Suns and other stupid BSD systems */
+ #ifdef toupper
+ # undef toupper
+ # undef tolower
+ # define toupper(c) my_toupper(c)
+ # define tolower(c) my_tolower(c)
+ #endif
+
+ #ifndef _toupper
+ # if 'A' == 65 && 'a' == 97
+ # define _toupper(c) ((c)-'a'+'A')
+ # define _tolower(c) ((c)-'A'+'a')
+ # else
+ # ifdef toupper
+ # undef toupper /* hope these are shadowing real functions, */
+ # undef tolower /* because my_toupper calls _toupper! */
+ # endif
+ # define _toupper(c) toupper(c)
+ # define _tolower(c) tolower(c)
+ # endif
+ #endif
+
+
+ #endif /* P2C_H */
+
+
+
+ /* End. */
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/parse.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/parse.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:23 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/parse.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,4380 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_PARSE_C
+ #include "trans.h"
+
+
+
+ Static short candeclare;
+ Static int trycount;
+ Static Strlist *includedfiles;
+ Static char echo_first;
+ Static int echo_pos;
+
+
+
+ void setup_parse()
+ {
+ candeclare = 0;
+ trycount = 0;
+ includedfiles = NULL;
+ echo_first = 1;
+ echo_pos = 0;
+ fixexpr_tryblock = 0;
+ }
+
+
+
+ void echobreak()
+ {
+ if (echo_pos > 0) {
+ printf("\n");
+ echo_pos = 0;
+ echo_first = 0;
+ }
+ }
+
+
+ void echoword(name, comma)
+ char *name;
+ int comma;
+ {
+ FILE *f = (outf == stdout) ? stderr : stdout;
+
+ if (quietmode || showprogress)
+ return;
+ if (!echo_first) {
+ if (comma) {
+ fprintf(f, ",");
+ echo_pos++;
+ }
+ if (echo_pos + strlen(name) > 77) {
+ fprintf(f, "\n");
+ echo_pos = 0;
+ } else {
+ fprintf(f, " ");
+ echo_pos++;
+ }
+ }
+ echo_first = 0;
+ fprintf(f, "%s", name);
+ echo_pos += strlen(name);
+ fflush(f);
+ }
+
+
+
+ void echoprocname(mp)
+ Meaning *mp;
+ {
+ echoword(mp->name, 1);
+ }
+
+
+
+
+
+ Static void forward_decl(func, isextern)
+ Meaning *func;
+ int isextern;
+ {
+ if (func->wasdeclared)
+ return;
+ if (isextern && func->constdefn && !checkvarmac(func))
+ return;
+ if (isextern) {
+ output("extern ");
+ } else if (func->ctx->kind == MK_FUNCTION) {
+ if (useAnyptrMacros)
+ output("Local ");
+ else
+ output("static ");
+ } else if ((use_static != 0 && !useAnyptrMacros) ||
+ (findsymbol(func->name)->flags & NEEDSTATIC)) {
+ output("static ");
+ } else if (useAnyptrMacros) {
+ output("Static ");
+ }
+ if (func->type->basetype != tp_void || ansiC != 0) {
+ outbasetype(func->type, ODECL_FORWARD);
+ output(" ");
+ }
+ outdeclarator(func->type, func->name, ODECL_FORWARD);
+ output(";\n");
+ func->wasdeclared = 1;
+ }
+
+
+
+
+ /* Check if calling a parent procedure, whose body must */
+ /* be declared forward */
+
+ void need_forward_decl(func)
+ Meaning *func;
+ {
+ Meaning *mp;
+
+ if (func->wasdeclared)
+ return;
+ for (mp = curctx->ctx; mp; mp = mp->ctx) {
+ if (mp == func) {
+ if (func->ctx->kind == MK_FUNCTION)
+ func->isforward = 1;
+ else
+ forward_decl(func, 0);
+ return;
+ }
+ }
+ }
+
+
+
+
+ void free_stmt(sp)
+ register Stmt *sp;
+ {
+ if (sp) {
+ free_stmt(sp->stm1);
+ free_stmt(sp->stm2);
+ free_stmt(sp->next);
+ freeexpr(sp->exp1);
+ freeexpr(sp->exp2);
+ freeexpr(sp->exp3);
+ FREE(sp);
+ }
+ }
+
+
+
+
+ Stmt *makestmt(kind)
+ enum stmtkind kind;
+ {
+ Stmt *sp;
+
+ sp = ALLOC(1, Stmt, stmts);
+ sp->kind = kind;
+ sp->next = NULL;
+ sp->stm1 = NULL;
+ sp->stm2 = NULL;
+ sp->exp1 = NULL;
+ sp->exp2 = NULL;
+ sp->exp3 = NULL;
+ sp->serial = curserial = ++serialcount;
+ return sp;
+ }
+
+
+
+ Stmt *makestmt_call(call)
+ Expr *call;
+ {
+ Stmt *sp = makestmt(SK_ASSIGN);
+ sp->exp1 = call;
+ return sp;
+ }
+
+
+
+ Stmt *makestmt_assign(lhs, rhs)
+ Expr *lhs, *rhs;
+ {
+ Stmt *sp = makestmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_assign(lhs, rhs);
+ return sp;
+ }
+
+
+
+ Stmt *makestmt_if(cond, thn, els)
+ Expr *cond;
+ Stmt *thn, *els;
+ {
+ Stmt *sp = makestmt(SK_IF);
+ sp->exp1 = cond;
+ sp->stm1 = thn;
+ sp->stm2 = els;
+ return sp;
+ }
+
+
+
+ Stmt *makestmt_seq(s1, s2)
+ Stmt *s1, *s2;
+ {
+ Stmt *s1a;
+
+ if (!s1)
+ return s2;
+ if (!s2)
+ return s1;
+ for (s1a = s1; s1a->next; s1a = s1a->next) ;
+ s1a->next = s2;
+ return s1;
+ }
+
+
+
+ Stmt *copystmt(sp)
+ Stmt *sp;
+ {
+ Stmt *sp2;
+
+ if (sp) {
+ sp2 = makestmt(sp->kind);
+ sp2->stm1 = copystmt(sp->stm1);
+ sp2->stm2 = copystmt(sp->stm2);
+ sp2->exp1 = copyexpr(sp->exp1);
+ sp2->exp2 = copyexpr(sp->exp2);
+ sp2->exp3 = copyexpr(sp->exp3);
+ return sp2;
+ } else
+ return NULL;
+ }
+
+
+
+ void nukestmt(sp)
+ Stmt *sp;
+ {
+ if (sp) {
+ sp->kind = SK_ASSIGN;
+ sp->exp1 = makeexpr_long(0);
+ }
+ }
+
+
+
+ void splicestmt(sp, spnew)
+ Stmt *sp, *spnew;
+ {
+ Stmt *snext;
+
+ if (spnew) {
+ snext = sp->next;
+ *sp = *spnew;
+ while (sp->next)
+ sp = sp->next;
+ sp->next = snext;
+ } else
+ nukestmt(sp);
+ }
+
+
+
+ int stmtcount(sp)
+ Stmt *sp;
+ {
+ int i = 0;
+
+ while (sp) {
+ i += 1 + stmtcount(sp->stm1) + stmtcount(sp->stm2);
+ sp = sp->next;
+ }
+ return i;
+ }
+
+
+
+
+
+ Stmt *close_files_to_ctx(ctx)
+ Meaning *ctx;
+ {
+ Meaning *ctx2, *mp;
+ Stmt *splist = NULL, *sp;
+
+ ctx2 = curctx;
+ while (ctx2 && ctx2 != ctx && ctx2->kind == MK_FUNCTION) {
+ for (mp = ctx2->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_VAR &&
+ isfiletype(mp->type, -1) && !mp->istemporary) {
+ var_reference(mp);
+ sp = makestmt_if(makeexpr_rel(EK_NE,
+ filebasename(makeexpr_var(mp)),
+ makeexpr_nil()),
+ makestmt_call(
+ makeexpr_bicall_1("fclose", tp_void,
+ filebasename(makeexpr_var(mp)))),
+ NULL);
+ splist = makestmt_seq(splist, sp);
+ }
+ }
+ ctx2 = ctx2->ctx;
+ }
+ return splist;
+ }
+
+
+
+
+ int simplewith(ex)
+ Expr *ex;
+ {
+ switch (ex->kind) {
+ case EK_VAR:
+ case EK_CONST:
+ return 1;
+ case EK_DOT:
+ return simplewith(ex->args[0]);
+ default:
+ return 0;
+ }
+ }
+
+
+ int simplefor(sp, ex)
+ Stmt *sp;
+ Expr *ex;
+ {
+ return (exprspeed(sp->exp2) <= 3 &&
+ !checkexprchanged(sp->stm1, sp->exp2) &&
+ !exproccurs(sp->exp2, ex));
+ }
+
+
+
+ int tryfuncmacro(exp, mp)
+ Expr **exp;
+ Meaning *mp;
+ {
+ char *name;
+ Strlist *lp;
+ Expr *ex = *exp, *ex2;
+
+ ex2 = (mp) ? mp->constdefn : NULL;
+ if (!ex2) {
+ if (ex->kind == EK_BICALL || ex->kind == EK_NAME)
+ name = ex->val.s;
+ else if (ex->kind == EK_FUNCTION)
+ name = ((Meaning *)ex->val.i)->name;
+ else
+ return 0;
+ lp = strlist_cifind(funcmacros, name);
+ ex2 = (lp) ? (Expr *)lp->value : NULL;
+ }
+ if (ex2) {
+ *exp = replacemacargs(copyexpr(ex2), ex);
+ freeexpr(ex);
+ return 1;
+ }
+ return 0;
+ }
+
+
+
+
+
+ #define addstmt(kind) \
+ *spp = sp = makestmt(kind), \
+ spp = &(sp->next)
+
+ #define newstmt(kind) \
+ addstmt(kind), \
+ steal_comments(firstserial, sp->serial, sflags & SF_FIRST), \
+ sflags &= ~SF_FIRST
+
+
+
+ #define SF_FUNC 0x1
+ #define SF_SAVESER 0x2
+ #define SF_FIRST 0x4
+ #define SF_IF 0x8
+
+ Static Stmt *p_stmt(slist, sflags)
+ Stmt *slist;
+ int sflags;
+ {
+ Stmt *sbase = NULL, **spp = &sbase, **spp2, **spp3, **savespp;
+ Stmt *defsp, **defsphook;
+ register Stmt *sp;
+ Stmt *sp2;
+ long li1, li2, firstserial = 0, saveserial = 0, saveserial2;
+ int i, forfixed, offset, line1, line2, toobig, isunsafe;
+ Token savetok;
+ char *name;
+ Expr *ep, *ep2, *ep3, *forstep, *range, *swexpr, *trueswexpr;
+ Type *tp;
+ Meaning *mp, *tvar, *tempmark;
+ Symbol *sym;
+ enum exprkind ekind;
+ Stmt *(*prochandler)();
+ Strlist *cmt;
+
+ tempmark = markstmttemps();
+ again:
+ while (findlabelsym()) {
+ newstmt(SK_LABEL);
+ sp->exp1 = makeexpr_name(format_s(name_LABEL, curtokmeaning->name), tp_integer);
+ gettok();
+ wneedtok(TOK_COLON);
+ }
+ firstserial = curserial;
+ checkkeyword(TOK_TRY);
+ checkkeyword(TOK_INLINE);
+ checkkeyword(TOK_LOOP);
+ checkkeyword(TOK_RETURN);
+ if (modula2) {
+ if (sflags & SF_SAVESER)
+ goto stmtSeq;
+ }
+ switch (curtok) {
+
+ case TOK_BEGIN:
+ stmtSeq:
+ if (sflags & (SF_FUNC|SF_SAVESER)) {
+ saveserial = curserial;
+ cmt = grabcomment(CMT_ONBEGIN);
+ if (sflags & SF_FUNC)
+ cmt = fixbeginendcomment(cmt);
+ strlist_mix(&curcomments, cmt);
+ }
+ i = sflags & SF_FIRST;
+ do {
+ if (modula2) {
+ if (curtok == TOK_BEGIN || curtok == TOK_SEMI)
+ gettok();
+ checkkeyword(TOK_ELSIF);
+ if (curtok == TOK_ELSE || curtok == TOK_ELSIF)
+ break;
+ } else
+ gettok();
+ *spp = p_stmt(sbase, i);
+ i = 0;
+ while (*spp)
+ spp = &((*spp)->next);
+ } while (curtok == TOK_SEMI);
+ if (sflags & (SF_FUNC|SF_SAVESER)) {
+ cmt = grabcomment(CMT_ONEND);
+ changecomments(cmt, -1, -1, -1, saveserial);
+ if (sflags & SF_FUNC)
+ cmt = fixbeginendcomment(cmt);
+ strlist_mix(&curcomments, cmt);
+ if (sflags & SF_FUNC)
+ changecomments(curcomments, -1, saveserial, -1, 10000);
+ curserial = saveserial;
+ }
+ checkkeyword(TOK_ELSIF);
+ if (modula2 && (sflags & SF_IF)) {
+ break;
+ }
+ if (curtok == TOK_VBAR)
+ break;
+ if (!wneedtok(TOK_END))
+ skippasttoken(TOK_END);
+ break;
+
+ case TOK_CASE:
+ gettok();
+ swexpr = trueswexpr = p_ord_expr();
+ if (nosideeffects(swexpr, 1)) {
+ tvar = NULL;
+ } else {
+ tvar = makestmttempvar(swexpr->val.type, name_TEMP);
+ swexpr = makeexpr_var(tvar);
+ }
+ savespp = spp;
+ newstmt(SK_CASE);
+ saveserial2 = curserial;
+ sp->exp1 = trueswexpr;
+ spp2 = &sp->stm1;
+ tp = swexpr->val.type;
+ defsp = NULL;
+ defsphook = &defsp;
+ if (!wneedtok(TOK_OF)) {
+ skippasttoken(TOK_END);
+ break;
+ }
+ i = 1;
+ while (curtok == TOK_VBAR)
+ gettok();
+ checkkeyword(TOK_OTHERWISE);
+ while (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
+ spp3 = spp2;
+ saveserial = curserial;
+ *spp2 = sp = makestmt(SK_CASELABEL);
+ steal_comments(saveserial, sp->serial, i);
+ spp2 = &sp->next;
+ range = NULL;
+ toobig = 0;
+ for (;;) {
+ ep = gentle_cast(p_expr(tp), tp);
+ if (curtok == TOK_DOTS) {
+ li1 = ord_value(eval_expr(ep));
+ gettok();
+ ep2 = gentle_cast(p_expr(tp), tp);
+ li2 = ord_value(eval_expr(ep2));
+ range = makeexpr_or(range,
+ makeexpr_range(copyexpr(swexpr),
+ ep, ep2, 1));
+ if (li2 - li1 >= caselimit)
+ toobig = 1;
+ if (!toobig) {
+ for (;;) {
+ sp->exp1 = makeexpr_val(make_ord(tp, li1));
+ if (li1 >= li2) break;
+ li1++;
+ serialcount--; /* make it reuse the count */
+ sp->stm1 = makestmt(SK_CASELABEL);
+ sp = sp->stm1;
+ }
+ }
+ } else {
+ sp->exp1 = copyexpr(ep);
+ range = makeexpr_or(range,
+ makeexpr_rel(EK_EQ,
+ copyexpr(swexpr),
+ ep));
+ }
+ if (curtok == TOK_COMMA) {
+ gettok();
+ serialcount--; /* make it reuse the count */
+ sp->stm1 = makestmt(SK_CASELABEL);
+ sp = sp->stm1;
+ } else
+ break;
+ }
+ wneedtok(TOK_COLON);
+ if (toobig) {
+ free_stmt(*spp3);
+ spp2 = spp3;
+ *defsphook = makestmt_if(range, p_stmt(NULL, SF_SAVESER),
+ NULL);
+ if (defsphook != &defsp && elseif != 0)
+ (*defsphook)->exp2 = makeexpr_long(1);
+ defsphook = &((*defsphook)->stm2);
+ } else {
+ freeexpr(range);
+ sp->stm1 = p_stmt(NULL, SF_SAVESER);
+ }
+ i = 0;
+ checkkeyword(TOK_OTHERWISE);
+ if (curtok != TOK_END && curtok != TOK_OTHERWISE && curtok != TOK_ELSE) {
+ if (curtok == TOK_VBAR) {
+ while (curtok == TOK_VBAR)
+ gettok();
+ } else
+ wneedtok(TOK_SEMI);
+ checkkeyword(TOK_OTHERWISE);
+ }
+ }
+ if (defsp) {
+ *spp2 = defsp;
+ spp2 = defsphook;
+ if (tvar) {
+ sp = makestmt_assign(makeexpr_var(tvar), trueswexpr);
+ sp->next = *savespp;
+ *savespp = sp;
+ sp->next->exp1 = swexpr;
+ }
+ } else {
+ if (tvar) {
+ canceltempvar(tvar);
+ freeexpr(swexpr);
+ }
+ }
+ if (curtok == TOK_OTHERWISE || curtok == TOK_ELSE) {
+ gettok();
+ while (curtok == TOK_SEMI)
+ gettok();
+ /* changecomments(curcomments, CMT_TRAIL, curserial,
+ CMT_POST, -1); */
+ i = SF_FIRST;
+ while (curtok != TOK_END) {
+ *spp2 = p_stmt(NULL, i);
+ while (*spp2)
+ spp2 = &((*spp2)->next);
+ i = 0;
+ if (curtok != TOK_SEMI)
+ break;
+ gettok();
+ }
+ if (!wexpecttok(TOK_END))
+ skiptotoken(TOK_END);
+ } else if (casecheck == 1 || (casecheck == 2 && range_flag)) {
+ *spp2 = makestmt(SK_CASECHECK);
+ }
+ curserial = saveserial2;
+ strlist_mix(&curcomments, grabcomment(CMT_ONEND));
+ gettok();
+ break;
+
+ case TOK_FOR:
+ forfixed = fixedflag;
+ gettok();
+ newstmt(SK_FOR);
+ ep = p_expr(tp_integer);
+ if (!wneedtok(TOK_ASSIGN)) {
+ skippasttoken(TOK_DO);
+ break;
+ }
+ ep2 = makeexpr_charcast(p_expr(ep->val.type));
+ if (curtok != TOK_DOWNTO) {
+ if (!wexpecttok(TOK_TO)) {
+ skippasttoken(TOK_DO);
+ break;
+ }
+ }
+ savetok = curtok;
+ gettok();
+ sp->exp2 = makeexpr_charcast(p_expr(ep->val.type));
+ checkkeyword(TOK_BY);
+ if (curtok == TOK_BY) {
+ gettok();
+ forstep = p_expr(tp_integer);
+ i = possiblesigns(forstep);
+ if ((i & 5) == 5) {
+ if (expr_is_neg(forstep)) {
+ ekind = EK_GE;
+ note("Assuming FOR loop step is negative [252]");
+ } else {
+ ekind = EK_LE;
+ note("Assuming FOR loop step is positive [252]");
+ }
+ } else {
+ if (!(i & 1))
+ ekind = EK_LE;
+ else
+ ekind = EK_GE;
+ }
+ } else {
+ if (savetok == TOK_DOWNTO) {
+ ekind = EK_GE;
+ forstep = makeexpr_long(-1);
+ } else {
+ ekind = EK_LE;
+ forstep = makeexpr_long(1);
+ }
+ }
+ tvar = NULL;
+ swexpr = NULL;
+ if (ep->kind == EK_VAR) {
+ tp = findbasetype(ep->val.type, ODECL_NOPRES);
+ if ((tp == tp_char || tp == tp_schar || tp == tp_uchar ||
+ tp == tp_abyte || tp == tp_sbyte || tp == tp_ubyte ||
+ tp == tp_boolean) &&
+ ((checkconst(sp->exp2, 0) &&
+ tp != tp_sbyte && tp != tp_schar) ||
+ checkconst(sp->exp2, -128) ||
+ (checkconst(sp->exp2, 127) &&
+ tp != tp_ubyte && tp != tp_uchar) ||
+ checkconst(sp->exp2, 255) ||
+ (tp == tp_char &&
+ (useAnyptrMacros == 1 || unsignedchar != 1) &&
+ isliteralconst(sp->exp2, NULL) == 2 &&
+ sp->exp2->val.i >= 128))) {
+ swexpr = ep;
+ tvar = makestmttempvar(tp_sshort, name_TEMP);
+ ep = makeexpr_var(tvar);
+ } else if (((tp == tp_sshort &&
+ (checkconst(sp->exp2, -32768) ||
+ checkconst(sp->exp2, 32767))) ||
+ (tp == tp_ushort &&
+ (checkconst(sp->exp2, 0) ||
+ checkconst(sp->exp2, 65535))))) {
+ swexpr = ep;
+ tvar = makestmttempvar(tp_integer, name_TEMP);
+ ep = makeexpr_var(tvar);
+ } else if (tp == tp_integer &&
+ (checkconst(sp->exp2, LONG_MAX) ||
+ (sp->exp2->kind == EK_VAR &&
+ sp->exp2->val.i == (long)mp_maxint))) {
+ swexpr = ep;
+ tvar = makestmttempvar(tp_unsigned, name_TEMP);
+ ep = makeexpr_var(tvar);
+ }
+ }
+ sp->exp3 = makeexpr_assign(copyexpr(ep),
+ makeexpr_inc(copyexpr(ep),
+ copyexpr(forstep)));
+ wneedtok(TOK_DO);
+ forfixed = (fixedflag != forfixed);
+ mp = makestmttempvar(ep->val.type, name_FOR);
+ sp->stm1 = p_stmt(NULL, SF_SAVESER);
+ if (tvar) {
+ if (checkexprchanged(sp->stm1, swexpr))
+ note(format_s("Rewritten FOR loop won't work if it meddles with %s [253]",
+ ((Meaning *)swexpr->val.i)->name));
+ sp->stm1 = makestmt_seq(makestmt_assign(swexpr, makeexpr_var(tvar)),
+ sp->stm1);
+ } else if (offsetforloops && ep->kind == EK_VAR) {
+ offset = checkvaroffset(sp->stm1, (Meaning *)ep->val.i);
+ if (offset != 0) {
+ ep3 = makeexpr_inc(copyexpr(ep), makeexpr_long(-offset));
+ replaceexpr(sp->stm1, ep, ep3);
+ freeexpr(ep3);
+ ep2 = makeexpr_plus(ep2, makeexpr_long(offset));
+ sp->exp2 = makeexpr_inc(sp->exp2, makeexpr_long(offset));
+ }
+ }
+ if (!exprsame(ep, ep2, 1))
+ sp->exp1 = makeexpr_assign(copyexpr(ep), copyexpr(ep2));
+ isunsafe = ((!nodependencies(ep2, 2) &&
+ !nosideeffects(sp->exp2, 1)) ||
+ (!nodependencies(sp->exp2, 2) &&
+ !nosideeffects(ep2, 1)));
+ if (forfixed || (simplefor(sp, ep) && !isunsafe)) {
+ canceltempvar(mp);
+ sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
+ } else {
+ ep3 = makeexpr_neg(copyexpr(forstep));
+ if ((checkconst(forstep, 1) || checkconst(forstep, -1)) &&
+ sp->exp2->kind == EK_PLUS &&
+ exprsame(sp->exp2->args[sp->exp2->nargs-1], ep3, 2)) {
+ sp->exp2 = makeexpr_inc(sp->exp2, forstep);
+ } else {
+ freeexpr(forstep);
+ freeexpr(ep3);
+ ep3 = makeexpr_long(0);
+ }
+ if (forevalorder && isunsafe) {
+ if (exprdepends(sp->exp2, ep)) {
+ tvar = makestmttempvar(mp->type, name_TEMP);
+ sp->exp1 = makeexpr_comma(
+ makeexpr_comma(
+ makeexpr_assign(makeexpr_var(tvar),
+ copyexpr(ep2)),
+ makeexpr_assign(makeexpr_var(mp),
+ sp->exp2)),
+ makeexpr_assign(copyexpr(ep),
+ makeexpr_var(tvar)));
+ } else
+ sp->exp1 = makeexpr_comma(
+ sp->exp1,
+ makeexpr_assign(makeexpr_var(mp),
+ sp->exp2));
+ } else {
+ if (isunsafe)
+ note("Evaluating FOR loop limit before initial value [315]");
+ sp->exp1 = makeexpr_comma(
+ makeexpr_assign(makeexpr_var(mp),
+ sp->exp2),
+ sp->exp1);
+ }
+ sp->exp2 = makeexpr_inc(makeexpr_var(mp), ep3);
+ sp->exp2 = makeexpr_rel(ekind, ep, sp->exp2);
+ }
+ freeexpr(ep2);
+ break;
+
+ case TOK_GOTO:
+ gettok();
+ if (findlabelsym()) {
+ if (curtokmeaning->ctx != curctx) {
+ curtokmeaning->val.i = 1;
+ *spp = close_files_to_ctx(curtokmeaning->ctx);
+ while (*spp)
+ spp = &((*spp)->next);
+ newstmt(SK_ASSIGN);
+ var_reference(curtokmeaning->xnext);
+ if (curtokmeaning->ctx->kind == MK_MODULE &&
+ !curtokmeaning->xnext->wasdeclared) {
+ outsection(minorspace);
+ declarevar(curtokmeaning->xnext, 0x7);
+ curtokmeaning->xnext->wasdeclared = 1;
+ outsection(minorspace);
+ }
+ sp->exp1 = makeexpr_bicall_2("longjmp", tp_void,
+ makeexpr_var(curtokmeaning->xnext),
+ makeexpr_long(1));
+ } else {
+ newstmt(SK_GOTO);
+ sp->exp1 = makeexpr_name(format_s(name_LABEL,
+ curtokmeaning->name),
+ tp_integer);
+ }
+ } else {
+ warning("Expected a label [263]");
+ }
+ gettok();
+ break;
+
+ case TOK_IF:
+ gettok();
+ newstmt(SK_IF);
+ saveserial = curserial;
+ curserial = ++serialcount;
+ sp->exp1 = p_expr(tp_boolean);
+ wneedtok(TOK_THEN);
+ sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
+ changecomments(curcomments, -1, saveserial+1, -1, saveserial);
+ checkkeyword(TOK_ELSIF);
+ while (curtok == TOK_ELSIF) {
+ gettok();
+ sp->stm2 = makestmt(SK_IF);
+ sp = sp->stm2;
+ sp->exp1 = p_expr(tp_boolean);
+ wneedtok(TOK_THEN);
+ sp->stm1 = p_stmt(NULL, SF_SAVESER|SF_IF);
+ sp->exp2 = makeexpr_long(1);
+ }
+ if (curtok == TOK_ELSE) {
+ line1 = inf_lnum;
+ strlist_mix(&curcomments, grabcomment(CMT_ONELSE));
+ gettok();
+ line2 = (curtok == TOK_IF) ? inf_lnum : -1;
+ saveserial2 = curserial;
+ sp->stm2 = p_stmt(NULL, SF_SAVESER|SF_IF);
+ changecomments(curcomments, -1, saveserial2, -1, saveserial+1);
+ if (sp->stm2 && sp->stm2->kind == SK_IF &&
+ !sp->stm2->next && !modula2) {
+ sp->stm2->exp2 = makeexpr_long(elseif > 0 ||
+ (elseif < 0 && line1 == line2));
+ }
+ }
+ if (modula2)
+ wneedtok(TOK_END);
+ curserial = saveserial;
+ break;
+
+ case TOK_INLINE:
+ gettok();
+ note("Inline assembly language encountered [254]");
+ if (curtok != TOK_LPAR) { /* Macintosh style */
+ newstmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_bicall_1("inline", tp_void,
+ p_expr(tp_integer));
+ break;
+ }
+ do {
+ name = getinlinepart();
+ if (!*name)
+ break;
+ newstmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_bicall_1("asm", tp_void,
+ makeexpr_string(format_s(" inline %s", name)));
+ gettok();
+ } while (curtok == TOK_SLASH);
+ skipcloseparen();
+ break;
+
+ case TOK_LOOP:
+ gettok();
+ newstmt(SK_WHILE);
+ sp->exp1 = makeexpr_long(1);
+ sp->stm1 = p_stmt(NULL, SF_SAVESER);
+ break;
+
+ case TOK_REPEAT:
+ newstmt(SK_REPEAT);
+ saveserial = curserial;
+ spp2 = &(sp->stm1);
+ i = SF_FIRST;
+ do {
+ gettok();
+ *spp2 = p_stmt(sp->stm1, i);
+ i = 0;
+ while (*spp2)
+ spp2 = &((*spp2)->next);
+ } while (curtok == TOK_SEMI);
+ if (!wneedtok(TOK_UNTIL))
+ skippasttoken(TOK_UNTIL);
+ sp->exp1 = makeexpr_not(p_expr(tp_boolean));
+ curserial = saveserial;
+ strlist_mix(&curcomments, grabcomment(CMT_ONEND));
+ break;
+
+ case TOK_RETURN:
+ gettok();
+ newstmt(SK_RETURN);
+ if (curctx->isfunction) {
+ sp->exp1 = gentle_cast(p_expr(curctx->cbase->type),
+ curctx->cbase->type);
+ }
+ break;
+
+ case TOK_TRY:
+ findsymbol("RECOVER")->flags &= ~KWPOSS;
+ newstmt(SK_TRY);
+ sp->exp1 = makeexpr_long(++trycount);
+ spp2 = &(sp->stm1);
+ i = SF_FIRST;
+ do {
+ gettok();
+ *spp2 = p_stmt(sp->stm1, i);
+ i = 0;
+ while (*spp2)
+ spp2 = &((*spp2)->next);
+ } while (curtok == TOK_SEMI);
+ if (!wneedtok(TOK_RECOVER))
+ skippasttoken(TOK_RECOVER);
+ sp->stm2 = p_stmt(NULL, SF_SAVESER);
+ break;
+
+ case TOK_WHILE:
+ gettok();
+ newstmt(SK_WHILE);
+ sp->exp1 = p_expr(tp_boolean);
+ wneedtok(TOK_DO);
+ sp->stm1 = p_stmt(NULL, SF_SAVESER);
+ break;
+
+ case TOK_WITH:
+ gettok();
+ if (withlevel >= MAXWITHS-1)
+ error("Too many nested WITHs");
+ ep = p_expr(NULL);
+ if (ep->val.type->kind != TK_RECORD)
+ warning("Argument of WITH is not a RECORD [264]");
+ withlist[withlevel] = ep->val.type;
+ if (simplewith(ep)) {
+ withexprs[withlevel] = ep;
+ mp = NULL;
+ } else { /* need to save a temporary pointer */
+ tp = makepointertype(ep->val.type);
+ mp = makestmttempvar(tp, name_WITH);
+ withexprs[withlevel] = makeexpr_hat(makeexpr_var(mp), 0);
+ }
+ withlevel++;
+ if (curtok == TOK_COMMA) {
+ curtok = TOK_WITH;
+ sp2 = p_stmt(NULL, sflags & SF_FIRST);
+ } else {
+ wneedtok(TOK_DO);
+ sp2 = p_stmt(NULL, sflags & SF_FIRST);
+ }
+ withlevel--;
+ if (mp) { /* if "with p^" for constant p, don't need temp ptr */
+ if (ep->kind == EK_HAT && ep->args[0]->kind == EK_VAR &&
+ !checkvarchanged(sp2, (Meaning *)ep->args[0]->val.i)) {
+ replaceexpr(sp2, withexprs[withlevel]->args[0],
+ ep->args[0]);
+ freeexpr(ep);
+ canceltempvar(mp);
+ } else {
+ newstmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_assign(makeexpr_var(mp),
+ makeexpr_addr(ep));
+ }
+ }
+ freeexpr(withexprs[withlevel]);
+ *spp = sp2;
+ while (*spp)
+ spp = &((*spp)->next);
+ break;
+
+ case TOK_INCLUDE:
+ badinclude();
+ goto again;
+
+ case TOK_ADDR: /* flakey Turbo "@procptr := anyptr" assignment */
+ newstmt(SK_ASSIGN);
+ ep = p_expr(tp_void);
+ if (wneedtok(TOK_ASSIGN))
+ sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
+ else
+ sp->exp1 = ep;
+ break;
+
+ case TOK_IDENT:
+ mp = curtokmeaning;
+ if (mp == mp_str_hp)
+ mp = curtokmeaning = mp_str_turbo;
+ if (mp == mp_val_modula)
+ mp = curtokmeaning = mp_val_turbo;
+ if (mp == mp_blockread_ucsd)
+ mp = curtokmeaning = mp_blockread_turbo;
+ if (mp == mp_blockwrite_ucsd)
+ mp = curtokmeaning = mp_blockwrite_turbo;
+ if (mp == mp_dec_dec)
+ mp = curtokmeaning = mp_dec_turbo;
+ if (!mp) {
+ sym = curtoksym; /* make a guess at what the undefined name is... */
+ name = stralloc(curtokcase);
+ gettok();
+ newstmt(SK_ASSIGN);
+ if (curtok == TOK_ASSIGN) {
+ gettok();
+ ep = p_expr(NULL);
+ mp = addmeaning(sym, MK_VAR);
+ mp->name = name;
+ mp->type = ep->val.type;
+ sp->exp1 = makeexpr_assign(makeexpr_var(mp), ep);
+ } else if (curtok == TOK_HAT || curtok == TOK_ADDR ||
+ curtok == TOK_LBR || curtok == TOK_DOT) {
+ ep = makeexpr_name(name, tp_integer);
+ ep = fake_dots_n_hats(ep);
+ if (wneedtok(TOK_ASSIGN))
+ sp->exp1 = makeexpr_assign(ep, p_expr(NULL));
+ else
+ sp->exp1 = ep;
+ } else if (curtok == TOK_LPAR) {
+ ep = makeexpr_bicall_0(name, tp_void);
+ do {
+ gettok();
+ insertarg(&ep, ep->nargs, p_expr(NULL));
+ } while (curtok == TOK_COMMA);
+ skipcloseparen();
+ sp->exp1 = ep;
+ } else {
+ sp->exp1 = makeexpr_bicall_0(name, tp_void);
+ }
+ if (!tryfuncmacro(&sp->exp1, NULL))
+ undefsym(sym);
+ } else if (mp->kind == MK_FUNCTION && !mp->isfunction) {
+ mp->refcount++;
+ gettok();
+ ep = p_funccall(mp);
+ if (!mp->constdefn)
+ need_forward_decl(mp);
+ if (mp->handler && !(mp->sym->flags & LEAVEALONE) &&
+ !mp->constdefn) {
+ prochandler = (Stmt *(*)())mp->handler;
+ *spp = (*prochandler)(ep, slist);
+ while (*spp)
+ spp = &((*spp)->next);
+ } else {
+ newstmt(SK_ASSIGN);
+ sp->exp1 = ep;
+ }
+ } else if (mp->kind == MK_SPECIAL) {
+ gettok();
+ if (mp->handler && !mp->isfunction) {
+ if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
+ ep = makeexpr_bicall_0(mp->name, tp_void);
+ if (curtok == TOK_LPAR) {
+ do {
+ gettok();
+ insertarg(&ep, ep->nargs, p_expr(NULL));
+ } while (curtok == TOK_COMMA);
+ skipcloseparen();
+ }
+ newstmt(SK_ASSIGN);
+ tryfuncmacro(&ep, mp);
+ sp->exp1 = ep;
+ } else {
+ prochandler = (Stmt *(*)())mp->handler;
+ *spp = (*prochandler)(mp, slist);
+ while (*spp)
+ spp = &((*spp)->next);
+ }
+ } else
+ symclass(curtoksym);
+ } else {
+ newstmt(SK_ASSIGN);
+ if (curtokmeaning->kind == MK_FUNCTION &&
+ peeknextchar() != '(') {
+ mp = curctx;
+ while (mp && mp != curtokmeaning)
+ mp = mp->ctx;
+ if (mp)
+ curtokmeaning = curtokmeaning->cbase;
+ }
+ ep = p_expr(tp_void);
+ #if 0
+ if (!(ep->kind == EK_SPCALL ||
+ (ep->kind == EK_COND &&
+ ep->args[1]->kind == EK_SPCALL)))
+ wexpecttok(TOK_ASSIGN);
+ #endif
+ if (curtok == TOK_ASSIGN) {
+ gettok();
+ if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
+ !curtokmeaning) { /* VAX Pascal foolishness */
+ gettok();
+ ep2 = makeexpr_sizeof(copyexpr(ep), 0);
+ sp->exp1 = makeexpr_bicall_3("memset", tp_void,
+ makeexpr_addr(ep),
+ makeexpr_long(0), ep2);
+ } else
+ sp->exp1 = makeexpr_assign(ep, p_expr(ep->val.type));
+ } else
+ sp->exp1 = ep;
+ }
+ break;
+
+ default:
+ break; /* null statement */
+ }
+ freestmttemps(tempmark);
+ if (sflags & SF_SAVESER)
+ curserial = firstserial;
+ return sbase;
+ }
+
+
+
+
+
+
+
+ #define BR_NEVER 0x1 /* never use braces */
+ #define BR_FUNCTION 0x2 /* function body */
+ #define BR_THENPART 0x4 /* before an "else" */
+ #define BR_ALWAYS 0x8 /* always use braces */
+ #define BR_REPEAT 0x10 /* "do-while" loop */
+ #define BR_TRY 0x20 /* in a recover block */
+ #define BR_ELSEPART 0x40 /* after an "else" */
+ #define BR_CASE 0x80 /* case of a switch stmt */
+
+ Static int usebraces(sp, opts)
+ Stmt *sp;
+ int opts;
+ {
+ if (opts & (BR_FUNCTION|BR_ALWAYS))
+ return 1;
+ if (opts & BR_NEVER)
+ return 0;
+ switch (bracesalways) {
+ case 0:
+ if (sp) {
+ if (sp->next ||
+ sp->kind == SK_TRY ||
+ (sp->kind == SK_IF && !sp->stm2) ||
+ (opts & BR_REPEAT))
+ return 1;
+ }
+ break;
+
+ case 1:
+ return 1;
+
+ default:
+ if (sp) {
+ if (sp->next ||
+ sp->kind == SK_IF ||
+ sp->kind == SK_WHILE ||
+ sp->kind == SK_REPEAT ||
+ sp->kind == SK_TRY ||
+ sp->kind == SK_CASE ||
+ sp->kind == SK_FOR)
+ return 1;
+ }
+ break;
+ }
+ if (sp != NULL &&
+ findcomment(curcomments, CMT_NOT | CMT_TRAIL, sp->serial) != NULL)
+ return 1;
+ return 0;
+ }
+
+
+
+ #define outspnl(spflag) output((spflag) ? " " : "\n")
+
+ #define openbrace() \
+ wbraces = (!candeclare); \
+ if (wbraces) { \
+ output("{"); \
+ outspnl(braceline <= 0); \
+ candeclare = 1; \
+ }
+
+ #define closebrace() \
+ if (wbraces) { \
+ if (sp->next || braces) \
+ output("}\n"); \
+ else \
+ braces = 1; \
+ }
+
+
+
+ Meaning *outcontext;
+
+ Static void outnl(serial)
+ int serial;
+ {
+ outtrailcomment(curcomments, serial, commentindent);
+ }
+
+
+ Static void out_block(spbase, opts, serial)
+ Stmt *spbase;
+ int opts, serial;
+ {
+ int i, j, braces, always, trynum, istrail, hascmt;
+ int gotcomments = 0;
+ int saveindent, saveindent2, delta;
+ Stmt *sp = spbase;
+ Stmt *sp2, *sp3;
+ Meaning *ctx, *mp;
+ Strlist *curcmt, *cmt, *savecurcmt = curcomments;
+ Strlist *trailcmt, *begincmt, *endcmt;
+
+ if (debug>1) { fprintf(outf, "out_block of:\n"); dumpstmt(spbase,5); }
+ if (opts & BR_FUNCTION) {
+ if (outcontext && outcontext->comments) {
+ gotcomments = 1;
+ curcomments = outcontext->comments;
+ }
+ attach_comments(spbase);
+ }
+ braces = usebraces(sp, opts);
+ trailcmt = findcomment(curcomments, CMT_TRAIL, serial);
+ begincmt = findcomment(curcomments, CMT_ONBEGIN, serial);
+ istrail = 1;
+ if (!trailcmt) {
+ trailcmt = begincmt;
+ begincmt = NULL;
+ istrail = 0;
+ }
+ endcmt = findcomment(curcomments, CMT_ONEND, serial);
+ if ((begincmt || endcmt) && !(opts & BR_NEVER))
+ braces = 1;
+ if (opts & BR_ELSEPART) {
+ cmt = findcomment(curcomments, CMT_ONELSE, serial);
+ if (cmt) {
+ if (trailcmt) {
+ out_spaces(bracecommentindent, commentoverindent,
+ commentlen(cmt), 0);
+ output("\001");
+ outcomment(cmt);
+ } else
+ trailcmt = cmt;
+ }
+ }
+ if (braces) {
+ j = (opts & BR_FUNCTION) ? funcopenindent : openbraceindent;
+ if (!line_start()) {
+ if (trailcmt &&
+ cur_column() + commentlen(trailcmt) + 2 > linewidth &&
+ outindent + commentlen(trailcmt) + 2 < linewidth) /*close enough*/
+ i = 0;
+ else if (opts & BR_ELSEPART)
+ i = ((braceelseline & 2) == 0);
+ else if (braceline >= 0)
+ i = (braceline == 0);
+ else
+ i = ((opts & BR_FUNCTION) == 0);
+ if (trailcmt && begincmt) {
+ out_spaces(commentindent, commentoverindent,
+ commentlen(trailcmt), j);
+ outcomment(trailcmt);
+ trailcmt = begincmt;
+ begincmt = NULL;
+ istrail = 0;
+ } else
+ outspnl(i);
+ }
+ if (line_start())
+ singleindent(j);
+ output("{");
+ candeclare = 1;
+ } else if (!sp) {
+ if (!line_start())
+ outspnl(!nullstmtline && !(opts & BR_TRY));
+ if (line_start())
+ singleindent(tabsize);
+ output(";");
+ }
+ if (opts & BR_CASE)
+ delta = 0;
+ else {
+ delta = tabsize;
+ if (opts & BR_FUNCTION)
+ delta = adddeltas(delta, bodyindent);
+ else if (braces)
+ delta = adddeltas(delta, blockindent);
+ }
+ futureindent(delta);
+ if (bracecombine && braces)
+ i = applydelta(outindent, delta) - cur_column();
+ else
+ i = -1;
+ if (commentvisible(trailcmt)) {
+ if (line_start()) {
+ singleindent(delta);
+ out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
+ outcomment(trailcmt);
+ } else /*if (commentlen(trailcmt) + cur_column() + 1 <= linewidth)*/ {
+ out_spaces(istrail ? commentindent : bracecommentindent,
+ commentoverindent, commentlen(trailcmt), delta);
+ outcomment(trailcmt);
+ } /*else {
+ output("\n");
+ singleindent(delta);
+ out_spaces(commentoverindent, 1000, commentlen(trailcmt), 0);
+ outcomment(trailcmt);
+ }*/
+ i = -9999;
+ }
+ if (i > 0)
+ out_spaces(i, 0, 0, 0);
+ else if (i != -9999)
+ output("\n");
+ saveindent = outindent;
+ moreindent(delta);
+ outcomment(begincmt);
+ while (sp) {
+ flushcomments(NULL, CMT_PRE, sp->serial);
+ if (cmtdebug)
+ output(format_d("[%d] ", sp->serial));
+ switch (sp->kind) {
+
+ case SK_HEADER:
+ ctx = (Meaning *)sp->exp1->val.i;
+ eatblanklines();
+ if (declarevars(ctx, 0))
+ outsection(minorspace);
+ flushcomments(NULL, CMT_NOT | CMT_ONEND, serial);
+ if (ctx->kind == MK_MODULE) {
+ if (ctx->anyvarflag) {
+ output(format_s(name_MAIN, ""));
+ if (spacefuncs)
+ output(" ");
+ output("(argc,");
+ if (spacecommas)
+ output(" ");
+ output("argv);\n");
+ } else {
+ output("static int _was_initialized = 0;\n");
+ output("if (_was_initialized++)\n");
+ singleindent(tabsize);
+ output("return;\n");
+ }
+ while (initialcalls) {
+ output(initialcalls->s);
+ output(";\n");
+ strlist_remove(&initialcalls, initialcalls->s);
+ }
+ } else {
+ if (ctx->varstructflag && ctx->ctx->kind == MK_FUNCTION &&
+ ctx->ctx->varstructflag) {
+ output(format_s(name_VARS, ctx->name));
+ output(".");
+ output(format_s(name_LINK, ctx->ctx->name));
+ output(" = ");
+ output(format_s(name_LINK, ctx->ctx->name));
+ output(";\n");
+ }
+ for (mp = ctx->cbase; mp; mp = mp->cnext) {
+ if ((mp->kind == MK_VAR || /* these are variables with */
+ mp->kind == MK_VARREF) &&
+ ((mp->varstructflag && /* initializers which were moved */
+ mp->cnext && /* into a varstruct, so they */
+ mp->cnext->snext == mp && /* must be initialized now */
+ mp->cnext->constdefn &&
+ ctx->kind == MK_FUNCTION) ||
+ (mp->constdefn &&
+ mp->type->kind == TK_ARRAY &&
+ mp->constdefn->val.type->kind == TK_STRING &&
+ !initpacstrings))) {
+ if (mp->type->kind == TK_ARRAY) {
+ output("memcpy(");
+ out_var(mp, 2);
+ output(",\002");
+ if (spacecommas)
+ output(" ");
+ if (mp->constdefn) {
+ output(makeCstring(mp->constdefn->val.s,
+ mp->constdefn->val.i));
+ mp->constdefn = NULL;
+ } else
+ out_var(mp->cnext, 2);
+ output(",\002");
+ if (spacecommas)
+ output(" ");
+ output("sizeof(");
+ out_type(mp->type, 1);
+ output("))");
+ } else {
+ out_var(mp, 2);
+ output(" = ");
+ out_var(mp->cnext, 2);
+ }
+ output(";\n");
+ }
+ }
+ }
+ break;
+
+ case SK_RETURN:
+ output("return");
+ if (sp->exp1) {
+ switch (returnparens) {
+
+ case 0:
+ output(" ");
+ out_expr(sp->exp1);
+ break;
+
+ case 1:
+ if (spaceexprs != 0)
+ output(" ");
+ out_expr_parens(sp->exp1);
+ break;
+
+ default:
+ if (sp->exp1->kind == EK_VAR ||
+ sp->exp1->kind == EK_CONST ||
+ sp->exp1->kind == EK_LONGCONST ||
+ sp->exp1->kind == EK_BICALL) {
+ output(" ");
+ out_expr(sp->exp1);
+ } else {
+ if (spaceexprs != 0)
+ output(" ");
+ out_expr_parens(sp->exp1);
+ }
+ break;
+ }
+ }
+ output(";");
+ outnl(sp->serial);
+ break;
+
+ case SK_ASSIGN:
+ out_expr_stmt(sp->exp1);
+ output(";");
+ outnl(sp->serial);
+ break;
+
+ case SK_CASE:
+ output("switch (");
+ out_expr(sp->exp1);
+ output(")");
+ outspnl(braceline <= 0);
+ output("{");
+ outnl(sp->serial);
+ saveindent2 = outindent;
+ moreindent(tabsize);
+ moreindent(switchindent);
+ sp2 = sp->stm1;
+ while (sp2 && sp2->kind == SK_CASELABEL) {
+ outsection(casespacing);
+ sp3 = sp2;
+ i = 0;
+ hascmt = (findcomment(curcomments, -1, sp2->serial) != NULL);
+ singleindent(caseindent);
+ flushcomments(NULL, CMT_PRE, sp2->serial);
+ for (;;) {
+ if (i)
+ singleindent(caseindent);
+ i = 0;
+ output("case ");
+ out_expr(sp3->exp1);
+ output(":\001");
+ sp3 = sp3->stm1;
+ if (!sp3 || sp3->kind != SK_CASELABEL)
+ break;
+ if (casetabs != 1000)
+ out_spaces(casetabs, 0, 0, 0);
+ else {
+ output("\n");
+ i = 1;
+ }
+ }
+ if (sp3)
+ out_block(sp3, BR_NEVER|BR_CASE, sp2->serial);
+ else {
+ outnl(sp2->serial);
+ if (!hascmt)
+ output("/* blank case */\n");
+ }
+ output("break;\n");
+ flushcomments(NULL, -1, sp2->serial);
+ sp2 = sp2->next;
+ }
+ if (sp2) {
+ outsection(casespacing);
+ singleindent(caseindent);
+ flushcomments(NULL, CMT_PRE, sp2->serial);
+ output("default:");
+ out_block(sp2, BR_NEVER|BR_CASE, sp2->serial);
+ output("break;\n");
+ flushcomments(NULL, -1, sp2->serial);
+ }
+ outindent = saveindent2;
+ output("}");
+ curcmt = findcomment(curcomments, CMT_ONEND, sp->serial);
+ if (curcmt)
+ outcomment(curcmt);
+ else
+ output("\n");
+ break;
+
+ case SK_CASECHECK:
+ output(name_CASECHECK);
+ output("(); /* CASE value range error */\n");
+ break;
+
+ case SK_FOR:
+ output("for (");
+ if (for_allornone)
+ output("\007");
+ if (sp->exp1 || sp->exp2 || sp->exp3 || spaceexprs > 0) {
+ if (sp->exp1)
+ out_expr_top(sp->exp1);
+ else if (spaceexprs > 0)
+ output(" ");
+ output(";\002 ");
+ if (sp->exp2)
+ out_expr(sp->exp2);
+ output(";\002 ");
+ if (sp->exp3)
+ out_expr_top(sp->exp3);
+ } else {
+ output(";;");
+ }
+ output(")");
+ out_block(sp->stm1, 0, sp->serial);
+ break;
+
+ case SK_LABEL:
+ if (!line_start())
+ output("\n");
+ singleindent(labelindent);
+ out_expr(sp->exp1);
+ output(":");
+ if (!sp->next)
+ output(" ;");
+ outnl(sp->serial);
+ break;
+
+ case SK_GOTO:
+ /* what about non-local goto's? */
+ output("goto ");
+ out_expr(sp->exp1);
+ output(";");
+ outnl(sp->serial);
+ break;
+
+ case SK_IF:
+ sp2 = sp;
+ for (;;) {
+ output("if (");
+ out_expr_bool(sp2->exp1);
+ output(")");
+ if (sp2->stm2) {
+ cmt = findcomment(curcomments, CMT_ONELSE, sp->serial+1);
+ i = (!cmt && sp2->stm2->kind == SK_IF &&
+ !sp2->stm2->next &&
+ ((sp2->stm2->exp2)
+ ? checkconst(sp2->stm2->exp2, 1)
+ : (elseif > 0)));
+ if (braceelse &&
+ (usebraces(sp2->stm1, 0) ||
+ usebraces(sp2->stm2, 0) || i))
+ always = BR_ALWAYS;
+ else
+ always = 0;
+ out_block(sp2->stm1, BR_THENPART|always, sp->serial);
+ output("else");
+ sp2 = sp2->stm2;
+ if (i) {
+ output(" ");
+ } else {
+ out_block(sp2, BR_ELSEPART|always, sp->serial+1);
+ break;
+ }
+ } else {
+ out_block(sp2->stm1, 0, sp->serial);
+ break;
+ }
+ }
+ break;
+
+ case SK_REPEAT:
+ output("do");
+ out_block(sp->stm1, BR_ALWAYS|BR_REPEAT, sp->serial);
+ output("while (");
+ out_expr_bool(sp->exp1);
+ output(");");
+ cmt = findcomment(curcomments, CMT_ONEND, sp->serial);
+ if (commentvisible(cmt)) {
+ out_spaces(commentindent, commentoverindent,
+ commentlen(cmt), 0);
+ output("\001");
+ outcomment(cmt);
+ } else
+ output("\n");
+ break;
+
+ case SK_TRY:
+ trynum = sp->exp1->val.i;
+ output(format_d("TRY(try%d);", trynum));
+ out_block(sp->stm1, BR_NEVER|BR_TRY, sp->serial);
+ if (sp->exp2)
+ output(format_ds("RECOVER2(try%d,%s);", trynum,
+ format_s(name_LABEL, format_d("try%d", trynum))));
+ else
+ output(format_d("RECOVER(try%d);", trynum));
+ out_block(sp->stm2, BR_NEVER|BR_TRY, sp->serial);
+ output(format_d("ENDTRY(try%d);\n", trynum));
+ break;
+
+ case SK_WHILE:
+ output("while (");
+ out_expr_bool(sp->exp1);
+ output(")");
+ out_block(sp->stm1, 0, sp->serial);
+ break;
+
+ case SK_BREAK:
+ output("break;");
+ outnl(sp->serial);
+ break;
+
+ case SK_CONTINUE:
+ output("continue;");
+ outnl(sp->serial);
+ break;
+
+ default:
+ intwarning("out_block",
+ format_s("Misplaced statement kind %s [265]",
+ stmtkindname(sp->kind)));
+ break;
+ }
+ flushcomments(NULL, -1, sp->serial);
+ candeclare = 0;
+ if (debug>1) { fprintf(outf, "in out_block:\n"); dumpstmt(spbase,5); }
+ sp = sp->next;
+ }
+ if (opts & BR_FUNCTION) {
+ cmt = extractcomment(&curcomments, CMT_ONEND, serial);
+ if (findcomment(curcomments, -1, -1) != NULL) /* check for non-DONE */
+ output("\n");
+ flushcomments(NULL, -1, -1);
+ curcomments = cmt;
+ }
+ outindent = saveindent;
+ if (braces) {
+ if (line_start()) {
+ if (opts & BR_FUNCTION)
+ singleindent(funccloseindent);
+ else
+ singleindent(closebraceindent);
+ }
+ output("}");
+ i = 1;
+ cmt = findcomment(curcomments, CMT_ONEND, serial);
+ if (!(opts & BR_REPEAT) && commentvisible(cmt)) {
+ out_spaces(bracecommentindent, commentoverindent,
+ commentlen(cmt), 0);
+ output("\001");
+ outcomment(cmt);
+ i = 0;
+ }
+ if (i) {
+ outspnl((opts & BR_REPEAT) ||
+ ((opts & BR_THENPART) && (braceelseline & 1) == 0));
+ }
+ candeclare = 0;
+ }
+ if (gotcomments) {
+ outcontext->comments = curcomments;
+ curcomments = savecurcmt;
+ }
+ }
+
+
+
+
+
+ /* Should have a way to convert GOTO's to the end of the function to RETURN's */
+
+
+ /* Convert "_RETV = foo;" at end of function to "return foo" */
+
+ Static int checkreturns(spp, nearret)
+ Stmt **spp;
+ int nearret;
+ {
+ Stmt *sp;
+ Expr *rvar, *ex;
+ Meaning *mp;
+ int spnearret, spnextreturn;
+ int result = 0;
+
+ if (debug>2) { fprintf(outf, "checkreturns on:\n"); dumpstmt(*spp, 5); }
+ while ((sp = *spp)) {
+ spnextreturn = (sp->next &&
+ sp->next->kind == SK_RETURN && sp->next->exp1 &&
+ isretvar(sp->next->exp1) == curctx->cbase);
+ spnearret = (nearret && !sp->next) || spnextreturn;
+ result = 0;
+ switch (sp->kind) {
+
+ case SK_ASSIGN:
+ ex = sp->exp1;
+ if (ex->kind == EK_ASSIGN || structuredfunc(ex)) {
+ rvar = ex->args[0];
+ mp = isretvar(rvar);
+ if (mp == curctx->cbase && spnearret) {
+ if (ex->kind == EK_ASSIGN) {
+ if (mp->kind == MK_VARPARAM) {
+ ex = makeexpr_comma(ex, makeexpr_var(mp));
+ } else {
+ ex = grabarg(ex, 1);
+ mp->refcount--;
+ }
+ }
+ sp->exp1 = ex;
+ sp->kind = SK_RETURN;
+ if (spnextreturn) {
+ mp->refcount--;
+ sp->next = sp->next->next;
+ }
+ result = 1;
+ }
+ }
+ break;
+
+ case SK_RETURN:
+ case SK_GOTO:
+ result = 1;
+ break;
+
+ case SK_IF:
+ result = checkreturns(&sp->stm1, spnearret) & /* NOT && */
+ checkreturns(&sp->stm2, spnearret);
+ break;
+
+ case SK_TRY:
+ (void) checkreturns(&sp->stm1, 0);
+ (void) checkreturns(&sp->stm2, spnearret);
+ break;
+
+ /* should handle CASE statements as well */
+
+ default:
+ (void) checkreturns(&sp->stm1, 0);
+ (void) checkreturns(&sp->stm2, 0);
+ break;
+ }
+ spp = &sp->next;
+ }
+ return result;
+ }
+
+
+
+
+
+
+
+ /* Replace all occurrences of one expression with another expression */
+
+ Expr *replaceexprexpr(ex, oldex, newex, keeptype)
+ Expr *ex, *oldex, *newex;
+ int keeptype;
+ {
+ int i;
+ Type *type;
+
+ for (i = 0; i < ex->nargs; i++)
+ ex->args[i] = replaceexprexpr(ex->args[i], oldex, newex, keeptype);
+ if (exprsame(ex, oldex, 2)) {
+ if (ex->val.type->kind == TK_POINTER &&
+ ex->val.type->basetype == oldex->val.type) {
+ freeexpr(ex);
+ return makeexpr_addr(copyexpr(newex));
+ } else if (oldex->val.type->kind == TK_POINTER &&
+ oldex->val.type->basetype == ex->val.type) {
+ freeexpr(ex);
+ return makeexpr_hat(copyexpr(newex), 0);
+ } else {
+ type = ex->val.type;
+ freeexpr(ex);
+ ex = copyexpr(newex);
+ if (keeptype)
+ ex->val.type = type;
+ return ex;
+ }
+ }
+ return resimplify(ex);
+ }
+
+
+ void replaceexpr(sp, oldex, newex)
+ Stmt *sp;
+ Expr *oldex, *newex;
+ {
+ while (sp) {
+ replaceexpr(sp->stm1, oldex, newex);
+ replaceexpr(sp->stm2, oldex, newex);
+ if (sp->exp1)
+ sp->exp1 = replaceexprexpr(sp->exp1, oldex, newex, 1);
+ if (sp->exp2)
+ sp->exp2 = replaceexprexpr(sp->exp2, oldex, newex, 1);
+ if (sp->exp3)
+ sp->exp3 = replaceexprexpr(sp->exp3, oldex, newex, 1);
+ sp = sp->next;
+ }
+ }
+
+
+
+
+
+
+ Stmt *mixassignments(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+ if (!sp)
+ return NULL;
+ sp->next = mixassignments(sp->next, mp);
+ if (sp->next &&
+ sp->kind == SK_ASSIGN &&
+ sp->exp1->kind == EK_ASSIGN &&
+ sp->exp1->args[0]->kind == EK_VAR &&
+ (!mp || mp == (Meaning *)sp->exp1->args[0]->val.i) &&
+ ord_type(sp->exp1->args[0]->val.type)->kind == TK_INTEGER &&
+ nodependencies(sp->exp1->args[1], 0) &&
+ sp->next->kind == SK_ASSIGN &&
+ sp->next->exp1->kind == EK_ASSIGN &&
+ (exprsame(sp->exp1->args[0], sp->next->exp1->args[0], 1) ||
+ (mp && mp->istemporary)) &&
+ exproccurs(sp->next->exp1->args[1], sp->exp1->args[0]) == 1) {
+ sp->next->exp1->args[1] = replaceexprexpr(sp->next->exp1->args[1],
+ sp->exp1->args[0],
+ sp->exp1->args[1], 1);
+ if (mp && mp->istemporary)
+ canceltempvar(mp);
+ return sp->next;
+ }
+ return sp;
+ }
+
+
+
+
+
+
+
+
+ /* Do various simple (sometimes necessary) massages on the statements */
+
+
+ Static Stmt bogusreturn = { SK_RETURN, NULL, NULL, NULL, NULL, NULL, NULL };
+
+
+
+ Static int isescape(ex)
+ Expr *ex;
+ {
+ if (ex->kind == EK_BICALL && (!strcmp(ex->val.s, name_ESCAPE) ||
+ !strcmp(ex->val.s, name_ESCIO) ||
+ !strcmp(ex->val.s, name_OUTMEM) ||
+ !strcmp(ex->val.s, name_CASECHECK) ||
+ !strcmp(ex->val.s, name_NILCHECK) ||
+ !strcmp(ex->val.s, "_exit") ||
+ !strcmp(ex->val.s, "exit")))
+ return 1;
+ if (ex->kind == EK_CAST)
+ return isescape(ex->args[0]);
+ return 0;
+ }
+
+
+ /* check if a block can never exit by falling off the end */
+ Static int deadendblock(sp)
+ Stmt *sp;
+ {
+ if (!sp)
+ return 0;
+ while (sp->next)
+ sp = sp->next;
+ return (sp->kind == SK_GOTO ||
+ sp->kind == SK_BREAK ||
+ sp->kind == SK_CONTINUE ||
+ sp->kind == SK_RETURN ||
+ sp->kind == SK_CASECHECK ||
+ (sp->kind == SK_IF && deadendblock(sp->stm1) &&
+ deadendblock(sp->stm2)) ||
+ (sp->kind == SK_ASSIGN && isescape(sp->exp1)));
+ }
+
+
+
+
+ int expr_is_bool(ex, want)
+ Expr *ex;
+ int want;
+ {
+ long val;
+
+ if (ex->val.type == tp_boolean && isconstexpr(ex, &val))
+ return (val == want);
+ return 0;
+ }
+
+
+
+
+ /* Returns 1 if c1 implies c2, 0 otherwise */
+ /* If not1 is true, then checks if (!c1) implies c2; similarly for not2 */
+
+ /* Identities used:
+ c1 -> (c2a && c2b) <=> (c1 -> c2a) && (c1 -> c2b)
+ c1 -> (c2a || c2b) <=> (c1 -> c2a) || (c1 -> c2b)
+ (c1a && c1b) -> c2 <=> (c1a -> c2) || (c1b -> c2)
+ (c1a || c1b) -> c2 <=> (c1a -> c2) && (c1b -> c2)
+ (!c1) -> (!c2) <=> c2 -> c1
+ (a == b) -> c2(b) <=> c2(a)
+ !(c1 && c2) <=> (!c1) || (!c2)
+ !(c1 || c2) <=> (!c1) && (!c2)
+ */
+ /* This could be smarter about, e.g., (a>5) -> (a>0) */
+
+ int implies(c1, c2, not1, not2)
+ Expr *c1, *c2;
+ int not1, not2;
+ {
+ Expr *ex;
+ int i;
+
+ if (c1->kind == EK_EQ && c1->args[0]->val.type == tp_boolean) {
+ if (checkconst(c1->args[0], 1)) { /* things like "flag = true" */
+ return implies(c1->args[1], c2, not1, not2);
+ } else if (checkconst(c1->args[1], 1)) {
+ return implies(c1->args[0], c2, not1, not2);
+ } else if (checkconst(c1->args[0], 0)) {
+ return implies(c1->args[1], c2, !not1, not2);
+ } else if (checkconst(c1->args[1], 0)) {
+ return implies(c1->args[0], c2, !not1, not2);
+ }
+ }
+ if (c2->kind == EK_EQ && c2->args[0]->val.type == tp_boolean) {
+ if (checkconst(c2->args[0], 1)) {
+ return implies(c1, c2->args[1], not1, not2);
+ } else if (checkconst(c2->args[1], 1)) {
+ return implies(c1, c2->args[0], not1, not2);
+ } else if (checkconst(c2->args[0], 0)) {
+ return implies(c1, c2->args[1], not1, !not2);
+ } else if (checkconst(c2->args[1], 0)) {
+ return implies(c1, c2->args[0], not1, !not2);
+ }
+ }
+ switch (c2->kind) {
+
+ case EK_AND:
+ if (not2) /* c1 -> (!c2a || !c2b) */
+ return (implies(c1, c2->args[0], not1, 1) ||
+ implies(c1, c2->args[1], not1, 1));
+ else /* c1 -> (c2a && c2b) */
+ return (implies(c1, c2->args[0], not1, 0) &&
+ implies(c1, c2->args[1], not1, 0));
+
+ case EK_OR:
+ if (not2) /* c1 -> (!c2a && !c2b) */
+ return (implies(c1, c2->args[0], not1, 1) &&
+ implies(c1, c2->args[1], not1, 1));
+ else /* c1 -> (c2a || c2b) */
+ return (implies(c1, c2->args[0], not1, 0) ||
+ implies(c1, c2->args[1], not1, 0));
+
+ case EK_NOT: /* c1 -> (!c2) */
+ return (implies(c1, c2->args[0], not1, !not2));
+
+ case EK_CONST:
+ if ((c2->val.i != 0) != not2) /* c1 -> true */
+ return 1;
+ break;
+
+ default:
+ break;
+ }
+ switch (c1->kind) {
+
+ case EK_AND:
+ if (not1) /* (!c1a || !c1b) -> c2 */
+ return (implies(c1->args[0], c2, 1, not2) &&
+ implies(c1->args[1], c2, 1, not2));
+ else /* (c1a && c1b) -> c2 */
+ return (implies(c1->args[0], c2, 0, not2) ||
+ implies(c1->args[1], c2, 0, not2));
+
+ case EK_OR:
+ if (not1) /* (!c1a && !c1b) -> c2 */
+ return (implies(c1->args[0], c2, 1, not2) ||
+ implies(c1->args[1], c2, 1, not2));
+ else /* (c1a || c1b) -> c2 */
+ return (implies(c1->args[0], c2, 0, not2) &&
+ implies(c1->args[1], c2, 0, not2));
+
+ case EK_NOT: /* (!c1) -> c2 */
+ return (implies(c1->args[0], c2, !not1, not2));
+
+ case EK_CONST:
+ if ((c1->val.i != 0) == not1) /* false -> c2 */
+ return 1;
+ break;
+
+ case EK_EQ: /* (a=b) -> c2 */
+ case EK_ASSIGN: /* (a:=b) -> c2 */
+ case EK_NE: /* (a<>b) -> c2 */
+ if ((c1->kind == EK_NE) == not1) {
+ if (c1->args[0]->kind == EK_VAR) {
+ ex = replaceexprexpr(copyexpr(c2), c1->args[0], c1->args[1], 1);
+ i = expr_is_bool(ex, !not2);
+ freeexpr(ex);
+ if (i)
+ return 1;
+ }
+ if (c1->args[1]->kind == EK_VAR) {
+ ex = replaceexprexpr(copyexpr(c2), c1->args[1], c1->args[0], 1);
+ i = expr_is_bool(ex, !not2);
+ freeexpr(ex);
+ if (i)
+ return 1;
+ }
+ }
+ break;
+
+ default:
+ break;
+ }
+ if (not1 == not2 && exprequiv(c1, c2)) { /* c1 -> c1 */
+ return 1;
+ }
+ return 0;
+ }
+
+
+
+
+
+ void infiniteloop(sp)
+ Stmt *sp;
+ {
+ switch (infloopstyle) {
+
+ case 1: /* write "for (;;) ..." */
+ sp->kind = SK_FOR;
+ freeexpr(sp->exp1);
+ sp->exp1 = NULL;
+ break;
+
+ case 2: /* write "while (1) ..." */
+ sp->kind = SK_WHILE;
+ freeexpr(sp->exp1);
+ sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
+ break;
+
+ case 3: /* write "do ... while (1)" */
+ sp->kind = SK_REPEAT;
+ freeexpr(sp->exp1);
+ sp->exp1 = makeexpr_val(make_ord(tp_boolean, 1));
+ break;
+
+ default: /* leave it alone */
+ break;
+
+ }
+ }
+
+
+
+
+
+ Expr *print_func(ex)
+ Expr *ex;
+ {
+ if (!ex || ex->kind != EK_BICALL)
+ return NULL;
+ if ((!strcmp(ex->val.s, "printf") &&
+ ex->args[0]->kind == EK_CONST) ||
+ !strcmp(ex->val.s, "putchar") ||
+ !strcmp(ex->val.s, "puts"))
+ return ex_output;
+ if ((!strcmp(ex->val.s, "fprintf") ||
+ !strcmp(ex->val.s, "sprintf")) &&
+ ex->args[1]->kind == EK_CONST)
+ return ex->args[0];
+ if (!strcmp(ex->val.s, "putc") ||
+ !strcmp(ex->val.s, "fputc") ||
+ !strcmp(ex->val.s, "fputs"))
+ return ex->args[1];
+ return NULL;
+ }
+
+
+
+ int printnl_func(ex)
+ Expr *ex;
+ {
+ char *cp, ch;
+ int i, len;
+
+ if (debug>2) { fprintf(outf,"printnl_func("); dumpexpr(ex); fprintf(outf, ")\n"); }
+ if (!strcmp(ex->val.s, "printf") ||
+ !strcmp(ex->val.s, "puts") ||
+ !strcmp(ex->val.s, "fputs")) {
+ if (ex->args[0]->kind != EK_CONST)
+ return 0;
+ cp = ex->args[0]->val.s;
+ len = ex->args[0]->val.i;
+ } else if (!strcmp(ex->val.s, "fprintf")) {
+ if (ex->args[1]->kind != EK_CONST)
+ return 0;
+ cp = ex->args[1]->val.s;
+ len = ex->args[1]->val.i;
+ } else if (!strcmp(ex->val.s, "putchar") ||
+ !strcmp(ex->val.s, "putc") ||
+ !strcmp(ex->val.s, "fputc")) {
+ if (ex->args[0]->kind != EK_CONST)
+ return 0;
+ ch = ex->args[0]->val.i;
+ cp = &ch;
+ len = 1;
+ } else
+ return 0;
+ for (i = 1; i <= len; i++)
+ if (*cp++ != '\n')
+ return 0;
+ return len + (!strcmp(ex->val.s, "puts"));
+ }
+
+
+
+ Expr *chg_printf(ex)
+ Expr *ex;
+ {
+ Expr *fex;
+
+ if (debug>2) { fprintf(outf,"chg_printf("); dumpexpr(ex); fprintf(outf, ")\n"); }
+ if (!strcmp(ex->val.s, "putchar")) {
+ ex = makeexpr_sprintfify(grabarg(ex, 0));
+ canceltempvar(istempvar(ex->args[0]));
+ strchange(&ex->val.s, "printf");
+ delfreearg(&ex, 0);
+ ex->val.type = tp_void;
+ } else if (!strcmp(ex->val.s, "putc") ||
+ !strcmp(ex->val.s, "fputc") ||
+ !strcmp(ex->val.s, "fputs")) {
+ fex = copyexpr(ex->args[1]);
+ ex = makeexpr_sprintfify(grabarg(ex, 0));
+ canceltempvar(istempvar(ex->args[0]));
+ strchange(&ex->val.s, "fprintf");
+ ex->args[0] = fex;
+ ex->val.type = tp_void;
+ } else if (!strcmp(ex->val.s, "puts")) {
+ ex = makeexpr_concat(makeexpr_sprintfify(grabarg(ex, 0)),
+ makeexpr_string("\n"), 1);
+ strchange(&ex->val.s, "printf");
+ delfreearg(&ex, 0);
+ ex->val.type = tp_void;
+ }
+ if (!strcmp(ex->val.s, "fprintf") && exprsame(ex->args[0], ex_output, 1)) {
+ delfreearg(&ex, 0);
+ strchange(&ex->val.s, "printf");
+ }
+ return ex;
+ }
+
+
+ Expr *mix_printf(ex, ex2)
+ Expr *ex, *ex2;
+ {
+ int i;
+
+ ex = chg_printf(ex);
+ if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex); fprintf(outf, "\n"); }
+ ex2 = chg_printf(copyexpr(ex2));
+ if (debug>2) { fprintf(outf,"chg_printf returns "); dumpexpr(ex2);fprintf(outf, "\n"); }
+ i = (!strcmp(ex->val.s, "printf")) ? 0 : 1;
+ ex->args[i] = makeexpr_concat(ex->args[i], ex2->args[i], 0);
+ for (i++; i < ex2->nargs; i++) {
+ insertarg(&ex, ex->nargs, ex2->args[i]);
+ }
+ return ex;
+ }
+
+
+
+
+
+
+ void eatstmt(spp)
+ Stmt **spp;
+ {
+ Stmt *sp = *spp;
+
+ if (debug>2) { fprintf(outf, "eatstmt on:\n"); dumpstmt(sp, 5); }
+ *spp = sp->next;
+ sp->next = NULL;
+ free_stmt(sp);
+ }
+
+
+
+ int haslabels(sp)
+ Stmt *sp;
+ {
+ if (!sp)
+ return 0;
+ if (haslabels(sp->stm1) || haslabels(sp->stm2))
+ return 1;
+ return (sp->kind == SK_LABEL);
+ }
+
+
+
+ void fixblock(spp, thereturn)
+ Stmt **spp, *thereturn;
+ {
+ Stmt *sp, *sp1, *sp2, *sp3, **spp2, *thisreturn;
+ Expr *ex;
+ Meaning *tvar;
+ int save_tryblock;
+ short save_tryflag;
+ int i, j, de1, de2;
+ long saveserial = curserial;
+
+ while ((sp = *spp)) {
+ sp2 = sp->next;
+ sp->next = NULL;
+ sp = fix_statement(*spp);
+ if (!sp) {
+ *spp = sp2;
+ continue;
+ }
+ *spp = sp;
+ for (sp3 = sp; sp3->next; sp3 = sp3->next) ;
+ sp3->next = sp2;
+ if (!sp->next)
+ thisreturn = thereturn;
+ else if (sp->next->kind == SK_RETURN ||
+ (sp->next->kind == SK_ASSIGN &&
+ isescape(sp->next->exp1)))
+ thisreturn = sp->next;
+ else
+ thisreturn = NULL;
+ if (sp->serial >= 0)
+ curserial = sp->serial;
+ switch (sp->kind) {
+
+ case SK_ASSIGN:
+ if (sp->exp1)
+ sp->exp1 = fixexpr(sp->exp1, ENV_STMT);
+ if (!sp->exp1)
+ intwarning("fixblock", "sp->exp1 == NULL in SK_ASSIGN");
+ if (!sp->exp1 || nosideeffects(sp->exp1, 1)) {
+ eatstmt(spp);
+ continue;
+ } else {
+ switch (sp->exp1->kind) {
+
+ case EK_COND:
+ *spp = makestmt_if(sp->exp1->args[0],
+ makestmt_call(sp->exp1->args[1]),
+ makestmt_call(sp->exp1->args[2]));
+ (*spp)->next = sp->next;
+ continue; /* ... to fix this new if statement */
+
+ case EK_ASSIGN:
+ if (sp->exp1->args[1]->kind == EK_COND && usecommas != 1) {
+ *spp = makestmt_if(sp->exp1->args[1]->args[0],
+ makestmt_assign(copyexpr(sp->exp1->args[0]),
+ sp->exp1->args[1]->args[1]),
+ makestmt_assign(sp->exp1->args[0],
+ sp->exp1->args[1]->args[2]));
+ (*spp)->next = sp->next;
+ continue;
+ }
+ if (isescape(sp->exp1->args[1])) {
+ sp->exp1 = grabarg(sp->exp1, 1);
+ continue;
+ }
+ if (exprsame(sp->exp1->args[0], sp->exp1->args[1], 1)) {
+ /* *spp = sp->next; */
+ sp->exp1 = grabarg(sp->exp1, 0);
+ continue;
+ }
+ if (sp->exp1->args[1]->kind == EK_BICALL) {
+ if (!strcmp(sp->exp1->args[1]->val.s,
+ getfbufname) &&
+ buildreads == 1 &&
+ sp->next &&
+ sp->next->kind == SK_ASSIGN &&
+ sp->next->exp1->kind == EK_BICALL &&
+ !strcmp(sp->next->exp1->val.s,
+ getname) &&
+ expr_has_address(sp->exp1->args[0]) &&
+ similartypes(sp->exp1->args[0]->val.type,
+ filebasetype(sp->exp1->args[1]->args[0]->val.type)) &&
+ exprsame(sp->exp1->args[1]->args[0],
+ sp->next->exp1->args[0], 1)) {
+ eatstmt(&sp->next);
+ ex = makeexpr_bicall_4("fread", tp_integer,
+ makeexpr_addr(sp->exp1->args[0]),
+ makeexpr_sizeof(sp->exp1->args[1]->args[1], 0),
+ makeexpr_long(1),
+ sp->exp1->args[1]->args[0]);
+ FREE(sp->exp1);
+ sp->exp1 = ex;
+ continue;
+ }
+ if (!strcmp(sp->exp1->args[1]->val.s,
+ chargetfbufname) &&
+ buildreads != 0 &&
+ sp->next &&
+ sp->next->kind == SK_ASSIGN &&
+ sp->next->exp1->kind == EK_BICALL &&
+ !strcmp(sp->next->exp1->val.s,
+ chargetname) &&
+ expr_has_address(sp->exp1->args[0]) &&
+ exprsame(sp->exp1->args[1]->args[0],
+ sp->next->exp1->args[0], 1)) {
+ eatstmt(&sp->next);
+ strchange(&sp->exp1->args[1]->val.s,
+ "getc");
+ continue;
+ }
+ }
+ break;
+
+ case EK_BICALL:
+ if (!strcmp(sp->exp1->val.s, name_ESCAPE)) {
+ if (fixexpr_tryblock) {
+ *spp = makestmt_assign(makeexpr_var(mp_escapecode),
+ grabarg(sp->exp1, 0));
+ (*spp)->next = makestmt(SK_GOTO);
+ (*spp)->next->exp1 = makeexpr_name(format_s(name_LABEL,
+ format_d("try%d",
+ fixexpr_tryblock)),
+ tp_integer);
+ (*spp)->next->next = sp->next;
+ fixexpr_tryflag = 1;
+ continue;
+ }
+ } else if (!strcmp(sp->exp1->val.s, name_ESCIO)) {
+ if (fixexpr_tryblock) {
+ *spp = makestmt_assign(makeexpr_var(mp_escapecode),
+ makeexpr_long(-10));
+ (*spp)->next = makestmt_assign(makeexpr_var(mp_ioresult),
+ grabarg(sp->exp1, 0));
+ (*spp)->next->next = makestmt(SK_GOTO);
+ (*spp)->next->next->exp1 = makeexpr_name(format_s(name_LABEL,
+ format_d("try%d",
+ fixexpr_tryblock)),
+ tp_integer);
+ (*spp)->next->next->next = sp->next;
+ fixexpr_tryflag = 1;
+ continue;
+ }
+ }
+ if (!strcmp(sp->exp1->val.s, putfbufname) &&
+ buildwrites == 1 &&
+ sp->next &&
+ sp->next->kind == SK_ASSIGN &&
+ sp->next->exp1->kind == EK_BICALL &&
+ !strcmp(sp->next->exp1->val.s,
+ putname) &&
+ exprsame(sp->exp1->args[0],
+ sp->next->exp1->args[0], 1)) {
+ eatstmt(&sp->next);
+ if (!expr_has_address(sp->exp1->args[2]) ||
+ sp->exp1->args[2]->val.type !=
+ sp->exp1->args[1]->val.type) {
+ tvar = maketempvar(sp->exp1->args[1]->val.type,
+ name_TEMP);
+ sp2 = makestmt_assign(makeexpr_var(tvar),
+ sp->exp1->args[2]);
+ sp2->next = sp;
+ *spp = sp2;
+ sp->exp1->args[2] = makeexpr_var(tvar);
+ freetempvar(tvar);
+ }
+ ex = makeexpr_bicall_4("fwrite", tp_integer,
+ makeexpr_addr(sp->exp1->args[2]),
+ makeexpr_sizeof(sp->exp1->args[1], 0),
+ makeexpr_long(1),
+ sp->exp1->args[0]);
+ FREE(sp->exp1);
+ sp->exp1 = ex;
+ continue;
+ }
+ if (!strcmp(sp->exp1->val.s, charputfbufname) &&
+ buildwrites != 0 &&
+ sp->next &&
+ sp->next->kind == SK_ASSIGN &&
+ sp->next->exp1->kind == EK_BICALL &&
+ !strcmp(sp->next->exp1->val.s,
+ charputname) &&
+ exprsame(sp->exp1->args[0],
+ sp->next->exp1->args[0], 1)) {
+ eatstmt(&sp->next);
+ swapexprs(sp->exp1->args[0],
+ sp->exp1->args[1]);
+ strchange(&sp->exp1->val.s, "putc");
+ continue;
+ }
+ if ((!strcmp(sp->exp1->val.s, resetbufname) ||
+ !strcmp(sp->exp1->val.s, setupbufname)) &&
+ !fileisbuffered(sp->exp1->args[0], 0)) {
+ eatstmt(spp);
+ continue;
+ }
+ ex = print_func(sp->exp1);
+ if (ex && sp->next && mixwritelns &&
+ sp->next->kind == SK_ASSIGN &&
+ exprsame(ex, print_func(sp->next->exp1), 1) &&
+ (printnl_func(sp->exp1) ||
+ printnl_func(sp->next->exp1))) {
+ sp->exp1 = mix_printf(sp->exp1,
+ sp->next->exp1);
+ eatstmt(&sp->next);
+ continue;
+ }
+ break;
+
+ case EK_FUNCTION:
+ case EK_SPCALL:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ case EK_AND:
+ case EK_OR:
+ break;
+
+ default:
+ spp2 = spp;
+ for (i = 0; i < sp->exp1->nargs; i++) {
+ *spp2 = makestmt_call(sp->exp1->args[i]);
+ spp2 = &(*spp2)->next;
+ }
+ *spp2 = sp->next;
+ continue; /* ... to fix these new statements */
+
+ }
+ }
+ break;
+
+ case SK_IF:
+ fixblock(&sp->stm1, thisreturn);
+ fixblock(&sp->stm2, thisreturn);
+ if (!sp->stm1) {
+ if (!sp->stm2) {
+ sp->kind = SK_ASSIGN;
+ continue;
+ } else {
+ if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
+ freeexpr(sp->stm2->exp2);
+ sp->stm2->exp2 = NULL;
+ }
+ sp->exp1 = makeexpr_not(sp->exp1); /* if (x) else foo => if (!x) foo */
+ swapstmts(sp->stm1, sp->stm2);
+ /* Ought to exchange comments for then/else parts */
+ }
+ }
+ /* At this point we know sp1 != NULL */
+ if (thisreturn) {
+ if (thisreturn->kind == SK_WHILE) {
+ if (usebreaks) {
+ sp1 = sp->stm1;
+ while (sp1->next)
+ sp1 = sp1->next;
+ if (sp->stm2) {
+ sp2 = sp->stm2;
+ while (sp2->next)
+ sp2 = sp2->next;
+ i = stmtcount(sp->stm1);
+ j = stmtcount(sp->stm2);
+ if (j >= breaklimit && i <= 2 && j > i*2 &&
+ ((implies(sp->exp1, thisreturn->exp1, 0, 1) &&
+ !checkexprchanged(sp->stm1, sp->exp1)) ||
+ (sp1->kind == SK_ASSIGN &&
+ implies(sp1->exp1, thisreturn->exp1, 0, 1)))) {
+ sp1->next = makestmt(SK_BREAK);
+ } else if (i >= breaklimit && j <= 2 && i > j*2 &&
+ ((implies(sp->exp1, thisreturn->exp1, 1, 1) &&
+ !checkexprchanged(sp->stm2, sp->exp1)) ||
+ (sp2->kind == SK_ASSIGN &&
+ implies(sp2->exp1, thisreturn->exp1, 0, 1)))) {
+ sp2->next = makestmt(SK_BREAK);
+ } else if (!checkconst(sp->exp2, 1)) {
+ /* not part of an else-if */
+ if (j >= continuelimit) {
+ sp1->next = makestmt(SK_CONTINUE);
+ } else if (i >= continuelimit) {
+ sp2->next = makestmt(SK_CONTINUE);
+ }
+ }
+ } else {
+ i = stmtcount(sp->stm1);
+ if (i >= breaklimit &&
+ implies(sp->exp1, thisreturn->exp1, 1, 1)) {
+ sp->exp1 = makeexpr_not(sp->exp1);
+ sp1->next = sp->next;
+ sp->next = sp->stm1;
+ sp->stm1 = makestmt(SK_BREAK);
+ } else if (i >= continuelimit) {
+ sp->exp1 = makeexpr_not(sp->exp1);
+ sp1->next = sp->next;
+ sp->next = sp->stm1;
+ sp->stm1 = makestmt(SK_CONTINUE);
+ }
+ }
+ }
+ } else {
+ if (usereturns) {
+ sp2 = sp->stm1;
+ while (sp2->next)
+ sp2 = sp2->next;
+ if (sp->stm2) {
+ /* if (x) foo; else bar; (return;) => if (x) {foo; return;} bar; */
+ if (stmtcount(sp->stm2) >= returnlimit) {
+ if (!deadendblock(sp->stm1))
+ sp2->next = copystmt(thisreturn);
+ } else if (stmtcount(sp->stm1) >= returnlimit) {
+ sp2 = sp->stm2;
+ while (sp2->next)
+ sp2 = sp2->next;
+ if (!deadendblock(sp->stm2))
+ sp2->next = copystmt(thisreturn);
+ }
+ } else { /* if (x) foo; (return;) => if (!x) return; foo; */
+ if (stmtcount(sp->stm1) >= returnlimit) {
+ sp->exp1 = makeexpr_not(sp->exp1);
+ sp2->next = sp->next;
+ sp->next = sp->stm1;
+ sp->stm1 = copystmt(thisreturn);
+ }
+ }
+ }
+ }
+ }
+ if (!checkconst(sp->exp2, 1)) { /* not part of an else-if */
+ de1 = deadendblock(sp->stm1);
+ de2 = deadendblock(sp->stm2);
+ if (de2 && !de1) {
+ sp->exp1 = makeexpr_not(sp->exp1);
+ swapstmts(sp->stm1, sp->stm2);
+ de1 = 1, de2 = 0;
+ }
+ if (de1 && !de2 && sp->stm2) {
+ if (sp->stm2->kind == SK_IF && sp->stm2->exp2) {
+ freeexpr(sp->stm2->exp2);
+ sp->stm2->exp2 = NULL;
+ }
+ for (sp2 = sp->stm2; sp2->next; sp2 = sp2->next) ;
+ sp2->next = sp->next;
+ sp->next = sp->stm2; /* if (x) ESCAPE else foo => if (x) ESCAPE; foo */
+ sp->stm2 = NULL;
+ }
+ }
+ sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
+ if (elimdeadcode > 1 && checkconst(sp->exp1, 0)) {
+ note("Eliminated \"if false\" statement [326]");
+ splicestmt(sp, sp->stm2);
+ continue;
+ } else if (elimdeadcode > 1 && checkconst(sp->exp1, 1)) {
+ note("Eliminated \"if true\" statement [327]");
+ splicestmt(sp, sp->stm1);
+ continue;
+ }
+ break;
+
+ case SK_WHILE:
+ if (whilefgets && /* handle "while eof(f) do readln(f,...)" */
+ sp->stm1 &&
+ sp->stm1->kind == SK_ASSIGN &&
+ sp->stm1->exp1->kind == EK_BICALL &&
+ !strcmp(sp->stm1->exp1->val.s, "fgets") &&
+ nosideeffects(sp->stm1->exp1->args[0], 1) &&
+ nosideeffects(sp->stm1->exp1->args[1], 1) &&
+ nosideeffects(sp->stm1->exp1->args[2], 1)) {
+ if ((sp->exp1->kind == EK_NOT &&
+ sp->exp1->args[0]->kind == EK_BICALL && *eofname &&
+ !strcmp(sp->exp1->args[0]->val.s, eofname) &&
+ exprsame(sp->exp1->args[0]->args[0],
+ sp->stm1->exp1->args[2], 1)) ||
+ (sp->exp1->kind == EK_EQ &&
+ sp->exp1->args[0]->kind == EK_BICALL &&
+ !strcmp(sp->exp1->args[0]->val.s, "feof") &&
+ checkconst(sp->exp1->args[1], 0) &&
+ exprsame(sp->exp1->args[0]->args[0],
+ sp->stm1->exp1->args[2], 1))) {
+ sp->stm1->exp1->val.type = tp_strptr;
+ sp->exp1 = makeexpr_rel(EK_NE,
+ sp->stm1->exp1,
+ makeexpr_nil());
+ sp->stm1 = sp->stm1->next;
+ }
+ }
+ fixblock(&sp->stm1, sp);
+ sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
+ if (checkconst(sp->exp1, 1))
+ infiniteloop(sp);
+ break;
+
+ case SK_REPEAT:
+ fixblock(&sp->stm1, NULL);
+ sp->exp1 = fixexpr(sp->exp1, ENV_BOOL);
+ if (checkconst(sp->exp1, 1))
+ infiniteloop(sp);
+ break;
+
+ case SK_TRY:
+ save_tryblock = fixexpr_tryblock;
+ save_tryflag = fixexpr_tryflag;
+ fixexpr_tryblock = sp->exp1->val.i;
+ fixexpr_tryflag = 0;
+ fixblock(&sp->stm1, NULL);
+ if (fixexpr_tryflag)
+ sp->exp2 = makeexpr_long(1);
+ fixexpr_tryblock = save_tryblock;
+ fixexpr_tryflag = save_tryflag;
+ fixblock(&sp->stm2, NULL);
+ break;
+
+ case SK_BODY:
+ fixblock(&sp->stm1, thisreturn);
+ break;
+
+ case SK_CASE:
+ fixblock(&sp->stm1, NULL);
+ sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
+ if (!sp->stm1) { /* empty case */
+ sp->kind = SK_ASSIGN;
+ continue;
+ } else if (sp->stm1->kind != SK_CASELABEL) { /* default only */
+ for (sp2 = sp->stm1; sp2->next; sp2 = sp2->next) ;
+ sp2->next = sp->next;
+ sp->next = sp->stm1;
+ sp->kind = SK_ASSIGN;
+ sp->stm1 = NULL;
+ continue;
+ }
+ break;
+
+ default:
+ fixblock(&sp->stm1, NULL);
+ fixblock(&sp->stm2, NULL);
+ sp->exp1 = fixexpr(sp->exp1, ENV_EXPR);
+ sp->exp2 = fixexpr(sp->exp2, ENV_EXPR);
+ sp->exp3 = fixexpr(sp->exp3, ENV_EXPR);
+ if (sp->next &&
+ (sp->kind == SK_GOTO ||
+ sp->kind == SK_BREAK ||
+ sp->kind == SK_CONTINUE ||
+ sp->kind == SK_RETURN) &&
+ !haslabels(sp->next)) {
+ if (elimdeadcode) {
+ note("Deleting unreachable code [255]");
+ while (sp->next && !haslabels(sp->next))
+ eatstmt(&sp->next);
+ } else {
+ note("Code is unreachable [256]");
+ }
+ } else if (sp->kind == SK_RETURN &&
+ thisreturn &&
+ thisreturn->kind == SK_RETURN &&
+ exprsame(sp->exp1, thisreturn->exp1, 1)) {
+ eatstmt(spp);
+ continue;
+ }
+ break;
+ }
+ spp = &sp->next;
+ }
+ saveserial = curserial;
+ }
+
+
+
+
+ /* Convert comma expressions into multiple statements */
+
+ Static int checkcomma_expr(spp, exp)
+ Stmt **spp;
+ Expr **exp;
+ {
+ Stmt *sp;
+ Expr *ex = *exp;
+ int i, res;
+
+ switch (ex->kind) {
+
+ case EK_COMMA:
+ if (spp) {
+ res = checkcomma_expr(spp, &ex->args[ex->nargs-1]);
+ for (i = ex->nargs-1; --i >= 0; ) {
+ sp = makestmt(SK_ASSIGN);
+ sp->exp1 = ex->args[i];
+ sp->next = *spp;
+ *spp = sp;
+ res = checkcomma_expr(spp, &ex->args[i]);
+ }
+ *exp = ex->args[ex->nargs-1];
+ }
+ return 1;
+
+ case EK_COND:
+ if (isescape(ex->args[1]) && spp &&
+ !isescape(ex->args[2])) {
+ swapexprs(ex->args[1], ex->args[2]);
+ ex->args[0] = makeexpr_not(ex->args[0]);
+ }
+ if (isescape(ex->args[2])) {
+ if (spp) {
+ res = checkcomma_expr(spp, &ex->args[1]);
+ if (ex->args[0]->kind == EK_ASSIGN) {
+ sp = makestmt(SK_ASSIGN);
+ sp->exp1 = copyexpr(ex->args[0]);
+ sp->next = makestmt(SK_IF);
+ sp->next->next = *spp;
+ *spp = sp;
+ res = checkcomma_expr(spp, &sp->exp1);
+ ex->args[0] = grabarg(ex->args[0], 0);
+ sp = sp->next;
+ } else {
+ sp = makestmt(SK_IF);
+ sp->next = *spp;
+ *spp = sp;
+ }
+ sp->exp1 = makeexpr_not(ex->args[0]);
+ sp->stm1 = makestmt(SK_ASSIGN);
+ sp->stm1->exp1 = eatcasts(ex->args[2]);
+ res = checkcomma_expr(&sp->stm1, &ex->args[2]);
+ res = checkcomma_expr(spp, &sp->exp1);
+ *exp = ex->args[1];
+ }
+ return 1;
+ }
+ return checkcomma_expr(spp, &ex->args[0]);
+
+ case EK_AND:
+ case EK_OR:
+ return checkcomma_expr(spp, &ex->args[0]);
+
+ default:
+ res = 0;
+ for (i = ex->nargs; --i >= 0; ) {
+ res += checkcomma_expr(spp, &ex->args[i]);
+ }
+ return res;
+
+ }
+ }
+
+
+
+ Static void checkcommas(spp)
+ Stmt **spp;
+ {
+ Stmt *sp;
+ int res;
+
+ while ((sp = *spp)) {
+ checkcommas(&sp->stm1);
+ checkcommas(&sp->stm2);
+ switch (sp->kind) {
+
+ case SK_ASSIGN:
+ case SK_IF:
+ case SK_CASE:
+ case SK_RETURN:
+ if (sp->exp1)
+ res = checkcomma_expr(spp, &sp->exp1);
+ break;
+
+ case SK_WHILE:
+ /* handle the argument */
+ break;
+
+ case SK_REPEAT:
+ /* handle the argument */
+ break;
+
+ case SK_FOR:
+ if (sp->exp1)
+ res = checkcomma_expr(spp, &sp->exp1);
+ /* handle the other arguments */
+ break;
+
+ default:
+ break;
+ }
+ spp = &sp->next;
+ }
+ }
+
+
+
+
+ Static int checkvarchangeable(ex, mp)
+ Expr *ex;
+ Meaning *mp;
+ {
+ switch (ex->kind) {
+
+ case EK_VAR:
+ return (mp == (Meaning *)ex->val.i);
+
+ case EK_DOT:
+ case EK_INDEX:
+ return checkvarchangeable(ex->args[0], mp);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ int checkvarchangedexpr(ex, mp, addrokay)
+ Expr *ex;
+ Meaning *mp;
+ int addrokay;
+ {
+ int i;
+ Meaning *mp3;
+ unsigned int safemask = 0;
+
+ switch (ex->kind) {
+
+ case EK_FUNCTION:
+ case EK_SPCALL:
+ if (ex->kind == EK_FUNCTION) {
+ i = 0;
+ mp3 = ((Meaning *)ex->val.i)->type->fbase;
+ } else {
+ i = 1;
+ if (ex->args[0]->val.type->kind != TK_PROCPTR)
+ return 1;
+ mp3 = ex->args[0]->val.type->basetype->fbase;
+ }
+ for ( ; i < ex->nargs && i < 16; i++) {
+ if (!mp3) {
+ intwarning("checkvarchangedexpr", "Too many arguments for EK_FUNCTION [266]");
+ break;
+ }
+ if (mp3->kind == MK_PARAM &&
+ (mp3->type->kind == TK_ARRAY ||
+ mp3->type->kind == TK_STRING ||
+ mp3->type->kind == TK_SET))
+ safemask |= 1<<i;
+ if (mp3->kind == MK_VARPARAM &&
+ mp3->type == tp_strptr && mp3->anyvarflag)
+ i++;
+ mp3 = mp3->xnext;
+ }
+ if (mp3)
+ intwarning("checkvarchangedexpr", "Too few arguments for EK_FUNCTION [267]");
+ break;
+
+ case EK_VAR:
+ if (mp == (Meaning *)ex->val.i) {
+ if ((mp->type->kind == TK_ARRAY ||
+ mp->type->kind == TK_STRING ||
+ mp->type->kind == TK_SET) &&
+ ex->val.type->kind == TK_POINTER && !addrokay)
+ return 1; /* must be an implicit & */
+ }
+ break;
+
+ case EK_ADDR:
+ case EK_ASSIGN:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ if (checkvarchangeable(ex->args[0], mp))
+ return 1;
+ break;
+
+ case EK_BICALL:
+ if (structuredfunc(ex) && checkvarchangeable(ex->args[0], mp))
+ return 1;
+ safemask = safemask_bicall(ex->val.s);
+ break;
+ /* In case calls to these functions were lazy and passed
+ the array rather than its (implicit) address. Other
+ BICALLs had better be careful about their arguments. */
+
+ case EK_PLUS:
+ if (addrokay) /* to keep from being scared by pointer */
+ safemask = ~0; /* arithmetic on string being passed */
+ break; /* to functions. */
+
+ default:
+ break;
+ }
+ for (i = 0; i < ex->nargs; i++) {
+ if (checkvarchangedexpr(ex->args[i], mp, safemask&1))
+ return 1;
+ safemask >>= 1;
+ }
+ return 0;
+ }
+
+
+
+ int checkvarchanged(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+ if (mp->constqual)
+ return 0;
+ if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION ||
+ mp->volatilequal || alwayscopyvalues)
+ return 1;
+ while (sp) {
+ if (/* sp->kind == SK_GOTO || */
+ sp->kind == SK_LABEL ||
+ checkvarchanged(sp->stm1, mp) ||
+ checkvarchanged(sp->stm2, mp) ||
+ (sp->exp1 && checkvarchangedexpr(sp->exp1, mp, 1)) ||
+ (sp->exp2 && checkvarchangedexpr(sp->exp2, mp, 1)) ||
+ (sp->exp3 && checkvarchangedexpr(sp->exp3, mp, 1)))
+ return 1;
+ sp = sp->next;
+ }
+ return 0;
+ }
+
+
+
+ int checkexprchanged(sp, ex)
+ Stmt *sp;
+ Expr *ex;
+ {
+ Meaning *mp;
+ int i;
+
+ for (i = 0; i < ex->nargs; i++) {
+ if (checkexprchanged(sp, ex->args[i]))
+ return 1;
+ }
+ switch (ex->kind) {
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ if (mp->kind == MK_CONST)
+ return 0;
+ else
+ return checkvarchanged(sp, mp);
+
+ case EK_HAT:
+ case EK_INDEX:
+ case EK_SPCALL:
+ return 1;
+
+ case EK_FUNCTION:
+ case EK_BICALL:
+ return !nosideeffects_func(ex);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+
+
+ /* Check if a variable always occurs with a certain offset added, e.g. "i+1" */
+
+ Static int theoffset, numoffsets, numzerooffsets;
+ #define BadOffset (-999)
+
+ void checkvaroffsetexpr(ex, mp, myoffset)
+ Expr *ex;
+ Meaning *mp;
+ int myoffset;
+ {
+ int i, nextoffset = 0;
+ Expr *ex2;
+
+ if (!ex)
+ return;
+ switch (ex->kind) {
+
+ case EK_VAR:
+ if (ex->val.i == (long)mp) {
+ if (myoffset == 0)
+ numzerooffsets++;
+ else if (numoffsets == 0 || myoffset == theoffset) {
+ theoffset = myoffset;
+ numoffsets++;
+ } else
+ theoffset = BadOffset;
+ }
+ break;
+
+ case EK_PLUS:
+ ex2 = ex->args[ex->nargs-1];
+ if (ex2->kind == EK_CONST &&
+ ex2->val.type->kind == TK_INTEGER) {
+ nextoffset = ex2->val.i;
+ }
+ break;
+
+ case EK_HAT:
+ case EK_POSTINC:
+ case EK_POSTDEC:
+ nextoffset = BadOffset;
+ break;
+
+ case EK_ASSIGN:
+ checkvaroffsetexpr(ex->args[0], mp, BadOffset);
+ checkvaroffsetexpr(ex->args[1], mp, 0);
+ return;
+
+ default:
+ break;
+ }
+ i = ex->nargs;
+ while (--i >= 0)
+ checkvaroffsetexpr(ex->args[i], mp, nextoffset);
+ }
+
+
+ void checkvaroffsetstmt(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+ while (sp) {
+ checkvaroffsetstmt(sp->stm1, mp);
+ checkvaroffsetstmt(sp->stm1, mp);
+ checkvaroffsetexpr(sp->exp1, mp, 0);
+ checkvaroffsetexpr(sp->exp2, mp, 0);
+ checkvaroffsetexpr(sp->exp3, mp, 0);
+ sp = sp->next;
+ }
+ }
+
+
+ int checkvaroffset(sp, mp)
+ Stmt *sp;
+ Meaning *mp;
+ {
+ if (mp->varstructflag || !mp->ctx || mp->ctx->kind != MK_FUNCTION)
+ return 0;
+ numoffsets = 0;
+ numzerooffsets = 0;
+ checkvaroffsetstmt(sp, mp);
+ if (numoffsets == 0 || theoffset == BadOffset ||
+ numoffsets <= numzerooffsets * 3)
+ return 0;
+ else
+ return theoffset;
+ }
+
+
+
+
+ Expr *initfilevar(ex)
+ Expr *ex;
+ {
+ Expr *ex2;
+ Meaning *mp;
+ char *name;
+
+ if (ex->val.type->kind == TK_BIGFILE) {
+ ex2 = copyexpr(ex);
+ if (ex->kind == EK_VAR &&
+ (mp = (Meaning *)ex->val.i)->kind == MK_VAR &&
+ mp->ctx->kind != MK_FUNCTION &&
+ !is_std_file(ex) &&
+ literalfilesflag > 0 &&
+ (literalfilesflag == 1 ||
+ strlist_cifind(literalfiles, mp->name)))
+ name = mp->name;
+ else
+ name = "";
+ return makeexpr_comma(makeexpr_assign(filebasename(ex),
+ makeexpr_nil()),
+ makeexpr_assign(makeexpr_dotq(ex2, "name",
+ tp_str255),
+ makeexpr_string(name)));
+ } else {
+ return makeexpr_assign(ex, makeexpr_nil());
+ }
+ }
+
+
+ void initfilevars(mp, sppp, exbase)
+ Meaning *mp;
+ Stmt ***sppp;
+ Expr *exbase;
+ {
+ Stmt *sp;
+ Type *tp;
+ Expr *ex;
+
+ while (mp) {
+ if ((mp->kind == MK_VAR && mp->refcount > 0 && !mp->istemporary) ||
+ mp->kind == MK_FIELD) {
+ tp = mp->type;
+ if (isfiletype(tp, -1)) {
+ mp->refcount++;
+ sp = makestmt(SK_ASSIGN);
+ sp->next = **sppp;
+ **sppp = sp;
+ if (exbase)
+ ex = makeexpr_dot(copyexpr(exbase), mp);
+ else
+ ex = makeexpr_var(mp);
+ sp->exp1 = initfilevar(copyexpr(ex));
+ } else if (tp->kind == TK_RECORD) {
+ if (exbase)
+ ex = makeexpr_dot(copyexpr(exbase), mp);
+ else
+ ex = makeexpr_var(mp);
+ initfilevars(tp->fbase, sppp, ex);
+ freeexpr(ex);
+ } else if (tp->kind == TK_ARRAY) {
+ while (tp->kind == TK_ARRAY)
+ tp = tp->basetype;
+ if (isfiletype(tp, -1))
+ note(format_s("Array of files %s should be initialized [257]",
+ mp->name));
+ }
+ }
+ mp = mp->cnext;
+ }
+ }
+
+
+
+
+
+ Static Stmt *p_body()
+ {
+ Stmt *sp, **spp, *spbody, **sppbody, *spbase, *thereturn;
+ Meaning *mp;
+ Expr *ex;
+ int haspostamble;
+ long saveserial;
+
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Translating %s (in %s)\n",
+ infname, inf_lnum, outf_lnum,
+ curctx->name, curctx->ctx->name);
+ notephase = 1;
+ spp = &spbase;
+ addstmt(SK_HEADER);
+ sp->exp1 = makeexpr_var(curctx);
+ checkkeyword(TOK_INLINE);
+ if (curtok != TOK_END && curtok != TOK_BEGIN && curtok != TOK_INLINE) {
+ if (curctx->kind == MK_FUNCTION || curctx->anyvarflag)
+ wexpecttok(TOK_BEGIN);
+ else
+ wexpecttok(TOK_END);
+ skiptotoken2(TOK_BEGIN, TOK_END);
+ }
+ if (curtok == TOK_END) {
+ gettok();
+ spbody = NULL;
+ } else {
+ spbody = p_stmt(NULL, SF_FUNC); /* parse the procedure/program body */
+ }
+ if (curtok == TOK_IDENT && curtokmeaning == curctx) {
+ gettok(); /* Modula-2 */
+ }
+ notephase = 2;
+ saveserial = curserial;
+ curserial = 10000;
+ if (curctx->kind == MK_FUNCTION) { /* handle copy parameters */
+ for (mp = curctx->type->fbase; mp; mp = mp->xnext) {
+ if (!mp->othername && mp->varstructflag) {
+ mp->othername = stralloc(format_s(name_COPYPAR, mp->name));
+ mp->rectype = mp->type;
+ addstmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_assign(makeexpr_var(mp),
+ makeexpr_name(mp->othername, mp->rectype));
+ mp->refcount++;
+ } else if (mp->othername) {
+ if (checkvarchanged(spbody, mp)) {
+ addstmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_assign(makeexpr_var(mp),
+ makeexpr_hat(makeexpr_name(mp->othername,
+ mp->rectype), 0));
+ mp->refcount++;
+ } else { /* don't need to copy it after all */
+ strchange(&mp->othername, mp->name);
+ ex = makeexpr_var(mp);
+ ex->val.type = mp->rectype;
+ replaceexpr(spbody, makeexpr_var(mp), makeexpr_hat(ex, 0));
+ }
+ }
+ }
+ }
+ for (mp = curctx->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_LABEL && mp->val.i) {
+ addstmt(SK_IF);
+ sp->exp1 = makeexpr_bicall_1("setjmp", tp_int,
+ makeexpr_var(mp->xnext));
+ sp->stm1 = makestmt(SK_GOTO);
+ sp->stm1->exp1 = makeexpr_name(format_s(name_LABEL, mp->name),
+ tp_integer);
+ }
+ }
+ *spp = spbody;
+ sppbody = spp;
+ while (*spp)
+ spp = &((*spp)->next);
+ haspostamble = 0;
+ initfilevars(curctx->cbase, &sppbody, NULL);
+ for (mp = curctx->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_VAR && mp->refcount > 0 &&
+ isfiletype(mp->type, -1) &&
+ !mp->istemporary) {
+ if (curctx->kind != MK_MODULE || curctx->anyvarflag) {
+ addstmt(SK_IF); /* close file variables */
+ sp->exp1 = makeexpr_rel(EK_NE, filebasename(makeexpr_var(mp)),
+ makeexpr_nil());
+ sp->stm1 = makestmt(SK_ASSIGN);
+ sp->stm1->exp1 = makeexpr_bicall_1("fclose", tp_void,
+ filebasename(makeexpr_var(mp)));
+ }
+ haspostamble = 1;
+ }
+ }
+ thereturn = &bogusreturn;
+ if (curctx->kind == MK_FUNCTION && curctx->type->basetype != tp_void) {
+ if ((haspostamble || !checkreturns(&spbase, 1)) &&
+ curctx->cbase->refcount > 0) { /* add function return code */
+ addstmt(SK_RETURN);
+ sp->exp1 = makeexpr_var(curctx->cbase);
+ }
+ thereturn = NULL;
+ } else if (curctx->kind == MK_MODULE && curctx->anyvarflag) {
+ addstmt(SK_ASSIGN);
+ sp->exp1 = makeexpr_bicall_1("exit", tp_void,
+ makeexpr_name("EXIT_SUCCESS",
+ tp_integer));
+ thereturn = NULL;
+ }
+ if (debug>2) { fprintf(outf, "calling fixblock/usecommas on:\n"); dumpstmt(spbase, 5); }
+ curserial = saveserial;
+ sp = makestmt(SK_BODY);
+ sp->stm1 = spbase;
+ fixblock(&sp, thereturn); /* finishing touches to statements and expressions */
+ spbase = sp->stm1;
+ FREE(sp);
+ if (usecommas != 1)
+ checkcommas(&spbase); /* unroll ugly EK_COMMA and EK_COND expressions */
+ if (debug>1) { fprintf(outf, "p_body returns:\n"); dumpstmt(spbase, 5); }
+ notephase = 0;
+ return spbase;
+ }
+
+
+
+
+ #define checkWord() if (anywords) output(" "); anywords = 1
+
+ Static void out_function(func)
+ Meaning *func;
+ {
+ Meaning *mp;
+ Symbol *sym;
+ int opts, anywords, spacing, saveindent;
+
+ if (func->varstructflag) {
+ makevarstruct(func);
+ }
+ if (collectnest) {
+ for (mp = func->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_FUNCTION && mp->isforward) {
+ forward_decl(mp, 0);
+ }
+ }
+ for (mp = func->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_FUNCTION && mp->type && !mp->exported) {
+ pushctx(mp);
+ out_function(mp); /* generate the sub-procedures first */
+ popctx();
+ }
+ }
+ }
+ spacing = functionspace;
+ for (mp = func; mp->ctx->kind == MK_FUNCTION; mp = mp->ctx) {
+ if (spacing > minfuncspace)
+ spacing--;
+ }
+ outsection(spacing);
+ flushcomments(&func->comments, -1, 0);
+ if (usePPMacros == 1) {
+ forward_decl(func, 0);
+ outsection(minorspace);
+ }
+ opts = ODECL_HEADER;
+ anywords = 0;
+ if (func->namedfile) {
+ checkWord();
+ if (useAnyptrMacros || ansiC < 2)
+ output("Inline");
+ else
+ output("inline");
+ }
+ if (!func->exported) {
+ if (func->ctx->kind == MK_FUNCTION) {
+ if (useAnyptrMacros) {
+ checkWord();
+ output("Local");
+ } else if (use_static) {
+ checkWord();
+ output("static");
+ }
+ } else if ((findsymbol(func->name)->flags & NEEDSTATIC) ||
+ (use_static != 0 && !useAnyptrMacros)) {
+ checkWord();
+ output("static");
+ } else if (useAnyptrMacros) {
+ checkWord();
+ output("Static");
+ }
+ }
+ if (func->type->basetype != tp_void || ansiC != 0) {
+ checkWord();
+ outbasetype(func->type, 0);
+ }
+ if (anywords) {
+ if (newlinefunctions)
+ opts |= ODECL_FUNCTION;
+ else
+ output(" ");
+ }
+ outdeclarator(func->type, func->name, opts);
+ if (fullprototyping == 0) {
+ saveindent = outindent;
+ moreindent(argindent);
+ out_argdecls(func->type);
+ outindent = saveindent;
+ }
+ for (mp = func->type->fbase; mp; mp = mp->xnext) {
+ if (mp->othername && strcmp(mp->name, mp->othername))
+ mp->wasdeclared = 0; /* make sure we also declare the copy */
+ }
+ func->wasdeclared = 1;
+ outcontext = func;
+ out_block((Stmt *)func->val.i, BR_FUNCTION, 10000);
+ if (useundef) {
+ anywords = 0;
+ for (mp = func->cbase; mp; mp = mp->cnext) {
+ if (mp->kind == MK_CONST &&
+ mp->isreturn) { /* the was-#defined flag */
+ if (!anywords)
+ outsection(minorspace);
+ anywords++;
+ output(format_s("#undef %s\n", mp->name));
+ sym = findsymbol(mp->name);
+ sym->flags &= ~AVOIDNAME;
+ }
+ }
+ }
+ if (conserve_mem) {
+ free_stmt((Stmt *)func->val.i); /* is this safe? */
+ func->val.i = 0;
+ forget_ctx(func, 0);
+ }
+ outsection(spacing);
+ }
+
+
+
+
+ void movetoend(mp)
+ Meaning *mp;
+ {
+ Meaning **mpp;
+
+ if (mp->ctx != curctx) {
+ intwarning("movetoend", "curctx is wrong [268]");
+ } else {
+ mpp = &mp->ctx->cbase; /* move a meaning to end of its parent context */
+ while (*mpp != mp) {
+ if (!*mpp) {
+ intwarning("movetoend", "meaning not on its context list [269]");
+ return;
+ }
+ mpp = &(*mpp)->cnext;
+ }
+ *mpp = mp->cnext; /* Remove from present position in list */
+ while (*mpp)
+ mpp = &(*mpp)->cnext;
+ *mpp = mp; /* Insert at end of list */
+ mp->cnext = NULL;
+ curctxlast = mp;
+ }
+ }
+
+
+
+ Static void scanfwdparams(mp)
+ Meaning *mp;
+ {
+ Symbol *sym;
+
+ mp = mp->type->fbase;
+ while (mp) {
+ sym = findsymbol(mp->name);
+ sym->flags |= FWDPARAM;
+ mp = mp->xnext;
+ }
+ }
+
+
+
+ Static void p_function(isfunc)
+ int isfunc;
+ {
+ Meaning *func;
+ Type *type;
+ Stmt *sp;
+ Strlist *sl, *comments, *savecmt;
+ int initializeattr = 0, isinline = 0;
+
+ if ((sl = strlist_find(attrlist, "INITIALIZE")) != NULL) {
+ initializeattr = 1;
+ strlist_delete(&attrlist, sl);
+ }
+ if ((sl = strlist_find(attrlist, "OPTIMIZE")) != NULL &&
+ sl->value != -1 &&
+ !strcmp((char *)(sl->value), "INLINE")) {
+ isinline = 1;
+ strlist_delete(&attrlist, sl);
+ }
+ ignore_attributes();
+ comments = extractcomment(&curcomments, -1, curserial);
+ changecomments(comments, -1, -1, -1, 0);
+ if (curctx->kind == MK_FUNCTION) { /* sub-procedure */
+ savecmt = curcomments;
+ } else {
+ savecmt = NULL;
+ flushcomments(&curcomments, -1, -1);
+ }
+ curcomments = comments;
+ curserial = serialcount = 1;
+ gettok();
+ if (!wexpecttok(TOK_IDENT))
+ skiptotoken(TOK_IDENT);
+ if (curtokmeaning && curtokmeaning->ctx == curctx &&
+ curtokmeaning->kind == MK_FUNCTION) {
+ func = curtokmeaning;
+ if (!func->isforward || func->val.i)
+ warning(format_s("Redeclaration of function %s [270]", func->name));
+ skiptotoken(TOK_SEMI);
+ movetoend(func);
+ pushctx(func);
+ type = func->type;
+ } else {
+ func = addmeaning(curtoksym, MK_FUNCTION);
+ gettok();
+ func->val.i = 0;
+ pushctx(func);
+ func->type = type = p_funcdecl(&isfunc, 0);
+ func->isfunction = isfunc;
+ func->namedfile = isinline;
+ type->meaning = func;
+ }
+ if (blockkind == TOK_EXPORT)
+ flushcomments(NULL, -1, -1);
+ wneedtok(TOK_SEMI);
+ if (initializeattr) {
+ sl = strlist_append(&initialcalls, format_s("%s()", func->name));
+ sl->value = 1;
+ }
+ if (curtok == TOK_IDENT && !strcmp(curtokbuf, "C")) {
+ gettok();
+ wneedtok(TOK_SEMI);
+ }
+ if (blockkind == TOK_IMPORT) {
+ strlist_empty(&curcomments);
+ if (curtok == TOK_IDENT &&
+ (!strcicmp(curtokbuf, "FORWARD") ||
+ strlist_cifind(externwords, curtokbuf) ||
+ strlist_cifind(cexternwords, curtokbuf))) {
+ gettok();
+ while (curtok == TOK_IDENT)
+ gettok();
+ wneedtok(TOK_SEMI);
+ }
+ /* do nothing more */
+ } else if (blockkind == TOK_EXPORT) {
+ func->isforward = 1;
+ scanfwdparams(func);
+ forward_decl(func, 1);
+ } else {
+ checkkeyword(TOK_INTERRUPT);
+ checkkeyword(TOK_INLINE);
+ if (curtok == TOK_INTERRUPT) {
+ note("Ignoring INTERRUPT keyword [258]");
+ gettok();
+ wneedtok(TOK_SEMI);
+ }
+ if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "FORWARD")) {
+ func->isforward = 1;
+ scanfwdparams(func);
+ gettok();
+ if (func->ctx->kind != MK_FUNCTION) {
+ outsection(minorspace);
+ flushcomments(NULL, -1, -1);
+ forward_decl(func, 0);
+ outsection(minorspace);
+ }
+ } else if (curtok == TOK_IDENT &&
+ (strlist_cifind(externwords, curtokbuf) ||
+ strlist_cifind(cexternwords, curtokbuf))) {
+ if (*externalias && my_strchr(externalias, '%')) {
+ strchange(&func->name, format_s(externalias, func->name));
+ } else if (strlist_cifind(cexternwords, curtokbuf)) {
+ if (func->name[0] == '_')
+ strchange(&func->name, func->name + 1);
+ if (func->name[strlen(func->name)-1] == '_')
+ func->name[strlen(func->name)-1] = 0;
+ }
+ func->isforward = 1; /* for Oregon Software Pascal-2 */
+ func->exported = 1;
+ gettok();
+ while (curtok == TOK_IDENT)
+ gettok();
+ outsection(minorspace);
+ flushcomments(NULL, -1, -1);
+ scanfwdparams(func);
+ forward_decl(func, 1);
+ outsection(minorspace);
+ } else if (curtok == TOK_IDENT) {
+ wexpecttok(TOK_BEGIN); /* print warning */
+ gettok();
+ outsection(minorspace);
+ flushcomments(NULL, -1, -1);
+ scanfwdparams(func);
+ forward_decl(func, 1);
+ outsection(minorspace);
+ } else {
+ if (func->ctx->kind == MK_FUNCTION)
+ func->ctx->needvarstruct = 1;
+ func->comments = curcomments;
+ curcomments = NULL;
+ p_block(TOK_FUNCTION);
+ echoprocname(func);
+ changecomments(curcomments, -1, curserial, -1, 10000);
+ sp = p_body();
+ func->ctx->needvarstruct = 0;
+ func->val.i = (long)sp;
+ strlist_mix(&func->comments, curcomments);
+ curcomments = NULL;
+ if (func->ctx->kind != MK_FUNCTION || !collectnest) {
+ out_function(func); /* output top-level procedures immediately */
+ } /* (sub-procedures are output later) */
+ }
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ }
+ strlist_mix(&curcomments, savecmt);
+ popctx();
+ }
+
+
+
+ Static void out_include(name, quoted)
+ char *name;
+ int quoted;
+ {
+ if (*name == '"' || *name == '<')
+ output(format_s("#include %s\n", name));
+ else if (quoted)
+ output(format_s("#include \"%s\"\n", name));
+ else
+ output(format_s("#include <%s>\n", name));
+ }
+
+
+ Static void cleanheadername(dest, name)
+ char *dest, *name;
+ {
+ char *cp;
+ int len;
+
+ if (*name == '<' || *name == '"')
+ name++;
+ cp = my_strrchr(name, '/');
+ if (cp)
+ cp++;
+ else
+ cp = name;
+ strcpy(dest, cp);
+ len = strlen(dest);
+ if (dest[len-1] == '>' || dest[len-1] == '"')
+ dest[len-1] = 0;
+ }
+
+
+
+
+ Static int tryimport(sym, fname, ext, need)
+ Symbol *sym;
+ char *fname, *ext;
+ int need;
+ {
+ int found = 0;
+ Meaning *savectx, *savectxlast;
+
+ savectx = curctx;
+ savectxlast = curctxlast;
+ curctx = nullctx;
+ curctxlast = curctx->cbase;
+ while (curctxlast && curctxlast->cnext)
+ curctxlast = curctxlast->cnext;
+ if (p_search(fname, ext, need)) {
+ curtokmeaning = sym->mbase;
+ while (curtokmeaning && !curtokmeaning->isactive)
+ curtokmeaning = curtokmeaning->snext;
+ if (curtokmeaning)
+ found = 1;
+ }
+ curctx = savectx;
+ curctxlast = savectxlast;
+ return found;
+ }
+
+
+
+ Static void p_import(inheader)
+ int inheader;
+ {
+ Strlist *sl;
+ Symbol *sym;
+ char *name;
+ int found, isfrom = (curtok == TOK_FROM);
+
+ outsection(minorspace);
+ do {
+ gettok();
+ if (!wexpecttok(TOK_IDENT)) {
+ skiptotoken(TOK_SEMI);
+ break;
+ }
+ sym = curtoksym;
+ if (curtokmeaning && curtokmeaning->kind == MK_MODULE) {
+ found = 1;
+ } else if (strlist_cifind(permimports, sym->name)) {
+ found = 2; /* built-in module, there already! */
+ } else {
+ found = 0;
+ sl = strlist_cifind(importfrom, sym->name);
+ name = (sl) ? format_none((char *)sl->value) : NULL;
+ if (name) {
+ if (tryimport(sym, name, "pas", 1))
+ found = 1;
+ } else {
+ for (sl = importdirs; sl && !found; sl = sl->next) {
+ if (tryimport(sym, format_s(sl->s, curtokcase), NULL, 0))
+ found = 1;
+ }
+ }
+ }
+ if (found == 1) {
+ if (!inheader) {
+ sl = strlist_cifind(includefrom, curtokmeaning->name);
+ name = (sl) ? (char *)sl->value :
+ format_ss(*headerfnfmt2 ? headerfnfmt2 : headerfnfmt,
+ infname, curtokmeaning->name);
+ if (name && !strlist_find(includedfiles, name)) {
+ strlist_insert(&includedfiles, name);
+ if (*name_HSYMBOL)
+ output(format_s("#ifndef %s\n", format_s(name_HSYMBOL, sym->name)));
+ out_include(name, quoteincludes);
+ if (*name_HSYMBOL)
+ output("#endif\n");
+ outsection(minorspace);
+ }
+ }
+ import_ctx(curtokmeaning);
+ } else if (curtokmeaning) {
+ /* Modula-2, importing a single ident */
+ /* Ignored for now, since we always import whole modules */
+ } else if (found == 0) {
+ warning(format_s("Could not find module %s [271]", sym->name));
+ if (!inheader) {
+ out_include(format_ss(*headerfnfmt2?headerfnfmt2:headerfnfmt,
+ sym->name, sym->name),
+ quoteincludes);
+ }
+ }
+ gettok();
+ } while (curtok == TOK_COMMA);
+ if (isfrom) {
+ checkkeyword(TOK_IMPORT);
+ if (wneedtok(TOK_IMPORT)) {
+ do {
+ gettok();
+ if (curtok == TOK_IDENT)
+ gettok();
+ } while (curtok == TOK_COMMA);
+ }
+ }
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ outsection(minorspace);
+ }
+
+
+
+
+ void do_include(blkind)
+ Token blkind;
+ {
+ FILE *oldfile = outf;
+ int savelnum = outf_lnum;
+ char fname[256];
+
+ outsection(majorspace);
+ strcpy(fname, curtokbuf);
+ removesuffix(fname);
+ strcat(fname, ".c");
+ if (!strcmp(fname, codefname)) {
+ warning("Include file name conflict! [272]");
+ badinclude();
+ return;
+ }
+ saveoldfile(fname);
+ outf = fopen(fname, "w");
+ if (!outf) {
+ outf = oldfile;
+ perror(fname);
+ badinclude();
+ return;
+ }
+ outf_lnum = 1;
+ if (nobanner)
+ output("\n");
+ else
+ output(format_ss("\n/* Include file %s from %s */\n\n",
+ fname, codefname));
+ if (blkind == TOK_END)
+ gettok();
+ else
+ curtok = blkind;
+ p_block(blockkind);
+ if (nobanner)
+ output("\n");
+ else
+ output("\n\n/* End. */\n\n");
+ fclose(outf);
+ outf = oldfile;
+ outf_lnum = savelnum;
+ if (curtok != TOK_EOF) {
+ warning("Junk at end of include file ignored [273]");
+ }
+ outsection(majorspace);
+ if (*includefnfmt)
+ out_include(format_s(includefnfmt, fname), 1);
+ else
+ out_include(fname, 1);
+ outsection(majorspace);
+ pop_input();
+ p2c_getline();
+ gettok();
+ }
+
+
+
+
+ /* blockkind is one of:
+ TOK_PROGRAM: Global declarations of a program
+ TOK_FUNCTION: Declarations local to a procedure or function
+ TOK_IMPORT: Import text read from a module
+ TOK_EXPORT: Export section of a module
+ TOK_IMPLEMENT: Implementation section of a module
+ TOK_END: None of the above
+ */
+
+ void p_block(blkind)
+ Token blkind;
+ {
+ Token saveblockkind = blockkind;
+ Token lastblockkind = TOK_END;
+
+ blockkind = blkind;
+ for (;;) {
+ while (curtok == TOK_INTFONLY) {
+ include_as_import();
+ gettok();
+ }
+ if (curtok == TOK_CONST || curtok == TOK_TYPE ||
+ curtok == TOK_VAR || curtok == TOK_VALUE) {
+ while (curtok == TOK_CONST || curtok == TOK_TYPE ||
+ curtok == TOK_VAR || curtok == TOK_VALUE) {
+ lastblockkind = curtok;
+ switch (curtok) {
+
+ case TOK_CONST:
+ p_constdecl();
+ break;
+
+ case TOK_TYPE:
+ p_typedecl();
+ break;
+
+ case TOK_VAR:
+ p_vardecl();
+ break;
+
+ case TOK_VALUE:
+ p_valuedecl();
+ break;
+
+ default:
+ break;
+ }
+ }
+ if ((blkind == TOK_PROGRAM ||
+ blkind == TOK_EXPORT ||
+ blkind == TOK_IMPLEMENT) &&
+ (curtok != TOK_BEGIN || !mainlocals)) {
+ outsection(majorspace);
+ if (declarevars(curctx, 0))
+ outsection(majorspace);
+ }
+ } else {
+ checkmodulewords();
+ checkkeyword(TOK_SEGMENT);
+ if (curtok == TOK_SEGMENT) {
+ note("SEGMENT or OVERLAY keyword ignored [259]");
+ gettok();
+ }
+ p_attributes();
+ switch (curtok) {
+
+ case TOK_LABEL:
+ p_labeldecl();
+ break;
+
+ case TOK_IMPORT:
+ case TOK_FROM:
+ p_import(0);
+ break;
+
+ case TOK_EXPORT:
+ do {
+ gettok();
+ checkkeyword(TOK_QUALIFIED);
+ if (curtok == TOK_QUALIFIED)
+ gettok();
+ wneedtok(TOK_IDENT);
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_SEMI))
+ skippasttoken(TOK_SEMI);
+ break;
+
+ case TOK_MODULE:
+ p_nested_module();
+ break;
+
+ case TOK_PROCEDURE:
+ p_function(0);
+ break;
+
+ case TOK_FUNCTION:
+ p_function(1);
+ break;
+
+ case TOK_INCLUDE:
+ if (blockkind == TOK_PROGRAM ||
+ blockkind == TOK_IMPLEMENT ||
+ (blockkind == TOK_FUNCTION && !collectnest)) {
+ do_include(lastblockkind);
+ } else {
+ badinclude();
+ }
+ break;
+
+ default:
+ if (curtok == TOK_BEGIN && blockkind == TOK_IMPORT) {
+ warning("BEGIN encountered in interface text [274]");
+ skipparens();
+ if (curtok == TOK_SEMI)
+ gettok();
+ break;
+ }
+ blockkind = saveblockkind;
+ return;
+ }
+ lastblockkind = TOK_END;
+ }
+ }
+ }
+
+
+
+
+ Static void skipunitheader()
+ {
+ if (curtok == TOK_LPAR || curtok == TOK_LBR) {
+ skipparens();
+ }
+ }
+
+
+ Static void skiptomodule()
+ {
+ skipping_module++;
+ while (curtok != TOK_MODULE) {
+ if (curtok == TOK_END) {
+ gettok();
+ if (curtok == TOK_DOT)
+ break;
+ } else
+ gettok();
+ }
+ skipping_module--;
+ }
+
+
+
+ Static void p_moduleinit(mod)
+ Meaning *mod;
+ {
+ Stmt *sp;
+ Strlist *sl;
+
+ if (curtok != TOK_BEGIN && curtok != TOK_END) {
+ wexpecttok(TOK_END);
+ skiptotoken2(TOK_BEGIN, TOK_END);
+ }
+ if (curtok == TOK_BEGIN || initialcalls) {
+ echoprocname(mod);
+ sp = p_body();
+ strlist_mix(&mod->comments, curcomments);
+ curcomments = NULL;
+ if (ansiC != 0)
+ output("void ");
+ output(format_s(name_UNITINIT, mod->name));
+ if (void_args)
+ output("(void)\n");
+ else
+ output("()\n");
+ outcontext = mod;
+ out_block(sp, BR_FUNCTION, 10000);
+ free_stmt(sp);
+ /* The following must come after out_block! */
+ sl = strlist_append(&initialcalls,
+ format_s("%s()",
+ format_s(name_UNITINIT, mod->name)));
+ sl->value = 1;
+ } else
+ wneedtok(TOK_END);
+ }
+
+
+
+ Static void p_nested_module()
+ {
+ Meaning *mp;
+
+ if (!modula2) {
+ note("Ignoring nested module [260]");
+ p_module(1, 0);
+ return;
+ }
+ note("Nested modules not fully supported [261]");
+ checkmodulewords();
+ wneedtok(TOK_MODULE);
+ wexpecttok(TOK_IDENT);
+ mp = addmeaning(curtoksym, MK_MODULE);
+ mp->anyvarflag = 0;
+ gettok();
+ skipunitheader();
+ wneedtok(TOK_SEMI);
+ p_block(TOK_IMPLEMENT);
+ p_moduleinit(mp);
+ if (curtok == TOK_IDENT)
+ gettok();
+ wneedtok(TOK_SEMI);
+ }
+
+
+
+ Static int p_module(ignoreit, isdefn)
+ int ignoreit;
+ int isdefn; /* Modula-2: 0=local module, 1=DEFINITION, 2=IMPLEMENTATION */
+ {
+ Meaning *mod, *mp;
+ Strlist *sl;
+ int kind;
+ char *cp;
+
+ checkmodulewords();
+ wneedtok(TOK_MODULE);
+ wexpecttok(TOK_IDENT);
+ if (curtokmeaning && curtokmeaning->kind == MK_MODULE && isdefn == 2) {
+ mod = curtokmeaning;
+ import_ctx(mod);
+ for (mp = mod->cbase; mp; mp = mp->cnext)
+ if (mp->kind == MK_FUNCTION)
+ mp->isforward = 1;
+ } else {
+ mod = addmeaning(curtoksym, MK_MODULE);
+ }
+ mod->anyvarflag = 0;
+ pushctx(mod);
+ gettok();
+ skipunitheader();
+ wneedtok(TOK_SEMI);
+ if (ignoreit ||
+ (requested_module && strcicmp(requested_module, mod->name))) {
+ if (!quietmode)
+ if (outf == stdout)
+ fprintf(stderr, "Skipping over module \"%s\"\n", mod->name);
+ else
+ printf("Skipping over module \"%s\"\n", mod->name);
+ checkmodulewords();
+ while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+ p_import(1);
+ checkmodulewords();
+ if (curtok == TOK_EXPORT)
+ gettok();
+ strlist_empty(&curcomments);
+ p_block(TOK_IMPORT);
+ setup_module(mod->sym->name, 0);
+ checkmodulewords();
+ if (curtok == TOK_IMPLEMENT) {
+ skiptomodule();
+ } else {
+ if (!wneedtok(TOK_END))
+ skippasttoken(TOK_END);
+ if (curtok == TOK_SEMI)
+ gettok();
+ }
+ popctx();
+ strlist_empty(&curcomments);
+ return 0;
+ }
+ found_module = 1;
+ if (isdefn != 2) {
+ if (!*hdrfname) {
+ sl = strlist_cifind(includefrom, mod->name);
+ if (sl)
+ cleanheadername(hdrfname, (char *)sl->value);
+ else
+ strcpy(hdrfname, format_ss(headerfnfmt, infname, mod->name));
+ }
+ saveoldfile(hdrfname);
+ hdrf = fopen(hdrfname, "w");
+ if (!hdrf) {
+ perror(hdrfname);
+ error("Could not open output file for header");
+ }
+ outsection(majorspace);
+ if (usevextern && my_strchr(name_GSYMBOL, '%'))
+ output(format_s("#define %s\n", format_s(name_GSYMBOL, mod->sym->name)));
+ if (*selfincludefmt)
+ cp = format_s(selfincludefmt, hdrfname);
+ else
+ cp = hdrfname;
+ out_include(cp, quoteincludes);
+ outsection(majorspace);
+ select_outfile(hdrf);
+ if (nobanner)
+ output("\n");
+ else
+ output(format_s("/* Header for module %s, generated by p2c */\n",
+ mod->name));
+ if (*name_HSYMBOL) {
+ cp = format_s(name_HSYMBOL, mod->sym->name);
+ output(format_ss("#ifndef %s\n#define %s\n", cp, cp));
+ }
+ outsection(majorspace);
+ checkmodulewords();
+ while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+ p_import(0);
+ checkmodulewords();
+ if (curtok == TOK_EXPORT)
+ gettok();
+ checkmodulewords();
+ while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+ p_import(0);
+ outsection(majorspace);
+ if (usevextern) {
+ output(format_s("#ifdef %s\n# define vextern\n#else\n",
+ format_s(name_GSYMBOL, mod->sym->name)));
+ output("# define vextern extern\n#endif\n");
+ }
+ checkmodulewords();
+ p_block(TOK_EXPORT);
+ flushcomments(NULL, -1, -1);
+ setup_module(mod->sym->name, 1);
+ outsection(majorspace);
+ if (usevextern)
+ output("#undef vextern\n");
+ outsection(minorspace);
+ if (*name_HSYMBOL)
+ output(format_s("#endif /*%s*/\n", format_s(name_HSYMBOL, mod->sym->name)));
+ if (nobanner)
+ output("\n");
+ else
+ output("\n/* End. */\n\n");
+ select_outfile(codef);
+ fclose(hdrf);
+ *hdrfname = 0;
+ redeclarevars(mod);
+ declarevars(mod, 0);
+ }
+ checkmodulewords();
+ if (curtok != TOK_END) {
+ if (!modula2 && !implementationmodules)
+ wneedtok(TOK_IMPLEMENT);
+ import_ctx(mod);
+ p_block(TOK_IMPLEMENT);
+ flushcomments(NULL, -1, -1);
+ p_moduleinit(mod);
+ kind = 1;
+ } else {
+ kind = 0;
+ if (!wneedtok(TOK_END))
+ skippasttoken(TOK_END);
+ }
+ if (curtok == TOK_IDENT)
+ gettok();
+ if (curtok == TOK_SEMI)
+ gettok();
+ popctx();
+ return kind;
+ }
+
+
+
+
+ int p_search(fname, ext, need)
+ char *fname, *ext;
+ int need;
+ {
+ char infnbuf[300];
+ FILE *fp;
+ Meaning *mod;
+ int savesysprog, savecopysource;
+ int outerimportmark, importmark, mypermflag;
+
+ strcpy(infnbuf, fname);
+ fixfname(infnbuf, ext);
+ fp = fopen(infnbuf, "r");
+ if (!fp) {
+ if (need)
+ perror(infnbuf);
+ if (logf)
+ fprintf(logf, "(Unable to open search file \"%s\")\n", infnbuf);
+ return 0;
+ }
+ flushcomments(NULL, -1, -1);
+ ignore_directives++;
+ savesysprog = sysprog_flag;
+ sysprog_flag |= 3;
+ savecopysource = copysource;
+ copysource = 0;
+ outerimportmark = numimports; /*obsolete*/
+ importmark = push_imports();
+ clearprogress();
+ push_input_file(fp, infnbuf, 0);
+ do {
+ strlist_empty(&curcomments);
+ checkmodulewords();
+ permflag = 0;
+ if (curtok == TOK_DEFINITION) {
+ gettok();
+ checkmodulewords();
+ } else if (curtok == TOK_IMPLEMENT && modula2) {
+ gettok();
+ checkmodulewords();
+ warning("IMPLEMENTATION module in search text! [275]");
+ }
+ if (!wneedtok(TOK_MODULE))
+ break;
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ mod = addmeaning(curtoksym, MK_MODULE);
+ mod->anyvarflag = 0;
+ if (!quietmode && !showprogress)
+ if (outf == stdout)
+ fprintf(stderr, "Reading import text for \"%s\"\n", mod->name);
+ else
+ printf("Reading import text for \"%s\"\n", mod->name);
+ if (verbose)
+ fprintf(logf, "%s, %d/%d: Reading import text for \"%s\"\n",
+ infname, inf_lnum, outf_lnum, mod->name);
+ pushctx(mod);
+ gettok();
+ skipunitheader();
+ wneedtok(TOK_SEMI);
+ mypermflag = permflag;
+ if (debug>0) printf("Found module %s\n", mod->name);
+ checkmodulewords();
+ while (curtok == TOK_IMPORT || curtok == TOK_FROM)
+ p_import(1);
+ checkmodulewords();
+ if (curtok == TOK_EXPORT)
+ gettok();
+ strlist_empty(&curcomments);
+ p_block(TOK_IMPORT);
+ setup_module(mod->sym->name, 0);
+ if (mypermflag) {
+ strlist_add(&permimports, mod->sym->name)->value = (long)mod;
+ perm_import(mod);
+ }
+ checkmodulewords();
+ if (curtok == TOK_END) {
+ gettok();
+ if (curtok == TOK_SEMI)
+ gettok();
+ } else {
+ wexpecttok(TOK_IMPLEMENT);
+ if (importall) {
+ skiptomodule();
+ }
+ }
+ popctx();
+ } while (curtok == TOK_MODULE);
+ pop_imports(importmark);
+ unimport(outerimportmark);
+ sysprog_flag = savesysprog;
+ copysource = savecopysource;
+ ignore_directives--;
+ pop_input();
+ strlist_empty(&curcomments);
+ clearprogress();
+ return 1;
+ }
+
+
+
+
+ void p_program()
+ {
+ Meaning *prog;
+ Stmt *sp;
+ int nummods, isdefn = 0;
+
+ flushcomments(NULL, -1, -1);
+ output(format_s("\n#include %s\n", p2c_h_name));
+ outsection(majorspace);
+ p_attributes();
+ ignore_attributes();
+ checkmodulewords();
+ if (modula2) {
+ if (curtok == TOK_MODULE) {
+ curtok = TOK_PROGRAM;
+ } else {
+ if (curtok == TOK_DEFINITION) {
+ isdefn = 1;
+ gettok();
+ checkmodulewords();
+ } else if (curtok == TOK_IMPLEMENT) {
+ isdefn = 2;
+ gettok();
+ checkmodulewords();
+ }
+ }
+ }
+ switch (curtok) {
+
+ case TOK_MODULE:
+ if (implementationmodules)
+ isdefn = 2;
+ nummods = 0;
+ while (curtok == TOK_MODULE) {
+ if (p_module(0, isdefn)) {
+ nummods++;
+ if (nummods == 2 && !requested_module)
+ warning("Multiple modules in one source file may not work correctly [276]");
+ }
+ }
+ wneedtok(TOK_DOT);
+ break;
+
+ default:
+ if (curtok == TOK_PROGRAM) {
+ gettok();
+ if (!wexpecttok(TOK_IDENT))
+ skiptotoken(TOK_IDENT);
+ prog = addmeaning(curtoksym, MK_MODULE);
+ gettok();
+ if (curtok == TOK_LPAR) {
+ while (curtok != TOK_RPAR) {
+ if (curtok == TOK_IDENT &&
+ strcicmp(curtokbuf, "INPUT") &&
+ strcicmp(curtokbuf, "OUTPUT") &&
+ strcicmp(curtokbuf, "KEYBOARD") &&
+ strcicmp(curtokbuf, "LISTING")) {
+ if (literalfilesflag == 2) {
+ strlist_add(&literalfiles, curtokbuf);
+ } else
+ note(format_s("Unexpected name \"%s\" in program header [262]",
+ curtokcase));
+ }
+ gettok();
+ }
+ gettok();
+ }
+ if (curtok == TOK_LBR)
+ skipparens();
+ wneedtok(TOK_SEMI);
+ } else {
+ prog = addmeaning(findsymbol("program"), MK_MODULE);
+ }
+ prog->anyvarflag = 1;
+ if (requested_module && strcicmp(requested_module, prog->name) &&
+ strcicmp(requested_module, "program")) {
+ for (;;) {
+ skiptomodule();
+ if (curtok == TOK_DOT)
+ break;
+ (void)p_module(0, 2);
+ }
+ gettok();
+ break;
+ }
+ pushctx(prog);
+ p_block(TOK_PROGRAM);
+ echoprocname(prog);
+ flushcomments(NULL, -1, -1);
+ if (curtok != TOK_EOF) {
+ sp = p_body();
+ strlist_mix(&prog->comments, curcomments);
+ curcomments = NULL;
+ if (fullprototyping > 0) {
+ output(format_sss("main%s(int argc,%s%s *argv[])",
+ spacefuncs ? " " : "",
+ spacecommas ? " " : "",
+ charname));
+ } else {
+ output("main");
+ if (spacefuncs)
+ output(" ");
+ output("(argc,");
+ if (spacecommas)
+ output(" ");
+ output("argv)\n");
+ singleindent(argindent);
+ output("int argc;\n");
+ singleindent(argindent);
+ output(format_s("%s *argv[];\n", charname));
+ }
+ outcontext = prog;
+ out_block(sp, BR_FUNCTION, 10000);
+ free_stmt(sp);
+ popctx();
+ if (curtok == TOK_SEMI)
+ gettok();
+ else
+ wneedtok(TOK_DOT);
+ }
+ break;
+
+ }
+ if (curtok != TOK_EOF) {
+ warning("Junk at end of input file ignored [277]");
+ }
+ }
+
+
+
+
+
+ /* End. */
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/pexpr.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/pexpr.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:23 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/pexpr.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,3626 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_PEXPR_C
+ #include "trans.h"
+
+
+
+
+ Expr *dots_n_hats(ex, target)
+ Expr *ex;
+ Type *target;
+ {
+ Expr *ex2, *ex3;
+ Type *tp, *tp2;
+ Meaning *mp, *tvar;
+ int hassl;
+
+ for (;;) {
+ if ((ex->val.type->kind == TK_PROCPTR ||
+ ex->val.type->kind == TK_CPROCPTR) &&
+ curtok != TOK_ASSIGN &&
+ ((mp = (tp2 = ex->val.type)->basetype->fbase) == NULL ||
+ (mp->isreturn && mp->xnext == NULL) ||
+ curtok == TOK_LPAR) &&
+ (tp2->basetype->basetype != tp_void || target == tp_void) &&
+ (!target || (target->kind != TK_PROCPTR &&
+ target->kind != TK_CPROCPTR))) {
+ hassl = tp2->escale;
+ ex2 = ex;
+ ex3 = copyexpr(ex2);
+ if (hassl != 0)
+ ex3 = makeexpr_cast(makeexpr_dotq(ex3, "proc", tp_anyptr),
+ makepointertype(tp2->basetype));
+ ex = makeexpr_un(EK_SPCALL, tp2->basetype->basetype, ex3);
+ if (mp && mp->isreturn) { /* pointer to buffer for return value */
+ tvar = makestmttempvar(ex->val.type->basetype,
+ (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
+ insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
+ mp = mp->xnext;
+ }
+ if (mp) {
+ if (wneedtok(TOK_LPAR)) {
+ ex = p_funcarglist(ex, mp, 0, 0);
+ skipcloseparen();
+ }
+ } else if (curtok == TOK_LPAR) {
+ gettok();
+ if (!wneedtok(TOK_RPAR))
+ skippasttoken(TOK_RPAR);
+ }
+ if (hassl != 1 || hasstaticlinks == 2) {
+ freeexpr(ex2);
+ } else {
+ ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
+ ex3 = copyexpr(ex);
+ insertarg(&ex3, ex3->nargs, copyexpr(ex2));
+ tp = maketype(TK_FUNCTION);
+ tp->basetype = tp2->basetype->basetype;
+ tp->fbase = tp2->basetype->fbase;
+ tp->issigned = 1;
+ ex3->args[0]->val.type = makepointertype(tp);
+ ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ ex3, ex);
+ }
+ if (tp2->basetype->fbase &&
+ tp2->basetype->fbase->isreturn &&
+ tp2->basetype->fbase->kind == MK_VARPARAM)
+ ex = makeexpr_hat(ex, 0); /* returns pointer to structured result */
+ continue;
+ }
+ switch (curtok) {
+
+ case TOK_HAT:
+ case TOK_ADDR:
+ gettok();
+ ex = makeexpr_hat(ex, 1);
+ break;
+
+ case TOK_LBR:
+ do {
+ gettok();
+ ex2 = p_ord_expr();
+ ex = p_index(ex, ex2);
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ break;
+
+ case TOK_DOT:
+ gettok();
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ if (ex->val.type->kind == TK_STRING) {
+ if (!strcicmp(curtokbuf, "LENGTH")) {
+ ex = makeexpr_bicall_1("strlen", tp_int, ex);
+ } else if (!strcicmp(curtokbuf, "BODY")) {
+ /* nothing to do */
+ }
+ gettok();
+ break;
+ }
+ mp = curtoksym->fbase;
+ while (mp && mp->rectype != ex->val.type)
+ mp = mp->snext;
+ if (mp)
+ ex = makeexpr_dot(ex, mp);
+ else {
+ warning(format_s("No field called %s in that record [288]", curtokbuf));
+ ex = makeexpr_dotq(ex, curtokcase, tp_integer);
+ }
+ gettok();
+ break;
+
+ case TOK_COLONCOLON:
+ gettok();
+ if (wexpecttok(TOK_IDENT)) {
+ ex = pascaltypecast(curtokmeaning->type, ex);
+ gettok();
+ }
+ break;
+
+ default:
+ return ex;
+ }
+ }
+ }
+
+
+ Expr *p_index(ex, ex2)
+ Expr *ex, *ex2;
+ {
+ Expr *ex3;
+ Type *tp, *ot;
+ Meaning *mp;
+ int bits;
+
+ tp = ex->val.type;
+ if (tp->kind == TK_STRING) {
+ if (checkconst(ex2, 0)) /* is it "s[0]"? */
+ return makeexpr_bicall_1("strlen", tp_char, ex);
+ else
+ return makeexpr_index(ex, ex2, makeexpr_long(1));
+ } else if (tp->kind == TK_ARRAY ||
+ tp->kind == TK_SMALLARRAY) {
+ if (tp->smax) {
+ ord_range_expr(tp->indextype, &ex3, NULL);
+ ex2 = makeexpr_minus(ex2, copyexpr(ex3));
+ if (!nodependencies(ex2, 0) &&
+ *getbitsname == '*') {
+ mp = makestmttempvar(tp_integer, name_TEMP);
+ ex3 = makeexpr_assign(makeexpr_var(mp), ex2);
+ ex2 = makeexpr_var(mp);
+ } else
+ ex3 = NULL;
+ ex = makeexpr_bicall_3(getbitsname, tp_int,
+ ex, ex2,
+ makeexpr_long(tp->escale));
+ if (tp->kind == TK_ARRAY) {
+ if (tp->basetype == tp_sshort)
+ bits = 4;
+ else
+ bits = 3;
+ insertarg(&ex, 3, makeexpr_long(bits));
+ }
+ ex = makeexpr_comma(ex3, ex);
+ ot = ord_type(tp->smax->val.type);
+ if (ot->kind == TK_ENUM && ot->meaning && useenum)
+ ex = makeexpr_cast(ex, tp->smax->val.type);
+ ex->val.type = tp->smax->val.type;
+ return ex;
+ } else {
+ ord_range_expr(ex->val.type->indextype, &ex3, NULL);
+ if (debug>2) { fprintf(outf, "ord_range_expr returns "); dumpexpr(ex3); fprintf(outf, "\n"); }
+ return makeexpr_index(ex, ex2, copyexpr(ex3));
+ }
+ } else {
+ warning("Index on a non-array variable [287]");
+ return makeexpr_bin(EK_INDEX, tp_integer, ex, ex2);
+ }
+ }
+
+
+ Expr *fake_dots_n_hats(ex)
+ Expr *ex;
+ {
+ for (;;) {
+ switch (curtok) {
+
+ case TOK_HAT:
+ case TOK_ADDR:
+ if (ex->val.type->kind == TK_POINTER)
+ ex = makeexpr_hat(ex, 0);
+ else {
+ ex->val.type = makepointertype(ex->val.type);
+ ex = makeexpr_un(EK_HAT, ex->val.type->basetype, ex);
+ }
+ gettok();
+ break;
+
+ case TOK_LBR:
+ do {
+ gettok();
+ ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
+ } while (curtok == TOK_COMMA);
+ if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ break;
+
+ case TOK_DOT:
+ gettok();
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ ex = makeexpr_dotq(ex, curtokcase, tp_integer);
+ gettok();
+ break;
+
+ case TOK_COLONCOLON:
+ gettok();
+ if (wexpecttok(TOK_IDENT)) {
+ ex = pascaltypecast(curtokmeaning->type, ex);
+ gettok();
+ }
+ break;
+
+ default:
+ return ex;
+ }
+ }
+ }
+
+
+
+ Static void bindnames(ex)
+ Expr *ex;
+ {
+ int i;
+ Symbol *sp;
+ Meaning *mp;
+
+ if (ex->kind == EK_NAME) {
+ sp = findsymbol_opt(fixpascalname(ex->val.s));
+ if (sp) {
+ mp = sp->mbase;
+ while (mp && !mp->isactive)
+ mp = mp->snext;
+ if (mp && !strcmp(mp->name, ex->val.s)) {
+ ex->kind = EK_VAR;
+ ex->val.i = (long)mp;
+ ex->val.type = mp->type;
+ }
+ }
+ }
+ i = ex->nargs;
+ while (--i >= 0)
+ bindnames(ex->args[i]);
+ }
+
+
+
+ void var_reference(mp)
+ Meaning *mp;
+ {
+ Meaning *mp2;
+
+ mp->refcount++;
+ if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
+ mp->ctx->needvarstruct &&
+ (mp->kind == MK_VAR ||
+ mp->kind == MK_VARREF ||
+ mp->kind == MK_VARMAC ||
+ mp->kind == MK_PARAM ||
+ mp->kind == MK_VARPARAM ||
+ (mp->kind == MK_CONST &&
+ (mp->type->kind == TK_ARRAY ||
+ mp->type->kind == TK_RECORD)))) {
+ if (debug>1) { fprintf(outf, "varstruct'ing %s\n", mp->name); }
+ if (!mp->varstructflag) {
+ mp->varstructflag = 1;
+ if (mp->constdefn && /* move init code into function body */
+ mp->kind != MK_VARMAC) {
+ mp2 = addmeaningafter(mp, curtoksym, MK_VAR);
+ curtoksym->mbase = mp2->snext; /* hide this fake variable */
+ mp2->snext = mp; /* remember true variable */
+ mp2->type = mp->type;
+ mp2->constdefn = mp->constdefn;
+ mp2->isforward = 1; /* declare it "static" */
+ mp2->refcount++; /* so it won't be purged! */
+ mp->constdefn = NULL;
+ mp->isforward = 0;
+ }
+ }
+ for (mp2 = curctx->ctx; mp2 != mp->ctx; mp2 = mp2->ctx)
+ mp2->varstructflag = 1;
+ mp2->varstructflag = 1;
+ }
+ }
+
+
+
+ Static Expr *p_variable(target)
+ Type *target;
+ {
+ Expr *ex, *ex2;
+ Meaning *mp;
+ Symbol *sym;
+
+ if (curtok != TOK_IDENT) {
+ warning("Expected a variable [289]");
+ return makeexpr_long(0);
+ }
+ if (!curtokmeaning) {
+ sym = curtoksym;
+ ex = makeexpr_name(curtokcase, tp_integer);
+ gettok();
+ if (curtok == TOK_LPAR) {
+ ex = makeexpr_bicall_0(ex->val.s, tp_integer);
+ do {
+ gettok();
+ insertarg(&ex, ex->nargs, p_expr(NULL));
+ } while (curtok == TOK_COMMA || curtok == TOK_ASSIGN);
+ if (!wneedtok(TOK_RPAR))
+ skippasttotoken(TOK_RPAR, TOK_SEMI);
+ }
+ if (!tryfuncmacro(&ex, NULL))
+ undefsym(sym);
+ return fake_dots_n_hats(ex);
+ }
+ var_reference(curtokmeaning);
+ mp = curtokmeaning;
+ if (mp->kind == MK_FIELD) {
+ ex = makeexpr_dot(copyexpr(withexprs[curtokint]), mp);
+ } else if (mp->kind == MK_CONST &&
+ mp->type->kind == TK_SET &&
+ mp->constdefn) {
+ ex = copyexpr(mp->constdefn);
+ mp = makestmttempvar(ex->val.type, name_SET);
+ ex2 = makeexpr(EK_MACARG, 0);
+ ex2->val.type = ex->val.type;
+ ex = replaceexprexpr(ex, ex2, makeexpr_var(mp), 0);
+ freeexpr(ex2);
+ } else if (mp->kind == MK_CONST &&
+ (mp == mp_false ||
+ mp == mp_true ||
+ mp->anyvarflag ||
+ (foldconsts > 0 &&
+ (mp->type->kind == TK_INTEGER ||
+ mp->type->kind == TK_BOOLEAN ||
+ mp->type->kind == TK_CHAR ||
+ mp->type->kind == TK_ENUM ||
+ mp->type->kind == TK_SUBR ||
+ mp->type->kind == TK_REAL)) ||
+ (foldstrconsts > 0 &&
+ (mp->type->kind == TK_STRING)))) {
+ if (mp->constdefn) {
+ ex = copyexpr(mp->constdefn);
+ if (ex->val.type == tp_int) /* kludge! */
+ ex->val.type = tp_integer;
+ } else
+ ex = makeexpr_val(copyvalue(mp->val));
+ } else if (mp->kind == MK_VARPARAM ||
+ mp->kind == MK_VARREF) {
+ ex = makeexpr_hat(makeexpr_var(mp), 0);
+ } else if (mp->kind == MK_VARMAC) {
+ ex = copyexpr(mp->constdefn);
+ bindnames(ex);
+ ex = gentle_cast(ex, mp->type);
+ ex->val.type = mp->type;
+ } else if (mp->kind == MK_SPVAR && mp->handler) {
+ gettok();
+ ex = (*mp->handler)(mp);
+ return dots_n_hats(ex, target);
+ } else if (mp->kind == MK_VAR ||
+ mp->kind == MK_CONST ||
+ mp->kind == MK_PARAM) {
+ ex = makeexpr_var(mp);
+ } else {
+ symclass(mp->sym);
+ ex = makeexpr_name(mp->name, tp_integer);
+ }
+ gettok();
+ return dots_n_hats(ex, target);
+ }
+
+
+
+
+ Expr *p_ord_expr()
+ {
+ return makeexpr_charcast(p_expr(tp_integer));
+ }
+
+
+
+ Static Expr *makesmallsetconst(bits, type)
+ long bits;
+ Type *type;
+ {
+ Expr *ex;
+
+ ex = makeexpr_long(bits);
+ ex->val.type = type;
+ if (smallsetconst != 2)
+ insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ return ex;
+ }
+
+
+
+ Expr *packset(ex, type)
+ Expr *ex;
+ Type *type;
+ {
+ Meaning *mp;
+ Expr *ex2;
+ long max2;
+
+ if (ex->kind == EK_BICALL) {
+ if (!strcmp(ex->val.s, setexpandname) &&
+ (mp = istempvar(ex->args[0])) != NULL) {
+ canceltempvar(mp);
+ return grabarg(ex, 1);
+ }
+ if (!strcmp(ex->val.s, setunionname) &&
+ (mp = istempvar(ex->args[0])) != NULL &&
+ !exproccurs(ex->args[1], ex->args[0]) &&
+ !exproccurs(ex->args[2], ex->args[0])) {
+ canceltempvar(mp);
+ return makeexpr_bin(EK_BOR, type, packset(ex->args[1], type),
+ packset(ex->args[2], type));
+ }
+ if (!strcmp(ex->val.s, setaddname)) {
+ ex2 = makeexpr_bin(EK_LSH, type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ ex->args[1]);
+ ex = packset(ex->args[0], type);
+ if (checkconst(ex, 0))
+ return ex2;
+ else
+ return makeexpr_bin(EK_BOR, type, ex, ex2);
+ }
+ if (!strcmp(ex->val.s, setaddrangename)) {
+ if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
+ note("Range construction was implemented by a subtraction which may overflow [278]");
+ ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ makeexpr_plus(ex->args[2],
+ makeexpr_long(1))),
+ makeexpr_bin(EK_LSH, type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ ex->args[1]));
+ ex = packset(ex->args[0], type);
+ if (checkconst(ex, 0))
+ return ex2;
+ else
+ return makeexpr_bin(EK_BOR, type, ex, ex2);
+ }
+ }
+ return makeexpr_bicall_1(setpackname, type, ex);
+ }
+
+
+
+ #define MAXSETLIT 400
+
+ Expr *p_setfactor(target, sure)
+ Type *target;
+ int sure;
+ {
+ Expr *ex, *exmax = NULL, *ex2;
+ Expr *first[MAXSETLIT], *last[MAXSETLIT];
+ char doneflag[MAXSETLIT];
+ int i, j, num, donecount;
+ int isconst, guesstype;
+ long maxv, max2;
+ Value val;
+ Type *tp, *type;
+ Meaning *tvar;
+
+ if (curtok == TOK_LBRACE)
+ gettok();
+ else if (!wneedtok(TOK_LBR))
+ return makeexpr_long(0);
+ if (curtok == TOK_RBR || curtok == TOK_RBRACE) { /* empty set */
+ gettok();
+ val.type = tp_smallset;
+ val.i = 0;
+ val.s = NULL;
+ return makeexpr_val(val);
+ }
+ type = target;
+ guesstype = !sure;
+ maxv = -1;
+ isconst = 1;
+ num = 0;
+ for (;;) {
+ if (num >= MAXSETLIT) {
+ warning(format_d("Too many elements in set literal; max=%d [290]", MAXSETLIT));
+ ex = p_expr(type);
+ while (curtok != TOK_RBR && curtok != TOK_RBRACE) {
+ gettok();
+ ex = p_expr(type);
+ }
+ break;
+ }
+ if (guesstype && num == 0) {
+ ex = p_ord_expr();
+ type = ex->val.type;
+ } else {
+ ex = p_expr(type);
+ }
+ first[num] = ex = gentle_cast(ex, type);
+ doneflag[num] = 0;
+ if (curtok == TOK_DOTS || curtok == TOK_COLON) { /* UCSD? */
+ val = eval_expr(ex);
+ if (val.type) {
+ if (val.i > maxv) { /* In case of [127..0] */
+ maxv = val.i;
+ exmax = ex;
+ }
+ } else
+ isconst = 0;
+ gettok();
+ last[num] = ex = gentle_cast(p_expr(type), type);
+ } else {
+ last[num] = NULL;
+ }
+ val = eval_expr(ex);
+ if (val.type) {
+ if (val.i > maxv) {
+ maxv = val.i;
+ exmax = ex;
+ }
+ } else {
+ isconst = 0;
+ maxv = LONG_MAX;
+ }
+ num++;
+ if (curtok == TOK_COMMA)
+ gettok();
+ else
+ break;
+ }
+ if (curtok == TOK_RBRACE)
+ gettok();
+ else if (!wneedtok(TOK_RBR))
+ skippasttotoken(TOK_RBR, TOK_SEMI);
+ tp = first[0]->val.type;
+ if (guesstype) { /* must determine type */
+ if (maxv == LONG_MAX) {
+ if (target && ord_range(target, NULL, &max2))
+ maxv = max2;
+ else if (ord_range(tp, NULL, &max2) && max2 < 1000000 &&
+ (max2 >= defaultsetsize || num == 1))
+ maxv = max2;
+ else
+ maxv = defaultsetsize-1;
+ exmax = makeexpr_long(maxv);
+ } else
+ exmax = copyexpr(exmax);
+ if (!ord_range(tp, NULL, &max2) || maxv != max2)
+ tp = makesubrangetype(tp, makeexpr_long(0), exmax);
+ type = makesettype(tp);
+ } else
+ type = makesettype(type);
+ donecount = 0;
+ if (smallsetconst > 0) {
+ val.i = 0;
+ for (i = 0; i < num; i++) {
+ if (first[i]->kind == EK_CONST && first[i]->val.i < setbits &&
+ (!last[i] || (last[i]->kind == EK_CONST &&
+ last[i]->val.i >= 0 &&
+ last[i]->val.i < setbits))) {
+ if (last[i]) {
+ for (j = first[i]->val.i; j <= last[i]->val.i; j++)
+ val.i |= 1<<j;
+ } else
+ val.i |= 1 << first[i]->val.i;
+ doneflag[i] = 1;
+ donecount++;
+ }
+ }
+ }
+ if (donecount) {
+ ex = makesmallsetconst(val.i, tp_smallset);
+ } else
+ ex = NULL;
+ if (type->kind == TK_SMALLSET) {
+ for (i = 0; i < num; i++) {
+ if (!doneflag[i]) {
+ ex2 = makeexpr_bin(EK_LSH, type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ enum_to_int(first[i]));
+ if (last[i]) {
+ if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
+ note("Range construction was implemented by a subtraction which may overflow [278]");
+ ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ makeexpr_plus(enum_to_int(last[i]),
+ makeexpr_long(1))),
+ ex2);
+ }
+ if (ex)
+ ex = makeexpr_bin(EK_BOR, type, makeexpr_longcast(ex, 1), ex2);
+ else
+ ex = ex2;
+ }
+ }
+ } else {
+ tvar = makestmttempvar(type, name_SET);
+ if (!ex) {
+ val.type = tp_smallset;
+ val.i = 0;
+ val.s = NULL;
+ ex = makeexpr_val(val);
+ }
+ ex = makeexpr_bicall_2(setexpandname, type,
+ makeexpr_var(tvar), makeexpr_arglong(ex, 1));
+ for (i = 0; i < num; i++) {
+ if (!doneflag[i]) {
+ if (last[i])
+ ex = makeexpr_bicall_3(setaddrangename, type,
+ ex, makeexpr_arglong(enum_to_int(first[i]), 0),
+ makeexpr_arglong(enum_to_int(last[i]), 0));
+ else
+ ex = makeexpr_bicall_2(setaddname, type,
+ ex, makeexpr_arglong(enum_to_int(first[i]), 0));
+ }
+ }
+ }
+ return ex;
+ }
+
+
+
+
+ Expr *p_funcarglist(ex, args, firstarg, ismacro)
+ Expr *ex;
+ Meaning *args;
+ int firstarg, ismacro;
+ {
+ Meaning *mp, *mp2, *arglist = args, *prevarg = NULL;
+ Expr *ex2;
+ int i, fi, fakenum = -1, castit, isconf, isnonpos = 0;
+ Type *tp, *tp2;
+ char *name;
+
+ castit = castargs;
+ if (castit < 0)
+ castit = (prototypes == 0);
+ while (args) {
+ if (isnonpos) {
+ while (curtok == TOK_COMMA)
+ gettok();
+ if (curtok == TOK_RPAR) {
+ args = arglist;
+ i = firstarg;
+ while (args) {
+ if (ex->nargs <= i)
+ insertarg(&ex, ex->nargs, NULL);
+ if (!ex->args[i]) {
+ if (args->constdefn)
+ ex->args[i] = copyexpr(args->constdefn);
+ else {
+ warning(format_s("Missing value for parameter %s [291]",
+ args->name));
+ ex->args[i] = makeexpr_long(0);
+ }
+ }
+ args = args->xnext;
+ i++;
+ }
+ break;
+ }
+ }
+ if (args->isreturn || args->fakeparam) {
+ if (args->fakeparam) {
+ if (fakenum < 0)
+ fakenum = ex->nargs;
+ if (args->constdefn)
+ insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ else
+ insertarg(&ex, ex->nargs, makeexpr_long(0));
+ }
+ args = args->xnext; /* return value parameter */
+ continue;
+ }
+ if (curtok == TOK_RPAR) {
+ if (args->constdefn) {
+ insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ args = args->xnext;
+ continue;
+ } else {
+ if (ex->kind == EK_FUNCTION) {
+ name = ((Meaning *)ex->val.i)->name;
+ ex->kind = EK_BICALL;
+ ex->val.s = stralloc(name);
+ } else
+ name = "function";
+ warning(format_s("Too few arguments for %s [292]", name));
+ return ex;
+ }
+ }
+ if (curtok == TOK_COMMA) {
+ if (args->constdefn)
+ insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ else {
+ warning(format_s("Missing parameter %s [293]", args->name));
+ insertarg(&ex, ex->nargs, makeexpr_long(0));
+ }
+ gettok();
+ args = args->xnext;
+ continue;
+ }
+ p_mech_spec(0);
+ if (curtok == TOK_IDENT) {
+ mp = arglist;
+ mp2 = NULL;
+ i = firstarg;
+ fi = -1;
+ while (mp && strcmp(curtokbuf, mp->sym->name)) {
+ if (mp->fakeparam) {
+ if (fi < 0)
+ fi = i;
+ } else
+ fi = -1;
+ i++;
+ mp2 = mp;
+ mp = mp->xnext;
+ }
+ if (mp &&
+ (peeknextchar() == ':' || !curtokmeaning || isnonpos)) {
+ gettok();
+ wneedtok(TOK_ASSIGN);
+ prevarg = mp2;
+ args = mp;
+ fakenum = fi;
+ isnonpos = 1;
+ } else
+ i = ex->nargs;
+ } else
+ i = ex->nargs;
+ while (ex->nargs <= i)
+ insertarg(&ex, ex->nargs, NULL);
+ if (ex->args[i])
+ warning(format_s("Multiple values for parameter %s [294]",
+ args->name));
+ tp = args->type;
+ ex2 = p_expr(tp);
+ if (args->kind == MK_VARPARAM)
+ tp = tp->basetype;
+ if (isfiletype(tp, 1) && is_std_file(ex2)) {
+ mp2 = makestmttempvar(tp_bigtext, name_TEMP);
+ ex2 = makeexpr_comma(
+ makeexpr_comma(makeexpr_assign(filebasename(makeexpr_var(mp2)),
+ ex2),
+ makeexpr_assign(filenamepart(makeexpr_var(mp2)),
+ makeexpr_string(""))),
+ makeexpr_var(mp2));
+ }
+ tp2 = ex2->val.type;
+ isconf = ((tp->kind == TK_ARRAY ||
+ tp->kind == TK_STRING) && tp->structdefd);
+ switch (args->kind) {
+
+ case MK_PARAM:
+ if (castit && tp->kind == TK_REAL &&
+ ex2->val.type->kind != TK_REAL)
+ ex2 = makeexpr_cast(ex2, tp);
+ else if (ord_type(tp)->kind == TK_INTEGER && !ismacro)
+ ex2 = makeexpr_arglong(ex2, long_type(tp));
+ else if (args->othername && args->rectype != tp &&
+ tp->kind != TK_STRING && args->type == tp2)
+ ex2 = makeexpr_addr(ex2);
+ else
+ ex2 = gentle_cast(ex2, tp);
+ ex->args[i] = ex2;
+ break;
+
+ case MK_VARPARAM:
+ if (args->type == tp_strptr && args->anyvarflag) {
+ ex->args[i] = strmax_func(ex2);
+ insertarg(&ex, ex->nargs-1, makeexpr_addr(ex2));
+ if (isnonpos)
+ note("Non-positional conformant parameters may not work [279]");
+ } else { /* regular VAR parameter */
+ if (!expr_is_lvalue(ex2) ||
+ (tp->kind == TK_REAL &&
+ ord_type(tp2)->kind == TK_INTEGER)) {
+ mp2 = makestmttempvar(tp, name_TEMP);
+ ex2 = makeexpr_comma(makeexpr_assign(makeexpr_var(mp2),
+ ex2),
+ makeexpr_addrf(makeexpr_var(mp2)));
+ } else
+ ex2 = makeexpr_addrf(ex2);
+ if (args->anyvarflag ||
+ (tp->kind == TK_POINTER && tp2->kind == TK_POINTER &&
+ (tp == tp_anyptr || tp2 == tp_anyptr))) {
+ if (!ismacro)
+ ex2 = makeexpr_cast(ex2, args->type);
+ } else {
+ if (tp2 != tp && !isconf &&
+ (tp2->kind != TK_STRING ||
+ tp->kind != TK_STRING))
+ warning(format_s("Type mismatch in VAR parameter %s [295]",
+ args->name));
+ }
+ ex->args[i] = ex2;
+ }
+ break;
+
+ default:
+ intwarning("p_funcarglist",
+ format_s("Parameter type is %s [296]",
+ meaningkindname(args->kind)));
+ break;
+ }
+ if (isconf && /* conformant array or string */
+ (!prevarg || prevarg->type != args->type)) {
+ while (tp->kind == TK_ARRAY && tp->structdefd) {
+ if (tp2->kind == TK_SMALLARRAY) {
+ warning("Trying to pass a small-array for a conformant array [297]");
+ /* this has a chance of working... */
+ ex->args[ex->nargs-1] =
+ makeexpr_addr(ex->args[ex->nargs-1]);
+ } else if (tp2->kind == TK_STRING) {
+ ex->args[fakenum++] =
+ makeexpr_arglong(makeexpr_long(1), integer16 == 0);
+ ex->args[fakenum++] =
+ makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
+ integer16 == 0);
+ break;
+ } else if (tp2->kind != TK_ARRAY) {
+ warning("Type mismatch for conformant array [298]");
+ break;
+ }
+ ex->args[fakenum++] =
+ makeexpr_arglong(copyexpr(tp2->indextype->smin),
+ integer16 == 0);
+ ex->args[fakenum++] =
+ makeexpr_arglong(copyexpr(tp2->indextype->smax),
+ integer16 == 0);
+ tp = tp->basetype;
+ tp2 = tp2->basetype;
+ }
+ if (tp->kind == TK_STRING && tp->structdefd) {
+ ex->args[fakenum] =
+ makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
+ integer16 == 0);
+ }
+ }
+ fakenum = -1;
+ if (!isnonpos) {
+ prevarg = args;
+ args = args->xnext;
+ if (args) {
+ if (curtok != TOK_RPAR && !wneedtok(TOK_COMMA))
+ skiptotoken2(TOK_RPAR, TOK_SEMI);
+ }
+ }
+ }
+ if (curtok == TOK_COMMA) {
+ if (ex->kind == EK_FUNCTION) {
+ name = ((Meaning *)ex->val.i)->name;
+ ex->kind = EK_BICALL;
+ ex->val.s = stralloc(name);
+ } else
+ name = "function";
+ warning(format_s("Too many arguments for %s [299]", name));
+ while (curtok == TOK_COMMA) {
+ gettok();
+ insertarg(&ex, ex->nargs, p_expr(tp_integer));
+ }
+ }
+ return ex;
+ }
+
+
+
+ Expr *replacemacargs(ex, fex)
+ Expr *ex, *fex;
+ {
+ int i;
+ Expr *ex2;
+
+ for (i = 0; i < ex->nargs; i++)
+ ex->args[i] = replacemacargs(ex->args[i], fex);
+ if (ex->kind == EK_MACARG) {
+ if (ex->val.i <= fex->nargs) {
+ ex2 = copyexpr(fex->args[ex->val.i - 1]);
+ } else {
+ ex2 = makeexpr_name("<meef>", tp_integer);
+ note("FuncMacro specified more arguments than call [280]");
+ }
+ freeexpr(ex);
+ return ex2;
+ }
+ return resimplify(ex);
+ }
+
+
+ Expr *p_noarglist(ex, mp, args)
+ Expr *ex;
+ Meaning *mp, *args;
+ {
+ while (args && args->constdefn) {
+ insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
+ args = args->xnext;
+ }
+ if (args) {
+ warning(format_s("Expected an argument list for %s [300]", mp->name));
+ ex->kind = EK_BICALL;
+ ex->val.s = stralloc(mp->name);
+ }
+ return ex;
+ }
+
+
+ void func_reference(func)
+ Meaning *func;
+ {
+ Meaning *mp;
+
+ if (func->ctx && func->ctx != curctx &&func->ctx->kind == MK_FUNCTION &&
+ func->ctx->varstructflag && !curctx->ctx->varstructflag) {
+ for (mp = curctx->ctx; mp != func->ctx; mp = mp->ctx)
+ mp->varstructflag = 1;
+ }
+ }
+
+
+ Expr *p_funccall(mp)
+ Meaning *mp;
+ {
+ Meaning *mp2, *tvar;
+ Expr *ex, *ex2;
+ int firstarg = 0;
+
+ func_reference(mp);
+ ex = makeexpr(EK_FUNCTION, 0);
+ ex->val.i = (long)mp;
+ ex->val.type = mp->type->basetype;
+ mp2 = mp->type->fbase;
+ if (mp2 && mp2->isreturn) { /* pointer to buffer for return value */
+ tvar = makestmttempvar(ex->val.type->basetype,
+ (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
+ insertarg(&ex, 0, makeexpr_addr(makeexpr_var(tvar)));
+ mp2 = mp2->xnext;
+ firstarg++;
+ }
+ if (mp2 && curtok != TOK_LPAR) {
+ ex = p_noarglist(ex, mp, mp2);
+ } else if (curtok == TOK_LPAR) {
+ gettok();
+ ex = p_funcarglist(ex, mp2, firstarg, (mp->constdefn != NULL));
+ skipcloseparen();
+ }
+ if (mp->constdefn) {
+ ex2 = replacemacargs(copyexpr(mp->constdefn), ex);
+ ex2 = gentle_cast(ex2, ex->val.type);
+ ex2->val.type = ex->val.type;
+ freeexpr(ex);
+ return ex2;
+ }
+ return ex;
+ }
+
+
+
+
+
+
+ Expr *accumulate_strlit()
+ {
+ char buf[256], ch, *cp, *cp2;
+ int len, i, danger = 0;
+
+ len = 0;
+ cp = buf;
+ for (;;) {
+ if (curtok == TOK_STRLIT) {
+ cp2 = curtokbuf;
+ i = curtokint;
+ while (--i >= 0) {
+ if (++len <= 255) {
+ ch = *cp++ = *cp2++;
+ if (ch & 128)
+ danger++;
+ }
+ }
+ } else if (curtok == TOK_HAT) { /* Turbo */
+ i = getchartok() & 0x1f;
+ if (++len <= 255)
+ *cp++ = i;
+ } else if (curtok == TOK_LPAR) { /* VAX */
+ Value val;
+ do {
+ gettok();
+ val = p_constant(tp_integer);
+ if (++len <= 255)
+ *cp++ = val.i;
+ } while (curtok == TOK_COMMA);
+ skipcloseparen();
+ continue;
+ } else
+ break;
+ gettok();
+ }
+ if (len > 255) {
+ warning("String literal too long [301]");
+ len = 255;
+ }
+ if (danger &&
+ !(unsignedchar == 1 ||
+ (unsignedchar != 0 && signedchars == 0)))
+ note(format_s("Character%s >= 128 encountered [281]", (danger > 1) ? "s" : ""));
+ return makeexpr_lstring(buf, len);
+ }
+
+
+
+ Expr *pascaltypecast(type, ex2)
+ Type *type;
+ Expr *ex2;
+ {
+ if (type->kind == TK_POINTER || type->kind == TK_STRING ||
+ type->kind == TK_ARRAY)
+ ex2 = makeexpr_stringcast(ex2);
+ else
+ ex2 = makeexpr_charcast(ex2);
+ if ((ex2->val.type->kind == TK_INTEGER ||
+ ex2->val.type->kind == TK_CHAR ||
+ ex2->val.type->kind == TK_BOOLEAN ||
+ ex2->val.type->kind == TK_ENUM ||
+ ex2->val.type->kind == TK_SUBR ||
+ ex2->val.type->kind == TK_REAL ||
+ ex2->val.type->kind == TK_POINTER ||
+ ex2->val.type->kind == TK_STRING) &&
+ (type->kind == TK_INTEGER ||
+ type->kind == TK_CHAR ||
+ type->kind == TK_BOOLEAN ||
+ type->kind == TK_ENUM ||
+ type->kind == TK_SUBR ||
+ type->kind == TK_REAL ||
+ type->kind == TK_POINTER)) {
+ if (type->kind == TK_POINTER || ex2->val.type->kind == TK_POINTER)
+ return makeexpr_un(EK_CAST, type, ex2);
+ else
+ return makeexpr_un(EK_ACTCAST, type, ex2);
+ } else {
+ return makeexpr_hat(makeexpr_cast(makeexpr_addr(ex2),
+ makepointertype(type)), 0);
+ }
+ }
+
+
+
+
+ Static Expr *p_factor(target)
+ Type *target;
+ {
+ Expr *ex, *ex2;
+ Type *type;
+ Meaning *mp, *mp2;
+
+ switch (curtok) {
+
+ case TOK_INTLIT:
+ ex = makeexpr_long(curtokint);
+ gettok();
+ return ex;
+
+ case TOK_HEXLIT:
+ ex = makeexpr_long(curtokint);
+ insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ gettok();
+ return ex;
+
+ case TOK_OCTLIT:
+ ex = makeexpr_long(curtokint);
+ insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
+ gettok();
+ return ex;
+
+ case TOK_MININT:
+ strcat(curtokbuf, ".0");
+
+ /* fall through */
+ case TOK_REALLIT:
+ ex = makeexpr_real(curtokbuf);
+ gettok();
+ return ex;
+
+ case TOK_HAT:
+ case TOK_STRLIT:
+ ex = accumulate_strlit();
+ return ex;
+
+ case TOK_LPAR:
+ gettok();
+ ex = p_expr(target);
+ skipcloseparen();
+ return dots_n_hats(ex, target);
+
+ case TOK_NOT:
+ case TOK_TWIDDLE:
+ gettok();
+ ex = p_factor(tp_integer);
+ if (ord_type(ex->val.type)->kind == TK_INTEGER)
+ return makeexpr_un(EK_BNOT, tp_integer, ex);
+ else
+ return makeexpr_not(ex);
+
+ case TOK_MINUS:
+ gettok();
+ if (curtok == TOK_MININT) {
+ gettok();
+ return makeexpr_long(MININT);
+ } else
+ return makeexpr_neg(p_factor(target));
+
+ case TOK_PLUS:
+ gettok();
+ return p_factor(target);
+
+ case TOK_ADDR:
+ gettok();
+ if (curtok == TOK_ADDR) {
+ gettok();
+ ex = p_factor(tp_proc);
+ if (ex->val.type->kind == TK_PROCPTR && ex->kind == EK_COMMA)
+ return grabarg(grabarg(grabarg(ex, 0), 1), 0);
+ if (ex->val.type->kind != TK_CPROCPTR)
+ warning("@@ allowed only for procedure pointers [302]");
+ return makeexpr_addrf(ex);
+ }
+ if (curtok == TOK_IDENT && 0 && /***/
+ curtokmeaning && (curtokmeaning->kind == MK_FUNCTION ||
+ curtokmeaning->kind == MK_SPECIAL)) {
+ if (curtokmeaning->ctx == nullctx)
+ warning(format_s("Can't take address of predefined object %s [303]",
+ curtokmeaning->name));
+ ex = makeexpr_name(curtokmeaning->name, tp_anyptr);
+ gettok();
+ } else {
+ ex = p_factor(tp_proc);
+ if (ex->val.type->kind == TK_PROCPTR) {
+ /* ex = makeexpr_dotq(ex, "proc", tp_anyptr); */
+ } else if (ex->val.type->kind == TK_CPROCPTR) {
+ ex = makeexpr_cast(ex, tp_anyptr);
+ } else
+ ex = makeexpr_addrf(ex);
+ }
+ return ex;
+
+ case TOK_LBR:
+ case TOK_LBRACE:
+ return p_setfactor(target && target->kind == TK_SET
+ ? target->indextype : NULL, 0);
+
+ case TOK_NIL:
+ gettok();
+ return makeexpr_nil();
+
+ case TOK_IF: /* nifty Pascal extension */
+ gettok();
+ ex = p_expr(tp_boolean);
+ wneedtok(TOK_THEN);
+ ex2 = p_expr(tp_integer);
+ if (wneedtok(TOK_ELSE))
+ return makeexpr_cond(ex, ex2, p_factor(ex2->val.type));
+ else
+ return makeexpr_cond(ex, ex2, makeexpr_long(0));
+
+ case TOK_IDENT:
+ mp = curtokmeaning;
+ switch ((mp) ? mp->kind : MK_VAR) {
+
+ case MK_TYPE:
+ gettok();
+ type = mp->type;
+ switch (curtok) {
+
+ case TOK_LPAR: /* Turbo type cast */
+ gettok();
+ ex2 = p_expr(type);
+ ex = pascaltypecast(type, ex2);
+ skipcloseparen();
+ return dots_n_hats(ex, target);
+
+ case TOK_LBR:
+ case TOK_LBRACE:
+ switch (type->kind) {
+
+ case TK_SET:
+ case TK_SMALLSET:
+ return p_setfactor(type->indextype, 1);
+
+ case TK_RECORD:
+ return p_constrecord(type, 0);
+
+ case TK_ARRAY:
+ case TK_SMALLARRAY:
+ return p_constarray(type, 0);
+
+ case TK_STRING:
+ return p_conststring(type, 0);
+
+ default:
+ warning("Bad type for constructor [304]");
+ skipparens();
+ return makeexpr_name(mp->name, mp->type);
+ }
+
+ default:
+ wexpected("an expression");
+ return makeexpr_name(mp->name, mp->type);
+ }
+
+ case MK_SPECIAL:
+ if (mp->handler && mp->isfunction &&
+ (curtok == TOK_LPAR || !target ||
+ (target->kind != TK_PROCPTR &&
+ target->kind != TK_CPROCPTR))) {
+ gettok();
+ if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
+ ex = makeexpr_bicall_0(mp->name, tp_integer);
+ if (curtok == TOK_LPAR) {
+ do {
+ gettok();
+ insertarg(&ex, ex->nargs, p_expr(NULL));
+ } while (curtok == TOK_COMMA);
+ skipcloseparen();
+ }
+ tryfuncmacro(&ex, mp);
+ return ex;
+ }
+ ex = (*mp->handler)(mp);
+ if (!ex)
+ ex = makeexpr_long(0);
+ return ex;
+ } else {
+ if (target &&
+ (target->kind == TK_PROCPTR ||
+ target->kind == TK_CPROCPTR))
+ note("Using a built-in procedure as a procedure pointer [316]");
+ else
+ symclass(curtoksym);
+ gettok();
+ return makeexpr_name(mp->name, tp_integer);
+ }
+
+ case MK_FUNCTION:
+ mp->refcount++;
+ need_forward_decl(mp);
+ gettok();
+ if (mp->isfunction &&
+ (curtok == TOK_LPAR || !target ||
+ (target->kind != TK_PROCPTR &&
+ target->kind != TK_CPROCPTR))) {
+ ex = p_funccall(mp);
+ if (!mp->constdefn) {
+ if (mp->handler && !(mp->sym->flags & LEAVEALONE))
+ ex = (*mp->handler)(ex);
+ }
+ if (mp->cbase->kind == MK_VARPARAM) {
+ ex = makeexpr_hat(ex, 0); /* returns pointer to structured result */
+ }
+ return dots_n_hats(ex, target);
+ } else {
+ if (mp->handler && !(mp->sym->flags & LEAVEALONE))
+ note("Using a built-in procedure as a procedure pointer [316]");
+ if (target && target->kind == TK_CPROCPTR) {
+ type = maketype(TK_CPROCPTR);
+ type->basetype = mp->type;
+ type->escale = 0;
+ mp2 = makestmttempvar(type, name_TEMP);
+ ex = makeexpr_comma(
+ makeexpr_assign(
+ makeexpr_var(mp2),
+ makeexpr_name(mp->name, tp_text)),
+ makeexpr_var(mp2));
+ if (mp->ctx->kind == MK_FUNCTION)
+ warning("Procedure pointer to nested procedure [305]");
+ } else {
+ type = maketype(TK_PROCPTR);
+ type->basetype = mp->type;
+ type->escale = 1;
+ mp2 = makestmttempvar(type, name_TEMP);
+ ex = makeexpr_comma(
+ makeexpr_comma(
+ makeexpr_assign(
+ makeexpr_dotq(makeexpr_var(mp2),
+ "proc",
+ tp_anyptr),
+ makeexpr_name(mp->name, tp_text)),
+ /* handy pointer type */
+ makeexpr_assign(
+ makeexpr_dotq(makeexpr_var(mp2),
+ "link",
+ tp_anyptr),
+ makeexpr_ctx(mp->ctx))),
+ makeexpr_var(mp2));
+ }
+ return ex;
+ }
+
+ default:
+ return p_variable(target);
+ }
+
+ default:
+ wexpected("an expression");
+ return makeexpr_long(0);
+
+ }
+ }
+
+
+
+
+ Static Expr *p_powterm(target)
+ Type *target;
+ {
+ Expr *ex = p_factor(target);
+ Expr *ex2;
+ int i, castit;
+ long v;
+
+ if (curtok == TOK_STARSTAR) {
+ gettok();
+ ex2 = p_powterm(target);
+ if (ex->val.type->kind == TK_REAL ||
+ ex2->val.type->kind == TK_REAL) {
+ if (checkconst(ex2, 2)) {
+ ex = makeexpr_sqr(ex, 0);
+ } else if (checkconst(ex2, 3)) {
+ ex = makeexpr_sqr(ex, 1);
+ } else {
+ castit = castargs >= 0 ? castargs : (prototypes == 0);
+ if (ex->val.type->kind != TK_REAL && castit)
+ ex = makeexpr_cast(ex, tp_longreal);
+ if (ex2->val.type->kind != TK_REAL && castit)
+ ex2 = makeexpr_cast(ex2, tp_longreal);
+ ex = makeexpr_bicall_2("pow", tp_longreal, ex, ex2);
+ }
+ } else if (checkconst(ex, 2)) {
+ freeexpr(ex);
+ ex = makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1), 1), ex2);
+ } else if (checkconst(ex, 0) ||
+ checkconst(ex, 1) ||
+ checkconst(ex2, 1)) {
+ freeexpr(ex2);
+ } else if (checkconst(ex2, 0)) {
+ freeexpr(ex);
+ freeexpr(ex2);
+ ex = makeexpr_long(1);
+ } else if (isliteralconst(ex, NULL) == 2 &&
+ isliteralconst(ex2, NULL) == 2 &&
+ ex2->val.i > 0) {
+ v = ex->val.i;
+ i = ex2->val.i;
+ while (--i > 0)
+ v *= ex->val.i;
+ freeexpr(ex);
+ freeexpr(ex2);
+ ex = makeexpr_long(v);
+ } else if (checkconst(ex2, 2)) {
+ ex = makeexpr_sqr(ex, 0);
+ } else if (checkconst(ex2, 3)) {
+ ex = makeexpr_sqr(ex, 1);
+ } else {
+ ex = makeexpr_bicall_2("ipow", tp_integer,
+ makeexpr_arglong(ex, 1),
+ makeexpr_arglong(ex2, 1));
+ }
+ }
+ return ex;
+ }
+
+
+ Static Expr *p_term(target)
+ Type *target;
+ {
+ Expr *ex = p_powterm(target);
+ Expr *ex2;
+ Type *type;
+ Meaning *tvar;
+ int useshort;
+
+ for (;;) {
+ checkkeyword(TOK_SHL);
+ checkkeyword(TOK_SHR);
+ checkkeyword(TOK_REM);
+ switch (curtok) {
+
+ case TOK_STAR:
+ gettok();
+ if (ex->val.type->kind == TK_SET ||
+ ex->val.type->kind == TK_SMALLSET) {
+ ex2 = p_powterm(ex->val.type);
+ type = mixsets(&ex, &ex2);
+ if (type->kind == TK_SMALLSET) {
+ ex = makeexpr_bin(EK_BAND, type, ex, ex2);
+ } else {
+ tvar = makestmttempvar(type, name_SET);
+ ex = makeexpr_bicall_3(setintname, type,
+ makeexpr_var(tvar),
+ ex, ex2);
+ }
+ } else
+ ex = makeexpr_times(ex, p_powterm(tp_integer));
+ break;
+
+ case TOK_SLASH:
+ gettok();
+ if (ex->val.type->kind == TK_SET ||
+ ex->val.type->kind == TK_SMALLSET) {
+ ex2 = p_powterm(ex->val.type);
+ type = mixsets(&ex, &ex2);
+ if (type->kind == TK_SMALLSET) {
+ ex = makeexpr_bin(EK_BXOR, type, ex, ex2);
+ } else {
+ tvar = makestmttempvar(type, name_SET);
+ ex = makeexpr_bicall_3(setxorname, type,
+ makeexpr_var(tvar),
+ ex, ex2);
+ }
+ } else
+ ex = makeexpr_divide(ex, p_powterm(tp_integer));
+ break;
+
+ case TOK_DIV:
+ gettok();
+ ex = makeexpr_div(ex, p_powterm(tp_integer));
+ break;
+
+ case TOK_REM:
+ gettok();
+ ex = makeexpr_rem(ex, p_powterm(tp_integer));
+ break;
+
+ case TOK_MOD:
+ gettok();
+ ex = makeexpr_mod(ex, p_powterm(tp_integer));
+ break;
+
+ case TOK_AND:
+ case TOK_AMP:
+ useshort = (curtok == TOK_AMP);
+ gettok();
+ ex2 = p_powterm(tp_integer);
+ if (ord_type(ex->val.type)->kind == TK_INTEGER)
+ ex = makeexpr_bin(EK_BAND, ex->val.type, ex, ex2);
+ else if (partial_eval_flag || useshort ||
+ (shortopt && nosideeffects(ex2, 1)))
+ ex = makeexpr_and(ex, ex2);
+ else
+ ex = makeexpr_bin(EK_BAND, tp_boolean, ex, ex2);
+ break;
+
+ case TOK_SHL:
+ gettok();
+ ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_powterm(tp_integer));
+ break;
+
+ case TOK_SHR:
+ gettok();
+ ex = force_unsigned(ex);
+ ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_powterm(tp_integer));
+ break;
+
+ default:
+ return ex;
+ }
+ }
+ }
+
+
+
+ Static Expr *p_sexpr(target)
+ Type *target;
+ {
+ Expr *ex, *ex2;
+ Type *type;
+ Meaning *tvar;
+ int useshort;
+
+ switch (curtok) {
+ case TOK_MINUS:
+ gettok();
+ if (curtok == TOK_MININT) {
+ gettok();
+ ex = makeexpr_long(MININT);
+ break;
+ }
+ ex = makeexpr_neg(p_term(target));
+ break;
+ case TOK_PLUS:
+ gettok();
+ /* fall through */
+ default:
+ ex = p_term(target);
+ break;
+ }
+ if (curtok == TOK_PLUS &&
+ (ex->val.type->kind == TK_STRING ||
+ ord_type(ex->val.type)->kind == TK_CHAR ||
+ ex->val.type->kind == TK_ARRAY)) {
+ while (curtok == TOK_PLUS) {
+ gettok();
+ ex = makeexpr_concat(ex, p_term(NULL), 0);
+ }
+ return ex;
+ } else {
+ for (;;) {
+ checkkeyword(TOK_XOR);
+ switch (curtok) {
+
+ case TOK_PLUS:
+ gettok();
+ if (ex->val.type->kind == TK_SET ||
+ ex->val.type->kind == TK_SMALLSET) {
+ ex2 = p_term(ex->val.type);
+ type = mixsets(&ex, &ex2);
+ if (type->kind == TK_SMALLSET) {
+ ex = makeexpr_bin(EK_BOR, type, ex, ex2);
+ } else {
+ tvar = makestmttempvar(type, name_SET);
+ ex = makeexpr_bicall_3(setunionname, type,
+ makeexpr_var(tvar),
+ ex, ex2);
+ }
+ } else
+ ex = makeexpr_plus(ex, p_term(tp_integer));
+ break;
+
+ case TOK_MINUS:
+ gettok();
+ if (ex->val.type->kind == TK_SET ||
+ ex->val.type->kind == TK_SMALLSET) {
+ ex2 = p_term(tp_integer);
+ type = mixsets(&ex, &ex2);
+ if (type->kind == TK_SMALLSET) {
+ ex = makeexpr_bin(EK_BAND, type, ex,
+ makeexpr_un(EK_BNOT, type, ex2));
+ } else {
+ tvar = makestmttempvar(type, name_SET);
+ ex = makeexpr_bicall_3(setdiffname, type,
+ makeexpr_var(tvar), ex, ex2);
+ }
+ } else
+ ex = makeexpr_minus(ex, p_term(tp_integer));
+ break;
+
+ case TOK_VBAR:
+ if (modula2)
+ return ex;
+ /* fall through */
+
+ case TOK_OR:
+ useshort = (curtok == TOK_VBAR);
+ gettok();
+ ex2 = p_term(tp_integer);
+ if (ord_type(ex->val.type)->kind == TK_INTEGER)
+ ex = makeexpr_bin(EK_BOR, ex->val.type, ex, ex2);
+ else if (partial_eval_flag || useshort ||
+ (shortopt && nosideeffects(ex2, 1)))
+ ex = makeexpr_or(ex, ex2);
+ else
+ ex = makeexpr_bin(EK_BOR, tp_boolean, ex, ex2);
+ break;
+
+ case TOK_XOR:
+ gettok();
+ ex2 = p_term(tp_integer);
+ ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
+ break;
+
+ default:
+ return ex;
+ }
+ }
+ }
+ }
+
+
+
+ Expr *p_expr(target)
+ Type *target;
+ {
+ Expr *ex = p_sexpr(target);
+ Expr *ex2, *ex3, *ex4;
+ Type *type;
+ Meaning *tvar;
+ long mask, smin, smax;
+ int i, j;
+
+ switch (curtok) {
+
+ case TOK_EQ:
+ gettok();
+ return makeexpr_rel(EK_EQ, ex, p_sexpr(ex->val.type));
+
+ case TOK_NE:
+ gettok();
+ return makeexpr_rel(EK_NE, ex, p_sexpr(ex->val.type));
+
+ case TOK_LT:
+ gettok();
+ return makeexpr_rel(EK_LT, ex, p_sexpr(ex->val.type));
+
+ case TOK_GT:
+ gettok();
+ return makeexpr_rel(EK_GT, ex, p_sexpr(ex->val.type));
+
+ case TOK_LE:
+ gettok();
+ return makeexpr_rel(EK_LE, ex, p_sexpr(ex->val.type));
+
+ case TOK_GE:
+ gettok();
+ return makeexpr_rel(EK_GE, ex, p_sexpr(ex->val.type));
+
+ case TOK_IN:
+ gettok();
+ ex2 = p_sexpr(tp_smallset);
+ ex = gentle_cast(ex, ex2->val.type->indextype);
+ if (ex2->val.type->kind == TK_SMALLSET) {
+ if (!ord_range(ex->val.type, &smin, &smax)) {
+ smin = -1;
+ smax = setbits;
+ }
+ if (!nosideeffects(ex, 0)) {
+ tvar = makestmttempvar(ex->val.type, name_TEMP);
+ ex3 = makeexpr_assign(makeexpr_var(tvar), ex);
+ ex = makeexpr_var(tvar);
+ } else
+ ex3 = NULL;
+ ex4 = copyexpr(ex);
+ if (ex->kind == EK_CONST && smallsetconst)
+ ex = makesmallsetconst(1<<ex->val.i, ex2->val.type);
+ else
+ ex = makeexpr_bin(EK_LSH, ex2->val.type,
+ makeexpr_longcast(makeexpr_long(1), 1),
+ enum_to_int(ex));
+ ex = makeexpr_rel(EK_NE, makeexpr_bin(EK_BAND, tp_integer, ex, ex2),
+ makeexpr_long(0));
+ if (*name_SETBITS ||
+ ((ex4->kind == EK_CONST) ? ((unsigned long)ex4->val.i >= setbits)
+ : !(0 <= smin && smax < setbits))) {
+ ex = makeexpr_and(makeexpr_range(enum_to_int(ex4),
+ makeexpr_long(0),
+ makeexpr_setbits(), 0),
+ ex);
+ } else
+ freeexpr(ex4);
+ ex = makeexpr_comma(ex3, ex);
+ return ex;
+ } else {
+ ex3 = ex2;
+ while (ex3->kind == EK_BICALL &&
+ (!strcmp(ex3->val.s, setaddname) ||
+ !strcmp(ex3->val.s, setaddrangename)))
+ ex3 = ex3->args[0];
+ if (ex3->kind == EK_BICALL && !strcmp(ex3->val.s, setexpandname) &&
+ (tvar = istempvar(ex3->args[0])) != NULL &&
+ isconstexpr(ex3->args[1], &mask)) {
+ canceltempvar(tvar);
+ if (!nosideeffects(ex, 0)) {
+ tvar = makestmttempvar(ex->val.type, name_TEMP);
+ ex3 = makeexpr_assign(makeexpr_var(tvar), ex);
+ ex = makeexpr_var(tvar);
+ } else
+ ex3 = NULL;
+ type = ord_type(ex2->val.type->indextype);
+ ex4 = NULL;
+ i = 0;
+ while (i < setbits) {
+ if (mask & (1<<i++)) {
+ if (i+1 < setbits && (mask & (2<<i))) {
+ for (j = i; j < setbits && (mask & (1<<j)); j++) ;
+ ex4 = makeexpr_or(ex4,
+ makeexpr_range(copyexpr(ex),
+ makeexpr_val(make_ord(type, i-1)),
+ makeexpr_val(make_ord(type, j-1)), 1));
+ i = j;
+ } else {
+ ex4 = makeexpr_or(ex4,
+ makeexpr_rel(EK_EQ, copyexpr(ex),
+ makeexpr_val(make_ord(type, i-1))));
+ }
+ }
+ }
+ mask = 0;
+ for (;;) {
+ if (!strcmp(ex2->val.s, setaddrangename)) {
+ if (checkconst(ex2->args[1], 'a') &&
+ checkconst(ex2->args[2], 'z')) {
+ mask |= 0x1;
+ } else if (checkconst(ex2->args[1], 'A') &&
+ checkconst(ex2->args[2], 'Z')) {
+ mask |= 0x2;
+ } else if (checkconst(ex2->args[1], '0') &&
+ checkconst(ex2->args[2], '9')) {
+ mask |= 0x4;
+ } else {
+ ex4 = makeexpr_or(ex4,
+ makeexpr_range(copyexpr(ex), ex2->args[1], ex2->args[2], 1));
+ }
+ } else if (!strcmp(ex2->val.s, setaddname)) {
+ ex4 = makeexpr_or(ex4,
+ makeexpr_rel(EK_EQ, copyexpr(ex), ex2->args[1]));
+ } else
+ break;
+ ex2 = ex2->args[0];
+ }
+ /* do these now so that EK_OR optimizations will work: */
+ if (mask & 0x1)
+ ex4 = makeexpr_or(ex4, makeexpr_range(copyexpr(ex),
+ makeexpr_char('a'),
+ makeexpr_char('z'), 1));
+ if (mask & 0x2)
+ ex4 = makeexpr_or(ex4, makeexpr_range(copyexpr(ex),
+ makeexpr_char('A'),
+ makeexpr_char('Z'), 1));
+ if (mask & 0x4)
+ ex4 = makeexpr_or(ex4, makeexpr_range(copyexpr(ex),
+ makeexpr_char('0'),
+ makeexpr_char('9'), 1));
+ freeexpr(ex);
+ return makeexpr_comma(ex3, ex4);
+ }
+ return makeexpr_bicall_2(setinname, tp_boolean,
+ makeexpr_arglong(ex, 0), ex2);
+ }
+
+ default:
+ return ex;
+ }
+ }
+
+
+
+
+
+
+
+ /* Parse a C expression; used by VarMacro, etc. */
+
+ Type *nametotype(name)
+ char *name;
+ {
+ if (!strcicmp(name, "malloc") ||
+ !strcicmp(name, mallocname)) {
+ return tp_anyptr;
+ }
+ return tp_integer;
+ }
+
+
+ int istypespec()
+ {
+ switch (curtok) {
+
+ case TOK_CONST:
+ return 1;
+
+ case TOK_IDENT:
+ return !strcmp(curtokcase, "volatile") ||
+ !strcmp(curtokcase, "void") ||
+ !strcmp(curtokcase, "char") ||
+ !strcmp(curtokcase, "short") ||
+ !strcmp(curtokcase, "int") ||
+ !strcmp(curtokcase, "long") ||
+ !strcmp(curtokcase, "float") ||
+ !strcmp(curtokcase, "double") ||
+ !strcmp(curtokcase, "signed") ||
+ !strcmp(curtokcase, "unsigned") ||
+ !strcmp(curtokcase, "struct") ||
+ !strcmp(curtokcase, "union") ||
+ !strcmp(curtokcase, "class") ||
+ !strcmp(curtokcase, "enum") ||
+ !strcmp(curtokcase, "typedef") ||
+ (curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE);
+
+ default:
+ return 0;
+ }
+ }
+
+
+
+ Expr *pc_parentype(cp)
+ char *cp;
+ {
+ Expr *ex;
+
+ if (curtok == TOK_IDENT &&
+ curtokmeaning &&
+ curtokmeaning->kind == MK_TYPE) {
+ ex = makeexpr_type(curtokmeaning->type);
+ gettok();
+ skipcloseparen();
+ } else if (curtok == TOK_IDENT && !strcmp(curtokcase, "typedef")) {
+ ex = makeexpr_name(getparenstr(inbufptr), tp_integer);
+ gettok();
+ } else {
+ ex = makeexpr_name(getparenstr(cp), tp_integer);
+ gettok();
+ }
+ return ex;
+ }
+
+
+
+
+ Expr *pc_expr2();
+
+ Expr *pc_factor()
+ {
+ Expr *ex;
+ char *cp;
+ Strlist *sl;
+ int i;
+
+ switch (curtok) {
+
+ case TOK_BANG:
+ gettok();
+ return makeexpr_not(pc_expr2(14));
+
+ case TOK_TWIDDLE:
+ gettok();
+ return makeexpr_un(EK_BNOT, tp_integer, pc_expr2(14));
+
+ case TOK_PLPL:
+ gettok();
+ ex = pc_expr2(14);
+ return makeexpr_assign(ex, makeexpr_plus(copyexpr(ex), makeexpr_long(1)));
+
+ case TOK_MIMI:
+ gettok();
+ ex = pc_expr2(14);
+ return makeexpr_assign(ex, makeexpr_minus(copyexpr(ex), makeexpr_long(1)));
+
+ case TOK_STAR:
+ gettok();
+ ex = pc_expr2(14);
+ if (ex->val.type->kind != TK_POINTER)
+ ex->val.type = makepointertype(ex->val.type);
+ return makeexpr_hat(ex, 0);
+
+ case TOK_AMP:
+ gettok();
+ return makeexpr_addr(pc_expr2(14));
+
+ case TOK_PLUS:
+ gettok();
+ return pc_expr2(14);
+
+ case TOK_MINUS:
+ gettok();
+ return makeexpr_neg(pc_expr2(14));
+
+ case TOK_LPAR:
+ cp = inbufptr;
+ gettok();
+ if (istypespec()) {
+ ex = pc_parentype(cp);
+ return makeexpr_bin(EK_LITCAST, tp_integer, ex, pc_expr2(14));
+ }
+ ex = pc_expr();
+ skipcloseparen();
+ return ex;
+
+ case TOK_IDENT:
+ if (!strcmp(curtokcase, "sizeof")) {
+ gettok();
+ if (curtok != TOK_LPAR)
+ return makeexpr_sizeof(pc_expr2(14), 1);
+ cp = inbufptr;
+ gettok();
+ if (istypespec()) {
+ ex = makeexpr_sizeof(pc_parentype(cp), 1);
+ } else {
+ ex = makeexpr_sizeof(pc_expr(), 1);
+ skipcloseparen();
+ }
+ return ex;
+ }
+ if (curtoksym->flags & FMACREC) {
+ ex = makeexpr(EK_MACARG, 0);
+ ex->val.type = tp_integer;
+ ex->val.i = 0;
+ for (sl = funcmacroargs, i = 1; sl; sl = sl->next, i++) {
+ if (sl->value == (long)curtoksym) {
+ ex->val.i = i;
+ break;
+ }
+ }
+ } else
+ ex = makeexpr_name(curtokcase, nametotype(curtokcase));
+ gettok();
+ return ex;
+
+ case TOK_INTLIT:
+ ex = makeexpr_long(curtokint);
+ if (curtokbuf[strlen(curtokbuf)-1] == 'L')
+ ex = makeexpr_longcast(ex, 1);
+ gettok();
+ return ex;
+
+ case TOK_HEXLIT:
+ ex = makeexpr_long(curtokint);
+ insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
+ if (curtokbuf[strlen(curtokbuf)-1] == 'L')
+ ex = makeexpr_longcast(ex, 1);
+ gettok();
+ return ex;
+
+ case TOK_OCTLIT:
+ ex = makeexpr_long(curtokint);
+ insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
+ if (curtokbuf[strlen(curtokbuf)-1] == 'L')
+ ex = makeexpr_longcast(ex, 1);
+ gettok();
+ return ex;
+
+ case TOK_REALLIT:
+ ex = makeexpr_real(curtokbuf);
+ gettok();
+ return ex;
+
+ case TOK_STRLIT:
+ ex = makeexpr_lstring(curtokbuf, curtokint);
+ gettok();
+ return ex;
+
+ case TOK_CHARLIT:
+ ex = makeexpr_char(curtokint);
+ gettok();
+ return ex;
+
+ default:
+ wexpected("a C expression");
+ return makeexpr_long(0);
+ }
+ }
+
+
+
+
+ #define pc_prec(pr) if (prec > (pr)) return ex; gettok();
+
+ Expr *pc_expr2(prec)
+ int prec;
+ {
+ Expr *ex, *ex2;
+ int i;
+
+ ex = pc_factor();
+ for (;;) {
+ switch (curtok) {
+
+ case TOK_COMMA:
+ pc_prec(1);
+ ex = makeexpr_comma(ex, pc_expr2(2));
+ break;
+
+ case TOK_EQ:
+ pc_prec(2);
+ ex = makeexpr_assign(ex, pc_expr2(2));
+ break;
+
+ case TOK_QM:
+ pc_prec(3);
+ ex2 = pc_expr();
+ if (wneedtok(TOK_COLON))
+ ex = makeexpr_cond(ex, ex2, pc_expr2(3));
+ else
+ ex = makeexpr_cond(ex, ex2, makeexpr_long(0));
+ break;
+
+ case TOK_OROR:
+ pc_prec(4);
+ ex = makeexpr_or(ex, pc_expr2(5));
+ break;
+
+ case TOK_ANDAND:
+ pc_prec(5);
+ ex = makeexpr_and(ex, pc_expr2(6));
+ break;
+
+ case TOK_VBAR:
+ pc_prec(6);
+ ex = makeexpr_bin(EK_BOR, tp_integer, ex, pc_expr2(7));
+ break;
+
+ case TOK_HAT:
+ pc_prec(7);
+ ex = makeexpr_bin(EK_BXOR, tp_integer, ex, pc_expr2(8));
+ break;
+
+ case TOK_AMP:
+ pc_prec(8);
+ ex = makeexpr_bin(EK_BAND, tp_integer, ex, pc_expr2(9));
+ break;
+
+ case TOK_EQEQ:
+ pc_prec(9);
+ ex = makeexpr_rel(EK_EQ, ex, pc_expr2(10));
+ break;
+
+ case TOK_BANGEQ:
+ pc_prec(9);
+ ex = makeexpr_rel(EK_NE, ex, pc_expr2(10));
+ break;
+
+ case TOK_LT:
+ pc_prec(10);
+ ex = makeexpr_rel(EK_LT, ex, pc_expr2(11));
+ break;
+
+ case TOK_LE:
+ pc_prec(10);
+ ex = makeexpr_rel(EK_LE, ex, pc_expr2(11));
+ break;
+
+ case TOK_GT:
+ pc_prec(10);
+ ex = makeexpr_rel(EK_GT, ex, pc_expr2(11));
+ break;
+
+ case TOK_GE:
+ pc_prec(10);
+ ex = makeexpr_rel(EK_GE, ex, pc_expr2(11));
+ break;
+
+ case TOK_LTLT:
+ pc_prec(11);
+ ex = makeexpr_bin(EK_LSH, tp_integer, ex, pc_expr2(12));
+ break;
+
+ case TOK_GTGT:
+ pc_prec(11);
+ ex = makeexpr_bin(EK_RSH, tp_integer, ex, pc_expr2(12));
+ break;
+
+ case TOK_PLUS:
+ pc_prec(12);
+ ex = makeexpr_plus(ex, pc_expr2(13));
+ break;
+
+ case TOK_MINUS:
+ pc_prec(12);
+ ex = makeexpr_minus(ex, pc_expr2(13));
+ break;
+
+ case TOK_STAR:
+ pc_prec(13);
+ ex = makeexpr_times(ex, pc_expr2(14));
+ break;
+
+ case TOK_SLASH:
+ pc_prec(13);
+ ex = makeexpr_div(ex, pc_expr2(14));
+ break;
+
+ case TOK_PERC:
+ pc_prec(13);
+ ex = makeexpr_mod(ex, pc_expr2(14));
+ break;
+
+ case TOK_PLPL:
+ pc_prec(15);
+ ex = makeexpr_un(EK_POSTINC, tp_integer, ex);
+ break;
+
+ case TOK_MIMI:
+ pc_prec(15);
+ ex = makeexpr_un(EK_POSTDEC, tp_integer, ex);
+ break;
+
+ case TOK_LPAR:
+ pc_prec(16);
+ if (ex->kind == EK_NAME) {
+ ex->kind = EK_BICALL;
+ } else {
+ ex = makeexpr_un(EK_SPCALL, tp_integer, ex);
+ }
+ while (curtok != TOK_RPAR) {
+ insertarg(&ex, ex->nargs, pc_expr2(2));
+ if (curtok != TOK_RPAR)
+ if (!wneedtok(TOK_COMMA))
+ skiptotoken2(TOK_RPAR, TOK_SEMI);
+ }
+ gettok();
+ break;
+
+ case TOK_LBR:
+ pc_prec(16);
+ ex = makeexpr_index(ex, pc_expr(), NULL);
+ if (!wneedtok(TOK_RBR))
+ skippasttoken(TOK_RBR);
+ break;
+
+ case TOK_ARROW:
+ pc_prec(16);
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ if (ex->val.type->kind != TK_POINTER)
+ ex->val.type = makepointertype(ex->val.type);
+ ex = makeexpr_dotq(makeexpr_hat(ex, 0),
+ curtokcase, tp_integer);
+ gettok();
+ break;
+
+ case TOK_DOT:
+ pc_prec(16);
+ if (!wexpecttok(TOK_IDENT))
+ break;
+ ex = makeexpr_dotq(ex, curtokcase, tp_integer);
+ gettok();
+ break;
+
+ case TOK_COLONCOLON:
+ if (prec > 16)
+ return ex;
+ i = C_lex;
+ C_lex = 0;
+ gettok();
+ if (curtok == TOK_IDENT &&
+ curtokmeaning && curtokmeaning->kind == MK_TYPE) {
+ ex->val.type = curtokmeaning->type;
+ } else if (curtok == TOK_LPAR) {
+ gettok();
+ ex->val.type = p_type(NULL);
+ if (!wexpecttok(TOK_RPAR))
+ skiptotoken(TOK_RPAR);
+ } else
+ wexpected("a type name");
+ C_lex = i;
+ gettok();
+ break;
+
+ default:
+ return ex;
+ }
+ }
+ }
+
+
+
+
+ Expr *pc_expr()
+ {
+ return pc_expr2(0);
+ }
+
+
+
+ Expr *pc_expr_str(buf)
+ char *buf;
+ {
+ Strlist *defsl, *sl;
+ Expr *ex;
+
+ defsl = NULL;
+ sl = strlist_append(&defsl, buf);
+ C_lex++;
+ push_input_strlist(defsl, buf);
+ ex = pc_expr();
+ if (curtok != TOK_EOF)
+ warning(format_s("Junk (%s) at end of C expression [306]",
+ tok_name(curtok)));
+ pop_input();
+ C_lex--;
+ strlist_empty(&defsl);
+ return ex;
+ }
+
+
+
+
+
+
+ /* Simplify an expression */
+
+ Expr *fixexpr(ex, env)
+ Expr *ex;
+ int env;
+ {
+ Expr *ex2, *ex3;
+ Type *type, *type2;
+ char *cp;
+ char sbuf[5];
+ int i, j;
+ Value val;
+
+ if (!ex)
+ return NULL;
+ if (debug>4) {fprintf(outf, "fixexpr("); dumpexpr(ex); fprintf(outf, ")\n");}
+ switch (ex->kind) {
+
+ case EK_BICALL:
+ ex2 = fix_bicall(ex, env);
+ if (ex2) {
+ ex = ex2;
+ break;
+ }
+ cp = ex->val.s;
+ if (!strcmp(cp, "strlen")) {
+ if (ex->args[0]->kind == EK_BICALL &&
+ !strcmp(ex->args[0]->val.s, "sprintf") &&
+ sprintf_value == 0) { /* does sprintf return char count? */
+ ex = grabarg(ex, 0);
+ strchange(&ex->val.s, "*sprintf");
+ ex = fixexpr(ex, env);
+ } else {
+ ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+ }
+ } else if (!strcmp(cp, name_SETIO)) {
+ ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ } else if (!strcmp(cp, "~~SETIO")) {
+ ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ ex = makeexpr_cond(ex->args[0],
+ makeexpr_long(0),
+ makeexpr_bicall_1(name_ESCIO, tp_int, ex->args[1]));
+ } else if (!strcmp(cp, name_CHKIO)) {
+ ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ ex->args[2] = fixexpr(ex->args[2], env);
+ ex->args[3] = fixexpr(ex->args[3], env);
+ } else if (!strcmp(cp, "~~CHKIO")) {
+ ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ ex->args[2] = fixexpr(ex->args[2], env);
+ ex->args[3] = fixexpr(ex->args[3], env);
+ ex2 = makeexpr_bicall_1(name_ESCIO, tp_int, ex->args[1]);
+ if (ord_type(ex->args[3]->val.type)->kind != TK_INTEGER)
+ ex2 = makeexpr_cast(ex2, ex->args[3]->val.type);
+ ex = makeexpr_cond(ex->args[0], ex->args[2], ex2);
+ } else if (!strcmp(cp, "assert")) {
+ ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ } else if ((!strcmp(cp, setaddname) ||
+ !strcmp(cp, setaddrangename)) &&
+ (ex2 = ex->args[0])->kind == EK_BICALL &&
+ (!strcmp(ex2->val.s, setaddname) ||
+ !strcmp(ex2->val.s, setaddrangename))) {
+ while (ex2->kind == EK_BICALL &&
+ (!strcmp(ex2->val.s, setaddname) ||
+ !strcmp(ex2->val.s, setaddrangename) ||
+ !strcmp(ex2->val.s, setexpandname)))
+ ex2 = ex2->args[0];
+ if (nosideeffects(ex2, 1)) {
+ ex = makeexpr_comma(ex->args[0], ex);
+ ex->args[1]->args[0] = ex2;
+ ex = fixexpr(ex, env);
+ } else
+ for (i = 0; i < ex->nargs; i++)
+ ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
+ } else if (!strcmp(cp, setunionname) &&
+ (ex3 = singlevar(ex->args[0])) != NULL &&
+ ((i=1, exprsame(ex->args[0], ex->args[i], 0)) ||
+ (i=2, exprsame(ex->args[0], ex->args[i], 0))) &&
+ !exproccurs(ex3, ex->args[3-i]) &&
+ ex->args[3-i]->kind == EK_BICALL &&
+ (!strcmp(ex->args[3-i]->val.s, setaddname) ||
+ !strcmp(ex->args[3-i]->val.s, setaddrangename) ||
+ (!strcmp(ex->args[3-i]->val.s, setexpandname) &&
+ checkconst(ex->args[3-i]->args[1], 0))) &&
+ totempvar(ex->args[3-i])) {
+ if (!strcmp(ex->args[3-i]->val.s, setexpandname)) {
+ ex = grabarg(ex, 0);
+ } else {
+ ex = makeexpr_comma(ex, ex->args[3-i]);
+ ex->args[0]->args[3-i] = ex->args[1]->args[0];
+ ex->args[1]->args[0] = copyexpr(ex->args[0]->args[0]);
+ }
+ ex = fixexpr(ex, env);
+ } else if (!strcmp(cp, setdiffname) && *setremname &&
+ (ex3 = singlevar(ex->args[0])) != NULL &&
+ exprsame(ex->args[0], ex->args[1], 0) &&
+ !exproccurs(ex3, ex->args[2]) &&
+ ex->args[2]->kind == EK_BICALL &&
+ (!strcmp(ex->args[2]->val.s, setaddname) ||
+ (!strcmp(ex->args[2]->val.s, setexpandname) &&
+ checkconst(ex->args[2]->args[1], 0))) &&
+ totempvar(ex->args[2])) {
+ if (!strcmp(ex->args[2]->val.s, setexpandname)) {
+ ex = grabarg(ex, 0);
+ } else {
+ ex = makeexpr_comma(ex, ex->args[2]);
+ ex->args[0]->args[2] = ex->args[1]->args[0];
+ ex->args[1]->args[0] = copyexpr(ex->args[0]->args[0]);
+ strchange(&ex->args[1]->val.s, setremname);
+ }
+ ex = fixexpr(ex, env);
+ } else {
+ for (i = 0; i < ex->nargs; i++)
+ ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
+ ex = cleansprintf(ex);
+ if (!strcmp(cp, "sprintf")) {
+ if (checkstring(ex->args[1], "%s")) {
+ delfreearg(&ex, 1);
+ strchange(&ex->val.s, "strcpy");
+ ex = fixexpr(ex, env);
+ } else if (sprintf_value != 1 && env != ENV_STMT) {
+ if (*sprintfname) {
+ strchange(&ex->val.s, format_s("*%s", sprintfname));
+ } else {
+ strchange(&ex->val.s, "*sprintf");
+ ex = makeexpr_comma(ex, copyexpr(ex->args[0]));
+ }
+ }
+ } else if (!strcmp(cp, "strcpy")) {
+ if (env == ENV_STMT &&
+ ex->args[1]->kind == EK_BICALL &&
+ !strcmp(ex->args[1]->val.s, "strcpy") &&
+ nosideeffects(ex->args[1]->args[0], 1)) {
+ ex2 = ex->args[1];
+ ex->args[1] = copyexpr(ex2->args[0]);
+ ex = makeexpr_comma(ex2, ex);
+ }
+ } else if (!strcmp(cp, "memcpy")) {
+ strchange(&ex->val.s, format_s("*%s", memcpyname));
+ if (!strcmp(memcpyname, "*bcopy")) {
+ swapexprs(ex->args[0], ex->args[1]);
+ if (env != ENV_STMT)
+ ex = makeexpr_comma(ex, copyexpr(ex->args[1]));
+ }
+ #if 0
+ } else if (!strcmp(cp, setunionname) &&
+ (ex3 = singlevar(ex->args[0])) != NULL &&
+ ((i=1, exprsame(ex->args[0], ex->args[i], 0)) ||
+ (i=2, exprsame(ex->args[0], ex->args[i], 0))) &&
+ !exproccurs(ex3, ex->args[3-i])) {
+ ep = &ex->args[3-i];
+ while ((ex2 = *ep)->kind == EK_BICALL &&
+ (!strcmp(ex2->val.s, setaddname) ||
+ !strcmp(ex2->val.s, setaddrangename)))
+ ep = &ex2->args[0];
+ if (ex2->kind == EK_BICALL &&
+ !strcmp(ex2->val.s, setexpandname) &&
+ checkconst(ex2->args[1], 0) &&
+ (mp = istempvar(ex2->args[0])) != NULL) {
+ if (ex2 == ex->args[3-i]) {
+ ex = grabarg(ex, i);
+ } else {
+ freeexpr(ex2);
+ *ep = ex->args[i];
+ ex = ex->args[3-i];
+ }
+ }
+ } else if (!strcmp(cp, setdiffname) && *setremname &&
+ (ex3 = singlevar(ex->args[0])) != NULL &&
+ exprsame(ex->args[0], ex->args[1], 0) &&
+ !exproccurs(ex3, ex->args[2])) {
+ ep = &ex->args[2];
+ while ((ex2 = *ep)->kind == EK_BICALL &&
+ !strcmp(ex2->val.s, setaddname))
+ ep = &ex2->args[0];
+ if (ex2->kind == EK_BICALL &&
+ !strcmp(ex2->val.s, setexpandname) &&
+ checkconst(ex2->args[1], 0) &&
+ (mp = istempvar(ex2->args[0])) != NULL) {
+ if (ex2 == ex->args[2]) {
+ ex = grabarg(ex, 1);
+ } else {
+ ex2 = ex->args[2];
+ while (ex2->kind == EK_BICALL &&
+ !strcmp(ex2->val.s, setaddname)) {
+ strchange(&ex2->val.s, setremname);
+ ex2 = ex2->args[0];
+ }
+ freeexpr(ex2);
+ *ep = ex->args[1];
+ ex = ex->args[2];
+ }
+ }
+ #endif
+ } else if (!strcmp(cp, setexpandname) && env == ENV_STMT &&
+ checkconst(ex->args[1], 0)) {
+ ex = makeexpr_assign(makeexpr_hat(ex->args[0], 0),
+ ex->args[1]);
+ } else if (!strcmp(cp, getbitsname)) {
+ type = ex->args[0]->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ sbuf[0] = (type->issigned) ? 'S' : 'U';
+ sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+ sbuf[2] = 0;
+ if (sbuf[1] == 'S' &&
+ type->smax->val.type == tp_boolean) {
+ ex = makeexpr_rel(EK_NE,
+ makeexpr_bin(EK_BAND, tp_integer,
+ ex->args[0],
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1),
+ type->basetype
+ == tp_unsigned),
+ ex->args[1])),
+ makeexpr_long(0));
+ ex = fixexpr(ex, env);
+ } else
+ strchange(&ex->val.s, format_s(cp, sbuf));
+ } else if (!strcmp(cp, putbitsname)) {
+ type = ex->args[0]->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ sbuf[0] = (type->issigned) ? 'S' : 'U';
+ sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+ sbuf[2] = 0;
+ if (sbuf[1] == 'S' &&
+ type->smax->val.type == tp_boolean) {
+ ex = makeexpr_assign(ex->args[0],
+ makeexpr_bin(EK_BOR, tp_integer,
+ copyexpr(ex->args[0]),
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(ex->args[2],
+ type->basetype
+ == tp_unsigned),
+ ex->args[1])));
+ } else
+ strchange(&ex->val.s, format_s(cp, sbuf));
+ } else if (!strcmp(cp, storebitsname)) {
+ type = ex->args[0]->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ sbuf[0] = (type->issigned) ? 'S' : 'U';
+ sbuf[1] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+ sbuf[2] = 0;
+ strchange(&ex->val.s, format_s(cp, sbuf));
+ } else if (!strcmp(cp, clrbitsname)) {
+ type = ex->args[0]->val.type;
+ if (type->kind == TK_POINTER)
+ type = type->basetype;
+ sbuf[0] = (type->kind == TK_ARRAY) ? 'B' : 'S';
+ sbuf[1] = 0;
+ if (sbuf[0] == 'S' &&
+ type->smax->val.type == tp_boolean) {
+ ex = makeexpr_assign(ex->args[0],
+ makeexpr_bin(EK_BAND, tp_integer,
+ copyexpr(ex->args[0]),
+ makeexpr_un(EK_BNOT, tp_integer,
+ makeexpr_bin(EK_LSH, tp_integer,
+ makeexpr_longcast(makeexpr_long(1),
+ type->basetype
+ == tp_unsigned),
+ ex->args[1]))));
+ } else
+ strchange(&ex->val.s, format_s(cp, sbuf));
+ } else if (!strcmp(cp, "fopen")) {
+ if (which_lang == LANG_HP &&
+ ex->args[0]->kind == EK_CONST &&
+ ex->args[0]->val.type->kind == TK_STRING &&
+ ex->args[0]->val.i >= 1 &&
+ ex->args[0]->val.i <= 2 &&
+ isdigit(ex->args[0]->val.s[0]) &&
+ (ex->args[0]->val.i == 1 ||
+ isdigit(ex->args[0]->val.s[1]))) {
+ strchange(&ex->val.s, "fdopen");
+ ex->args[0] = makeexpr_long(atoi(ex->args[0]->val.s));
+ }
+ }
+ }
+ break;
+
+ case EK_NOT:
+ ex = makeexpr_not(fixexpr(grabarg(ex, 0), ENV_BOOL));
+ break;
+
+ case EK_AND:
+ case EK_OR:
+ for (i = 0; i < ex->nargs; ) {
+ ex->args[i] = fixexpr(ex->args[i], ENV_BOOL);
+ if (checkconst(ex->args[i], (ex->kind == EK_OR) ? 0 : 1) &&
+ ex->nargs > 1)
+ delfreearg(&ex, i);
+ else if (checkconst(ex->args[i], (ex->kind == EK_OR) ? 1 : 0))
+ return grabarg(ex, i);
+ else
+ i++;
+ }
+ if (ex->nargs == 1)
+ ex = grabarg(ex, 0);
+ break;
+
+ case EK_EQ:
+ case EK_NE:
+ ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+ ex->args[1] = fixexpr(ex->args[1], ENV_EXPR);
+ if (checkconst(ex->args[1], 0) && env == ENV_BOOL &&
+ ord_type(ex->args[1]->val.type)->kind != TK_ENUM &&
+ (implicitzero > 0 ||
+ (implicitzero < 0 && ex->args[0]->kind == EK_BICALL &&
+ boolean_bicall(ex->args[0]->val.s)))) {
+ if (ex->kind == EK_EQ)
+ ex = makeexpr_not(grabarg(ex, 0));
+ else {
+ ex = grabarg(ex, 0);
+ ex->val.type = tp_boolean;
+ }
+ }
+ break;
+
+ case EK_COND:
+ ex->args[0] = fixexpr(ex->args[0], ENV_BOOL);
+ #if 0
+ val = eval_expr(ex->args[0]);
+ #else
+ val = ex->args[0]->val;
+ if (ex->args[0]->kind != EK_CONST)
+ val.type = NULL;
+ #endif
+ if (val.type == tp_boolean) {
+ ex = grabarg(ex, (val.i) ? 1 : 2);
+ ex = fixexpr(ex, env);
+ } else {
+ ex->args[1] = fixexpr(ex->args[1], env);
+ ex->args[2] = fixexpr(ex->args[2], env);
+ }
+ break;
+
+ case EK_COMMA:
+ for (i = 0; i < ex->nargs; ) {
+ j = (i < ex->nargs-1);
+ ex->args[i] = fixexpr(ex->args[i], j ? ENV_STMT : env);
+ if (nosideeffects(ex->args[i], 1) && j) {
+ delfreearg(&ex, i);
+ } else if (ex->args[i]->kind == EK_COMMA) {
+ ex2 = ex->args[i];
+ ex->args[i++] = ex2->args[0];
+ for (j = 1; j < ex2->nargs; j++)
+ insertarg(&ex, i++, ex2->args[j]);
+ FREE(ex2);
+ } else
+ i++;
+ }
+ if (ex->nargs == 1)
+ ex = grabarg(ex, 0);
+ break;
+
+ case EK_CHECKNIL:
+ ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+ if (ex->nargs == 2) {
+ ex->args[1] = fixexpr(ex->args[1], ENV_EXPR);
+ ex2 = makeexpr_assign(copyexpr(ex->args[1]), ex->args[0]);
+ ex3 = ex->args[1];
+ } else {
+ ex2 = copyexpr(ex->args[0]);
+ ex3 = ex->args[0];
+ }
+ type = ex->args[0]->val.type;
+ type2 = ex->val.type;
+ ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
+ ex3,
+ makeexpr_cast(makeexpr_bicall_0(name_NILCHECK,
+ tp_int),
+ type));
+ ex->val.type = type2;
+ ex = fixexpr(ex, env);
+ break;
+
+ case EK_CAST:
+ case EK_ACTCAST:
+ if (env == ENV_STMT) {
+ ex = fixexpr(grabarg(ex, 0), ENV_STMT);
+ } else {
+ ex->args[0] = fixexpr(ex->args[0], ENV_EXPR);
+ }
+ break;
+
+ default:
+ for (i = 0; i < ex->nargs; i++)
+ ex->args[i] = fixexpr(ex->args[i], ENV_EXPR);
+ break;
+ }
+ if (debug>4) {fprintf(outf, "fixexpr returns "); dumpexpr(ex); fprintf(outf, "\n");}
+ return fix_expression(ex, env);
+ }
+
+
+
+
+
+
+
+
+ /* Output an expression */
+
+
+ #define bitOp(k) ((k)==EK_BAND || (k)==EK_BOR || (k)==EK_BXOR)
+
+ #define shfOp(k) ((k)==EK_LSH || (k)==EK_RSH)
+
+ #define logOp(k) ((k)==EK_AND || (k)==EK_OR)
+
+ #define relOp(k) ((k)==EK_EQ || (k)==EK_LT || (k)==EK_GT || \
+ (k)==EK_NE || (k)==EK_GE || (k)==EK_LE)
+
+ #define mathOp(k) ((k)==EK_PLUS || (k)==EK_TIMES || (k)==EK_NEG || \
+ (k)==EK_DIV || (k)==EK_DIVIDE || (k)==EK_MOD)
+
+ #define divOp(k) ((k)==EK_DIV || (k)==EK_DIVIDE)
+
+
+ Static int incompat(ex, num, prec)
+ Expr *ex;
+ int num, prec;
+ {
+ Expr *subex = ex->args[num];
+
+ if (extraparens == 0)
+ return prec;
+ if (ex->kind == subex->kind) {
+ if (logOp(ex->kind) || bitOp(ex->kind) ||
+ (divOp(ex->kind) && num == 0))
+ return -99; /* not even invisible parens */
+ else if (extraparens != 2)
+ return prec;
+ }
+ if (extraparens == 2)
+ return 15;
+ if (divOp(ex->kind) && num == 0 &&
+ (subex->kind == EK_TIMES || divOp(subex->kind)))
+ return -99;
+ if (bitOp(ex->kind) || shfOp(ex->kind))
+ return 15;
+ if (relOp(ex->kind) && relOp(subex->kind))
+ return 15;
+ if ((relOp(ex->kind) || logOp(ex->kind)) && bitOp(subex->kind))
+ return 15;
+ if (ex->kind == EK_COMMA)
+ return 15;
+ if (ex->kind == EK_ASSIGN && relOp(subex->kind))
+ return 15;
+ if (extraparens != 1)
+ return prec;
+ if (ex->kind == EK_ASSIGN)
+ return prec;
+ if (relOp(ex->kind) && mathOp(subex->kind))
+ return prec;
+ return 15;
+ }
+
+
+
+
+ #define EXTRASPACE() if (spaceexprs == 1) output(" ")
+ #define NICESPACE() if (spaceexprs != 0) output(" ")
+
+ #define setprec(p) \
+ if ((subprec=(p)) <= prec) { \
+ parens = 1; output("("); \
+ }
+
+ #define setprec2(p) \
+ if ((subprec=(p)) <= prec) { \
+ parens = 1; output("("); \
+ } else if (prec != -99) { \
+ parens = 2; output((breakparens == 1) ? "\010" : "\003"); \
+ }
+
+ #define setprec3(p) \
+ if ((subprec=(p)) <= prec) { \
+ parens = 1; output("("); \
+ } else if (prec != -99) { \
+ parens = 2; output((prec > 2 && breakparens != 0) ? "\010" \
+ : "\003"); \
+ }
+
+
+ Static void outop3(breakbefore, name)
+ int breakbefore;
+ char *name;
+ {
+ if (breakbefore & BRK_LEFT) {
+ output("\002");
+ if (breakbefore & BRK_RPREF)
+ output("\013");
+ }
+ output(name);
+ if (breakbefore & BRK_HANG)
+ output("\015");
+ if (breakbefore & BRK_RIGHT) {
+ output("\002");
+ if (breakbefore & BRK_LPREF)
+ output("\013");
+ }
+ }
+
+ #define outop(name) do { \
+ NICESPACE(); outop3(breakflag, name); NICESPACE(); \
+ } while (0)
+
+ #define outop2(name) do { \
+ EXTRASPACE(); outop3(breakflag, name); EXTRASPACE(); \
+ } while (0)
+
+ #define checkbreak(code) do { \
+ breakflag=(code); \
+ if ((prec != -99) && (breakflag & BRK_ALLNONE)) output("\007"); \
+ } while (0)
+
+
+ Static void out_ctx(ctx, address)
+ Meaning *ctx;
+ int address;
+ {
+ Meaning *ctx2;
+ int breakflag = breakbeforedot;
+
+ if (ctx->kind == MK_FUNCTION && ctx->varstructflag) {
+ if (curctx != ctx) {
+ if (address && curctx->ctx && curctx->ctx != ctx) {
+ output("\003");
+ if (breakflag & BRK_ALLNONE)
+ output("\007");
+ }
+ output(format_s(name_LINK, curctx->ctx->name));
+ ctx2 = curctx->ctx;
+ while (ctx2 && ctx2 != ctx) {
+ outop2("->");
+ output(format_s(name_LINK, ctx2->ctx->name));
+ ctx2 = ctx2->ctx;
+ }
+ if (ctx2 != ctx)
+ intwarning("out_ctx",
+ format_s("variable from %s not present in context path [307]",
+ ctx->name));
+ if (address && curctx->ctx && curctx->ctx != ctx)
+ output("\004");
+ if (!address)
+ outop2("->");
+ } else {
+ if (address) {
+ output("&");
+ EXTRASPACE();
+ }
+ output(format_s(name_VARS, curctx->name));
+ if (!address) {
+ outop2(".");
+ }
+ }
+ } else {
+ if (address)
+ output("NULL");
+ }
+ }
+
+
+
+ void out_var(mp, prec)
+ Meaning *mp;
+ int prec;
+ {
+ switch (mp->kind) {
+
+ case MK_CONST:
+ output(mp->name);
+ return;
+
+ case MK_VAR:
+ case MK_VARREF:
+ case MK_VARMAC:
+ case MK_PARAM:
+ case MK_VARPARAM:
+ if (mp->varstructflag) {
+ output("\003");
+ out_ctx(mp->ctx, 0);
+ output(mp->name);
+ output("\004");
+ } else
+ output(mp->name);
+ return;
+
+ default:
+ if (mp->name)
+ output(mp->name);
+ else
+ intwarning("out_var", "mp->sym == NULL [308]");
+ return;
+ }
+ }
+
+
+
+ Static int scanfield(variants, unions, lev, mp, field)
+ Meaning **variants, *mp, *field;
+ short *unions;
+ int lev;
+ {
+ int i, num, breakflag;
+ Value v;
+
+ unions[lev] = (mp && mp->kind == MK_VARIANT);
+ while (mp && mp->kind == MK_FIELD) {
+ if (mp == field) {
+ for (i = 0; i < lev; i++) {
+ v = variants[i]->val; /* sidestep a Sun 386i compiler bug */
+ num = ord_value(v);
+ breakflag = breakbeforedot;
+ if (!unions[i]) {
+ output(format_s(name_UNION, ""));
+ outop2(".");
+ }
+ if (variants[i]->ctx->cnext ||
+ variants[i]->ctx->kind != MK_FIELD) {
+ output(format_s(name_VARIANT, variantfieldname(num)));
+ outop2(".");
+ }
+ }
+ output(mp->name);
+ return 1;
+ }
+ mp = mp->cnext;
+ }
+ while (mp && mp->kind == MK_VARIANT) {
+ variants[lev] = mp;
+ if (scanfield(variants, unions, lev+1, mp->ctx, field))
+ return 1;
+ mp = mp->cnext;
+ }
+ return 0;
+ }
+
+
+ void out_field(mp)
+ Meaning *mp;
+ {
+ Meaning *variants[50];
+ short unions[51];
+
+ if (!scanfield(variants, unions, 0, mp->rectype->fbase, mp))
+ intwarning("out_field", "field name not in tree [309]");
+ else if (mp->warnifused) {
+ if (mp->rectype->meaning)
+ note(format_ss("Reference to field %s of record %s [282]",
+ mp->name, mp->rectype->meaning->name));
+ else
+ note(format_s("Reference to field %s [282]", mp->name));
+ }
+ }
+
+
+
+
+ Static void wrexpr(ex, prec)
+ Expr *ex;
+ int prec;
+ {
+ short parens = 0;
+ int subprec, i, j, minusflag, breakflag = 0;
+ int saveindent;
+ Expr *ex2, *ex3;
+ char *cp;
+ Meaning *mp;
+ Symbol *sp;
+
+ if (debug>2) { fprintf(outf,"wrexpr{"); dumpexpr(ex); fprintf(outf,", %d}\n", prec); }
+ switch (ex->kind) {
+
+ case EK_VAR:
+ mp = (Meaning *)ex->val.i;
+ if (mp->warnifused)
+ note(format_s("Reference to %s [283]", mp->name));
+ out_var(mp, prec);
+ break;
+
+ case EK_NAME:
+ output(ex->val.s);
+ break;
+
+ case EK_MACARG:
+ output("<meef>");
+ intwarning("wrexpr", "Stray EK_MACARG encountered [310]");
+ break;
+
+ case EK_CTX:
+ out_ctx((Meaning *)ex->val.i, 1);
+ break;
+
+ case EK_CONST:
+ if (ex->nargs > 0)
+ cp = value_name(ex->val, ex->args[0]->val.s, 0);
+ else
+ cp = value_name(ex->val, NULL, 0);
+ if (*cp == '-')
+ setprec(14);
+ output(cp);
+ break;
+
+ case EK_LONGCONST:
+ if (ex->nargs > 0)
+ cp = value_name(ex->val, ex->args[0]->val.s, 1);
+ else
+ cp = value_name(ex->val, NULL, 1);
+ if (*cp == '-')
+ setprec(14);
+ output(cp);
+ break;
+
+ case EK_STRUCTCONST:
+ ex3 = NULL;
+ for (i = 0; i < ex->nargs; i++) {
+ ex2 = ex->args[i];
+ if (ex2->kind == EK_STRUCTOF) {
+ j = ex2->val.i;
+ ex2 = ex2->args[0];
+ } else
+ j = 1;
+ if (ex2->kind == EK_VAR) {
+ mp = (Meaning *)ex2->val.i;
+ if (mp->kind == MK_CONST &&
+ mp->val.type &&
+ (mp->val.type->kind == TK_RECORD ||
+ mp->val.type->kind == TK_ARRAY)) {
+ if (foldconsts != 1)
+ note(format_s("Expanding constant %s into another constant [284]",
+ mp->name));
+ ex2 = (Expr *)mp->val.i;
+ }
+ }
+ while (--j >= 0) {
+ if (ex3) {
+ if (ex3->kind == EK_STRUCTCONST ||
+ ex2->kind == EK_STRUCTCONST)
+ output(",\n");
+ else if (spacecommas)
+ output(",\001 ");
+ else
+ output(",\001");
+ }
+ if (ex2->kind == EK_STRUCTCONST) {
+ output("{ \005");
+ saveindent = outindent;
+ moreindent(extrainitindent);
+ out_expr(ex2);
+ outindent = saveindent;
+ output(" }");
+ } else
+ out_expr(ex2);
+ ex3 = ex2;
+ }
+ }
+ break;
+
+ case EK_FUNCTION:
+ mp = (Meaning *)ex->val.i;
+ sp = findsymbol_opt(mp->name);
+ if ((sp && (sp->flags & WARNLIBR)) || mp->warnifused)
+ note(format_s("Called procedure %s [285]", mp->name));
+ output(mp->name);
+ if (spacefuncs)
+ output(" ");
+ output("(\002");
+ j = sp ? (sp->flags & FUNCBREAK) : 0;
+ if (j == FALLBREAK)
+ output("\007");
+ for (i = 0; i < ex->nargs; i++) {
+ if ((j == FSPCARG1 && i == 1) ||
+ (j == FSPCARG2 && i == 2) ||
+ (j == FSPCARG3 && i == 3))
+ if (spacecommas)
+ output(",\011 ");
+ else
+ output(",\011");
+ else if (i > 0)
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ out_expr(ex->args[i]);
+ }
+ if (mp->ctx->kind == MK_FUNCTION && mp->ctx->varstructflag) {
+ if (i > 0)
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ out_ctx(mp->ctx, 1);
+ }
+ output(")");
+ break;
+
+ case EK_BICALL:
+ cp = ex->val.s;
+ while (*cp == '*')
+ cp++;
+ sp = findsymbol_opt(cp);
+ if (sp && (sp->flags & WARNLIBR))
+ note(format_s("Called library procedure %s [286]", cp));
+ output(cp);
+ if (spacefuncs)
+ output(" ");
+ output("(\002");
+ j = sp ? (sp->flags & FUNCBREAK) : 0;
+ if (j == FALLBREAK)
+ output("\007");
+ for (i = 0; i < ex->nargs; i++) {
+ if ((j == FSPCARG1 && i == 1) ||
+ (j == FSPCARG2 && i == 2) ||
+ (j == FSPCARG3 && i == 3))
+ if (spacecommas)
+ output(",\011 ");
+ else
+ output(",\011");
+ else if (i > 0)
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ out_expr(ex->args[i]);
+ }
+ output(")");
+ break;
+
+ case EK_SPCALL:
+ setprec(16);
+ if (starfunctions) {
+ output("(\002*");
+ wrexpr(ex->args[0], 13);
+ output(")");
+ } else
+ wrexpr(ex->args[0], subprec-1);
+ if (spacefuncs)
+ output(" ");
+ output("(\002");
+ for (i = 1; i < ex->nargs; i++) {
+ if (i > 1)
+ if (spacecommas)
+ output(",\002 ");
+ else
+ output(",\002");
+ out_expr(ex->args[i]);
+ }
+ output(")");
+ break;
+
+ case EK_INDEX:
+ setprec(16);
+ wrexpr(ex->args[0], subprec-1);
+ if (lookback(1) == ']')
+ output("\001");
+ output("[");
+ out_expr(ex->args[1]);
+ output("]");
+ break;
+
+ case EK_DOT:
+ setprec2(16);
+ checkbreak(breakbeforedot);
+ if (ex->args[0]->kind == EK_HAT) {
+ wrexpr(ex->args[0]->args[0], subprec-1);
+ outop2("->");
+ } else if (ex->args[0]->kind == EK_CTX) {
+ out_ctx((Meaning *)ex->args[0]->val.i, 0);
+ } else {
+ wrexpr(ex->args[0], subprec-1);
+ outop2(".");
+ }
+ if (ex->val.i)
+ out_field((Meaning *)ex->val.i);
+ else
+ output(ex->val.s);
+ break;
+
+ case EK_POSTINC:
+ if (prec == 0 && !postincrement) {
+ setprec(14);
+ output("++");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec);
+ } else {
+ setprec(15);
+ wrexpr(ex->args[0], subprec);
+ EXTRASPACE();
+ output("++");
+ }
+ break;
+
+ case EK_POSTDEC:
+ if (prec == 0 && !postincrement) {
+ setprec(14);
+ output("--");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec);
+ } else {
+ setprec(15);
+ wrexpr(ex->args[0], subprec);
+ EXTRASPACE();
+ output("--");
+ }
+ break;
+
+ case EK_HAT:
+ setprec(14);
+ if (lookback_prn(1) == '/')
+ output(" ");
+ output("*");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec-1);
+ break;
+
+ case EK_ADDR:
+ setprec(14);
+ if (lookback_prn(1) == '&')
+ output(" ");
+ output("&");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec-1);
+ break;
+
+ case EK_NEG:
+ setprec(14);
+ output("-");
+ EXTRASPACE();
+ if (ex->args[0]->kind == EK_TIMES)
+ wrexpr(ex->args[0], 12);
+ else
+ wrexpr(ex->args[0], subprec-1);
+ break;
+
+ case EK_NOT:
+ setprec(14);
+ output("!");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec-1);
+ break;
+
+ case EK_BNOT:
+ setprec(14);
+ output("~");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec-1);
+ break;
+
+ case EK_CAST:
+ case EK_ACTCAST:
+ if (similartypes(ex->val.type, ex->args[0]->val.type)) {
+ wrexpr(ex->args[0], prec);
+ } else if (ord_type(ex->args[0]->val.type)->kind == TK_ENUM &&
+ ex->val.type == tp_int && !useenum) {
+ wrexpr(ex->args[0], prec);
+ } else {
+ setprec2(14);
+ output("(");
+ out_type(ex->val.type, 0);
+ output(")\002");
+ EXTRASPACE();
+ if (extraparens != 0)
+ wrexpr(ex->args[0], 15);
+ else
+ wrexpr(ex->args[0], subprec-1);
+ }
+ break;
+
+ case EK_LITCAST:
+ setprec2(14);
+ output("(");
+ out_expr(ex->args[0]);
+ output(")\002");
+ EXTRASPACE();
+ if (extraparens != 0)
+ wrexpr(ex->args[1], 15);
+ else
+ wrexpr(ex->args[1], subprec-1);
+ break;
+
+ case EK_SIZEOF:
+ setprec(14);
+ output("sizeof");
+ if (spacefuncs)
+ output(" ");
+ output("(");
+ out_expr(ex->args[0]);
+ output(")");
+ break;
+
+ case EK_TYPENAME:
+ out_type(ex->val.type, 1);
+ break;
+
+ case EK_TIMES:
+ setprec2(13);
+ checkbreak(breakbeforearith);
+ ex2 = copyexpr(ex);
+ if (expr_looks_neg(ex2->args[ex2->nargs-1])) {
+ ex2->args[0] = makeexpr_neg(ex2->args[0]);
+ ex2->args[ex2->nargs-1] = makeexpr_neg(ex2->args[ex2->nargs-1]);
+ }
+ wrexpr(ex2->args[0], incompat(ex2, 0, subprec-1));
+ for (i = 1; i < ex2->nargs; i++) {
+ outop("*");
+ wrexpr(ex2->args[i], incompat(ex2, i, subprec));
+ }
+ freeexpr(ex2);
+ break;
+
+ case EK_DIV:
+ case EK_DIVIDE:
+ setprec2(13);
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("/");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec));
+ break;
+
+ case EK_MOD:
+ setprec2(13);
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("%");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec));
+ break;
+
+ case EK_PLUS:
+ setprec2(12);
+ checkbreak(breakbeforearith);
+ ex2 = copyexpr(ex);
+ minusflag = 0;
+ if (expr_looks_neg(ex2->args[0])) {
+ j = 1;
+ while (j < ex2->nargs && expr_looks_neg(ex2->args[j])) j++;
+ if (j < ex2->nargs)
+ swapexprs(ex2->args[0], ex2->args[j]);
+ } else if (ex2->val.i && ex2->nargs == 2) { /* this was originally "a-b" */
+ if (isliteralconst(ex2->args[1], NULL) != 2) {
+ if (expr_neg_cost(ex2->args[1]) <= 0) {
+ minusflag = 1;
+ } else if (expr_neg_cost(ex2->args[0]) <= 0) {
+ swapexprs(ex2->args[0], ex2->args[1]);
+ if (isliteralconst(ex2->args[0], NULL) != 2)
+ minusflag = 1;
+ }
+ }
+ }
+ wrexpr(ex2->args[0], incompat(ex, 0, subprec));
+ for (i = 1; i < ex2->nargs; i++) {
+ if (expr_looks_neg(ex2->args[i]) || minusflag) {
+ outop("-");
+ ex2->args[i] = makeexpr_neg(ex2->args[i]);
+ } else
+ outop("+");
+ wrexpr(ex2->args[i], incompat(ex, i, subprec));
+ }
+ freeexpr(ex2);
+ break;
+
+ case EK_LSH:
+ setprec3(11);
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop("<<");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec));
+ break;
+
+ case EK_RSH:
+ setprec3(11);
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop(">>");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec));
+ break;
+
+ case EK_LT:
+ setprec2(10);
+ checkbreak(breakbeforerel);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop("<");
+ wrexpr(ex->args[1], incompat(ex, 0, subprec));
+ break;
+
+ case EK_GT:
+ setprec2(10);
+ checkbreak(breakbeforerel);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop(">");
+ wrexpr(ex->args[1], incompat(ex, 0, subprec));
+ break;
+
+ case EK_LE:
+ setprec2(10);
+ checkbreak(breakbeforerel);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop("<=");
+ wrexpr(ex->args[1], incompat(ex, 0, subprec));
+ break;
+
+ case EK_GE:
+ setprec2(10);
+ checkbreak(breakbeforerel);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop(">=");
+ wrexpr(ex->args[1], incompat(ex, 0, subprec));
+ break;
+
+ case EK_EQ:
+ setprec2(9);
+ checkbreak(breakbeforerel);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop("==");
+ wrexpr(ex->args[1], incompat(ex, 0, subprec));
+ break;
+
+ case EK_NE:
+ setprec2(9);
+ checkbreak(breakbeforerel);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec));
+ outop("!=");
+ wrexpr(ex->args[1], incompat(ex, 0, subprec));
+ break;
+
+ case EK_BAND:
+ setprec3(8);
+ if (ex->val.type == tp_boolean)
+ checkbreak(breakbeforelog);
+ else
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("&");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+ break;
+
+ case EK_BXOR:
+ setprec3(7);
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("^");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+ break;
+
+ case EK_BOR:
+ setprec3(6);
+ if (ex->val.type == tp_boolean)
+ checkbreak(breakbeforelog);
+ else
+ checkbreak(breakbeforearith);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("|");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+ break;
+
+ case EK_AND:
+ setprec3(5);
+ checkbreak(breakbeforelog);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("&&");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+ break;
+
+ case EK_OR:
+ setprec3(4);
+ checkbreak(breakbeforelog);
+ wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
+ outop("||");
+ wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
+ break;
+
+ case EK_COND:
+ setprec3(3);
+ i = 0;
+ for (;;) {
+ i++;
+ if (extraparens != 0)
+ wrexpr(ex->args[0], 15);
+ else
+ wrexpr(ex->args[0], subprec);
+ NICESPACE();
+ output("\002?");
+ NICESPACE();
+ out_expr(ex->args[1]);
+ if (ex->args[2]->kind == EK_COND) {
+ NICESPACE();
+ output("\002:");
+ NICESPACE();
+ ex = ex->args[2];
+ } else {
+ NICESPACE();
+ output((i == 1) ? "\017:" : "\002:");
+ NICESPACE();
+ wrexpr(ex->args[2], subprec-1);
+ break;
+ }
+ }
+ break;
+
+ case EK_ASSIGN:
+ if (ex->args[1]->kind == EK_PLUS &&
+ exprsame(ex->args[1]->args[0], ex->args[0], 2) &&
+ ex->args[1]->args[1]->kind == EK_CONST &&
+ ex->args[1]->args[1]->val.type->kind == TK_INTEGER &&
+ abs(ex->args[1]->args[1]->val.i) == 1) {
+ if (prec == 0 && postincrement) {
+ setprec(15);
+ wrexpr(ex->args[0], subprec);
+ EXTRASPACE();
+ if (ex->args[1]->args[1]->val.i == 1)
+ output("++");
+ else
+ output("--");
+ } else {
+ setprec(14);
+ if (ex->args[1]->args[1]->val.i == 1)
+ output("++");
+ else
+ output("--");
+ EXTRASPACE();
+ wrexpr(ex->args[0], subprec-1);
+ }
+ } else {
+ setprec2(2);
+ checkbreak(breakbeforeassign);
+ wrexpr(ex->args[0], subprec);
+ ex2 = copyexpr(ex->args[1]);
+ j = -1;
+ switch (ex2->kind) {
+
+ case EK_PLUS:
+ case EK_TIMES:
+ case EK_BAND:
+ case EK_BOR:
+ case EK_BXOR:
+ for (i = 0; i < ex2->nargs; i++) {
+ if (exprsame(ex->args[0], ex2->args[i], 2)) {
+ j = i;
+ break;
+ }
+ if (ex2->val.type->kind == TK_REAL)
+ break; /* non-commutative */
+ }
+ break;
+
+ case EK_DIVIDE:
+ case EK_DIV:
+ case EK_MOD:
+ case EK_LSH:
+ case EK_RSH:
+ if (exprsame(ex->args[0], ex2->args[0], 2))
+ j = 0;
+ break;
+
+ default:
+ break;
+ }
+ if (j >= 0) {
+ if (ex2->nargs == 2)
+ ex2 = grabarg(ex2, 1-j);
+ else
+ delfreearg(&ex2, j);
+ switch (ex->args[1]->kind) {
+
+ case EK_PLUS:
+ if (expr_looks_neg(ex2)) {
+ outop("-=");
+ ex2 = makeexpr_neg(ex2);
+ } else
+ outop("+=");
+ break;
+
+ case EK_TIMES:
+ outop("*=");
+ break;
+
+ case EK_DIVIDE:
+ case EK_DIV:
+ outop("/=");
+ break;
+
+ case EK_MOD:
+ outop("%=");
+ break;
+
+ case EK_LSH:
+ outop("<<=");
+ break;
+
+ case EK_RSH:
+ outop(">>=");
+ break;
+
+ case EK_BAND:
+ outop("&=");
+ break;
+
+ case EK_BOR:
+ outop("|=");
+ break;
+
+ case EK_BXOR:
+ outop("^=");
+ break;
+
+ default:
+ break;
+ }
+ } else {
+ output(" ");
+ outop3(breakbeforeassign, "=");
+ output(" ");
+ }
+ if (extraparens != 0 &&
+ (ex2->kind == EK_EQ || ex2->kind == EK_NE ||
+ ex2->kind == EK_GT || ex2->kind == EK_LT ||
+ ex2->kind == EK_GE || ex2->kind == EK_LE ||
+ ex2->kind == EK_AND || ex2->kind == EK_OR))
+ wrexpr(ex2, 16);
+ else
+ wrexpr(ex2, subprec-1);
+ freeexpr(ex2);
+ }
+ break;
+
+ case EK_COMMA:
+ setprec3(1);
+ for (i = 0; i < ex->nargs-1; i++) {
+ wrexpr(ex->args[i], subprec);
+ output(",\002");
+ if (spacecommas)
+ NICESPACE();
+ }
+ wrexpr(ex->args[ex->nargs-1], subprec);
+ break;
+
+ default:
+ intwarning("wrexpr", "bad ex->kind [311]");
+ }
+ switch (parens) {
+ case 1:
+ output(")");
+ break;
+ case 2:
+ output("\004");
+ break;
+ }
+ }
+
+
+
+ /* will parenthesize assignments and "," operators */
+
+ void out_expr(ex)
+ Expr *ex;
+ {
+ wrexpr(ex, 2);
+ }
+
+
+
+ /* will not parenthesize anything at top level */
+
+ void out_expr_top(ex)
+ Expr *ex;
+ {
+ wrexpr(ex, 0);
+ }
+
+
+
+ /* will parenthesize unless only writing a factor */
+
+ void out_expr_factor(ex)
+ Expr *ex;
+ {
+ wrexpr(ex, 15);
+ }
+
+
+
+ /* will parenthesize always */
+
+ void out_expr_parens(ex)
+ Expr *ex;
+ {
+ output("(");
+ wrexpr(ex, 1);
+ output(")");
+ }
+
+
+
+ /* evaluate expression for side effects only */
+ /* no top-level parentheses */
+
+ void out_expr_stmt(ex)
+ Expr *ex;
+ {
+ wrexpr(ex, 0);
+ }
+
+
+
+ /* evaluate expression for boolean (zero/non-zero) result only */
+ /* parenthesizes like out_expr() */
+
+ void out_expr_bool(ex)
+ Expr *ex;
+ {
+ wrexpr(ex, 2);
+ }
+
+
+
+
+ /* End. */
+
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/stuff.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/stuff.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:23 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/stuff.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,839 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+ #define PROTO_STUFF_C
+ #include "trans.h"
+
+
+
+
+
+
+ /* Called regularly, for debugging purposes */
+
+ void debughook()
+ {
+ #if 0
+ Symbol *sp;
+ Meaning *mp;
+ static int flag = 0;
+
+ sp = findsymbol_opt("DEFSTIPPLES");
+ if (sp) {
+ mp = sp->mbase;
+ if (mp) {
+ flag = 1;
+ if (mp->sym != sp || mp->snext)
+ intwarning("debughook", "Inconsistent!");
+ } else
+ if (flag)
+ intwarning("debughook", "Missing!");
+ }
+ #endif
+ }
+
+
+
+
+
+
+ /* The "Strlist" data type, like in NEWASM */
+
+
+ /* Add a string to end of strlist */
+
+ Strlist *strlist_append(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+ register Strlist *p;
+
+ while (*base)
+ base = &(*base)->next;
+ *base = p = ALLOCV(sizeof(Strlist) + strlen(s), Strlist, strlists);
+ p->next = NULL;
+ p->value = 0;
+ strcpy(p->s, s);
+ return p;
+ }
+
+
+
+ /* Insert a string at front of strlist */
+
+ Strlist *strlist_insert(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+ register Strlist *p;
+
+ p = ALLOCV(sizeof(Strlist) + strlen(s), Strlist, strlists);
+ p->next = *base;
+ *base = p;
+ p->value = 0;
+ strcpy(p->s, s);
+ return p;
+ }
+
+
+
+ /* Add a string to a sorted strlist */
+
+ Strlist *strlist_add(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+ register Strlist *p;
+
+ while ((p = *base) && strcmp(p->s, s) < 0)
+ base = &p->next;
+ if (!p || strcmp(p->s, s)) {
+ p = ALLOCV(sizeof(Strlist) + strlen(s), Strlist, strlists);
+ p->next = *base;
+ *base = p;
+ strcpy(p->s, s);
+ }
+ p->value = 0;
+ return p;
+ }
+
+
+
+ /* Append two strlists together */
+
+ void strlist_mix(base, sl)
+ register Strlist **base;
+ Strlist *sl;
+ {
+ if (sl) {
+ while (*base)
+ base = &(*base)->next;
+ *base = sl;
+ }
+ }
+
+
+
+ /* Remove the first element of a strlist */
+
+ void strlist_eat(base)
+ register Strlist **base;
+ {
+ register Strlist *p;
+
+ if ((p = *base) != NULL) {
+ *base = p->next;
+ FREE(p);
+ }
+ }
+
+
+
+ /* Remove all elements of a strlist */
+
+ void strlist_empty(base)
+ register Strlist **base;
+ {
+ register Strlist *p;
+
+ if (!base) {
+ intwarning("strlist_empty", "NULL base pointer [312]");
+ return;
+ }
+ while ((p = *base) != NULL) {
+ *base = p->next;
+ FREE(p);
+ }
+ }
+
+
+
+ /* Remove first occurrence of a given string */
+
+ void strlist_remove(base, s)
+ register Strlist **base;
+ register char *s;
+ {
+ register Strlist *p;
+
+ while ((p = *base) != NULL) {
+ if (!strcmp(p->s, s)) {
+ *base = p->next;
+ FREE(p);
+ } else
+ base = &p->next;
+ }
+ }
+
+
+
+ /* Remove a given entry from a strlist */
+
+ void strlist_delete(base, sl)
+ register Strlist **base, *sl;
+ {
+ register Strlist *p;
+
+ while ((p = *base) && p != sl)
+ base = &p->next;
+ if (p) {
+ *base = p->next;
+ FREE(p);
+ }
+ }
+
+
+
+ /* Find the first occurrence of a string */
+
+ Strlist *strlist_find(base, s)
+ register Strlist *base;
+ register char *s;
+ {
+ if (!s)
+ return NULL;
+ while (base && strcmp(base->s, s))
+ base = base->next;
+ return base;
+ }
+
+
+
+ /* Case-insensitive version of strlist_find */
+
+ Strlist *strlist_cifind(base, s)
+ register Strlist *base;
+ register char *s;
+ {
+ if (!s)
+ return NULL;
+ while (base && strcicmp(base->s, s))
+ base = base->next;
+ return base;
+ }
+
+
+
+
+
+
+ /* String comparisons */
+
+
+ int strcincmp(s1, s2, n)
+ register char *s1, *s2;
+ register int n;
+ {
+ register unsigned char ch1, ch2;
+
+ while (--n >= 0) {
+ if (!(ch1 = *s1++))
+ return (*s2) ? -1 : 0;
+ if (!(ch2 = *s2++))
+ return 1;
+ if (islower(ch1))
+ ch1 = _toupper(ch1);
+ if (islower(ch2))
+ ch2 = _toupper(ch2);
+ if (ch1 != ch2)
+ return ch1 - ch2;
+ }
+ return 0;
+ }
+
+
+
+ int strcicmp(s1, s2)
+ register char *s1, *s2;
+ {
+ register unsigned char ch1, ch2;
+
+ for (;;) {
+ if (!(ch1 = *s1++))
+ return (*s2) ? -1 : 0;
+ if (!(ch2 = *s2++))
+ return 1;
+ if (islower(ch1))
+ ch1 = _toupper(ch1);
+ if (islower(ch2))
+ ch2 = _toupper(ch2);
+ if (ch1 != ch2)
+ return ch1 - ch2;
+ }
+ }
+
+
+
+
+
+
+ /* File name munching */
+
+
+ void fixfname(fn, ext)
+ char *fn, *ext;
+ {
+ char *cp, *cp2;
+
+ if (!ext)
+ return;
+ cp = my_strrchr(fn, '.');
+ cp2 = my_strrchr(fn, '/');
+ if (cp && (!cp2 || cp > cp2)) {
+ if (!cp[1]) /* remove trailing '.' */
+ *cp = 0;
+ } else {
+ strcat(fn, ".");
+ strcat(fn, ext);
+ }
+ }
+
+
+
+ void removesuffix(fn)
+ char *fn;
+ {
+ char *cp, *cp2;
+
+ cp = my_strrchr(fn, '.');
+ if (!cp)
+ return;
+ #if defined(unix) || defined(__unix)
+ cp2 = my_strrchr(fn, '/');
+ if (cp2 && cp < cp2)
+ return;
+ #endif
+ *cp = 0;
+ }
+
+
+
+
+
+
+ /* Dynamically-allocated strings */
+
+
+ char *stralloc(s)
+ char *s;
+ {
+ register char *buf = ALLOC(strlen(s) + 1, char, strings);
+ strcpy(buf, s);
+ return buf;
+ }
+
+
+
+ void strchange(v, s)
+ char **v, *s;
+ {
+ s = stralloc(s); /* do this first in case **v and *s overlap */
+ FREE(*v);
+ *v = s;
+ }
+
+
+
+
+
+ /* Handy string formatting */
+
+ #define NUMBUF 8
+ static char *(formatbuf[NUMBUF]);
+ static int nextformat = -1;
+
+ #define getformat() ((nextformat=(nextformat+1)%NUMBUF), formatbuf[nextformat])
+
+
+ #define FF_UCASE 0x1
+ #define FF_LCASE 0x2
+ #define FF_REMSUFF 0x4
+ #define FF_UNDER 0x8 /* Thanks to William Bader for suggesting these */
+ #define FF_PRESERVE 0x10
+ #define FF_REMSLASH 0x20
+ #define FF_REMUNDER 0x40
+
+ Static void cvcase(buf, flags)
+ char *buf;
+ int flags;
+ {
+ char *cp, *cp2;
+ int ulflag, i;
+
+ if (flags & FF_PRESERVE) {
+ ulflag = 0;
+ for (cp = buf; *cp; cp++) {
+ if (isupper(*cp))
+ ulflag |= 1;
+ else if (islower(*cp))
+ ulflag |= 2;
+ }
+ if (ulflag == 3)
+ flags &= ~(FF_UCASE | FF_LCASE);
+ }
+ if ((flags & FF_UNDER) && *buf) {
+ for (cp = buf + 1; *cp; cp++) {
+ if (isupper(*cp) && islower(cp[-1])) {
+ for (i = strlen(cp); i >= 0; i--)
+ cp[i+1] = cp[i];
+ *cp++ = '_';
+ }
+ }
+ }
+ if (flags & FF_UCASE) {
+ if (flags & FF_LCASE) {
+ for (cp = buf; *cp; cp++) {
+ if (cp == buf || !isalpha(cp[-1]))
+ *cp = toupper(*cp);
+ else
+ *cp = tolower(*cp);
+ }
+ } else
+ upc(buf);
+ } else if (flags & FF_LCASE)
+ lwc(buf);
+ if (flags & FF_REMUNDER) {
+ for (cp = cp2 = buf; *cp; cp++) {
+ if (isalnum(*cp))
+ *cp2++ = *cp;
+ }
+ if (cp2 > buf)
+ *cp2 = 0;
+ }
+ }
+
+
+ char *format_gen(fmt, i1, i2, dbl, s1, s2, s3)
+ char *fmt;
+ long i1, i2;
+ double dbl;
+ char *s1, *s2, *s3;
+ {
+ char *buf = getformat();
+ char *dst = buf, *src = fmt, *cp, *cp2, *saves2 = s2;
+ int wid, prec;
+ int flags;
+ char fmtbuf[50], *fp;
+
+ debughook();
+ while (*src) {
+ if (*src != '%') {
+ *dst++ = *src++;
+ continue;
+ }
+ src++;
+ wid = -1;
+ prec = -1;
+ flags = 0;
+ fp = fmtbuf;
+ *fp++ = '%';
+ for (;;) {
+ if (*src == '-' || *src == '+' || *src == ' ' || *src == '#') {
+ *fp++ = *src;
+ } else if (*src == '^') {
+ flags |= FF_UCASE;
+ } else if (*src == '_') {
+ flags |= FF_LCASE;
+ } else if (*src == 'R') {
+ flags |= FF_REMSUFF;
+ } else if (*src == '~') {
+ flags |= FF_UNDER;
+ } else if (*src == '!') {
+ flags |= FF_REMUNDER;
+ } else if (*src == '?') {
+ flags |= FF_PRESERVE;
+ } else if (*src == '/') {
+ flags |= FF_REMSLASH;
+ } else
+ break;
+ src++;
+ }
+ if (isdigit(*src)) {
+ wid = 0;
+ while (isdigit(*src))
+ wid = wid*10 + (*fp++ = *src++) - '0';
+ } else if (*src == '*') {
+ src++;
+ wid = i1;
+ sprintf(fp, "%d", wid);
+ fp = fp + strlen(fp);
+ if (wid < 0)
+ wid = -wid;
+ i1 = i2;
+ }
+ if (*src == '.') {
+ if (*++src == '*') {
+ prec = i1;
+ i1 = i2;
+ src++;
+ } else {
+ prec = 0;
+ while (isdigit(*src))
+ prec = prec*10 + (*src++) - '0';
+ }
+ sprintf(fp, ".%d", prec);
+ fp = fp + strlen(fp);
+ }
+ if (*src == 'l' || *src == 'h')
+ src++;
+ switch (*src) {
+
+ case '%':
+ *dst++ = '%';
+ break;
+
+ case 'H':
+ strcpy(dst, p2c_home);
+ dst = dst + strlen(dst);
+ break;
+
+ case 'd':
+ case 'i':
+ case 'o':
+ case 'u':
+ case 'x':
+ case 'X':
+ *fp++ = 'l';
+ *fp++ = *src;
+ *fp = 0;
+ sprintf(dst, fmtbuf, i1);
+ i1 = i2;
+ cvcase(dst, flags);
+ dst = dst + strlen(dst);
+ break;
+
+ case 'c':
+ *fp++ = *src;
+ *fp = 0;
+ sprintf(dst, fmtbuf, (int)i1);
+ i1 = i2;
+ cvcase(dst, flags);
+ dst = dst + strlen(dst);
+ break;
+
+ case 'e':
+ case 'E':
+ case 'f':
+ case 'g':
+ case 'G':
+ *fp++ = *src;
+ *fp++ = 0;
+ sprintf(dst, fmtbuf, dbl);
+ cvcase(dst, flags);
+ dst = dst + strlen(dst);
+ break;
+
+ case 's':
+ case 'S':
+ *fp++ = 's';
+ *fp = 0;
+ if (*src == 'S' && saves2) {
+ cp = saves2;
+ } else {
+ cp = s1;
+ s1 = s2;
+ s2 = s3;
+ }
+ if (flags & FF_REMSUFF) {
+ cp = format_s("%s", cp);
+ removesuffix(cp);
+ }
+ if (flags & FF_REMSLASH) {
+ cp2 = cp + strlen(cp);
+ while (cp2 >= cp &&
+ *cp2 != '/' && *cp2 != '\\' &&
+ *cp2 != ']' && *cp2 != ':')
+ cp2--;
+ if (cp2[1])
+ cp = cp2 + 1;
+ }
+ sprintf(dst, fmtbuf, cp);
+ cvcase(dst, flags);
+ dst = dst + strlen(dst);
+ break;
+
+ }
+ src++;
+ }
+ *dst = 0;
+ return buf;
+ }
+
+
+
+
+ char *format_none(fmt)
+ char *fmt;
+ {
+ return format_gen(fmt, 0L, 0L, 0.0, NULL, NULL, NULL);
+ }
+
+
+ char *format_d(fmt, a1)
+ char *fmt;
+ int a1;
+ {
+ return format_gen(fmt, a1, 0L, (double)a1, NULL, NULL, NULL);
+ }
+
+
+ char *format_g(fmt, a1)
+ char *fmt;
+ double a1;
+ {
+ return format_gen(fmt, (long)a1, 0L, a1, NULL, NULL, NULL);
+ }
+
+
+ char *format_s(fmt, a1)
+ char *fmt, *a1;
+ {
+ return format_gen(fmt, 0L, 0L, 0.0, a1, NULL, NULL);
+ }
+
+
+ char *format_ss(fmt, a1, a2)
+ char *fmt, *a1, *a2;
+ {
+ return format_gen(fmt, 0L, 0L, 0.0, a1, a2, NULL);
+ }
+
+
+ char *format_sd(fmt, a1, a2)
+ char *fmt, *a1;
+ int a2;
+ {
+ return format_gen(fmt, a2, 0L, (double)a2, a1, NULL, NULL);
+ }
+
+
+ char *format_ds(fmt, a1, a2)
+ char *fmt, *a2;
+ long a1;
+ {
+ return format_gen(fmt, a1, 0L, (double)a1, a2, NULL, NULL);
+ }
+
+
+ char *format_dd(fmt, a1, a2)
+ char *fmt;
+ long a1, a2;
+ {
+ return format_gen(fmt, a1, a2, (double)a1, NULL, NULL, NULL);
+ }
+
+
+ char *format_sss(fmt, a1, a2, a3)
+ char *fmt, *a1, *a2, *a3;
+ {
+ return format_gen(fmt, 0L, 0L, 0.0, a1, a2, a3);
+ }
+
+
+ char *format_ssd(fmt, a1, a2, a3)
+ char *fmt, *a1, *a2;
+ long a3;
+ {
+ return format_gen(fmt, a3, 0L, (double)a3, a1, a2, NULL);
+ }
+
+
+ char *format_sds(fmt, a1, a2, a3)
+ char *fmt, *a1, *a3;
+ long a2;
+ {
+ return format_gen(fmt, a2, 0L, (double)a2, a1, a3, NULL);
+ }
+
+
+
+
+ /* String conversions */
+
+ int my_toupper(c)
+ int c;
+ {
+ if (islower(c))
+ return _toupper(c);
+ else
+ return c;
+ }
+
+
+ int my_tolower(c)
+ int c;
+ {
+ if (isupper(c))
+ return _tolower(c);
+ else
+ return c;
+ }
+
+
+ void upc(s)
+ register char *s;
+ {
+ for (; *s; s++)
+ *s = toupper(*s);
+ }
+
+
+ void lwc(s)
+ register char *s;
+ {
+ for (; *s; s++)
+ *s = tolower(*s);
+ }
+
+
+ char *strupper(s)
+ register char *s;
+ {
+ char *dest = getformat();
+ register char *s2 = dest;
+ while (*s)
+ *s2++ = toupper(*s++);
+ *s2 = 0;
+ return dest;
+ }
+
+
+ char *strlower(s)
+ register char *s;
+ {
+ char *dest = getformat();
+ register char *s2 = dest;
+ while (*s)
+ *s2++ = tolower(*s++);
+ *s2 = 0;
+ return dest;
+ }
+
+
+
+ char *my_strchr(cp, c)
+ register char *cp;
+ int c;
+ {
+ while (*cp && *cp != c)
+ cp++;
+ if (*cp)
+ return cp;
+ else
+ return NULL;
+ }
+
+
+ char *my_strrchr(cp, c)
+ register char *cp;
+ int c;
+ {
+ register char *cp2 = NULL;
+ while (*cp) {
+ if (*cp == c)
+ cp2 = cp;
+ cp++;
+ }
+ return cp2;
+ }
+
+
+ char *my_strtok(cp, delim)
+ char *cp, *delim;
+ {
+ static char *ptr;
+
+ if (cp)
+ ptr = cp;
+ while (*ptr && my_strchr(delim, *ptr))
+ ptr++;
+ if (!*ptr)
+ return NULL;
+ cp = ptr;
+ while (*ptr && !my_strchr(delim, *ptr))
+ ptr++;
+ *ptr++ = 0;
+ return cp;
+ }
+
+
+
+ long my_strtol(buf, ret, base)
+ char *buf, **ret;
+ int base;
+ {
+ unsigned long val = 0;
+ int dig, sign = 1;
+
+ while (isspace(*buf))
+ buf++;
+ if (*buf == '+')
+ buf++;
+ else if (*buf == '-') {
+ sign = -1;
+ buf++;
+ }
+ if (*buf == '0') {
+ if ((buf[1] == 'x' || buf[1] == 'X') &&
+ (base == 0 || base == 16)) {
+ buf++;
+ base = 16;
+ } else if (base == 0)
+ base = 8;
+ buf++;
+ }
+ for (;;) {
+ if (isdigit(*buf))
+ dig = *buf - '0';
+ else if (*buf >= 'a')
+ dig = *buf - 'a' + 10;
+ else if (*buf >= 'A')
+ dig = *buf - 'A' + 10;
+ else
+ break;
+ if (dig >= base)
+ break;
+ val = val * base + dig;
+ buf++;
+ }
+ if (ret)
+ *ret = buf;
+ if (sign > 0)
+ return val;
+ else
+ return -val;
+ }
+
+
+
+
+ void init_stuff()
+ {
+ int i;
+
+ for (i = 0; i < NUMBUF; i++)
+ formatbuf[i] = ALLOC(1000, char, misc);
+ }
+
+
+
+
+ /* End. */
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.c
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.c:1.1.2.1
*** /dev/null Mon Mar 1 17:59:23 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.c Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,1512 ----
+ /* "p2c", a Pascal to C translator.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+
+ #define define_globals
+ #define PROTO_TRANS_C
+ #include "trans.h"
+
+ #include <time.h>
+
+
+
+
+
+
+ /* Roadmap:
+
+ trans.h Declarations for all public global variables, types,
+ and macros. Functions are declared in separate
+ files p2c.{proto,hdrs} which are created
+ mechanically by the makeproto program.
+
+ trans.c Main program. Parses the p2crc file. Also reserves
+ storage for public globals in trans.h.
+
+ stuff.c Miscellaneous support routines.
+
+ out.c Routines to handle the writing of C code to the output
+ file. This includes line breaking and indentation
+ support.
+
+ comment.c Routines for managing comments and comment lists.
+
+ lex.c Lexical analyzer. Manages input files and streams,
+ splits input stream into Pascal tokens. Parses
+ compiler directives and special comments. Also keeps
+ the symbol table.
+
+ parse.c Parsing and writing statements and blocks.
+
+ decl.c Parsing and writing declarations.
+
+ expr.c Manipulating expressions.
+
+ pexpr.c Parsing and writing expressions.
+
+ funcs.c Built-in special functions and procedures.
+
+ dir.c Interface file to "external" functions and procedures
+ such as hpmods and citmods.
+
+ hpmods.c Definitions for HP-supplied Pascal modules.
+
+ citmods.c Definitions for some Caltech-local Pascal modules.
+ (Outside of Caltech this file is mostly useful
+ as a large body of examples of how to write your
+ own translator extensions.)
+
+
+ p2crc Control file (read when p2c starts up).
+
+ p2c.h Header file used by translated programs.
+
+ p2clib.c Run-time library used by translated programs.
+
+ */
+
+
+
+
+ Static Strlist *tweaksymbols, *synonyms;
+ Strlist *addmacros;
+
+
+
+ Static void initrc()
+ {
+ int i;
+
+ for (i = 0; i < numparams; i++) {
+ switch (rctable[i].kind) {
+ case 'S':
+ case 'B':
+ *((short *)rctable[i].ptr) = rctable[i].def;
+ break;
+ case 'I':
+ case 'D':
+ *((int *)rctable[i].ptr) = rctable[i].def;
+ break;
+ case 'L':
+ *((long *)rctable[i].ptr) = rctable[i].def;
+ break;
+ case 'R':
+ *((double *)rctable[i].ptr) = rctable[i].def/100.0;
+ break;
+ case 'U':
+ case 'C':
+ *((char *)rctable[i].ptr) = 0;
+ break;
+ case 'A':
+ *((Strlist **)rctable[i].ptr) = NULL;
+ break;
+ case 'X':
+ if (rctable[i].def == 1)
+ *((Strlist **)rctable[i].ptr) = NULL;
+ break;
+ }
+ rcprevvalues[i] = NULL;
+ }
+ tweaksymbols = NULL;
+ synonyms = NULL;
+ addmacros = NULL;
+ varmacros = NULL;
+ constmacros = NULL;
+ fieldmacros = NULL;
+ funcmacros = NULL;
+ }
+
+
+
+ Static int readrc(rcname, need)
+ char *rcname;
+ int need;
+ {
+ FILE *rc;
+ char buf[500], *cp, *cp2;
+ long val = 0;
+ int i;
+ Strlist *sl;
+
+ rc = fopen(rcname, "r");
+ if (!rc) {
+ if (need)
+ perror(rcname);
+ return 0;
+ }
+ while (fgets(buf, 500, rc)) {
+ cp = my_strtok(buf, " =\t\n");
+ if (cp && *cp != '#') {
+ upc(cp);
+ i = numparams;
+ while (--i >= 0 && strcmp(rctable[i].name, cp)) ;
+ if (i >= 0) {
+ if (rctable[i].kind != 'M') {
+ cp = my_strtok(NULL, " =\t\n");
+ if (cp && *cp == '#')
+ cp = NULL;
+ if (cp && (isdigit(*cp) || *cp == '-' || *cp == '+'))
+ val = atol(cp);
+ else
+ val = rctable[i].def;
+ }
+ switch (rctable[i].kind) {
+
+ case 'S':
+ *((short *)rctable[i].ptr) = val;
+ break;
+
+ case 'I':
+ *((int *)rctable[i].ptr) = val;
+ break;
+
+ case 'D':
+ *((int *)rctable[i].ptr) =
+ parsedelta(cp, rctable[i].def);
+ break;
+
+ case 'L':
+ *((long *)rctable[i].ptr) = val;
+ break;
+
+ case 'R':
+ if (cp && (isdigit(*cp) || *cp == '-' || *cp == '.'))
+ *((double *)rctable[i].ptr) = atof(cp);
+ else
+ *((double *)rctable[i].ptr) = rctable[i].def/100.0;
+ break;
+
+ case 'U':
+ if (cp)
+ upc(cp);
+
+ /* fall through */
+ case 'C':
+ val = rctable[i].def;
+ strncpy((char *)rctable[i].ptr, cp ? cp : "", val-1);
+ ((char *)rctable[i].ptr)[val-1] = 0;
+ break;
+
+ case 'F':
+ while (cp && *cp != '#') {
+ sl = strlist_append(&tweaksymbols,
+ format_s("*%s", cp));
+ sl->value = rctable[i].def;
+ cp = my_strtok(NULL, " \t\n");
+ }
+ break;
+
+ case 'G':
+ while (cp && *cp != '#') {
+ sl = strlist_append(&tweaksymbols, cp);
+ sl->value = rctable[i].def;
+ cp = my_strtok(NULL, " \t\n");
+ }
+ break;
+
+ case 'A':
+ while (cp && *cp != '#') {
+ strlist_insert((Strlist **)rctable[i].ptr, cp);
+ cp = my_strtok(NULL, " \t\n");
+ }
+ break;
+
+ case 'M':
+ cp = my_strtok(NULL, "\n");
+ if (cp) {
+ while (isspace(*cp)) cp++;
+ for (cp2 = cp; *cp2 && *cp2 != '#'; cp2++) ;
+ *cp2 = 0;
+ if (*cp) {
+ sl = strlist_append(&addmacros, cp);
+ sl->value = rctable[i].def;
+ }
+ }
+ break;
+
+ case 'B':
+ if (cp)
+ val = parse_breakstr(cp);
+ if (val != -1)
+ *((short *)rctable[i].ptr) = val;
+ break;
+
+ case 'X':
+ switch (rctable[i].def) {
+
+ case 1: /* strlist with string values */
+ if (cp) {
+ sl = strlist_append((Strlist **)rctable[i].ptr, cp);
+ cp = my_strtok(NULL, " =\t\n");
+ if (cp && *cp != '#')
+ sl->value = (long)stralloc(cp);
+ }
+ break;
+
+ case 2: /* Include */
+ if (cp)
+ readrc(format_s(cp, infname), 1);
+ break;
+
+ case 3: /* Synonym */
+ if (cp) {
+ sl = strlist_append(&synonyms, cp);
+ cp = my_strtok(NULL, " =\t\n");
+ if (cp && *cp != '#')
+ sl->value = (long)stralloc(cp);
+ }
+ break;
+
+ }
+ }
+ } else
+ fprintf(stderr, "warning: can't understand %s in %s\n", cp, rcname);
+ }
+ }
+ fclose(rc);
+ return 1;
+ }
+
+
+ Static void postrc()
+ {
+ int longbits;
+ unsigned long val;
+
+ which_unix = UNIX_ANY;
+ if (!strcmp(target, "CHIPMUNK") ||
+ !strcmp(target, "HPUX-300") ||
+ !strcmp(target, "SUN-68K") ||
+ !strcmp(target, "BSD-VAX")) {
+ signedchars = 1;
+ sizeof_char = 8;
+ sizeof_short = 16;
+ sizeof_int = sizeof_long = sizeof_pointer = 32;
+ sizeof_enum = 32;
+ sizeof_float = 32;
+ sizeof_double = 64;
+ if (!strcmp(target, "CHIPMUNK") ||
+ !strcmp(target, "HPUX-300"))
+ which_unix = UNIX_SYSV;
+ else
+ which_unix = UNIX_BSD;
+ } else if (!strcmp(target, "LSC-MAC")) {
+ signedchars = 1;
+ if (prototypes < 0)
+ prototypes = 1;
+ if (fullprototyping < 0)
+ fullprototyping = 0;
+ if (voidstar < 0)
+ voidstar = 1;
+ sizeof_char = 8;
+ sizeof_short = sizeof_int = 16;
+ sizeof_long = sizeof_pointer = 32;
+ } else if (!strcmp(target, "BSD")) {
+ which_unix = UNIX_BSD;
+ } else if (!strcmp(target, "SYSV")) {
+ which_unix = UNIX_SYSV;
+ } else if (*target) {
+ fprintf(stderr, "p2c: warning: don't understand target name %s\n", target);
+ }
+ if (ansiC > 0) {
+ if (sprintf_value < 0)
+ sprintf_value = 0;
+ if (castnull < 0)
+ castnull = 0;
+ }
+ if (useenum < 0)
+ useenum = (ansiC != 0) ? 1 : 0;
+ if (void_args < 0)
+ void_args = (ansiC > 0 && prototypes != 0) ? 1 : 0;
+ if (prototypes < 0)
+ prototypes = (cplus > 0) ? 2 : (ansiC > 0) ? 1 : 0;
+ if (prototypes == 0)
+ fullprototyping = 0;
+ else if (fullprototyping < 0)
+ fullprototyping = 1;
+ if (useAnyptrMacros < 0)
+ useAnyptrMacros = (ansiC > 0 || cplus > 0) ? 2 : 1;
+ if (usePPMacros < 0)
+ usePPMacros = (ansiC > 0 || cplus > 0) ? 0 : 2;
+ if (voidstar < 0)
+ voidstar = (ansiC > 0 || cplus > 0) ? 1 : 0;
+ if (hassignedchar < 0)
+ hassignedchar = (ansiC > 0) ? 1 : 0;
+ if (useconsts < 0)
+ useconsts = (ansiC > 0 || cplus > 0) ? 1 : 0;
+ if (copystructs < 0)
+ copystructs = (ansiC != 0 || cplus > 0) ? 3 : 0;
+ if (copystructfuncs < 0)
+ copystructfuncs = (ansiC > 0 || cplus > 0) ? 0 : 1;
+ if (starfunctions < 0)
+ starfunctions = (ansiC > 0) ? 0 : 1;
+ if (variablearrays < 0)
+ variablearrays = (ansiC > 1) ? 1 : 0;
+ if (initpacstrings < 0)
+ initpacstrings = (ansiC > 0) ? 1 : 0;
+ if (*memcpyname) {
+ if (ansiC > 0 || which_unix == UNIX_SYSV)
+ strcpy(memcpyname, "memcpy");
+ else if (which_unix == UNIX_BSD)
+ strcpy(memcpyname, "bcopy");
+ }
+ sizeof_integer = (sizeof_int >= 32) ? sizeof_int : sizeof_long;
+ integername = (sizeof_int >= 32) ? "int" : "long";
+ if (sizeof_integer && sizeof_integer < 32)
+ fprintf(stderr, "Warning: long integers have less than 32 bits\n");
+ if (sizeof_int >= 32 && sizeof_long > sizeof_int && prototypes == 0)
+ fprintf(stderr, "Warning: translated code assumes int and long are the same");
+ if (setbits < 0)
+ setbits = (sizeof_integer > 0) ? sizeof_integer : 32;
+ ucharname = (*name_UCHAR) ? name_UCHAR :
+ (signedchars == 0) ? "char" : "unsigned char";
+ scharname = (*name_SCHAR) ? name_SCHAR :
+ (signedchars == 1) ? "char" :
+ (useAnyptrMacros == 1) ? "Signed char" : "signed char";
+ for (longbits = 1, val = LONG_MAX; val >>= 1; longbits++) ;
+ if (sizeof_char) {
+ if (sizeof_char < 8 && ansiC > 0)
+ fprintf(stderr, "Warning: chars have less than 8 bits\n");
+ if (sizeof_char > longbits) {
+ min_schar = LONG_MIN;
+ max_schar = LONG_MAX;
+ } else {
+ min_schar = - (1<<(sizeof_char-1));
+ max_schar = (1<<(sizeof_char-1)) - 1;
+ }
+ if (sizeof_char >= longbits)
+ max_uchar = LONG_MAX;
+ else
+ max_uchar = (1<<sizeof_char) - 1;
+ } else {
+ min_schar = -128; /* Ansi-required minimum maxima */
+ max_schar = 127;
+ max_uchar = 255;
+ }
+ if (sizeof_short) {
+ if (sizeof_short < 16 && ansiC > 0)
+ fprintf(stderr, "Warning: shorts have less than 16 bits\n");
+ if (sizeof_short > longbits) {
+ min_sshort = LONG_MIN;
+ max_sshort = LONG_MAX;
+ } else {
+ min_sshort = - (1<<(sizeof_short-1));
+ max_sshort = (1<<(sizeof_short-1)) - 1;
+ }
+ if (sizeof_short >= longbits)
+ max_ushort = LONG_MAX;
+ else
+ max_ushort = (1<<sizeof_short) - 1;
+ } else {
+ min_sshort = -32768; /* Ansi-required minimum maxima */
+ max_sshort = 32767;
+ max_ushort = 65535;
+ }
+ if (symcase < 0)
+ symcase = 1;
+ if (smallsetconst == -2)
+ smallsetconst = (*name_SETBITS) ? -1 : 1;
+ hpux_lang = 0;
+ if (!strcmp(language, "TURBO")) {
+ which_lang = LANG_TURBO;
+ } else if (!strcmp(language, "UCSD")) {
+ which_lang = LANG_UCSD;
+ } else if (!strcmp(language, "MPW")) {
+ which_lang = LANG_MPW;
+ } else if (!strcmp(language, "HPUX") || !strcmp(language, "HP-UX")) {
+ which_lang = LANG_HP;
+ hpux_lang = 1;
+ } else if (!strcmp(language, "OREGON")) {
+ which_lang = LANG_OREGON;
+ } else if (!strcmp(language, "VAX") || !strcmp(language, "VMS")) {
+ which_lang = LANG_VAX;
+ } else if (!strncmp(language, "MODULA", 6)) {
+ which_lang = LANG_MODULA;
+ } else if (!strncmp(language, "BERK", 4) ||
+ !strcmp(language, "SUN")) {
+ which_lang = LANG_BERK;
+ } else {
+ if (*language && strcmp(language, "HP") && strcmp(language, "MODCAL"))
+ fprintf(stderr, "Warning: Language %s not recognized, using HP\n", language);
+ which_lang = LANG_HP;
+ }
+ if (modula2 < 0)
+ modula2 = (which_lang == LANG_MODULA) ? 1 : 0;
+ if (pascalcasesens < 0)
+ pascalcasesens = (which_lang == LANG_MODULA) ? 2 :
+ (which_lang == LANG_BERK) ? 3 : 0;
+ if (implementationmodules < 0)
+ implementationmodules = (which_lang == LANG_VAX) ? 1 : 0;
+ if (integer16 < 0)
+ integer16 = (which_lang == LANG_TURBO ||
+ which_lang == LANG_MPW) ? 1 : 0;
+ if (doublereals < 0)
+ doublereals = (hpux_lang ||
+ which_lang == LANG_OREGON ||
+ which_lang == LANG_VAX) ? 0 : 1;
+ if (pascalenumsize < 0)
+ pascalenumsize = (which_lang == LANG_HP) ? 16 : 8;
+ if (storefilenames < 0)
+ storefilenames = (which_lang == LANG_TURBO) ? 1 : 0;
+ if (charfiletext < 0)
+ charfiletext = (which_lang == LANG_BERK) ? 1 : 0;
+ if (readwriteopen < 0)
+ readwriteopen = (which_lang == LANG_TURBO) ? 1 : 0;
+ if (literalfilesflag < 0)
+ literalfilesflag = (which_lang == LANG_BERK) ? 2 : 0;
+ if (newlinespace < 0)
+ newlinespace = (which_lang == LANG_TURBO) ? 0 : 1;
+ if (nestedcomments < 0)
+ nestedcomments = (which_lang == LANG_TURBO ||
+ which_lang == LANG_MPW ||
+ which_lang == LANG_UCSD ||
+ which_lang == LANG_BERK) ? 2 : 0;
+ if (importall < 0)
+ importall = (which_lang == LANG_HP) ? 1 : 0;
+ if (seek_base < 0)
+ seek_base = (which_lang == LANG_TURBO ||
+ which_lang == LANG_MPW ||
+ which_lang == LANG_UCSD) ? 0 : 1;
+ if (unsignedchar < 0 && signedchars == 0)
+ unsignedchar = 2;
+ if (hasstaticlinks < 0)
+ hasstaticlinks = (which_lang == LANG_HP) ? 1 : 0;
+ if (dollar_idents < 0)
+ dollar_idents = (which_lang == LANG_OREGON ||
+ which_lang == LANG_VAX) ? 1 : 0;
+ if (ignorenonalpha < 0)
+ ignorenonalpha = (which_lang == LANG_UCSD) ? 1 : 0;
+ if (stringtrunclimit < 0)
+ stringtrunclimit = (which_lang == LANG_TURBO) ? 80 : 0;
+ if (defaultsetsize < 0)
+ defaultsetsize = (which_lang == LANG_VAX) ? 256 :
+ (which_lang == LANG_BERK) ? 128 :
+ (which_lang == LANG_MPW) ? 2040 : 8192;
+ if (enumbyte < 0)
+ enumbyte = (which_lang == LANG_HP) ? 0 : 1;
+ if (!*filenamefilter && (which_lang == LANG_OREGON ||
+ which_lang == LANG_BERK))
+ strcpy(filenamefilter, "P_trimname");
+ charname = (useAnyptrMacros) ? "Char" :
+ (unsignedchar == 1) ? ucharname :
+ (unsignedchar == 0) ? scharname : "char";
+ if (!*memcpyname)
+ strcpy(memcpyname, "memcpy");
+ if (!*mallocname)
+ strcpy(mallocname, "malloc");
+ if (!*freename)
+ strcpy(freename, "free");
+ fix_parameters();
+ }
+
+
+
+
+ void saveoldfile(fname)
+ char *fname;
+ {
+ #if defined(unix) || defined(__unix) || defined(CAN_LINK)
+ (void) unlink(format_s("%s~", fname));
+ if (link(fname, format_s("%s~", fname)) == 0)
+ (void) unlink(fname);
+ #endif
+ }
+
+
+
+ #ifndef __STDC__
+ # ifdef NO_GETENV
+ # define getenv(x) NULL
+ # else
+ extern char *getenv PP((char *));
+ # endif
+ #endif
+
+ Static long starting_time;
+
+ Static void openlogfile()
+ {
+ char *name, *uname;
+
+ if (*codefname == '<')
+ name = format_ss(logfnfmt, infname, infname);
+ else
+ name = format_ss(logfnfmt, infname, codefname);
+ if (!name)
+ name = format_s("%s.log", codefname);
+ saveoldfile(name);
+ logf = fopen(name, "w");
+ if (logf) {
+ fprintf(logf, "\nTranslation of %s to %s by p2c %s\n",
+ infname, codefname, P2C_VERSION);
+ fprintf(logf, "Translated");
+ uname = getenv("USER");
+ if (uname)
+ fprintf(logf, " by %s", uname);
+ time(&starting_time);
+ fprintf(logf, " on %s", ctime(&starting_time));
+ fprintf(logf, "\n\n");
+ } else {
+ perror(name);
+ verbose = 0;
+ }
+ }
+
+
+ void closelogfile()
+ {
+ long ending_time;
+
+ if (logf) {
+ fprintf(logf, "\n\n");
+ #if defined(unix) || defined(__unix)
+ fprintf(logf, "Total memory used: %ld bytes.\n", (long)sbrk(0));
+ #endif
+ time(&ending_time);
+ fprintf(logf, "Processed %d source lines in %ld:%ld seconds.\n",
+ inf_ltotal,
+ (ending_time - starting_time) / 60,
+ (ending_time - starting_time) % 60);
+ fprintf(logf, "\n\nTranslation completed on %s", ctime(&ending_time));
+ fclose(logf);
+ }
+ }
+
+
+
+
+ void showinitfile()
+ {
+ FILE *f;
+ int ch;
+ char *name;
+
+ name = format_s("%H/%s", "p2crc");
+ printf("# Copy of file %%H/p2crc => %s:\n\n", name);
+ f = fopen(name, "r");
+ if (!f) {
+ perror(name);
+ exit(1);
+ }
+ while ((ch = getc(f)) != EOF)
+ putchar(ch);
+ fclose(f);
+ exit(0);
+ }
+
+
+
+
+ void usage()
+ {
+ fprintf(stderr, "usage: p2c [options] file [modulename] [-h file.h] [-o file.c]\n");
+ exit(EXIT_FAILURE);
+ }
+
+
+
+ int main(argc, argv)
+ int argc;
+ char **argv;
+ {
+ int numsearch;
+ char *searchlist[50];
+ char infnbuf[200], codefnbuf[200], hdrfnbuf[200], *cp;
+ Symbol *sp;
+ Strlist *sl;
+ int i, nobuffer = 0, savequiet;
+
+ i = 0;
+ while (i < argc && strcmp(argv[i], "-H")) i++;
+ if (i < argc-1)
+ p2c_home = argv[i+1];
+ else {
+ cp = getenv("P2C_HOME");
+ if (cp)
+ p2c_home = cp;
+ }
+ init_stuff();
+ i = 0;
+ while (i < argc && strcmp(argv[i], "-i")) i++;
+ if (i < argc)
+ showinitfile();
+ initrc();
+ setup_dir();
+ infname = infnbuf;
+ *infname = 0;
+ i = 0;
+ while (i < argc && argv[i][0] == '-') i++;
+ if (i >= argc)
+ strcpy(infname, argv[i]);
+ i = 0;
+ while (i < argc && strcmp(argv[i], "-v")) i++;
+ if (i >= argc) {
+ cp = getenv("P2CRC");
+ if (cp)
+ readrc(cp, 1);
+ else
+ readrc(format_s("%H/%s", "p2crc"), 1);
+ }
+ i = 0;
+ while (i < argc && strcmp(argv[i], "-c")) i++;
+ if (i < argc-1) {
+ if (strcmp(argv[i+1], "-"))
+ readrc(argv[i+1], 1);
+ } else
+ if (!readrc("p2crc", 0))
+ readrc(".p2crc", 0);
+ codefname = codefnbuf;
+ *codefname = 0;
+ hdrfname = hdrfnbuf;
+ *hdrfname = 0;
+ requested_module = NULL;
+ found_module = 0;
+ error_crash = 0;
+ #ifdef CONSERVE_MEMORY
+ conserve_mem = CONSERVE_MEMORY;
+ #else
+ conserve_mem = 1;
+ #endif
+ regression = 0;
+ verbose = 0;
+ partialdump = 1;
+ numsearch = 0;
+ argc--, argv++;
+ while (argc > 0) {
+ if (**argv == '-' && (*argv)[1]) {
+ if (!strcmp(*argv, "-a")) {
+ ansiC = 1;
+ } else if (argv[0][1] == 'L') {
+ if (strlen(*argv) == 2 && argc > 1) {
+ strcpy(language, ++*argv);
+ --argc;
+ } else
+ strcpy(language, *argv + 2);
+ upc(language);
+ } else if (!strcmp(*argv, "-q")) {
+ quietmode = 1;
+ } else if (!strcmp(*argv, "-o")) {
+ if (*codefname || --argc <= 0)
+ usage();
+ strcpy(codefname, *++argv);
+ } else if (!strcmp(*argv, "-h")) {
+ if (*hdrfname || --argc <= 0)
+ usage();
+ strcpy(hdrfname, *++argv);
+ } else if (!strcmp(*argv, "-s")) {
+ if (--argc <= 0)
+ usage();
+ cp = *++argv;
+ if (!strcmp(cp, "-"))
+ librfiles = NULL;
+ else
+ searchlist[numsearch++] = cp;
+ } else if (!strcmp(*argv, "-c")) {
+ if (--argc <= 0)
+ usage();
+ argv++;
+ /* already done above */
+ } else if (!strcmp(*argv, "-v")) {
+ /* already done above */
+ } else if (!strcmp(*argv, "-H")) {
+ /* already done above */
+ } else if (argv[0][1] == 'I') {
+ if (strlen(*argv) == 2 && argc > 1) {
+ strlist_append(&importdirs, ++*argv);
+ --argc;
+ } else
+ strlist_append(&importdirs, *argv + 2);
+ } else if (argv[0][1] == 'p') {
+ if (strlen(*argv) == 2)
+ showprogress = 25;
+ else
+ showprogress = atoi(*argv + 2);
+ nobuffer = 1;
+ } else if (!strcmp(*argv, "-e")) {
+ copysource++;
+ } else if (!strcmp(*argv, "-t")) {
+ tokentrace++;
+ } else if (!strcmp(*argv, "-x")) {
+ error_crash++;
+ } else if (argv[0][1] == 'E') {
+ if (strlen(*argv) == 2)
+ maxerrors = 0;
+ else
+ maxerrors = atoi(*argv + 2);
+ } else if (!strcmp(*argv, "-F")) {
+ partialdump = 0;
+ } else if (argv[0][1] == 'd') {
+ nobuffer = 1;
+ if (strlen(*argv) == 2)
+ debug = 1;
+ else
+ debug = atoi(*argv + 2);
+ } else if (argv[0][1] == 'B') {
+ if (strlen(*argv) == 2)
+ i = 1;
+ else
+ i = atoi(*argv + 2);
+ if (argc == 2 &&
+ strlen(argv[1]) > 2 &&
+ !strcmp(argv[1] + strlen(argv[1]) - 2, ".c")) {
+ testlinebreaker(i, argv[1]);
+ exit(EXIT_SUCCESS);
+ } else
+ testlinebreaker(i, NULL);
+ } else if (argv[0][1] == 'C') {
+ if (strlen(*argv) == 2)
+ cmtdebug = 1;
+ else
+ cmtdebug = atoi(*argv + 2);
+ } else if (!strcmp(*argv, "-R")) {
+ regression = 1;
+ } else if (argv[0][1] == 'V') {
+ if (strlen(*argv) == 2)
+ verbose = 1;
+ else
+ verbose = atoi(*argv + 2);
+ } else if (argv[0][1] == 'M') {
+ if (strlen(*argv) == 2)
+ conserve_mem = 1;
+ else
+ conserve_mem = atoi(*argv + 2);
+ } else
+ usage();
+ } else if (!*infname) {
+ strcpy(infname, *argv);
+ } else if (!requested_module) {
+ requested_module = stralloc(*argv);
+ } else
+ usage();
+ argc--, argv++;
+ }
+ if (requested_module && !*codefname)
+ strcpy(codefname, format_ss(modulefnfmt, infname, requested_module));
+ if (*infname && strcmp(infname, "-")) {
+ if (strlen(infname) > 2 &&
+ !strcmp(infname + strlen(infname) - 2, ".c")) {
+ fprintf(stderr, "What is wrong with this picture?\n");
+ exit(EXIT_FAILURE);
+ }
+ inf = fopen(infname, "r");
+ if (!inf) {
+ perror(infname);
+ exit(EXIT_FAILURE);
+ }
+ if (!*codefname)
+ strcpy(codefname, format_s(codefnfmt, infname));
+ } else {
+ strcpy(infname, "<stdin>");
+ inf = stdin;
+ if (!*codefname)
+ strcpy(codefname, "-");
+ }
+ if (strcmp(codefname, "-")) {
+ saveoldfile(codefname);
+ codef = fopen(codefname, "w");
+ if (!codef) {
+ perror(codefname);
+ exit(EXIT_FAILURE);
+ }
+ fprintf(codef, "/* Output from p2c, the Pascal-to-C translator */\n");
+ } else {
+ strcpy(codefname, "<stdout>");
+ codef = stdout;
+ }
+ if (nobuffer)
+ setbuf(codef, NULL); /* for debugging */
+ outf = codef;
+ outf_lnum = 1;
+ logf = NULL;
+ if (verbose)
+ openlogfile();
+ setup_complete = 0;
+ init_lex();
+ leadingcomments();
+ postrc();
+ setup_comment(); /* must call this first */
+ setup_lex(); /* must call this second */
+ setup_out();
+ setup_decl(); /* must call *after* setup_lex() */
+ setup_parse();
+ setup_funcs();
+ for (sl = tweaksymbols; sl; sl = sl->next) {
+ cp = sl->s;
+ if (*cp == '*') {
+ cp++;
+ if (!pascalcasesens)
+ upc(cp);
+ }
+ sp = findsymbol(cp);
+ if (sl->value & FUNCBREAK)
+ sp->flags &= ~FUNCBREAK;
+ sp->flags |= sl->value;
+ }
+ strlist_empty(&tweaksymbols);
+ for (sl = synonyms; sl; sl = sl->next) {
+ if (!pascalcasesens)
+ upc(sl->s);
+ sp = findsymbol(sl->s);
+ sp->flags |= SSYNONYM;
+ if (sl->value) {
+ if (!pascalcasesens)
+ upc((char *)sl->value);
+ strlist_append(&sp->symbolnames, "===")->value =
+ (long)findsymbol((char *)sl->value);
+ } else
+ strlist_append(&sp->symbolnames, "===")->value = 0;
+ }
+ strlist_empty(&synonyms);
+ for (sl = addmacros; sl; sl = sl->next) {
+ defmacro(sl->s, sl->value, "<macro>", 0);
+ }
+ strlist_empty(&addmacros);
+ handle_nameof();
+ setup_complete = 1;
+ savequiet = quietmode;
+ quietmode = 1;
+ for (sl = librfiles; sl; sl = sl->next)
+ (void)p_search(format_none(sl->s), "pas", 0);
+ for (i = 0; i < numsearch; i++)
+ (void)p_search(format_none(searchlist[i]), "pas", 1);
+ quietmode = savequiet;
+ p_program();
+ end_source();
+ flushcomments(NULL, -1, -1);
+ showendnotes();
+ check_unused_macros();
+ printf("\n");
+ if (!showprogress)
+ fprintf(stderr, "\n");
+ output("\n");
+ if (requested_module && !found_module)
+ error(format_s("Module \"%s\" not found in file", requested_module));
+ if (codef != stdout)
+ output("\n\n/* End. */\n");
+ if (inf != stdin)
+ fclose(inf);
+ if (codef != stdout)
+ fclose(codef);
+ closelogfile();
+ mem_summary();
+ if (!quietmode)
+ fprintf(stderr, "Translation completed.\n");
+ exit(EXIT_SUCCESS);
+ }
+
+
+
+
+ int outmem()
+ {
+ fprintf(stderr, "p2c: Out of memory!\n");
+ exit(EXIT_FAILURE);
+ }
+
+
+
+ #if !defined(NO_ISBOGUS) && (defined(mc68000) || defined(m68k) || defined(vax))
+ int ISBOGUS(p)
+ char *p;
+ {
+ unsigned long ip = (unsigned long)p;
+
+ if (ip < 0) {
+ if (ip < (unsigned long)&ip)
+ return 1; /* below the start of the stack */
+ } else if (ip >= 512) {
+ if (ip > (unsigned long)sbrk(0))
+ return 1; /* past the end of memory */
+ } else
+ return 1;
+ return 0;
+ }
+ #else
+ #define ISBOGUS(p) 0
+ #endif
+
+
+
+
+
+
+ char *meaningkindname(kind)
+ enum meaningkind kind;
+ {
+ #ifdef HASDUMPS
+ if ((unsigned int)kind < (unsigned int)MK_LAST)
+ return meaningkindnames[(int) kind];
+ else
+ #endif /*HASDUMPS*/
+ return format_d("<meaning %d>", (int) kind);
+ }
+
+ char *typekindname(kind)
+ enum typekind kind;
+ {
+ #ifdef HASDUMPS
+ if ((unsigned int)kind < (unsigned int)TK_LAST)
+ return typekindnames[(int) kind];
+ else
+ #endif /*HASDUMPS*/
+ return format_d("<type %d>", (int) kind);
+ }
+
+ char *exprkindname(kind)
+ enum exprkind kind;
+ {
+ #ifdef HASDUMPS
+ if ((unsigned int)kind < (unsigned int)EK_LAST)
+ return exprkindnames[(int) kind];
+ else
+ #endif /*HASDUMPS*/
+ return format_d("<expr %d>", (int) kind);
+ }
+
+ char *stmtkindname(kind)
+ enum stmtkind kind;
+ {
+ #ifdef HASDUMPS
+ if ((unsigned int)kind < (unsigned int)SK_LAST)
+ return stmtkindnames[(int) kind];
+ else
+ #endif /*HASDUMPS*/
+ return format_d("<stmt %d>", (int) kind);
+ }
+
+
+
+ void dumptype(tp)
+ Type *tp;
+ {
+ if (!tp) {
+ fprintf(outf, "<NULL>\n");
+ return;
+ }
+ if (ISBOGUS(tp)) {
+ fprintf(outf, "0x%lX\n", tp);
+ return;
+ }
+ fprintf(outf, " Type %lx, kind=%s", tp, typekindname(tp->kind));
+ #ifdef HASDUMPS
+ fprintf(outf, ", meaning=%lx, basetype=%lx, indextype=%lx\n",
+ tp->meaning, tp->basetype, tp->indextype);
+ tp->dumped = 1;
+ if (tp->basetype)
+ dumptype(tp->basetype);
+ if (tp->indextype)
+ dumptype(tp->indextype);
+ #else
+ fprintf(outf, "\n");
+ #endif /*HASDUMPS*/
+ }
+
+
+ void dumpmeaning(mp)
+ Meaning *mp;
+ {
+ if (!mp) {
+ fprintf(outf, "<NULL>\n");
+ return;
+ }
+ if (ISBOGUS(mp)) {
+ fprintf(outf, "0x%lX\n", mp);
+ return;
+ }
+ fprintf(outf, " Meaning %lx, name=%s, kind=%s", mp, ((mp->name) ? mp->name : "<null>"),
+ meaningkindname(mp->kind));
+ #ifdef HASDUMPS
+ fprintf(outf, ", ctx=%lx, cbase=%lx, cnext=%lx, type=%lx\n",
+ mp->ctx, mp->cbase, mp->cnext, mp->type);
+ if (mp->type && !mp->type->dumped)
+ dumptype(mp->type);
+ mp->dumped = 1;
+ #else
+ fprintf(outf, "\n");
+ #endif /*HASDUMPS*/
+ }
+
+
+ void dumpsymtable(sym)
+ Symbol *sym;
+ {
+ Meaning *mp;
+
+ if (sym) {
+ dumpsymtable(sym->left);
+ #ifdef HASDUMPS
+ if ((sym->mbase && !sym->mbase->dumped) ||
+ (sym->fbase && !sym->fbase->dumped))
+ #endif
+ {
+ fprintf(outf, "Symbol %s:\n", sym->name);
+ for (mp = sym->mbase; mp; mp = mp->snext)
+ dumpmeaning(mp);
+ for (mp = sym->fbase; mp; mp = mp->snext)
+ dumpmeaning(mp);
+ fprintf(outf, "\n");
+ }
+ dumpsymtable(sym->right);
+ }
+ }
+
+
+ void dumptypename(tp, waddr)
+ Type *tp;
+ int waddr;
+ {
+ #ifdef HASDUMPS
+ if (!tp) {
+ fprintf(outf, "<NULL>");
+ return;
+ }
+ if (ISBOGUS(tp)) {
+ fprintf(outf, "0x%lX", tp);
+ return;
+ }
+ if (tp == tp_int) fprintf(outf, "I");
+ else if (tp == tp_sint) fprintf(outf, "SI");
+ else if (tp == tp_uint) fprintf(outf, "UI");
+ else if (tp == tp_integer) fprintf(outf, "L");
+ else if (tp == tp_unsigned) fprintf(outf, "UL");
+ else if (tp == tp_char) fprintf(outf, "C");
+ else if (tp == tp_schar) fprintf(outf, "UC");
+ else if (tp == tp_uchar) fprintf(outf, "SC");
+ else if (tp == tp_boolean) fprintf(outf, "B");
+ else if (tp == tp_longreal) fprintf(outf, "R");
+ else if (tp == tp_real) fprintf(outf, "F");
+ else if (tp == tp_anyptr) fprintf(outf, "A");
+ else if (tp == tp_void) fprintf(outf, "V");
+ else if (tp == tp_text) fprintf(outf, "T");
+ else if (tp == tp_bigtext) fprintf(outf, "BT");
+ else if (tp == tp_sshort) fprintf(outf, "SS");
+ else if (tp == tp_ushort) fprintf(outf, "US");
+ else if (tp == tp_abyte) fprintf(outf, "AB");
+ else if (tp == tp_sbyte) fprintf(outf, "SB");
+ else if (tp == tp_ubyte) fprintf(outf, "UB");
+ else if (tp == tp_str255) fprintf(outf, "S");
+ else if (tp == tp_strptr) fprintf(outf, "SP");
+ else if (tp == tp_charptr) fprintf(outf, "CP");
+ else if (tp == tp_smallset) fprintf(outf, "SMS");
+ else if (tp == tp_proc) fprintf(outf, "PR");
+ else if (tp == tp_jmp_buf) fprintf(outf, "JB");
+ else {
+ if (tp->meaning && !ISBOGUS(tp->meaning) &&
+ tp->meaning->name && !ISBOGUS(tp->meaning->name) &&
+ tp->meaning->name[0]) {
+ fprintf(outf, "%s", tp->meaning->name);
+ if (tp->dumped)
+ return;
+ fprintf(outf, "=");
+ waddr = 1;
+ }
+ if (waddr) {
+ fprintf(outf, "%lX", tp);
+ if (tp->dumped)
+ return;
+ fprintf(outf, ":");
+ tp->dumped = 1;
+ }
+ switch (tp->kind) {
+
+ case TK_STRING:
+ fprintf(outf, "Str");
+ if (tp->structdefd)
+ fprintf(outf, "Conf");
+ break;
+
+ case TK_SUBR:
+ dumptypename(tp->basetype, 0);
+ break;
+
+ case TK_POINTER:
+ fprintf(outf, "^");
+ dumptypename(tp->basetype, 0);
+ break;
+
+ case TK_SMALLARRAY:
+ fprintf(outf, "Sm");
+ /* fall through */
+
+ case TK_ARRAY:
+ fprintf(outf, "Ar");
+ if (tp->structdefd)
+ fprintf(outf, "Conf");
+ fprintf(outf, "{");
+ dumptypename(tp->indextype, 0);
+ fprintf(outf, "}");
+ if (tp->smin) {
+ fprintf(outf, "Skip(");
+ dumpexpr(tp->smin);
+ fprintf(outf, ")");
+ }
+ if (tp->smax) {
+ fprintf(outf, "/");
+ if (!ISBOGUS(tp->smax))
+ dumptypename(tp->smax->val.type, 0);
+ fprintf(outf, "{%d%s}", tp->escale,
+ tp->issigned ? "S" : "U");
+ }
+ fprintf(outf, ":");
+ dumptypename(tp->basetype, 0);
+ break;
+
+ case TK_SMALLSET:
+ fprintf(outf, "Sm");
+ /* fall through */
+
+ case TK_SET:
+ fprintf(outf, "Set{");
+ dumptypename(tp->indextype, 0);
+ fprintf(outf, "}");
+ break;
+
+ case TK_FILE:
+ fprintf(outf, "File{");
+ dumptypename(tp->basetype, 0);
+ fprintf(outf, "}");
+ break;
+
+ case TK_BIGFILE:
+ fprintf(outf, "BigFile{");
+ dumptypename(tp->basetype, 0);
+ fprintf(outf, "}");
+ break;
+
+ case TK_FUNCTION:
+ fprintf(outf, "Func");
+ if (tp->issigned)
+ fprintf(outf, "Link");
+ fprintf(outf, "{");
+ dumptypename(tp->basetype, 0);
+ fprintf(outf, "}");
+ break;
+
+ case TK_CPROCPTR:
+ fprintf(outf, "C");
+ /* fall through */
+
+ case TK_PROCPTR:
+ fprintf(outf, "Proc%d{", tp->escale);
+ dumptypename(tp->basetype, 0);
+ fprintf(outf, "}");
+ break;
+
+ default:
+ fprintf(outf, "%s", typekindname(tp->kind));
+ break;
+
+ }
+ if (tp->kind != TK_ARRAY && tp->kind != TK_SMALLARRAY &&
+ (tp->smin || tp->smax)) {
+ fprintf(outf, "{");
+ dumpexpr(tp->smin);
+ fprintf(outf, "..");
+ dumpexpr(tp->smax);
+ fprintf(outf, "}");
+ }
+ }
+ #else
+ fprintf(outf, "%lX", tp);
+ #endif
+ }
+
+
+ void dumptypename_file(f, tp)
+ FILE *f;
+ Type *tp;
+ {
+ FILE *save = outf;
+ outf = f;
+ dumptypename(tp, 1);
+ outf = save;
+ }
+
+
+ void dumpexpr(ex)
+ Expr *ex;
+ {
+ int i;
+ Type *type;
+ char *name;
+
+ if (!ex) {
+ fprintf(outf, "<NULL>");
+ return;
+ }
+ if (ISBOGUS(ex)) {
+ fprintf(outf, "0x%lX", ex);
+ return;
+ }
+ if (ex->kind == EK_CONST && ex->val.type == tp_integer &&
+ ex->nargs == 0 && !ex->val.s) {
+ fprintf(outf, "%ld", ex->val.i);
+ return;
+ }
+ if (ex->kind == EK_LONGCONST && ex->val.type == tp_integer &&
+ ex->nargs == 0 && !ex->val.s) {
+ fprintf(outf, "%ldL", ex->val.i);
+ return;
+ }
+ name = exprkindname(ex->kind);
+ if (!strncmp(name, "EK_", 3))
+ name += 3;
+ fprintf(outf, "%s", name);
+ #ifdef HASDUMPS
+
+ type = ex->val.type;
+ fprintf(outf, "/");
+ dumptypename(type, 1);
+ if (ex->val.i) {
+ switch (ex->kind) {
+
+ case EK_VAR:
+ case EK_FUNCTION:
+ case EK_CTX:
+ if (ISBOGUS(ex->val.i))
+ fprintf(outf, "[0x%lX]", ex->val.i);
+ else
+ fprintf(outf, "[\"%s\"]", ((Meaning *)ex->val.i)->name);
+ break;
+
+ default:
+ fprintf(outf, "[i=%ld]", ex->val.i);
+ break;
+ }
+ }
+ if (ISBOGUS(ex->val.s))
+ fprintf(outf, "[0x%lX]", ex->val.s);
+ else if (ex->val.s) {
+ switch (ex->kind) {
+
+ case EK_BICALL:
+ case EK_NAME:
+ case EK_DOT:
+ fprintf(outf, "[s=\"%s\"]", ex->val.s);
+ break;
+
+ default:
+ switch (ex->val.type ? ex->val.type->kind : TK_VOID) {
+ case TK_STRING:
+ fprintf(outf, "[s=%s]", makeCstring(ex->val.s, ex->val.i));
+ break;
+ case TK_REAL:
+ fprintf(outf, "[s=%s]", ex->val.s);
+ break;
+ default:
+ fprintf(outf, "[s=%lx]", ex->val.s);
+ }
+ break;
+ }
+ }
+ if (ex->nargs > 0) {
+ fprintf(outf, "(");
+ if (ex->nargs < 10) {
+ for (i = 0; i < ex->nargs; i++) {
+ if (i)
+ fprintf(outf, ", ");
+ dumpexpr(ex->args[i]);
+ }
+ } else
+ fprintf(outf, "...");
+ fprintf(outf, ")");
+ }
+ #endif
+ }
+
+
+ void dumpexpr_file(f, ex)
+ FILE *f;
+ Expr *ex;
+ {
+ FILE *save = outf;
+ outf = f;
+ dumpexpr(ex);
+ outf = save;
+ }
+
+
+ void innerdumpstmt(sp, indent)
+ Stmt *sp;
+ int indent;
+ {
+ #ifdef HASDUMPS
+ if (!sp) {
+ fprintf(outf, "<NULL>\n");
+ return;
+ }
+ while (sp) {
+ if (ISBOGUS(sp)) {
+ fprintf(outf, "0x%lX\n", sp);
+ return;
+ }
+ fprintf(outf, "%s", stmtkindname(sp->kind));
+ if (sp->exp1) {
+ fprintf(outf, ", exp1=");
+ dumpexpr(sp->exp1);
+ }
+ if (sp->exp2) {
+ fprintf(outf, ", exp2=");
+ dumpexpr(sp->exp2);
+ }
+ if (sp->exp3) {
+ fprintf(outf, ", exp3=");
+ dumpexpr(sp->exp3);
+ }
+ fprintf(outf, "\n");
+ if (sp->stm1) {
+ fprintf(outf, "%*sstm1=", indent, "");
+ innerdumpstmt(sp->stm1, indent+5);
+ }
+ if (sp->stm2) {
+ fprintf(outf, "%*sstm2=", indent, "");
+ innerdumpstmt(sp->stm2, indent+5);
+ }
+ sp = sp->next;
+ if (sp) {
+ if (indent > 5)
+ fprintf(outf, "%*s", indent-5, "");
+ fprintf(outf, "next=");
+ }
+ }
+ #endif
+ }
+
+
+ void dumpstmt(sp, indent)
+ Stmt *sp;
+ int indent;
+ {
+ fprintf(outf, "%*s", indent, "");
+ innerdumpstmt(sp, indent);
+ }
+
+
+ void dumpstmt_file(f, sp)
+ FILE *f;
+ Stmt *sp;
+ {
+ FILE *save = outf;
+ Stmt *savenext = NULL;
+ outf = f;
+ if (sp) {
+ savenext = sp->next;
+ sp->next = NULL;
+ }
+ dumpstmt(sp, 5);
+ if (sp)
+ sp->next = savenext;
+ outf = save;
+ }
+
+
+
+ void wrapup()
+ {
+ int i;
+
+ for (i = 0; i < SYMHASHSIZE; i++)
+ dumpsymtable(symtab[i]);
+ }
+
+
+
+
+ void mem_summary()
+ {
+ #ifdef TEST_MALLOC
+ printf("Summary of memory allocated but not freed:\n");
+ printf("Total bytes = %d of %d\n", final_bytes, total_bytes);
+ printf("Expressions = %d of %d\n", final_exprs, total_exprs);
+ printf("Meanings = %d of %d (%d of %d)\n",
+ final_meanings, total_meanings,
+ final_meanings / sizeof(Meaning),
+ total_meanings / sizeof(Meaning));
+ printf("Strings = %d of %d\n", final_strings, total_strings);
+ printf("Symbols = %d of %d\n", final_symbols, total_symbols);
+ printf("Types = %d of %d (%d of %d)\n", final_types, total_types,
+ final_types / sizeof(Type), total_types / sizeof(Type));
+ printf("Statements = %d of %d (%d of %d)\n", final_stmts, total_stmts,
+ final_stmts / sizeof(Stmt), total_stmts / sizeof(Stmt));
+ printf("Strlists = %d of %d\n", final_strlists, total_strlists);
+ printf("Literals = %d of %d\n", final_literals, total_literals);
+ printf("Ctxstacks = %d of %d\n", final_ctxstacks, total_ctxstacks);
+ printf("Temp vars = %d of %d\n", final_tempvars, total_tempvars);
+ printf("Input recs = %d of %d\n", final_inprecs, total_inprecs);
+ printf("Parens = %d of %d\n", final_parens, total_parens);
+ printf("Ptr Descs = %d of %d\n", final_ptrdescs, total_ptrdescs);
+ printf("Other = %d of %d\n", final_misc, total_misc);
+ printf("\n");
+ #endif
+ }
+
+
+ #ifdef TEST_MALLOC
+
+ anyptr memlist;
+
+ anyptr test_malloc(size, total, final)
+ int size, *total, *final;
+ {
+ anyptr p;
+
+ p = malloc(size + 3*sizeof(long));
+ #if 1
+ ((anyptr *)p)[0] = memlist;
+ memlist = p;
+ ((long *)p)[1] = size;
+ ((int **)p)[2] = final;
+ total_bytes += size;
+ final_bytes += size;
+ *total += size;
+ *final += size;
+ #endif
+ return (anyptr)((long *)p + 3);
+ }
+
+ void test_free(p)
+ anyptr p;
+ {
+ #if 1
+ final_bytes -= ((long *)p)[1-3];
+ *((int **)p)[2-3] -= ((long *)p)[1-3];
+ ((long *)p)[1-3] *= -1;
+ #endif
+ }
+
+ anyptr test_realloc(p, size)
+ anyptr p;
+ int size;
+ {
+ anyptr p2;
+
+ p2 = test_malloc(size, &total_misc, &final_misc);
+ memcpy(p2, p, size);
+ test_free(p);
+ return p2;
+ }
+
+ #endif /* TEST_MALLOC */
+
+
+
+
+ /* End. */
+
+
Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.h
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.h:1.1.2.1
*** /dev/null Mon Mar 1 17:59:23 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/trans.h Mon Mar 1 17:59:12 2004
***************
*** 0 ****
--- 1,1867 ----
+ /* "p2c", a Pascal to C translator, version 1.20.
+ Copyright (C) 1989, 1990, 1991 Free Software Foundation.
+ Author: Dave Gillespie.
+ Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation (any version).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+
+
+ #ifdef __STDC__
+ # define PP(x) x /* use true prototypes */
+ # define PV() (void)
+ # define Anyptr void
+ # define __CAT__(a,b)a##b
+ #else
+ # define PP(x) () /* use old-style declarations */
+ # define PV() ()
+ # define Anyptr char
+ # define __ID__(a)a
+ # define __CAT__(a,b)__ID__(a)b
+ #endif
+
+ #define Static /* For debugging purposes */
+
+
+
+ #include <stdio.h>
+
+
+ /* If the following heuristic fails, compile -DBSD=0 for non-BSD systems,
+ or -DBSD=1 for BSD systems. */
+
+ #ifdef M_XENIX
+ # define BSD 0
+ #endif
+
+ #ifdef FILE /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
+ # ifndef BSD
+ # define BSD 1
+ # endif
+ #endif
+
+ #ifdef BSD
+ # if !BSD
+ # undef BSD
+ # endif
+ #endif
+
+
+ #ifdef __STDC__
+ /* # include <stddef.h> */
+ # include <stdlib.h>
+ # include <limits.h>
+ #else
+ # ifndef BSD
+ # include <malloc.h>
+ # include <memory.h>
+ # include <values.h>
+ # endif
+ # define EXIT_SUCCESS 0
+ # define EXIT_FAILURE 1
+ # define CHAR_BIT 8
+ # define LONG_MAX (((unsigned long)~0L) >> 1)
+ # define LONG_MIN (- LONG_MAX - 1)
+ #endif
+
+
+
+ #if defined(BSD) && !defined(__STDC__)
+ # include <strings.h>
+ # define memcpy(a,b,n) bcopy(b,a,n)
+ # define memcmp(a,b,n) bcmp(a,b,n)
+ char *malloc(), *realloc();
+ #else
+ # include <string.h>
+ #endif
+
+ #include <ctype.h>
+
+
+ #ifdef __GNUC__ /* Fast, in-line version of strcmp */
+ # define strcmp(a,b) ({ char *_aa = (a), *_bb = (b); int _diff; \
+ for (;;) { \
+ if (!*_aa && !*_bb) { _diff = 0; break; } \
+ if (*_aa++ != *_bb++) \
+ { _diff = _aa[-1] - _bb[-1]; break; } \
+ } _diff; })
+ #endif
+
+
+ #if defined(HASDUMPS) && defined(define_globals)
+ # define DEFDUMPS
+ #endif
+
+
+
+ /* Constants */
+
+ #undef MININT /* we want the Pascal definitions, not the local C definitions */
+ #undef MAXINT
+
+ #define MININT 0x80000000
+ #define MAXINT 0x7fffffff
+
+
+ #ifndef EXIT_SUCCESS
+ # define EXIT_SUCCESS 0
+ # define EXIT_FAILURE 1
+ #endif
+
+
+ #ifndef P2C_HOME
+ # ifdef citPWS
+ # define P2C_HOME "/lib/p2c"
+ # else
+ # define P2C_HOME "/usr/local/p2c" /* sounds reasonable... */
+ # endif
+ #endif
+
+ #ifdef define_globals
+ char *p2c_home = P2C_HOME;
+ #else
+ extern char *p2c_home;
+ #endif
+
+ #define P2C_VERSION "1.20"
+
+
+
+
+ /* Types */
+
+ #ifdef __STDC__
+ typedef void *anyptr;
+ #else
+ typedef char *anyptr;
+ #endif
+
+ typedef unsigned char uchar;
+
+
+
+ /* Ought to rearrange token assignments at the next full re-compile */
+
+ typedef enum E_token {
+ TOK_NONE,
+
+ /* reserved words */
+ TOK_AND, TOK_ARRAY, TOK_BEGIN, TOK_CASE, TOK_CONST,
+ TOK_DIV, TOK_DO, TOK_DOWNTO, TOK_ELSE, TOK_END,
+ TOK_FILE, TOK_FOR, TOK_FUNCTION, TOK_GOTO, TOK_IF,
+ TOK_IN, TOK_LABEL, TOK_MOD, TOK_NIL, TOK_NOT,
+ TOK_OF, TOK_OR, TOK_PACKED, TOK_PROCEDURE, TOK_PROGRAM,
+ TOK_RECORD, TOK_REPEAT, TOK_SET, TOK_THEN, TOK_TO,
+ TOK_TYPE, TOK_UNTIL, TOK_VAR, TOK_WHILE, TOK_WITH,
+
+ /* symbols */
+ TOK_DOLLAR, TOK_STRLIT, TOK_LPAR, TOK_RPAR, TOK_STAR,
+ TOK_PLUS, TOK_COMMA, TOK_MINUS, TOK_DOT, TOK_DOTS,
+ TOK_SLASH, TOK_INTLIT, TOK_REALLIT, TOK_COLON, TOK_ASSIGN,
+ TOK_SEMI, TOK_NE, TOK_LT, TOK_GT, TOK_LE, TOK_GE,
+ TOK_EQ, TOK_LBR, TOK_RBR, TOK_HAT,
+ TOK_INCLUDE, TOK_ENDIF,
+ TOK_IDENT, TOK_MININT, TOK_EOF,
+
+ /* C symbols */
+ TOK_ARROW, TOK_AMP, TOK_VBAR, TOK_BANG,
+ TOK_TWIDDLE, TOK_PERC, TOK_QM,
+ TOK_LTLT, TOK_GTGT, TOK_EQEQ, TOK_BANGEQ,
+ TOK_PLPL, TOK_MIMI, TOK_ANDAND, TOK_OROR,
+ TOK_LBRACE, TOK_RBRACE, TOK_CHARLIT,
+
+ /* HP Pascal tokens */
+ TOK_ANYVAR, TOK_EXPORT, TOK_IMPLEMENT, TOK_IMPORT, TOK_MODULE,
+ TOK_OTHERWISE, TOK_RECOVER, TOK_TRY,
+
+ /* Turbo Pascal tokens */
+ TOK_SHL, TOK_SHR, TOK_XOR, TOK_INLINE, TOK_ABSOLUTE,
+ TOK_INTERRUPT, TOK_ADDR, TOK_HEXLIT,
+
+ /* Oregon Software Pascal tokens */
+ TOK_ORIGIN, TOK_INTFONLY,
+
+ /* VAX Pascal tokens */
+ TOK_REM, TOK_VALUE, TOK_VARYING, TOK_OCTLIT, TOK_COLONCOLON,
+ TOK_STARSTAR,
+
+ /* Modula-2 tokens */
+ TOK_BY, TOK_DEFINITION, TOK_ELSIF, TOK_FROM, TOK_LOOP,
+ TOK_POINTER, TOK_QUALIFIED, TOK_RETURN,
+
+ /* UCSD Pascal tokens */
+ TOK_SEGMENT,
+
+ TOK_LAST
+ } Token;
+
+ #ifdef define_globals
+ char *toknames[(int)TOK_LAST] = { "",
+ "AND", "ARRAY", "BEGIN", "CASE", "CONST",
+ "DIV", "DO", "DOWNTO", "ELSE", "END",
+ "FILE", "FOR", "FUNCTION", "GOTO", "IF",
+ "IN", "LABEL", "MOD", "NIL", "NOT",
+ "OF", "OR", "PACKED", "PROCEDURE", "PROGRAM",
+ "RECORD", "REPEAT", "SET", "THEN", "TO",
+ "TYPE", "UNTIL", "VAR", "WHILE", "WITH",
+
+ "a '$'", "a string literal", "a '('", "a ')'", "a '*'",
+ "a '+'", "a comma", "a '-'", "a '.'", "'..'",
+ "a '/'", "an integer", "a real number", "a colon", "a ':='",
+ "a semicolon", "a '<>'", "a '<'", "a '>'", "a '<='", "a '>='",
+ "an '='", "a '['", "a ']'", "a '^'",
+ "an \"include\" file", "$end$",
+ "an identifier", "an integer", "end of file",
+
+ "an '->'", "an '&'", "a '|'", "a '!'",
+ "a '~'", "a '%'", "a '?'",
+ "a '<<'", "a '>>'", "a '=='", "a '!='",
+ "a '++'", "a '--'", "a '&&'", "a '||'",
+ "a '{'", "a '}'", "a character literal",
+
+ "ANYVAR", "EXPORT", "IMPLEMENT", "IMPORT", "MODULE",
+ "OTHERWISE", "RECOVER", "TRY",
+
+ "SHL", "SHR", "XOR", "INLINE", "ABSOLUTE",
+ "INTERRUPT", "an '@'", "a hex integer",
+
+ "ORIGIN", "INTF-ONLY",
+
+ "REM", "VALUE", "VARYING", "an octal integer", "a '::'",
+ "a '**'",
+
+ "BY", "DEFINITION", "ELSIF", "FROM", "LOOP",
+ "POINTER", "QUALIFIED", "RETURN",
+
+ "SEGMENT"
+ } ;
+ #else
+ extern char *toknames[];
+ #endif /*define_globals*/
+
+ typedef struct S_strlist {
+ struct S_strlist *next;
+ long value;
+ char s[1];
+ } Strlist;
+
+
+
+ typedef struct S_value {
+ struct S_type *type;
+ long i;
+ char *s;
+ } Value;
+
+
+
+ /* "Symbol" notes:
+ *
+ * The symbol table is used for several things. Mainly it records all
+ * identifiers in the Pascal program (normally converted to upper case).
+ * Also used for recording certain properties about C and Pascal names.
+ *
+ * The symbol table is a hash table of binary trees.
+ */
+
+ #define AVOIDNAME 0x1 /* Avoid this name in C code */
+ #define WARNNAME 0x2 /* Warn if using this name in C code */
+ #define AVOIDGLOB 0x4 /* Avoid C name except private to module */
+ #define NOSIDEEFF 0x8 /* Function by this name has no side effects */
+ #define STRUCTF 0x10 /* Function by this name is a StructFunction */
+ #define STRLAPF 0x20 /* Function by this name is a StrlapFunction */
+ #define LEAVEALONE 0x40 /* Do not use custom handler for function */
+ #define DETERMF 0x80 /* Function by this name is Deterministic */
+ #define FMACREC 0x100 /* Used by FieldMacro stuff */
+ #define AVOIDFIELD 0x200 /* Avoid this name as a struct field name */
+ #define NEEDSTATIC 0x400 /* This name must be declared static */
+ #define KWPOSS 0x800 /* This word may be a keyword */
+ #define FUNCBREAK 0x7000 /* Line breaking flags (see sys.p2crc) */
+ # define FALLBREAK 0x1000 /* Break at all commas if at any */
+ # define FSPCARG1 0x2000 /* First argument is special */
+ # define FSPCARG2 0x3000 /* First two arguments are special */
+ # define FSPCARG3 0x4000 /* First three arguments are special */
+ #define WARNLIBR 0x8000 /* Warn for all uses of this library function */
+ #define FWDPARAM 0x10000 /* Was a param name for forward-declared func */
+ #define SSYNONYM 0x20000 /* Symbol is a synonym for another */
+
+ typedef struct S_symbol {
+ struct S_symbol *left; /* Left pointer in binary tree */
+ struct S_symbol *right; /* Right pointer in binary tree */
+ struct S_meaning *mbase; /* First normal meaning for this symbol */
+ struct S_meaning *fbase; /* First record-field meaning for this symbol */
+ Strlist *symbolnames; /* List of NameOf's for this name */
+ long flags; /* (above) */
+ Token kwtok; /* Token, if symbol is a keyword */
+ char name[1]; /* Pascal name (actually variable-sized) */
+ } Symbol;
+
+
+
+ /* "Meaning" notes:
+ *
+ * This represents one meaning of a symbol (see below). Meanings are
+ * organized in a tree of contexts (i.e., scopes), and also in linked
+ * lists of meanings per symbol. Fields described in the following are
+ * undefined for kinds where they are not listed. Other fields are
+ * defined in all kinds of meanings.
+ *
+ * MK_MODULE: Program, module, or unit.
+ * mp->anyvarflag = 1 if main program, 0 if module.
+ * mp->cbase => First meaning in module's context.
+ *
+ * MK_CONST: Pascal CONST.
+ * mp->type => Type of constant, same as mp->constdefn->type & mp->val.type.
+ * mp->anyvarflag = 1 if FoldConstants was true when defined.
+ * mp->constdefn => Expression for the value of the constant.
+ * mp->val = Value of the const, if can be evaluated, else val.type is NULL.
+ * mp->xnext => Next constant in enumeration, else NULL.
+ * mp->isreturn = 1 if constant was declared as a macro (with #define).
+ *
+ * MK_TYPE: Pascal type name.
+ * mp->type => Type which name represents.
+ *
+ * MK_VAR: Normal variable.
+ * mp->type => Type of variable.
+ * mp->constdefn => Initializer for variable, else NULL.
+ * mp->varstructflag = 1 if variable is in parent function's varstruct.
+ * mp->isforward = 1 if should be declared static.
+ * mp->isfunction = 1 if should be declared extern.
+ * mp->namedfile = 1 if this file variable has a shadow file-name variable.
+ * mp->bufferedfile = 1 if this file variable has a shadow buffer variable.
+ * mp->val.s => name format string if temporary var, else NULL.
+ *
+ * MK_VARREF: Variable always referenced through a pointer.
+ * mp->type => Type "pointer to T" where T is type of variable.
+ * mp->constdefn => Initializer for the pointer, else NULL.
+ * (Others same as for MK_VAR.)
+ *
+ * MK_VARMAC: Variable which has a VarMacro.
+ * mp->type => Type of variable.
+ * mp->constdefn => Expression for VarMacro definition.
+ * (Others same as for MK_VAR.)
+ *
+ * MK_SPVAR: Special variable.
+ * mp->handler => C function to parse and translate the special variable.
+ *
+ * MK_FIELD: Record/struct field name.
+ * mp->ctx, cbase = unused (unlike other meanings).
+ * mp->cnext => Next field in record or variant.
+ * mp->type => Type of field (base type if a bit-field).
+ * mp->rectype => Type of containing record.
+ * mp->constdefn => Expression for definition if FieldMacro, else NULL.
+ * mp->val.i = Number of bits if bit-field, or 0 if normal field.
+ * mp->val.type => True type of bit-field, else same as mp->type.
+ * mp->isforward = 1 if tag field for following variant, else 0.
+ * mp->namedfile = 1 if this file field has a shadow file-name field.
+ * mp->bufferedfile = 1 if this file field has a shadow buffer field.
+ *
+ * MK_VARIANT: Header for variant record case.
+ * mp->ctx => First field in variant (unlike other meanings).
+ * mp->cbase = unused (unlike other meanings).
+ * mp->cnext => Next variant in record (or next sub-variant in variant).
+ * mp->rectype => Type of containing record.
+ * mp->val = Tag value of variant.
+ *
+ * MK_LABEL: Statement label.
+ * mp->val.i => Case number if used by non-local gotos, else -1.
+ * mp->xnext => MK_VAR representing associated jmp_buf variable.
+ * (All optional fields are unused.)
+ *
+ * MK_FUNCTION: Procedure or function.
+ * mp->type => TK_FUNCTION type.
+ * mp->cbase => First meaning in procedure's context (when isfunction is 1,
+ * this will always be the return-value meaning.)
+ * mp->val.i => Body of the function (cast to Stmt *).
+ * mp->constdefn => Expression for definition if FuncMacro, else NULL.
+ * mp->handler => C function to adjust parse tree if predefined, else NULL.
+ * mp->isfunction = 1 if function, 0 if procedure.
+ * mp->isforward = 1 if function has been declared forward.
+ * mp->varstructflag = 1 if function has a varstruct.
+ * mp->needvarstruct = 1 if no varstruct yet but may need one.
+ * mp->namedfile = 1 if function should be declared "inline".
+ *
+ * MK_SPECIAL: Special, irregular built-in function.
+ * mp->handler => C function to parse and translate the special function.
+ * mp->constdefn => Expression for definition if FuncMacro, else NULL.
+ * mp->isfunction = 1 if function, 0 if procedure.
+ *
+ * MK_PARAM: Procedure or function parameter, or function return value.
+ * mp->type => Type of parameter.
+ * mp->isreturn = 1 if a function return value (not on parameter list).
+ * mp->xnext => Next parameter of function.
+ * mp->fakeparam = 1 if a fake parameter (e.g., conformant array size).
+ * mp->othername => Name of true param if this one is a local copy.
+ * mp->rectype => Type of true param if this one is a local copy.
+ * If a normal copy param, will be "pointer to" mp->type.
+ * If copied for varstruct reasons, will be same as mp->type.
+ * mp->varstructflag = 1 if variable is in parent function's varstruct.
+ *
+ * MK_VARPARAM: VAR parameter, or StructFunction return value.
+ * mp->type => Type "pointer to T" where T is type of parameter.
+ * mp->anyvarflag = 1 if no type checking is to be applied to parameter.
+ * mp->isreturn = 1 if a StructFunction return value (will be first param).
+ * (Others same as for MK_PARAM.)
+ *
+ * MK_VARPARAM with mp->type == tp_anyptr: Turbo "typeless var" parameter.
+ * mp->type = tp_anyptr.
+ * mp->anyvarflag = 1.
+ * (Others same as for MK_PARAM.)
+ *
+ * MK_VARPARAM with mp->type == tp_strptr: HP Pascal "var s:string" parameter.
+ * mp->type = tp_strptr.
+ * mp->anyvarflag = 1 if a separate "strmax" parameter is passed.
+ * (Others same as for MK_PARAM.)
+ *
+ * MK_SYNONYM: Meaning which should be treated as identical to another.
+ * mp->xnext => Actual meaning to be used.
+ *
+ */
+
+ enum meaningkind {
+ MK_NONE, MK_SPECIAL,
+ MK_MODULE, MK_FUNCTION, MK_CONST, MK_VAR, MK_TYPE,
+ MK_FIELD, MK_LABEL, MK_VARIANT,
+ MK_PARAM, MK_VARPARAM, MK_VARREF, MK_VARMAC,
+ MK_SPVAR, MK_SYNONYM,
+ MK_LAST
+ } ;
+
+ #ifdef DEFDUMPS
+ char *meaningkindnames[(int)MK_LAST] = {
+ "MK_NONE", "MK_SPECIAL",
+ "MK_MODULE", "MK_FUNCTION", "MK_CONST", "MK_VAR", "MK_TYPE",
+ "MK_FIELD", "MK_LABEL", "MK_VARIANT",
+ "MK_PARAM", "MK_VARPARAM", "MK_VARREF", "MK_VARMAC",
+ "MK_SPVAR", "MK_SYNONYM"
+ } ;
+ #endif /*DEFDUMPS*/
+
+ typedef struct S_meaning {
+ struct S_meaning *snext; /* Next meaning for this symbol */
+ struct S_meaning *cnext; /* Next meaning in this meaning's context */
+ struct S_meaning *cbase; /* First meaning in this context */
+ struct S_meaning *ctx; /* Context of this meaning */
+ struct S_meaning *xnext; /* (above) */
+ struct S_meaning *dtype; /* Declared type name, if any */
+ struct S_symbol *sym; /* Symbol of which this is a meaning */
+ struct S_type *type; /* (above) */
+ struct S_type *rectype; /* (above) */
+ struct S_expr *constdefn; /* (above) */
+ enum meaningkind kind; /* Kind of meaning */
+ unsigned needvarstruct:1, /* (above) */
+ varstructflag:1, /* (above) */
+ wasdeclared:1, /* Declaration has been written for meaning */
+ istemporary:1, /* Is a temporary variable */
+ isforward:1, /* (above) */
+ isfunction:1, /* (above) */
+ anyvarflag:1, /* (above) */
+ isactive:1, /* Meaning is currently in scope */
+ exported:1, /* Meaning is visible outside this module */
+ warnifused:1, /* WarnNames was 1 when meaning was declared */
+ dumped:1, /* Has been dumped (for debugging) */
+ isreturn:1, /* (above) */
+ fakeparam:1, /* (above) */
+ namedfile:1, /* (above) */
+ bufferedfile:1, /* (above) */
+ volatilequal:1, /* Object has C "volatile" qualifier */
+ constqual:1, /* Object has C "const" qualifier */
+ dummy17:1, dummy18:1, dummy19:1,
+ dummy20:1, dummy21:1, dummy22:1, dummy23:1, dummy24:1, dummy25:1,
+ dummy26:1, dummy27:1, dummy28:1, dummy29:1, dummy30:1, dummy31:1;
+ Value val; /* (above) */
+ int refcount; /* Number of references to meaning in program */
+ char *name; /* Print name (i.e., C name) of the meaning */
+ char *othername; /* (above) */
+ struct S_expr *(*handler)(); /* Custom translator for procedure */
+ Strlist *comments; /* Comments associated with meaning */
+ } Meaning;
+
+
+
+ /* "Type" notes:
+ *
+ * This struct represents a data type. Types are stored in a strange
+ * cross between Pascal and C semantics. (This usually works out okay.)
+ *
+ * TK_INTEGER: Base integer type.
+ * The following types are TK_INTEGER:
+ * tp_integer, tp_unsigned, tp_int, tp_uint, tp_sint.
+ * All other integer types are represented by subranges.
+ * tp->smin => Minimum value for integer.
+ * tp->smax => Maximum value for integer.
+ *
+ * TK_CHAR: Base character type.
+ * The following types are TK_CHAR: tp_char, tp_schar, tp_uchar.
+ * All other character types are represented by subranges.
+ * tp->smin => Minimum value for character.
+ * tp->smax => Maximum value for character.
+ *
+ * TK_BOOLEAN: Boolean type.
+ * The only TK_BOOLEAN type is tp_boolean.
+ * tp->smin => "False" expression.
+ * tp->smax => "True" expression.
+ *
+ * TK_REAL: Real types.
+ * The only TK_REAL types are tp_real, tp_longreal, and/or the SINGLE type.
+ *
+ * TK_VOID: C "void" type.
+ * The only TK_VOID type is tp_void.
+ *
+ * TK_SUBR: Subrange of ordinal type.
+ * tp->basetype => a TK_INTEGER, TK_CHAR, TK_BOOLEAN, or TK_ENUM type.
+ * tp->smin => Minimum ordinal value for subrange.
+ * tp->smax => Maximum ordinal value for subrange.
+ *
+ * TK_ENUM: Enumerated type.
+ * tp->fbase => First enumeration constant.
+ * tp->smin => Minimum value (zero).
+ * tp->smax => Maximum value (number of choices minus 1).
+ *
+ * TK_POINTER: Pointer type.
+ * tp->basetype => Base type of pointer.
+ * tp->smin => EK_NAME for type if not-yet-resolved forward; else NULL.
+ * tp->fbase => Actual type name for tp->basetype, or NULL.
+ * Only one pointer type is ever generated for a given other type;
+ * each tp->pointertype points back to that type if it has been generated.
+ *
+ * TK_STRING: Pascal string or VARYING OF CHAR type.
+ * tp->basetype => tp_char.
+ * tp->indextype => TK_SUBR from 0 to maximum string length.
+ * tp->structdefd = 1 if type is for a conformant VARYING OF CHAR parameter.
+ *
+ * TK_RECORD: Pascal record/C struct type.
+ * tp->fbase => First field in record.
+ * tp->structdefd = 1 if struct type has been declared in output.
+ *
+ * TK_ARRAY with smax == NULL: Normal array type.
+ * tp->basetype => Element type of array.
+ * tp->indextype => Index type (usually a TK_SUBR).
+ * tp->smin => Integer constant if SkipIndices was used, else NULL.
+ * tp->smax = NULL.
+ * tp->structdefd = 1 if type is for a conformant array parameter.
+ * tp->fbase => Actual type name for tp->basetype, or NULL.
+ *
+ * TK_ARRAY with smax != NULL: Large packed array type.
+ * tp->basetype => Element type of C array (tp_ubyte/tp_sbyte/tp_sshort).
+ * tp->indextype => Index type (usually a TK_SUBR).
+ * tp->smin => Integer constant if SkipIndices was used, else NULL.
+ * tp->smax => EK_TYPENAME for element type of Pascal array.
+ * tp->escale = log-base-two of number of bits per packed element, else 0.
+ * tp->issigned = 1 if packed array elements are signed, 0 if unsigned.
+ * tp->structdefd = 1 if type is for a conformant array parameter.
+ * tp->fbase => Actual type name for tp->basetype, or NULL.
+ *
+ * TK_SMALLARRAY: Packed array fitting within a single integer.
+ * (Same as for packed TK_ARRAY.)
+ *
+ * TK_SET: Normal set type.
+ * tp->basetype => tp_integer.
+ * tp->indextype => Element type of the set.
+ *
+ * TK_SMALLSET: Set fitting within a single integer.
+ * (Same as for TK_SET.)
+ *
+ * TK_FILE: File type (corresponds to C "FILE" type).
+ * tp->basetype => Type of file elements, or tp_abyte if UCSD untyped file.
+ * A Pascal "file" variable is represented as a TK_POINTER to a TK_FILE.
+ *
+ * TK_BIGFILE: File type with attached buffers and name.
+ * tp->basetype => Type of file elements, or tp_abyte if UCSD untyped file.
+ * A Pascal "file" variable is represented directly as a TK_BIGFILE.
+ *
+ * TK_FUNCTION: Procedure or procedure-pointer type.
+ * tp->basetype => Return type of function, or tp_void if procedure.
+ * tp->issigned = 1 if type has a generic static link.
+ * tp->fbase => First argument (or StructFunction return buffer pointer).
+ *
+ * TK_PROCPTR: Procedure pointer with static link.
+ * tp->basetype => TK_FUNCTION type.
+ * tp->fbase => Internal Meaning struct associated with basetype.
+ * tp->escale = Value of StaticLinks when type was declared.
+ *
+ * TK_CPROCPTR: Procedure pointer without static link.
+ * tp->basetype => TK_FUNCTION type.
+ * tp->fbase => Internal Meaning struct associated with basetype.
+ * tp->escale = Value of StaticLinks = 0.
+ *
+ * TK_SPECIAL: Special strange data type.
+ * Only TK_SPECIAL type at present is tp_jmp_buf.
+ *
+ */
+
+ enum typekind {
+ TK_NONE,
+ TK_INTEGER, TK_CHAR, TK_BOOLEAN, TK_REAL, TK_VOID,
+ TK_SUBR, TK_ENUM, TK_POINTER, TK_STRING,
+ TK_RECORD, TK_ARRAY, TK_SET, TK_FILE, TK_FUNCTION,
+ TK_PROCPTR, TK_SMALLSET, TK_SMALLARRAY, TK_CPROCPTR,
+ TK_SPECIAL, TK_BIGFILE,
+ TK_LAST
+ } ;
+
+ #ifdef DEFDUMPS
+ char *typekindnames[(int)TK_LAST] = {
+ "TK_NONE",
+ "TK_INTEGER", "TK_CHAR", "TK_BOOLEAN", "TK_REAL", "TK_VOID",
+ "TK_SUBR", "TK_ENUM", "TK_POINTER", "TK_STRING",
+ "TK_RECORD", "TK_ARRAY", "TK_SET", "TK_FILE", "TK_FUNCTION",
+ "TK_PROCPTR", "TK_SMALLSET", "TK_SMALLARRAY", "TK_CPROCPTR",
+ "TK_SPECIAL", "TK_BIGFILE"
+ } ;
+ #endif /*DEFDUMPS*/
+
+ typedef struct S_type {
+ enum typekind kind; /* Kind of type */
+ struct S_type *basetype; /* (above) */
+ struct S_type *indextype; /* (above) */
+ struct S_type *pointertype; /* Pointer to this type */
+ struct S_meaning *meaning; /* Name of this type, if any */
+ struct S_meaning *fbase; /* (above) */
+ struct S_expr *smin; /* (above) */
+ struct S_expr *smax; /* (above) */
+ unsigned issigned:1, /* (above) */
+ dumped:1, /* Has been dumped (for debugging) */
+ structdefd:1, /* (above) */
+ preserved:1; /* Declared with preservetypes = 1 */
+ short escale; /* (above) */
+ } Type;
+
+
+ /* "Expr" notes:
+ *
+ * Expression trees generally reflect C notation and semantics. For example,
+ * EK_ASSIGN is not generated for string arguments; these would get an
+ * EK_BICALL to strcpy instead.
+ *
+ * The data type of each expression node is stored in its "val.type" field.
+ * The rest of the "val" field is used only when shown below.
+ * The "nargs" field always contains the number of arguments; the "args"
+ * array is allocated to that size and will contain non-NULL Expr pointers.
+ *
+ * EK_EQ, EK_NE, EK_LT, EK_GT, EK_LE, EK_GE: Relational operators.
+ * ep->nargs = 2.
+ *
+ * EK_PLUS: Addition.
+ * ep->nargs >= 2.
+ *
+ * EK_NEG: Negation.
+ * ep->nargs = 1.
+ *
+ * EK_TIMES: Multiplication.
+ * ep->nargs >= 2.
+ *
+ * EK_DIVIDE: Real division.
+ * ep->nargs = 2.
+ *
+ * EK_DIV: Integer division.
+ * ep->nargs = 2.
+ *
+ * EK_MOD: Integer modulo (C "%" operator).
+ * ep->nargs = 2.
+ *
+ * EK_OR, EK_AND: Logical operators (C "&&" and "||").
+ * ep->nargs = 2.
+ *
+ * EK_NOT: Logical NOT (C "!" operator).
+ * ep->nargs = 1.
+ *
+ * EK_BAND, EK_BOR, EK_BXOR: Bitwise operators (C "&", "|", "^").
+ * ep->nargs = 2.
+ *
+ * EK_BNOT: Bitwise NOT (C "~" operator).
+ * ep->nargs = 1.
+ *
+ * EK_LSH, EK_RSH: Shift operators.
+ * ep->nargs = 2.
+ *
+ * EK_HAT: Pointer dereference.
+ * ep->nargs = 1.
+ *
+ * EK_INDEX: Array indexing.
+ * ep->nargs = 2.
+ *
+ * EK_CAST: "Soft" type cast, change data type retaining value.
+ * ep->type => New data type.
+ * ep->nargs = 1.
+ *
+ * EK_ACTCAST: "Active" type cast, performs a computation as result of cast.
+ * ep->type => New data type.
+ * ep->nargs = 1.
+ *
+ * EK_LITCAST: Literal type cast.
+ * ep->nargs = 2.
+ * ep->args[0] => EK_TYPENAME expression for name of new data type.
+ * ep->args[1] => Argument of cast.
+ *
+ * EK_DOT: Struct field extraction.
+ * ep->nargs = 1. (Only one of the following will be nonzero:)
+ * ep->val.i => MK_FIELD being extracted (cast to Meaning *), else 0.
+ * ep->val.s => Literal name of field being extracted, else NULL.
+ *
+ * EK_COND: C conditional expression.
+ * ep->nargs = 3.
+ * ep->args[0] => Condition expression.
+ * ep->args[1] => "Then" expression.
+ * ep->args[2] => "Else" expression.
+ *
+ * EK_ADDR: Address-of operator.
+ * ep->nargs = 1.
+ *
+ * EK_SIZEOF: Size-of operator.
+ * ep->nargs = 1.
+ * ep->args[0] => Argument expression, may be EK_TYPENAME.
+ *
+ * EK_CONST: Literal constant.
+ * ep->nargs = 0 or 1.
+ * ep->val = Value of constant.
+ * ep->args[0] => EK_NAME of printf format string for constant, if any.
+ *
+ * EK_LONGCONST: Literal constant, type "long int".
+ * (Same as for EK_CONST.)
+ *
+ * EK_VAR: Variable name.
+ * ep->nargs = 0.
+ * ep->val.i => Variable being referenced (cast to Meaning *).
+ *
+ * EK_ASSIGN: Assignment operator.
+ * ep->nargs = 2.
+ * ep->args[0] => Destination l-value expression.
+ * ep->args[1] => Source expression.
+ *
+ * EK_POSTINC, EK_POSTDEC: Post-increment/post-decrement operators.
+ * ep->nargs = 1.
+ *
+ * EK_MACARG: Placeholder for argument in expression for FuncMacro, etc.
+ * ep->nargs = 0.
+ * ep->val.i = Code selecting which argument.
+ *
+ * EK_CHECKNIL: Null-pointer check.
+ * ep->nargs = 1.
+ *
+ * EK_BICALL: Call to literal function name.
+ * ep->val.s => Name of function.
+ *
+ * EK_STRUCTCONST: Structured constant.
+ * ep->nargs = Number of elements in constant.
+ * (Note: constdefn points to an EK_CONST whose val.i points to this.)
+ *
+ * EK_STRUCTOF: Repeated element in structured constant.
+ * ep->nargs = 1.
+ * ep->val.i = Number of repetitions.
+ *
+ * EK_COMMA: C comma operator.
+ * ep->nargs >= 2.
+ *
+ * EK_NAME: Literal variable name.
+ * ep->nargs = 0.
+ * ep->val.s => Name of variable.
+ *
+ * EK_CTX: Name of a context, with static links.
+ * ep->nargs = 0.
+ * ep->val.i => MK_FUNCTION or MK_MODULE to name (cast to Meaning *).
+ *
+ * EK_SPCALL: Special function call.
+ * ep->nargs = 1 + number of arguments to function.
+ * ep->args[0] => Expression which is the function to call.
+ *
+ * EK_TYPENAME: Type name.
+ * ep->nargs = 0.
+ * ep->val.type => Type whose name should be printed.
+ *
+ * EK_FUNCTION: Normal function call.
+ * ep->val.i => MK_FUNCTION being called (cast to Meaning *).
+ *
+ */
+
+ enum exprkind {
+ EK_EQ, EK_NE, EK_LT, EK_GT, EK_LE, EK_GE,
+ EK_PLUS, EK_NEG, EK_TIMES, EK_DIVIDE,
+ EK_DIV, EK_MOD,
+ EK_OR, EK_AND, EK_NOT,
+ EK_BAND, EK_BOR, EK_BXOR, EK_BNOT, EK_LSH, EK_RSH,
+ EK_HAT, EK_INDEX, EK_CAST, EK_DOT, EK_COND,
+ EK_ADDR, EK_SIZEOF, EK_ACTCAST,
+ EK_CONST, EK_VAR, EK_FUNCTION,
+ EK_ASSIGN, EK_POSTINC, EK_POSTDEC, EK_CHECKNIL,
+ EK_MACARG, EK_BICALL, EK_STRUCTCONST, EK_STRUCTOF,
+ EK_COMMA, EK_LONGCONST, EK_NAME, EK_CTX, EK_SPCALL,
+ EK_LITCAST, EK_TYPENAME,
+ EK_LAST
+ } ;
+
+ #ifdef DEFDUMPS
+ char *exprkindnames[(int)EK_LAST] = {
+ "EK_EQ", "EK_NE", "EK_LT", "EK_GT", "EK_LE", "EK_GE",
+ "EK_PLUS", "EK_NEG", "EK_TIMES", "EK_DIVIDE",
+ "EK_DIV", "EK_MOD",
+ "EK_OR", "EK_AND", "EK_NOT",
+ "EK_BAND", "EK_BOR", "EK_BXOR", "EK_BNOT", "EK_LSH", "EK_RSH",
+ "EK_HAT", "EK_INDEX", "EK_CAST", "EK_DOT", "EK_COND",
+ "EK_ADDR", "EK_SIZEOF", "EK_ACTCAST",
+ "EK_CONST", "EK_VAR", "EK_FUNCTION",
+ "EK_ASSIGN", "EK_POSTINC", "EK_POSTDEC", "EK_CHECKNIL",
+ "EK_MACARG", "EK_BICALL", "EK_STRUCTCONST", "EK_STRUCTOF",
+ "EK_COMMA", "EK_LONGCONST", "EK_NAME", "EK_CTX", "EK_SPCALL",
+ "EK_LITCAST", "EK_TYPENAME"
+ } ;
+ #endif /*DEFDUMPS*/
+
+ typedef struct S_expr {
+ enum exprkind kind;
+ short nargs;
+ Value val;
+ struct S_expr *args[1]; /* (Actually, variable-sized) */
+ } Expr;
+
+
+
+ /* "Stmt" notes.
+ *
+ * Statements form linked lists along the "next" pointers.
+ * All other pointers are NULL and unused unless shown below.
+ *
+ * SK_ASSIGN: Assignment or function call (C expression statement).
+ * sp->exp1 => Expression to be evaluated.
+ *
+ * SK_RETURN: C "return" statement.
+ * sp->exp1 => Value to return, else NULL.
+ *
+ * SK_CASE: C "switch" statement.
+ * sp->exp1 => Switch selector expression.
+ * sp->stm1 => List of SK_CASELABEL statements, followed by list of
+ * statements that make up the "default:" clause.
+ *
+ * SK_CASELABEL: C "case" label.
+ * sp->exp1 => Case value.
+ * sp->stm1 => List of SK_CASELABELs labelling the same clause, followed
+ * by list of statements in that clause.
+ *
+ * SK_CASECHECK: Case-value-range-error, occurs in "default:" clause.
+ *
+ * SK_IF: C "if" statement.
+ * sp->exp1 => Conditional expression.
+ * sp->exp2 => Constant expression, "1" if this "if" should be else-if'd
+ * on to parent "if". NULL => follow ElseIf parameter.
+ * sp->stm1 => "Then" clause.
+ * sp->stm2 => "Else" clause.
+ *
+ * SK_FOR: C "for" statement.
+ * sp->exp1 => Initialization expression (may be NULL).
+ * sp->exp2 => Conditional expression (may be NULL).
+ * sp->exp3 => Iteration expression (may be NULL).
+ * sp->stm1 => Loop body.
+ *
+ * SK_REPEAT: C "do-while" statement.
+ * sp->exp1 => Conditional expression (True = continue loop).
+ * sp->stm1 => Loop body.
+ *
+ * SK_WHILE: C "while" statement.
+ * sp->exp1 => Conditional expression.
+ * sp->stm1 => Loop body.
+ *
+ * SK_BREAK: C "break" statement.
+ *
+ * SK_CONTINUE: C "continue" statement.
+ *
+ * SK_TRY: HP Pascal TRY-RECOVER statement.
+ * sp->exp1->val.i = Global serial number of the TRY statement.
+ * sp->exp2 = Non-NULL if must generate a label for RECOVER block.
+ * sp->stm1 => TRY block.
+ * sp->stm2 => RECOVER block.
+ *
+ * SK_GOTO: C "goto" statement.
+ * sp->exp1 => EK_NAME for the label number or name.
+ *
+ * SK_LABEL: C statement label.
+ * sp->exp1 => EK_NAME for the label number of name.
+ *
+ * SK_HEADER: Function/module header.
+ * sp->exp1 => EK_VAR pointing to MK_FUNCTION or MK_MODULE.
+ * (This always comes first in a context's statement list.)
+ *
+ * SK_BODY: Body of function/module.
+ * sp->stm1 => SK_HEADER that begins the body.
+ * (This exists only during fixblock.)
+ *
+ */
+
+ enum stmtkind {
+ SK_ASSIGN, SK_RETURN,
+ SK_CASE, SK_CASELABEL, SK_IF,
+ SK_FOR, SK_REPEAT, SK_WHILE, SK_BREAK, SK_CONTINUE,
+ SK_TRY, SK_GOTO, SK_LABEL,
+ SK_HEADER, SK_CASECHECK, SK_BODY,
+ SK_LAST
+ } ;
+
+ #ifdef DEFDUMPS
+ char *stmtkindnames[(int)SK_LAST] = {
+ "SK_ASSIGN", "SK_RETURN",
+ "SK_CASE", "SK_CASELABEL", "SK_IF",
+ "SK_FOR", "SK_REPEAT", "SK_WHILE", "SK_BREAK", "SK_CONTINUE",
+ "SK_TRY", "SK_GOTO", "SK_LABEL",
+ "SK_HEADER", "SK_CASECHECK", "SK_BODY"
+ } ;
+ #endif /*DEFDUMPS*/
+
+ typedef struct S_stmt {
+ enum stmtkind kind;
+ struct S_stmt *next, *stm1, *stm2;
+ struct S_expr *exp1, *exp2, *exp3;
+ long serial;
+ } Stmt;
+
+
+
+ /* Flags for out_declarator(): */
+
+ #define ODECL_CHARSTAR 0x1
+ #define ODECL_FREEARRAY 0x2
+ #define ODECL_FUNCTION 0x4
+ #define ODECL_HEADER 0x8
+ #define ODECL_FORWARD 0x10
+ #define ODECL_DECL 0x20
+ #define ODECL_NOPRES 0x40
+
+
+ /* Flags for fixexpr(): */
+
+ #define ENV_EXPR 0 /* return value needed */
+ #define ENV_STMT 1 /* return value ignored */
+ #define ENV_BOOL 2 /* boolean return value needed */
+
+
+ /* Flags for defmacro(): */
+ #define MAC_VAR 0 /* VarMacro */
+ #define MAC_CONST 1 /* ConstMacro */
+ #define MAC_FIELD 2 /* FieldMacro */
+ #define MAC_FUNC 3 /* FuncMacro */
+
+ #define FMACRECname "<rec>"
+
+
+ /* Kinds of comment lines: */
+ #define CMT_SHIFT 24
+ #define CMT_MASK ((1L<<CMT_SHIFT)-1)
+ #define CMT_KMASK ((1<<(32-CMT_SHIFT))-1)
+ #define CMT_DONE 0 /* comment that has already been printed */
+ #define CMT_PRE 1 /* comment line preceding subject */
+ #define CMT_POST 2 /* comment line following subject */
+ #define CMT_TRAIL 4 /* comment at end of line of code */
+ #define CMT_ONBEGIN 6 /* comment on "begin" of procedure */
+ #define CMT_ONEND 7 /* comment on "end" of procedure */
+ #define CMT_ONELSE 8 /* comment on "else" keyword */
+ #define CMT_NOT 256 /* negation of above, for searches */
+
+ #ifdef define_globals
+ char *CMT_NAMES[] = { "DONE", "PRE", "POST", "3", "TRAIL", "5",
+ "BEGIN", "END", "ELSE" };
+ #else
+ extern char *CMT_NAMES[];
+ #endif
+
+ #define getcommentkind(cmt) (((cmt)->value >> CMT_SHIFT) & CMT_KMASK)
+
+
+ /* Kinds of operator line-breaking: */
+ #define BRK_LEFT 0x1
+ #define BRK_RIGHT 0x2
+ #define BRK_LPREF 0x4
+ #define BRK_RPREF 0x8
+ #define BRK_ALLNONE 0x10
+ #define BRK_HANG 0x20
+
+
+
+
+ /* Translation parameters: */
+
+ #ifdef define_parameters
+ # define extern
+ #endif /* define_parameters */
+
+ extern enum {
+ UNIX_ANY, UNIX_BSD, UNIX_SYSV
+ } which_unix;
+
+ extern enum {
+ LANG_HP, LANG_UCSD, LANG_TURBO, LANG_OREGON, LANG_VAX,
+ LANG_MODULA, LANG_MPW, LANG_BERK
+ } which_lang;
+
+ extern short debug, tokentrace, quietmode, cmtdebug, copysource;
+ extern int nobanner, showprogress, maxerrors;
+ extern short hpux_lang, integer16, doublereals, pascalenumsize;
+ extern short needsignedbyte, unsignedchar, importall;
+ extern short nestedcomments, pascalsignif, pascalcasesens;
+ extern short dollar_idents, ignorenonalpha, modula2;
+ extern short ansiC, cplus, signedchars, signedfield, signedshift;
+ extern short hassignedchar, voidstar, symcase, ucconsts, csignif;
+ extern short copystructs, usevextern, implementationmodules;
+ extern short useAnyptrMacros, usePPMacros;
+ extern short sprintf_value;
+ extern char codefnfmt[40], modulefnfmt[40], logfnfmt[40];
+ extern char headerfnfmt[40], headerfnfmt2[40], includefnfmt[40];
+ extern char selfincludefmt[40];
+ extern char constformat[40], moduleformat[40], functionformat[40];
+ extern char varformat[40], fieldformat[40], typeformat[40];
+ extern char enumformat[40], symbolformat[40];
+ extern char p2c_h_name[40], exportsymbol[40], export_symbol[40];
+ extern char externalias[40];
+ extern char memcpyname[40], sprintfname[40];
+ extern char roundname[40], divname[40], modname[40], remname[40];
+ extern char strposname[40], strcicmpname[40];
+ extern char strsubname[40], strdeletename[40], strinsertname[40];
+ extern char strmovename[40], strpadname[40];
+ extern char strltrimname[40], strrtrimname[40], strrptname[40];
+ extern char absname[40], oddname[40], evenname[40], swapname[40];
+ extern char mallocname[40], freename[40], freervaluename[40];
+ extern char randrealname[40], randintname[40], randomizename[40];
+ extern char skipspacename[40], readlnname[40], freopenname[40];
+ extern char eofname[40], eolnname[40], fileposname[40], maxposname[40];
+ extern char setunionname[40], setintname[40], setdiffname[40];
+ extern char setinname[40], setaddname[40], setaddrangename[40];
+ extern char setremname[40];
+ extern char setequalname[40], subsetname[40], setxorname[40];
+ extern char setcopyname[40], setexpandname[40], setpackname[40];
+ extern char getbitsname[40], clrbitsname[40], putbitsname[40];
+ extern char declbufname[40], declbufncname[40];
+ extern char resetbufname[40], setupbufname[40];
+ extern char getfbufname[40], chargetfbufname[40], arraygetfbufname[40];
+ extern char putfbufname[40], charputfbufname[40], arrayputfbufname[40];
+ extern char getname[40], chargetname[40], arraygetname[40];
+ extern char putname[40], charputname[40], arrayputname[40];
+ extern char eofbufname[40], fileposbufname[40];
+ extern char storebitsname[40], signextname[40];
+ extern char filenotfoundname[40], filenotopenname[40];
+ extern char filewriteerrorname[40], badinputformatname[40], endoffilename[40];
+ extern short strcpyleft;
+ extern char language[40], target[40];
+ extern int sizeof_char, sizeof_short, sizeof_integer, sizeof_pointer,
+ sizeof_double, sizeof_float, sizeof_enum, sizeof_int, sizeof_long;
+ extern short size_t_long;
+ extern int setbits, defaultsetsize, seek_base, integerwidth, realwidth;
+ extern short quoteincludes, expandincludes, collectnest;
+ extern int phystabsize, intabsize, linewidth, maxlinewidth;
+ extern int majorspace, minorspace, functionspace, minfuncspace;
+ extern int casespacing, caselimit;
+ extern int returnlimit, breaklimit, continuelimit;
+ extern short nullstmtline, shortcircuit, shortopt, usecommas, elseif;
+ extern short usereturns, usebreaks, infloopstyle, reusefieldnames;
+ extern short bracesalways, braceline, bracecombine, braceelse, braceelseline;
+ extern short newlinefunctions;
+ extern short eatcomments, spitcomments, spitorphancomments;
+ extern short commentafter, blankafter;
+ extern int tabsize, blockindent, bodyindent, argindent;
+ extern int switchindent, caseindent, labelindent;
+ extern int openbraceindent, closebraceindent;
+ extern int funcopenindent, funccloseindent;
+ extern int structindent, structinitindent, extrainitindent;
+ extern int constindent, commentindent, bracecommentindent, commentoverindent;
+ extern int declcommentindent;
+ extern int minspacing, minspacingthresh;
+ extern int extraindent, bumpindent;
+ extern double overwidepenalty, overwideextrapenalty;
+ extern double commabreakpenalty, commabreakextrapenalty;
+ extern double assignbreakpenalty, assignbreakextrapenalty;
+ extern double specialargbreakpenalty;
+ extern double opbreakpenalty, opbreakextrapenalty, exhyphenpenalty;
+ extern double logbreakpenalty, logbreakextrapenalty;
+ extern double relbreakpenalty, relbreakextrapenalty;
+ extern double morebreakpenalty, morebreakextrapenalty;
+ extern double parenbreakpenalty, parenbreakextrapenalty;
+ extern double qmarkbreakpenalty, qmarkbreakextrapenalty;
+ extern double wrongsidepenalty, earlybreakpenalty, extraindentpenalty;
+ extern double bumpindentpenalty, nobumpindentpenalty;
+ extern double indentamountpenalty, sameindentpenalty;
+ extern double showbadlimit;
+ extern long maxalts;
+ extern short breakbeforearith, breakbeforerel, breakbeforelog;
+ extern short breakbeforedot, breakbeforeassign;
+ extern short for_allornone;
+ extern short extraparens, breakparens, returnparens;
+ extern short variablearrays, initpacstrings, stararrays;
+ extern short spaceexprs, spacefuncs, spacecommas, implicitzero, starindex;
+ extern int casetabs;
+ extern short starfunctions, mixfields, alloczeronil, postincrement;
+ extern short mixvars, mixtypes, mixinits, nullcharconst, castnull, addindex;
+ extern short highcharints, highcharbits, hasstaticlinks;
+ extern short mainlocals, storefilenames, addrstdfiles, readwriteopen;
+ extern short charfiletext, messagestderr, literalfilesflag, structfilesflag;
+ extern short printfonly, mixwritelns, usegets, newlinespace, binarymode;
+ extern char openmode[40], filenamefilter[40];
+ extern short atan2flag, div_po2, mod_po2, assumebits, assumesigns;
+ extern short fullstrwrite, fullstrread, whilefgets, buildreads, buildwrites;
+ extern short foldconsts, foldstrconsts, charconsts, useconsts, useundef;
+ extern short elimdeadcode, offsetforloops, forevalorder;
+ extern short smallsetconst, bigsetconst, lelerange, unsignedtrick;
+ extern short useisalpha, useisspace, usestrncmp;
+ extern short casecheck, arraycheck, rangecheck, nilcheck, malloccheck;
+ extern short checkfileopen, checkfileisopen, checkfilewrite;
+ extern short checkreadformat, checkfileeof, checkstdineof, checkfileseek;
+ extern short squeezesubr, useenum, enumbyte, packing, packsigned, keepnulls;
+ extern short compenums, formatstrings, alwayscopyvalues;
+ extern short use_static, var_static, void_args, prototypes, fullprototyping;
+ extern short procptrprototypes, promote_enums;
+ extern short preservetypes, preservepointers, preservestrings;
+ extern short castargs, castlongargs, promoteargs, fixpromotedargs;
+ extern short varstrings, varfiles, copystructfuncs;
+ extern long skipindices;
+ extern short stringleaders;
+ extern int stringceiling, stringdefault, stringtrunclimit, longstringsize;
+ extern short warnnames, warnmacros;
+ extern Strlist *importfrom, *importdirs, *includedirs, *includefrom;
+ extern Strlist *librfiles, *bufferedfiles, *unbufferedfiles;
+ extern Strlist *externwords, *cexternwords;
+ extern Strlist *varmacros, *constmacros, *fieldmacros;
+ extern Strlist *funcmacros, *funcmacroargs, *nameoflist;
+ extern Strlist *specialmallocs, *specialfrees, *specialsizeofs;
+ extern Strlist *initialcalls, *eatnotes, *literalfiles, *structfiles;
+
+ extern char fixedcomment[40], permanentcomment[40], interfacecomment[40];
+ extern char embedcomment[40], skipcomment[40], noskipcomment[40];
+ extern char signedcomment[40], unsignedcomment[40];
+
+ extern char name_RETV[40], name_STRMAX[40], name_LINK[40];
+ extern char name_COPYPAR[40], name_TEMP[40], name_DUMMY[40];
+ extern char name_LOC[40], name_VARS[40], name_STRUCT[40];
+ extern char name_FAKESTRUCT[40], name_AHIGH[40], name_ALOW[40];
+ extern char name_UNION[40], name_VARIANT[40], name_LABEL[40], name_LABVAR[40];
+ extern char name_WITH[40], name_FOR[40], name_ENUM[40];
+ extern char name_PTR[40], name_STRING[40], name_SET[40];
+ extern char name_PROCEDURE[40], name_MAIN[40], name_UNITINIT[40];
+ extern char name_HSYMBOL[40], name_GSYMBOL[40];
+ extern char name_SETBITS[40], name_UCHAR[40], name_SCHAR[40];
+ extern char name_BOOLEAN[40], name_TRUE[40], name_FALSE[40], name_NULL[40];
+ extern char name_ESCAPECODE[40], name_IORESULT[40];
+ extern char name_ARGC[40], name_ARGV[40];
+ extern char name_ESCAPE[40], name_ESCIO[40], name_CHKIO[40], name_SETIO[40];
+ extern char name_OUTMEM[40], name_CASECHECK[40], name_NILCHECK[40];
+ extern char name_FNSIZE[40], name_FNVAR[40];
+ extern char alternatename1[40], alternatename2[40], alternatename[40];
+
+
+ #ifndef define_parameters
+ extern
+ #endif
+ struct rcstruct {
+ char kind;
+ char chgmode;
+ char *name;
+ anyptr ptr;
+ long def;
+ } rctable[]
+ #ifdef define_parameters
+ = {
+ 'S', 'R', "DEBUG", (anyptr) &debug, 0,
+ 'I', 'R', "SHOWPROGRESS", (anyptr) &showprogress, 0,
+ 'S', 'V', "TOKENTRACE", (anyptr) &tokentrace, 0,
+ 'S', 'V', "QUIET", (anyptr) &quietmode, 0,
+ 'S', 'V', "COPYSOURCE", (anyptr) ©source, 0,
+ 'I', 'R', "MAXERRORS", (anyptr) &maxerrors, 0,
+ 'X', ' ', "INCLUDE", (anyptr) NULL, 2,
+
+ /* INPUT LANGUAGE */
+ 'U', 'T', "LANGUAGE", (anyptr) language, 40,
+ 'S', 'V', "MODULA2", (anyptr) &modula2, -1,
+ 'S', 'T', "INTEGER16", (anyptr) &integer16, -1,
+ 'S', 'T', "DOUBLEREALS", (anyptr) &doublereals, -1,
+ 'S', 'V', "UNSIGNEDCHAR", (anyptr) &unsignedchar, -1,
+ 'S', 'V', "NEEDSIGNEDBYTE", (anyptr) &needsignedbyte, 0,
+ 'S', 'V', "PASCALENUMSIZE", (anyptr) &pascalenumsize, -1,
+ 'S', 'V', "NESTEDCOMMENTS", (anyptr) &nestedcomments, -1,
+ 'S', 'V', "IMPORTALL", (anyptr) &importall, -1,
+ 'S', 'V', "IMPLMODULES", (anyptr) &implementationmodules, -1,
+ 'A', 'V', "EXTERNWORDS", (anyptr) &externwords, 0,
+ 'A', 'V', "CEXTERNWORDS", (anyptr) &cexternwords, 0,
+ 'S', 'V', "PASCALSIGNIF", (anyptr) &pascalsignif, -1,
+ 'S', 'V', "PASCALCASESENS", (anyptr) &pascalcasesens, -1,
+ 'S', 'V', "DOLLARIDENTS", (anyptr) &dollar_idents, -1,
+ 'S', 'V', "IGNORENONALPHA", (anyptr) &ignorenonalpha, -1,
+ 'I', 'V', "SEEKBASE", (anyptr) &seek_base, -1,
+ 'I', 'R', "INPUTTABSIZE", (anyptr) &intabsize, 8,
+
+ /* TARGET LANGUAGE */
+ 'S', 'T', "ANSIC", (anyptr) &ansiC, -1,
+ 'S', 'T', "C++", (anyptr) &cplus, -1,
+ 'S', 'T', "VOID*", (anyptr) &voidstar, -1,
+ 'S', 'T', "HASSIGNEDCHAR", (anyptr) &hassignedchar, -1,
+ 'S', 'V', "CASTNULL", (anyptr) &castnull, -1,
+ 'S', 'V', "COPYSTRUCTS", (anyptr) ©structs, -1,
+ 'S', 'V', "VARIABLEARRAYS", (anyptr) &variablearrays, -1,
+ 'S', 'V', "INITPACSTRINGS", (anyptr) &initpacstrings, -1,
+ 'S', 'V', "REUSEFIELDNAMES", (anyptr) &reusefieldnames, 1,
+ 'S', 'V', "USEVEXTERN", (anyptr) &usevextern, 1,
+ 'S', 'V', "CSIGNIF", (anyptr) &csignif, -1,
+ 'S', 'V', "USEANYPTRMACROS", (anyptr) &useAnyptrMacros, -1,
+ 'S', 'V', "USEPPMACROS", (anyptr) &usePPMacros, -1,
+
+ /* TARGET MACHINE */
+ 'U', 'T', "TARGET", (anyptr) target, 40,
+ 'S', 'T', "SIGNEDCHAR", (anyptr) &signedchars, -1,
+ 'S', 'T', "SIGNEDFIELD", (anyptr) &signedfield, -1,
+ 'S', 'T', "SIGNEDSHIFT", (anyptr) &signedshift, -1,
+ 'I', 'T', "CHARSIZE", (anyptr) &sizeof_char, 0,
+ 'I', 'T', "SHORTSIZE", (anyptr) &sizeof_short, 0,
+ 'I', 'T', "INTSIZE", (anyptr) &sizeof_int, 0,
+ 'I', 'T', "LONGSIZE", (anyptr) &sizeof_long, 0,
+ 'I', 'T', "PTRSIZE", (anyptr) &sizeof_pointer, 0,
+ 'I', 'T', "DOUBLESIZE", (anyptr) &sizeof_double, 0,
+ 'I', 'T', "FLOATSIZE", (anyptr) &sizeof_float, 0,
+ 'I', 'T', "ENUMSIZE", (anyptr) &sizeof_enum, 0,
+ 'S', 'T', "SIZE_T_LONG", (anyptr) &size_t_long, -1,
+
+ /* BRACES */
+ 'S', 'V', "NULLSTMTLINE", (anyptr) &nullstmtline, 0,
+ 'S', 'V', "BRACESALWAYS", (anyptr) &bracesalways, -1,
+ 'S', 'V', "BRACELINE", (anyptr) &braceline, -1,
+ 'S', 'V', "BRACECOMBINE", (anyptr) &bracecombine, 0,
+ 'S', 'V', "BRACEELSE", (anyptr) &braceelse, 0,
+ 'S', 'V', "BRACEELSELINE", (anyptr) &braceelseline, 0,
+ 'S', 'V', "ELSEIF", (anyptr) &elseif, -1,
+ 'S', 'V', "NEWLINEFUNCS", (anyptr) &newlinefunctions, 0,
+
+ /* INDENTATION */
+ 'I', 'R', "PHYSTABSIZE", (anyptr) &phystabsize, 8,
+ 'D', 'R', "INDENT", (anyptr) &tabsize, 2,
+ 'D', 'R', "BLOCKINDENT", (anyptr) &blockindent, 0,
+ 'D', 'R', "BODYINDENT", (anyptr) &bodyindent, 0,
+ 'D', 'R', "FUNCARGINDENT", (anyptr) &argindent, 1000,
+ 'D', 'R', "OPENBRACEINDENT", (anyptr) &openbraceindent, 0,
+ 'D', 'R', "CLOSEBRACEINDENT",(anyptr) &closebraceindent, 0,
+ 'D', 'R', "FUNCOPENINDENT", (anyptr) &funcopenindent, 0,
+ 'D', 'R', "FUNCCLOSEINDENT", (anyptr) &funccloseindent, 0,
+ 'D', 'R', "SWITCHINDENT", (anyptr) &switchindent, 0,
+ 'D', 'R', "CASEINDENT", (anyptr) &caseindent, -2,
+ 'D', 'R', "LABELINDENT", (anyptr) &labelindent, 1000,
+ 'D', 'R', "STRUCTINDENT", (anyptr) &structindent, 0,
+ 'D', 'R', "STRUCTINITINDENT",(anyptr) &structinitindent, 0,
+ 'D', 'R', "EXTRAINITINDENT", (anyptr) &extrainitindent, 2,
+ 'I', 'R', "EXTRAINDENT", (anyptr) &extraindent, 2,
+ 'I', 'R', "BUMPINDENT", (anyptr) &bumpindent, 1,
+ 'D', 'R', "CONSTINDENT", (anyptr) &constindent, 1024,
+ 'D', 'R', "COMMENTINDENT", (anyptr) &commentindent, 3,
+ 'D', 'R', "BRACECOMMENTINDENT",(anyptr)&bracecommentindent, 2,
+ 'D', 'R', "DECLCOMMENTINDENT",(anyptr)&declcommentindent, -999,
+ 'D', 'R', "COMMENTOVERINDENT",(anyptr)&commentoverindent, 4, /*1000*/
+ 'I', 'R', "MINSPACING", (anyptr) &minspacing, 2,
+ 'I', 'R', "MINSPACINGTHRESH",(anyptr) &minspacingthresh, -1,
+
+ /* LINE BREAKING */
+ 'I', 'R', "LINEWIDTH", (anyptr) &linewidth, 78,
+ 'I', 'R', "MAXLINEWIDTH", (anyptr) &maxlinewidth, 90,
+ 'R', 'V', "OVERWIDEPENALTY", (anyptr) &overwidepenalty, 2500,
+ 'R', 'V', "OVERWIDEEXTRAPENALTY", (anyptr) &overwideextrapenalty, 100,
+ 'R', 'V', "COMMABREAKPENALTY", (anyptr) &commabreakpenalty, 1000,
+ 'R', 'V', "COMMABREAKEXTRAPENALTY",(anyptr) &commabreakextrapenalty, 500,
+ 'R', 'V', "ASSIGNBREAKPENALTY", (anyptr) &assignbreakpenalty, 5000,
+ 'R', 'V', "ASSIGNBREAKEXTRAPENALTY",(anyptr)&assignbreakextrapenalty, 3000,
+ 'R', 'V', "SPECIALARGBREAKPENALTY",(anyptr) &specialargbreakpenalty, 500,
+ 'R', 'V', "OPBREAKPENALTY", (anyptr) &opbreakpenalty, 2500,
+ 'R', 'V', "OPBREAKEXTRAPENALTY", (anyptr) &opbreakextrapenalty, 2000,
+ 'R', 'V', "LOGBREAKPENALTY", (anyptr) &logbreakpenalty, 500,
+ 'R', 'V', "LOGBREAKEXTRAPENALTY", (anyptr) &logbreakextrapenalty, 100,
+ 'R', 'V', "RELBREAKPENALTY", (anyptr) &relbreakpenalty, 2000,
+ 'R', 'V', "RELBREAKEXTRAPENALTY", (anyptr) &relbreakextrapenalty, 1000,
+ 'R', 'V', "EXHYPHENPENALTY", (anyptr) &exhyphenpenalty, 1000,
+ 'R', 'V', "MOREBREAKPENALTY", (anyptr) &morebreakpenalty, -500,
+ 'R', 'V', "MOREBREAKEXTRAPENALTY", (anyptr) &morebreakextrapenalty, -300,
+ 'R', 'V', "QMARKBREAKPENALTY", (anyptr) &qmarkbreakpenalty, 5000,
+ 'R', 'V', "QMARKBREAKEXTRAPENALTY",(anyptr) &qmarkbreakextrapenalty, 3000,
+ 'R', 'V', "PARENBREAKPENALTY", (anyptr) &parenbreakpenalty, 2500,
+ 'R', 'V', "PARENBREAKEXTRAPENALTY",(anyptr) &parenbreakextrapenalty, 1000,
+ 'R', 'V', "WRONGSIDEPENALTY", (anyptr) &wrongsidepenalty, 1000,
+ 'R', 'V', "EARLYBREAKPENALTY", (anyptr) &earlybreakpenalty, 100,
+ 'R', 'V', "EXTRAINDENTPENALTY", (anyptr) &extraindentpenalty, 3000,
+ 'R', 'V', "BUMPINDENTPENALTY", (anyptr) &bumpindentpenalty, 1000,
+ 'R', 'V', "NOBUMPINDENTPENALTY", (anyptr) &nobumpindentpenalty, 2500,
+ 'R', 'V', "INDENTAMOUNTPENALTY", (anyptr) &indentamountpenalty, 50,
+ 'R', 'V', "SAMEINDENTPENALTY", (anyptr) &sameindentpenalty, 500,
+ 'R', 'V', "SHOWBADLIMIT", (anyptr) &showbadlimit, -120,
+ 'L', 'R', "MAXLINEBREAKTRIES", (anyptr) &maxalts, 5000,
+ 'G', 'V', "ALLORNONEBREAK", (anyptr) NULL, FALLBREAK,
+ 'G', 'V', "ONESPECIALARG", (anyptr) NULL, FSPCARG1,
+ 'G', 'V', "TWOSPECIALARGS", (anyptr) NULL, FSPCARG2,
+ 'G', 'V', "THREESPECIALARGS",(anyptr) NULL, FSPCARG3,
+ 'B', 'V', "BREAKARITH", (anyptr) &breakbeforearith, BRK_RIGHT,
+ 'B', 'V', "BREAKREL", (anyptr) &breakbeforerel, BRK_RIGHT,
+ 'B', 'V', "BREAKLOG", (anyptr) &breakbeforelog, BRK_RIGHT,
+ 'B', 'V', "BREAKDOT", (anyptr) &breakbeforedot, BRK_RIGHT,
+ 'B', 'V', "BREAKASSIGN", (anyptr) &breakbeforeassign, BRK_RIGHT,
+ 'S', 'V', "FOR_ALLORNONE", (anyptr) &for_allornone, 1,
+
+ /* COMMENTS AND BLANK LINES */
+ 'S', 'V', "NOBANNER", (anyptr) &nobanner, 0,
+ 'S', 'V', "EATCOMMENTS", (anyptr) &eatcomments, 0,
+ 'S', 'V', "SPITCOMMENTS", (anyptr) &spitcomments, 0,
+ 'S', 'V', "SPITORPHANCOMMENTS",(anyptr)&spitorphancomments, 0,
+ 'S', 'V', "COMMENTAFTER", (anyptr) &commentafter, -1,
+ 'S', 'V', "BLANKAFTER", (anyptr) &blankafter, 1,
+ 'A', 'V', "EATNOTES", (anyptr) &eatnotes, 0,
+
+ /* SPECIAL COMMENTS */
+ 'C', 'V', "FIXEDCOMMENT", (anyptr) fixedcomment, 40,
+ 'C', 'V', "PERMANENTCOMMENT",(anyptr) permanentcomment, 40,
+ 'C', 'V', "INTERFACECOMMENT",(anyptr) interfacecomment, 40,
+ 'C', 'V', "EMBEDCOMMENT", (anyptr) embedcomment, 40,
+ 'C', 'V', "SKIPCOMMENT", (anyptr) skipcomment, 40,
+ 'C', 'V', "NOSKIPCOMMENT", (anyptr) noskipcomment, 40,
+ 'C', 'V', "SIGNEDCOMMENT", (anyptr) signedcomment, 40,
+ 'C', 'V', "UNSIGNEDCOMMENT", (anyptr) unsignedcomment, 40,
+
+ /* STYLISTIC OPTIONS */
+ 'I', 'V', "MAJORSPACING", (anyptr) &majorspace, 2,
+ 'I', 'V', "MINORSPACING", (anyptr) &minorspace, 1,
+ 'I', 'V', "FUNCSPACING", (anyptr) &functionspace, 2,
+ 'I', 'V', "MINFUNCSPACING", (anyptr) &minfuncspace, 1,
+ 'S', 'V', "EXTRAPARENS", (anyptr) &extraparens, -1,
+ 'S', 'V', "BREAKADDPARENS", (anyptr) &breakparens, -1,
+ 'S', 'V', "RETURNPARENS", (anyptr) &returnparens, -1,
+ 'S', 'V', "SPACEEXPRS", (anyptr) &spaceexprs, -1,
+ 'S', 'V', "SPACEFUNCS", (anyptr) &spacefuncs, 0,
+ 'S', 'V', "SPACECOMMAS", (anyptr) &spacecommas, 1,
+ 'S', 'V', "IMPLICITZERO", (anyptr) &implicitzero, -1,
+ 'S', 'V', "STARINDEX", (anyptr) &starindex, -1,
+ 'S', 'V', "ADDINDEX", (anyptr) &addindex, -1,
+ 'S', 'V', "STARARRAYS", (anyptr) &stararrays, 1,
+ 'S', 'V', "STARFUNCTIONS", (anyptr) &starfunctions, -1,
+ 'S', 'V', "POSTINCREMENT", (anyptr) &postincrement, 1,
+ 'S', 'V', "MIXVARS", (anyptr) &mixvars, -1,
+ 'S', 'V', "MIXTYPES", (anyptr) &mixtypes, -1,
+ 'S', 'V', "MIXFIELDS", (anyptr) &mixfields, -1,
+ 'S', 'V', "MIXINITS", (anyptr) &mixinits, -1,
+ 'S', 'V', "MAINLOCALS", (anyptr) &mainlocals, 1,
+ 'S', 'V', "NULLCHAR", (anyptr) &nullcharconst, 1,
+ 'S', 'V', "HIGHCHARINT", (anyptr) &highcharints, 1,
+ 'I', 'V', "CASESPACING", (anyptr) &casespacing, 1,
+ 'D', 'V', "CASETABS", (anyptr) &casetabs, 1000,
+ 'I', 'V', "CASELIMIT", (anyptr) &caselimit, 9,
+ 'S', 'V', "USECOMMAS", (anyptr) &usecommas, -1,
+ 'S', 'V', "USERETURNS", (anyptr) &usereturns, 1,
+ 'I', 'V', "RETURNLIMIT", (anyptr) &returnlimit, 3,
+ 'S', 'V', "USEBREAKS", (anyptr) &usebreaks, 1,
+ 'I', 'V', "BREAKLIMIT", (anyptr) &breaklimit, 2,
+ 'I', 'V', "CONTINUELIMIT", (anyptr) &continuelimit, 5,
+ 'S', 'V', "INFLOOPSTYLE", (anyptr) &infloopstyle, 0,
+
+ /* NAMING CONVENTIONS */
+ 'C', 'V', "CODEFILENAME", (anyptr) codefnfmt, 40,
+ 'C', 'V', "MODULEFILENAME", (anyptr) modulefnfmt, 40,
+ 'C', 'V', "HEADERFILENAME", (anyptr) headerfnfmt, 40,
+ 'C', 'V', "HEADERFILENAME2", (anyptr) headerfnfmt2, 40,
+ 'C', 'V', "SELFINCLUDENAME", (anyptr) selfincludefmt, 40,
+ 'C', 'V', "LOGFILENAME", (anyptr) logfnfmt, 40,
+ 'C', 'V', "INCLUDEFILENAME", (anyptr) includefnfmt, 40,
+ 'S', 'V', "SYMCASE", (anyptr) &symcase, -1,
+ 'C', 'V', "SYMBOLFORMAT", (anyptr) symbolformat, 40,
+ 'C', 'V', "CONSTFORMAT", (anyptr) constformat, 40,
+ 'C', 'V', "MODULEFORMAT", (anyptr) moduleformat, 40,
+ 'C', 'V', "FUNCTIONFORMAT", (anyptr) functionformat, 40,
+ 'C', 'V', "VARFORMAT", (anyptr) varformat, 40,
+ 'C', 'V', "FIELDFORMAT", (anyptr) fieldformat, 40,
+ 'C', 'V', "TYPEFORMAT", (anyptr) typeformat, 40,
+ 'C', 'V', "ENUMFORMAT", (anyptr) enumformat, 40,
+ 'C', 'V', "RETURNVALUENAME", (anyptr) name_RETV, 40,
+ 'C', 'V', "UNITINITNAME", (anyptr) name_UNITINIT, 40,
+ 'C', 'V', "HSYMBOLNAME", (anyptr) name_HSYMBOL, 40,
+ 'C', 'V', "GSYMBOLNAME", (anyptr) name_GSYMBOL, 40,
+ 'C', 'V', "STRINGMAXNAME", (anyptr) name_STRMAX, 40,
+ 'C', 'V', "ARRAYMINNAME", (anyptr) name_ALOW, 40,
+ 'C', 'V', "ARRAYMAXNAME", (anyptr) name_AHIGH, 40,
+ 'C', 'V', "COPYPARNAME", (anyptr) name_COPYPAR, 40,
+ 'C', 'V', "STATICLINKNAME", (anyptr) name_LINK, 40,
+ 'C', 'V', "LOCALVARSSTRUCT", (anyptr) name_LOC, 40,
+ 'C', 'V', "LOCALVARSNAME", (anyptr) name_VARS, 40,
+ 'C', 'V', "FWDSTRUCTNAME", (anyptr) name_STRUCT, 40,
+ 'C', 'V', "ENUMLISTNAME", (anyptr) name_ENUM, 40,
+ 'C', 'V', "UNIONNAME", (anyptr) name_UNION, 40,
+ 'C', 'V', "UNIONPARTNAME", (anyptr) name_VARIANT, 40,
+ 'C', 'V', "FAKESTRUCTNAME", (anyptr) name_FAKESTRUCT, 40,
+ 'C', 'V', "LABELNAME", (anyptr) name_LABEL, 40,
+ 'C', 'V', "LABELVARNAME", (anyptr) name_LABVAR, 40,
+ 'C', 'V', "TEMPNAME", (anyptr) name_TEMP, 40,
+ 'C', 'V', "DUMMYNAME", (anyptr) name_DUMMY, 40,
+ 'C', 'V', "FORNAME", (anyptr) name_FOR, 40,
+ 'C', 'V', "WITHNAME", (anyptr) name_WITH, 40,
+ 'C', 'V', "PTRNAME", (anyptr) name_PTR, 40,
+ 'C', 'V', "STRINGNAME", (anyptr) name_STRING, 40,
+ 'C', 'V', "SETNAME", (anyptr) name_SET, 40,
+ 'C', 'V', "FNVARNAME", (anyptr) name_FNVAR, 40,
+ 'C', 'V', "FNSIZENAME", (anyptr) name_FNSIZE, 40,
+ 'C', 'V', "ALTERNATENAME1", (anyptr) alternatename1, 40,
+ 'C', 'V', "ALTERNATENAME2", (anyptr) alternatename2, 40,
+ 'C', 'V', "ALTERNATENAME", (anyptr) alternatename, 40,
+ 'C', 'V', "EXPORTSYMBOL", (anyptr) exportsymbol, 40,
+ 'C', 'V', "EXPORT_SYMBOL", (anyptr) export_symbol, 40,
+ 'C', 'V', "ALIAS", (anyptr) externalias, 40,
+ 'X', 'V', "SYNONYM", (anyptr) NULL, 3,
+ 'X', 'V', "NAMEOF", (anyptr) &nameoflist, 1,
+ 'G', 'V', "AVOIDNAME", (anyptr) NULL, AVOIDNAME,
+ 'G', 'V', "AVOIDGLOBALNAME", (anyptr) NULL, AVOIDGLOB,
+ 'G', 'V', "WARNNAME", (anyptr) NULL, WARNNAME,
+ 'G', 'V', "NOSIDEEFFECTS", (anyptr) NULL, NOSIDEEFF,
+ 'G', 'V', "STRUCTFUNCTION", (anyptr) NULL, STRUCTF,
+ 'G', 'V', "STRLAPFUNCTION", (anyptr) NULL, STRLAPF,
+ 'F', 'V', "LEAVEALONE", (anyptr) NULL, LEAVEALONE,
+ 'G', 'V', "DETERMINISTIC", (anyptr) NULL, DETERMF,
+ 'G', 'V', "NEEDSTATIC", (anyptr) NULL, NEEDSTATIC,
+ 'S', 'V', "WARNNAMES", (anyptr) &warnnames, 0,
+ 'M', 'V', "VARMACRO", (anyptr) NULL, MAC_VAR,
+ 'M', 'V', "CONSTMACRO", (anyptr) NULL, MAC_CONST,
+ 'M', 'V', "FIELDMACRO", (anyptr) NULL, MAC_FIELD,
+ 'M', 'V', "FUNCMACRO", (anyptr) NULL, MAC_FUNC,
+ 'S', 'V', "WARNMACROS", (anyptr) &warnmacros, 0,
+
+ /* CODING OPTIONS */
+ 'A', 'V', "INITIALCALLS", (anyptr) &initialcalls, 0,
+ 'S', 'V', "EXPANDINCLUDES", (anyptr) &expandincludes, -1,
+ 'S', 'V', "COLLECTNEST", (anyptr) &collectnest, 1,
+ 'S', 'V', "SHORTCIRCUIT", (anyptr) &shortcircuit, -1,
+ 'S', 'V', "SHORTOPT", (anyptr) &shortopt, 1,
+ 'S', 'V', "ELIMDEADCODE", (anyptr) &elimdeadcode, 1,
+ 'S', 'V', "FOLDCONSTANTS", (anyptr) &foldconsts, -1,
+ 'S', 'V', "FOLDSTRCONSTANTS",(anyptr) &foldstrconsts, -1,
+ 'S', 'V', "CHARCONSTS", (anyptr) &charconsts, 1,
+ 'S', 'V', "USECONSTS", (anyptr) &useconsts, -1,
+ 'S', 'V', "USEUNDEF", (anyptr) &useundef, 1,
+ 'L', 'V', "SKIPINDICES", (anyptr) &skipindices, 0,
+ 'S', 'V', "OFFSETFORLOOPS", (anyptr) &offsetforloops, 1,
+ 'S', 'V', "FOREVALORDER", (anyptr) &forevalorder, 0,
+ 'S', 'V', "STRINGLEADERS", (anyptr) &stringleaders, 2,
+ 'S', 'V', "STOREFILENAMES", (anyptr) &storefilenames, -1,
+ 'S', 'V', "CHARFILETEXT", (anyptr) &charfiletext, -1,
+ 'S', 'V', "SQUEEZESUBR", (anyptr) &squeezesubr, 1,
+ 'S', 'T', "USEENUM", (anyptr) &useenum, -1,
+ 'S', 'V', "SQUEEZEENUM", (anyptr) &enumbyte, -1,
+ 'S', 'V', "COMPENUMS", (anyptr) &compenums, -1,
+ 'S', 'V', "PRESERVETYPES", (anyptr) &preservetypes, 1,
+ 'S', 'V', "PRESERVEPOINTERS",(anyptr) &preservepointers, 0,
+ 'S', 'V', "PRESERVESTRINGS", (anyptr) &preservestrings, -1,
+ 'S', 'V', "PACKING", (anyptr) &packing, 1,
+ 'S', 'V', "PACKSIGNED", (anyptr) &packsigned, 1,
+ 'I', 'V', "STRINGCEILING", (anyptr) &stringceiling, 255,
+ 'I', 'V', "STRINGDEFAULT", (anyptr) &stringdefault, 255,
+ 'I', 'V', "STRINGTRUNCLIMIT",(anyptr) &stringtrunclimit, -1,
+ 'I', 'V', "LONGSTRINGSIZE", (anyptr) &longstringsize, -1,
+ 'S', 'V', "KEEPNULLS", (anyptr) &keepnulls, 0,
+ 'S', 'V', "HIGHCHARBITS", (anyptr) &highcharbits, -1,
+ 'S', 'V', "ALWAYSCOPYVALUES",(anyptr) &alwayscopyvalues, 0,
+ 'S', 'V', "STATICFUNCTIONS", (anyptr) &use_static, 1,
+ 'S', 'V', "STATICVARIABLES", (anyptr) &var_static, 1,
+ 'S', 'V', "VOIDARGS", (anyptr) &void_args, -1,
+ 'S', 'V', "PROTOTYPES", (anyptr) &prototypes, -1,
+ 'S', 'V', "FULLPROTOTYPING", (anyptr) &fullprototyping, -1,
+ 'S', 'V', "PROCPTRPROTOTYPES",(anyptr)&procptrprototypes, 1,
+ 'S', 'V', "CASTARGS", (anyptr) &castargs, -1,
+ 'S', 'V', "CASTLONGARGS", (anyptr) &castlongargs, -1,
+ 'S', 'V', "PROMOTEARGS", (anyptr) &promoteargs, -1,
+ 'S', 'V', "FIXPROMOTEDARGS", (anyptr) &fixpromotedargs, 1,
+ 'S', 'V', "PROMOTEENUMS", (anyptr) &promote_enums, -1,
+ 'S', 'V', "STATICLINKS", (anyptr) &hasstaticlinks, -1,
+ 'S', 'V', "VARSTRINGS", (anyptr) &varstrings, 0,
+ 'S', 'V', "VARFILES", (anyptr) &varfiles, 1,
+ 'S', 'V', "ADDRSTDFILES", (anyptr) &addrstdfiles, 0,
+ 'S', 'V', "COPYSTRUCTFUNCS", (anyptr) ©structfuncs, -1,
+ 'S', 'V', "ATAN2", (anyptr) &atan2flag, 0,
+ 'S', 'V', "BITWISEMOD", (anyptr) &mod_po2, -1,
+ 'S', 'V', "BITWISEDIV", (anyptr) &div_po2, -1,
+ 'S', 'V', "ASSUMEBITS", (anyptr) &assumebits, 0,
+ 'S', 'V', "ASSUMESIGNS", (anyptr) &assumesigns, 1,
+ 'S', 'V', "ALLOCZERONIL", (anyptr) &alloczeronil, 0,
+ 'S', 'V', "PRINTFONLY", (anyptr) &printfonly, -1,
+ 'S', 'V', "MIXWRITELNS", (anyptr) &mixwritelns, 1,
+ 'S', 'V', "MESSAGESTDERR", (anyptr) &messagestderr, 1,
+ 'I', 'V', "INTEGERWIDTH", (anyptr) &integerwidth, -1,
+ 'I', 'V', "REALWIDTH", (anyptr) &realwidth, 12,
+ 'S', 'V', "FORMATSTRINGS", (anyptr) &formatstrings, 0,
+ 'S', 'V', "WHILEFGETS", (anyptr) &whilefgets, 1,
+ 'S', 'V', "USEGETS", (anyptr) &usegets, 1,
+ 'S', 'V', "NEWLINESPACE", (anyptr) &newlinespace, -1,
+ 'S', 'V', "BUILDREADS", (anyptr) &buildreads, 1,
+ 'S', 'V', "BUILDWRITES", (anyptr) &buildwrites, 1,
+ 'S', 'V', "BINARYMODE", (anyptr) &binarymode, 1,
+ 'S', 'V', "READWRITEOPEN", (anyptr) &readwriteopen, -1,
+ 'C', 'V', "OPENMODE", (anyptr) openmode, 40,
+ 'S', 'V', "LITERALFILES", (anyptr) &literalfilesflag, -1,
+ 'A', 'V', "LITERALFILE", (anyptr) &literalfiles, 0,
+ 'S', 'V', "STRUCTFILES", (anyptr) &structfilesflag, 0,
+ 'A', 'V', "STRUCTFILE", (anyptr) &structfiles, 0,
+ 'C', 'V', "FILENAMEFILTER", (anyptr) filenamefilter, 40,
+ 'S', 'V', "FULLSTRWRITE", (anyptr) &fullstrwrite, -1,
+ 'S', 'V', "FULLSTRREAD", (anyptr) &fullstrread, 1,
+ 'I', 'R', "SETBITS", (anyptr) &setbits, -1,
+ 'I', 'V', "DEFAULTSETSIZE", (anyptr) &defaultsetsize, -1,
+ 'S', 'V', "SMALLSETCONST", (anyptr) &smallsetconst, -2,
+ 'S', 'V', "BIGSETCONST", (anyptr) &bigsetconst, 1,
+ 'S', 'V', "LELERANGE", (anyptr) &lelerange, 0,
+ 'S', 'V', "UNSIGNEDTRICK", (anyptr) &unsignedtrick, 1,
+ 'S', 'V', "USEISALPHA", (anyptr) &useisalpha, 1,
+ 'S', 'V', "USEISSPACE", (anyptr) &useisspace, 0,
+ 'S', 'V', "USESTRNCMP", (anyptr) &usestrncmp, 1,
+
+ /* TARGET LIBRARY */
+ 'G', 'V', "WARNLIBRARY", (anyptr) NULL, WARNLIBR,
+ 'S', 'V', "QUOTEINCLUDES", (anyptr) "eincludes, 1,
+ 'X', 'V', "IMPORTFROM", (anyptr) &importfrom, 1,
+ 'A', 'V', "IMPORTDIR", (anyptr) &importdirs, 0,
+ 'A', 'V', "INCLUDEDIR", (anyptr) &includedirs, 0,
+ 'X', 'V', "INCLUDEFROM", (anyptr) &includefrom, 1,
+ 'A', 'V', "LIBRARYFILE", (anyptr) &librfiles, 0,
+ 'C', 'V', "HEADERNAME", (anyptr) p2c_h_name, 40,
+ 'C', 'V', "PROCTYPENAME", (anyptr) name_PROCEDURE, 40,
+ 'C', 'V', "UCHARNAME", (anyptr) name_UCHAR, 40,
+ 'C', 'V', "SCHARNAME", (anyptr) name_SCHAR, 40,
+ 'C', 'V', "BOOLEANNAME", (anyptr) name_BOOLEAN, 40,
+ 'C', 'V', "TRUENAME", (anyptr) name_TRUE, 40,
+ 'C', 'V', "FALSENAME", (anyptr) name_FALSE, 40,
+ 'C', 'V', "NULLNAME", (anyptr) name_NULL, 40,
+ 'C', 'V', "ESCAPECODENAME", (anyptr) name_ESCAPECODE, 40,
+ 'C', 'V', "IORESULTNAME", (anyptr) name_IORESULT, 40,
+ 'C', 'V', "ARGCNAME", (anyptr) name_ARGC, 40,
+ 'C', 'V', "ARGVNAME", (anyptr) name_ARGV, 40,
+ 'C', 'V', "MAINNAME", (anyptr) name_MAIN, 40,
+ 'C', 'V', "ESCAPENAME", (anyptr) name_ESCAPE, 40,
+ 'C', 'V', "ESCIONAME", (anyptr) name_ESCIO, 40,
+ 'C', 'V', "CHECKIONAME", (anyptr) name_CHKIO, 40,
+ 'C', 'V', "SETIONAME", (anyptr) name_SETIO, 40,
+ 'C', 'V', "FILENOTFOUNDNAME",(anyptr) filenotfoundname, 40,
+ 'C', 'V', "FILENOTOPENNAME", (anyptr) filenotopenname, 40,
+ 'C', 'V', "FILEWRITEERRORNAME",(anyptr)filewriteerrorname,40,
+ 'C', 'V', "BADINPUTFORMATNAME",(anyptr)badinputformatname,40,
+ 'C', 'V', "ENDOFFILENAME", (anyptr) endoffilename, 40,
+ 'C', 'V', "OUTMEMNAME", (anyptr) name_OUTMEM, 40,
+ 'C', 'V', "CASECHECKNAME", (anyptr) name_CASECHECK, 40,
+ 'C', 'V', "NILCHECKNAME", (anyptr) name_NILCHECK, 40,
+ 'C', 'V', "SETBITSNAME", (anyptr) name_SETBITS, 40,
+ 'S', 'V', "SPRINTFVALUE", (anyptr) &sprintf_value, -1,
+ 'C', 'V', "SPRINTFNAME", (anyptr) sprintfname, 40,
+ 'C', 'V', "MEMCPYNAME", (anyptr) memcpyname, 40,
+ 'C', 'V', "ROUNDNAME", (anyptr) roundname, 40,
+ 'C', 'V', "DIVNAME", (anyptr) divname, 40,
+ 'C', 'V', "MODNAME", (anyptr) modname, 40,
+ 'C', 'V', "REMNAME", (anyptr) remname, 40,
+ 'C', 'V', "STRCICMPNAME", (anyptr) strcicmpname, 40,
+ 'C', 'V', "STRSUBNAME", (anyptr) strsubname, 40,
+ 'C', 'V', "STRPOSNAME", (anyptr) strposname, 40,
+ 'S', 'V', "STRCPYLEFT", (anyptr) &strcpyleft, 1,
+ 'C', 'V', "STRDELETENAME", (anyptr) strdeletename, 40,
+ 'C', 'V', "STRINSERTNAME", (anyptr) strinsertname, 40,
+ 'C', 'V', "STRMOVENAME", (anyptr) strmovename, 40,
+ 'C', 'V', "STRLTRIMNAME", (anyptr) strltrimname, 40,
+ 'C', 'V', "STRRTRIMNAME", (anyptr) strrtrimname, 40,
+ 'C', 'V', "STRRPTNAME", (anyptr) strrptname, 40,
+ 'C', 'V', "STRPADNAME", (anyptr) strpadname, 40,
+ 'C', 'V', "ABSNAME", (anyptr) absname, 40,
+ 'C', 'V', "ODDNAME", (anyptr) oddname, 40,
+ 'C', 'V', "EVENNAME", (anyptr) evenname, 40,
+ 'C', 'V', "SWAPNAME", (anyptr) swapname, 40,
+ 'C', 'V', "MALLOCNAME", (anyptr) mallocname, 40,
+ 'C', 'V', "FREENAME", (anyptr) freename, 40,
+ 'C', 'V', "FREERVALUENAME", (anyptr) freervaluename, 40,
+ 'X', 'V', "SPECIALMALLOC", (anyptr) &specialmallocs, 1,
+ 'X', 'V', "SPECIALFREE", (anyptr) &specialfrees, 1,
+ 'X', 'V', "SPECIALSIZEOF", (anyptr) &specialsizeofs, 1,
+ 'C', 'V', "RANDREALNAME", (anyptr) randrealname, 40,
+ 'C', 'V', "RANDINTNAME", (anyptr) randintname, 40,
+ 'C', 'V', "RANDOMIZENAME", (anyptr) randomizename, 40,
+ 'C', 'V', "SKIPSPACENAME", (anyptr) skipspacename, 40,
+ 'C', 'V', "READLNNAME", (anyptr) readlnname, 40,
+ 'C', 'V', "FREOPENNAME", (anyptr) freopenname, 40,
+ 'C', 'V', "EOFNAME", (anyptr) eofname, 40,
+ 'C', 'V', "EOLNNAME", (anyptr) eolnname, 40,
+ 'C', 'V', "FILEPOSNAME", (anyptr) fileposname, 40,
+ 'C', 'V', "MAXPOSNAME", (anyptr) maxposname, 40,
+ 'C', 'V', "SETUNIONNAME", (anyptr) setunionname, 40,
+ 'C', 'V', "SETINTNAME", (anyptr) setintname, 40,
+ 'C', 'V', "SETDIFFNAME", (anyptr) setdiffname, 40,
+ 'C', 'V', "SETXORNAME", (anyptr) setxorname, 40,
+ 'C', 'V', "SETINNAME", (anyptr) setinname, 40,
+ 'C', 'V', "SETADDNAME", (anyptr) setaddname, 40,
+ 'C', 'V', "SETADDRANGENAME", (anyptr) setaddrangename, 40,
+ 'C', 'V', "SETREMNAME", (anyptr) setremname, 40,
+ 'C', 'V', "SETEQUALNAME", (anyptr) setequalname, 40,
+ 'C', 'V', "SUBSETNAME", (anyptr) subsetname, 40,
+ 'C', 'V', "SETCOPYNAME", (anyptr) setcopyname, 40,
+ 'C', 'V', "SETEXPANDNAME", (anyptr) setexpandname, 40,
+ 'C', 'V', "SETPACKNAME", (anyptr) setpackname, 40,
+ 'C', 'V', "SIGNEXTENDNAME", (anyptr) signextname, 40,
+ 'C', 'V', "GETBITSNAME", (anyptr) getbitsname, 40,
+ 'C', 'V', "CLRBITSNAME", (anyptr) clrbitsname, 40,
+ 'C', 'V', "PUTBITSNAME", (anyptr) putbitsname, 40,
+ 'C', 'V', "STOREBITSNAME", (anyptr) storebitsname, 40,
+ 'C', 'V', "DECLBUFNAME", (anyptr) declbufname, 40,
+ 'C', 'V', "DECLBUFNCNAME", (anyptr) declbufncname, 40,
+ 'A', 'V', "BUFFEREDFILE", (anyptr) &bufferedfiles, 0,
+ 'A', 'V', "UNBUFFEREDFILE", (anyptr) &unbufferedfiles, 0,
+ 'C', 'V', "RESETBUFNAME", (anyptr) resetbufname, 40,
+ 'C', 'V', "SETUPBUFNAME", (anyptr) setupbufname, 40,
+ 'C', 'V', "GETFBUFNAME", (anyptr) getfbufname, 40,
+ 'C', 'V', "CHARGETFBUFNAME", (anyptr) chargetfbufname, 40,
+ 'C', 'V', "ARRAYGETFBUFNAME",(anyptr) arraygetfbufname, 40,
+ 'C', 'V', "PUTFBUFNAME", (anyptr) putfbufname, 40,
+ 'C', 'V', "CHARPUTFBUFNAME", (anyptr) charputfbufname, 40,
+ 'C', 'V', "ARRAYPUTFBUFNAME",(anyptr) arrayputfbufname, 40,
+ 'C', 'V', "GETNAME", (anyptr) getname, 40,
+ 'C', 'V', "CHARGETNAME", (anyptr) chargetname, 40,
+ 'C', 'V', "ARRAYGETNAME", (anyptr) arraygetname, 40,
+ 'C', 'V', "PUTNAME", (anyptr) putname, 40,
+ 'C', 'V', "CHARPUTNAME", (anyptr) charputname, 40,
+ 'C', 'V', "ARRAYPUTNAME", (anyptr) arrayputname, 40,
+ 'C', 'V', "EOFBUFNAME", (anyptr) eofbufname, 40,
+ 'C', 'V', "FILEPOSBUFNAME", (anyptr) fileposbufname, 40,
+
+ /* RANGE CHECKING */
+ 'S', 'V', "CASECHECK", (anyptr) &casecheck, 0,
+ 'S', 'V', "ARRAYCHECK", (anyptr) &arraycheck, 0,
+ 'S', 'V', "RANGECHECK", (anyptr) &rangecheck, 0,
+ 'S', 'V', "NILCHECK", (anyptr) &nilcheck, 0,
+ 'S', 'V', "MALLOCCHECK", (anyptr) &malloccheck, 0,
+ 'S', 'V', "CHECKFILEOPEN", (anyptr) &checkfileopen, 1,
+ 'S', 'V', "CHECKFILEISOPEN", (anyptr) &checkfileisopen, 0,
+ 'S', 'V', "CHECKFILEWRITE", (anyptr) &checkfilewrite, 2,
+ 'S', 'V', "CHECKREADFORMAT", (anyptr) &checkreadformat, 2,
+ 'S', 'V', "CHECKFILEEOF", (anyptr) &checkfileeof, 2,
+ 'S', 'V', "CHECKSTDINEOF", (anyptr) &checkstdineof, 2,
+ 'S', 'V', "CHECKFILESEEK", (anyptr) &checkfileseek, 2,
+ }
+ #endif /* define_parameters */
+ ;
+
+
+ #undef extern
+
+
+ #ifdef define_parameters
+ int numparams = sizeof(rctable) / sizeof(struct rcstruct);
+ Strlist *rcprevvalues[sizeof(rctable) / sizeof(struct rcstruct)];
+ #else
+ extern int numparams;
+ extern Strlist *rcprevvalues[];
+ #endif /* define_parameters */
+
+
+
+ /* Global variables: */
+
+ #ifdef define_globals
+ # define extern
+ #endif /* define_globals */
+
+
+ extern char *charname, *ucharname, *scharname, *integername;
+ extern long min_schar, max_schar, max_uchar;
+ extern long min_sshort, max_sshort, max_ushort;
+
+ extern char *alloctemp;
+ extern short error_crash;
+ extern int total_bytes, total_exprs, total_meanings, total_strings;
+ extern int total_symbols, total_types, total_stmts, total_strlists;
+ extern int total_literals, total_ctxstacks, total_tempvars, total_inprecs;
+ extern int total_parens, total_ptrdescs, total_misc;
+ extern int final_bytes, final_exprs, final_meanings, final_strings;
+ extern int final_symbols, final_types, final_stmts, final_strlists;
+ extern int final_literals, final_ctxstacks, final_tempvars, final_inprecs;
+ extern int final_parens, final_ptrdescs, final_misc;
+
+ extern char *infname, *outfname, *codefname, *hdrfname;
+ extern char *requested_module;
+ extern FILE *inf, *outf, *codef, *hdrf, *logf;
+ extern short setup_complete, found_module;
+ extern short regression, verbose, conserve_mem;
+ extern int inf_lnum, inf_ltotal;
+
+ extern int outindent, outputmode;
+ extern int outf_lnum;
+ extern short dontbreaklines;
+
+ extern Token curtok;
+ extern char curtokbuf[256], curtokcase[256];
+ extern char *inbufptr;
+ extern int inbufindent;
+ extern long curtokint;
+ extern Symbol *curtoksym;
+ extern Meaning *curtokmeaning;
+ extern Strlist *curcomments;
+ extern Strlist **keepingstrlist;
+ extern short ignore_directives, skipping_module;
+ extern short C_lex;
+ extern char sysprog_flag, partial_eval_flag, iocheck_flag;
+ extern char range_flag, ovflcheck_flag, stackcheck_flag;
+ extern short switch_strpos;
+ extern int fixedflag;
+ extern int numimports;
+ extern Strlist *tempoptionlist;
+ extern long curserial, serialcount;
+ extern int notephase;
+ extern Strlist *permimports;
+ extern int permflag;
+
+ #define SYMHASHSIZE 293
+ extern Symbol *(symtab[SYMHASHSIZE]);
+ extern short partialdump;
+
+ #define MAXWITHS 100
+ extern int withlevel;
+ extern Type *withlist[MAXWITHS];
+ extern Expr *withexprs[MAXWITHS];
+
+ extern Token blockkind;
+ extern Meaning *curctx, *curctxlast, *nullctx;
+
+ extern int fixexpr_tryblock;
+ extern short fixexpr_tryflag;
+
+ extern Type *tp_integer, *tp_char, *tp_boolean, *tp_real, *tp_longreal;
+ extern Type *tp_anyptr, *tp_jmp_buf, *tp_schar, *tp_uchar, *tp_charptr;
+ extern Type *tp_int, *tp_sshort, *tp_ushort, *tp_abyte, *tp_sbyte, *tp_ubyte;
+ extern Type *tp_void, *tp_str255, *tp_strptr, *tp_text, *tp_bigtext;
+ extern Type *tp_unsigned, *tp_uint, *tp_sint, *tp_smallset, *tp_proc;
+ extern Meaning *mp_string, *mp_true, *mp_false;
+ extern Meaning *mp_input, *mp_output, *mp_stderr;
+ extern Meaning *mp_maxint, *mp_minint, *mp_escapecode, *mp_ioresult;
+ extern Meaning *mp_uchar, *mp_schar, *mp_unsigned, *mp_uint;
+ extern Meaning *mp_str_hp, *mp_str_turbo;
+ extern Meaning *mp_val_modula, *mp_val_turbo;
+ extern Meaning *mp_blockread_ucsd, *mp_blockread_turbo;
+ extern Meaning *mp_blockwrite_ucsd, *mp_blockwrite_turbo;
+ extern Meaning *mp_dec_dec, *mp_dec_turbo;
+ extern Expr *ex_input, *ex_output;
+ extern Strlist *attrlist;
+
+
+ #ifndef define_globals
+ # undef extern
+ #endif
+
+
+
+
+ /* Function declarations are created automatically by "makeproto" */
+
+ #include "p2c.hdrs"
+
+ #include "p2c.proto"
+
+
+
+ /* Our library omits declarations for these functions! */
+
+ int link PP( (char *, char *) );
+ int unlink PP( (char *) );
+
+
+
+ #define minspcthresh ((minspacingthresh >= 0) ? minspacingthresh : minspacing)
+
+ #define delfreearg(ex, n) freeexpr((*(ex))->args[n]), deletearg(ex, n)
+ #define delsimpfreearg(ex, n) freeexpr((*(ex))->args[n]), delsimparg(ex, n)
+
+ #define swapexprs(a,b) do {register Expr *t=(a);(a)=(b);(b)=(t);} while (0)
+ #define swapstmts(a,b) do {register Stmt *t=(a);(a)=(b);(b)=(t);} while (0)
+
+ #define CHECKORDEXPR(ex,v) ((ex)->kind==EK_CONST ? (ex)->val.i - (v) : -2)
+
+ #define FCheck(flag) ((flag) == 1 || (!iocheck_flag && (flag)))
+ #define checkeof(fex) (isvar(fex, mp_input) ? FCheck(checkstdineof) \
+ : FCheck(checkfileeof))
+
+
+ #ifdef TEST_MALLOC /* Memory testing */
+
+ #define ALLOC(N,TYPE,NAME) \
+ (TYPE *) test_malloc((unsigned)((N)*sizeof(TYPE)), \
+ &__CAT__(total_,NAME), &__CAT__(final_,NAME))
+
+ #define ALLOCV(N,TYPE,NAME) \
+ (TYPE *) test_malloc((unsigned)(N), \
+ &__CAT__(total_,NAME), &__CAT__(final_,NAME))
+
+ #define REALLOC(P,N,TYPE) \
+ (TYPE *) test_realloc((char *)(P), (unsigned)((N)*sizeof(TYPE)))
+
+ #define FREE(P) test_free((char*)(P))
+
+ #else /* not TEST_MALLOC */
+
+ /* If p2c always halts immediately with an out-of-memory error, try
+ recompiling all modules with BROKEN_OR defined. */
+ #ifdef BROKEN_OR
+
+ #define ALLOC(N,TYPE,NAME) \
+ ((alloctemp = malloc((unsigned)((N)*sizeof(TYPE)))), \
+ (alloctemp ? (TYPE *) alloctemp : (TYPE *) outmem()))
+
+ #define ALLOCV(N,TYPE,NAME) \
+ ((alloctemp = malloc((unsigned)(N))), \
+ (alloctemp ? (TYPE *) alloctemp : (TYPE *) outmem()))
+
+ #define REALLOC(P,N,TYPE) \
+ ((alloctemp = realloc((char*)(P), (unsigned)((N)*sizeof(TYPE)))), \
+ (alloctemp ? (TYPE *) alloctemp : (TYPE *) outmem()))
+
+ #define FREE(P) free((char*)(P))
+
+ #else /* not BROKEN_OR */
+
+ #define ALLOC(N,TYPE,NAME) \
+ ((alloctemp = malloc((unsigned)((N)*sizeof(TYPE)))) || outmem(), \
+ (TYPE *) alloctemp)
+
+ #define ALLOCV(N,TYPE,NAME) \
+ ((alloctemp = malloc((unsigned)(N))) || outmem(), \
+ (TYPE *) alloctemp)
+
+ #define REALLOC(P,N,TYPE) \
+ ((alloctemp = realloc((char*)(P), (unsigned)((N)*sizeof(TYPE)))) || outmem(), \
+ (TYPE *) alloctemp)
+
+ #define FREE(P) free((char*)(P))
+
+ #endif /* BROKEN_OR */
+ #endif /* TEST_MALLOC */
+
+
+ #define MIN(a,b) ((a) < (b) ? (a) : (b))
+ #define MAX(a,b) ((a) > (b) ? (a) : (b))
+
+
+
+ #ifdef toupper
+ # undef toupper
+ # undef tolower
+ # define toupper(c) my_toupper(c)
+ # define tolower(c) my_tolower(c)
+ #endif
+
+ #ifndef _toupper
+ # if 'A' == 65 && 'a' == 97
+ # define _toupper(c) ((c)-'a'+'A')
+ # define _tolower(c) ((c)-'A'+'a')
+ # else
+ # ifdef toupper
+ # undef toupper /* hope these are shadowing real functions, */
+ # undef tolower /* because my_toupper calls _toupper! */
+ # endif
+ # define _toupper(c) toupper(c)
+ # define _tolower(c) tolower(c)
+ # endif
+ #endif
+
+
+
+
+ /* End. */
+
More information about the llvm-commits
mailing list