Google Git
Sign in
fuchsia / third_party / github.com / llvm / llvm-test-suite / ca00bd8d7afe1bbb393d0e6a1672db70de5d5042 / . / MultiSource / Benchmarks / MallocBench / p2c / decl.c
blob: 8769a39532a1a74cc425d66b81a6ce2e430f1d07 [file] [log] [blame]
/* "p2c", a Pascal to C translator.
Copyright (C) 1989, 1990, 1991 Free Software Foundation.
Author's address: daveg@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. */