Logo Search packages:      
Sourcecode: p2c version File versions  Download package

decl.c

/* "p2c", a Pascal to C translator.
   Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation.
   Author's address: daveg@synaptics.com.

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 int useextern;

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;
    distinctdef = 0;
    varstructdecllist = NULL;
    nonloclabelcount = -1;
    useextern = -1;
    new_array_size = NULL;
    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 */
    mp = makestandardmeaning(MK_TYPE, "FIXED");
    mp->type = tp_longreal;
    mp = makestandardmeaning(MK_TYPE, "DECIMAL");
    mp->type = tp_longreal;

    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_cproc = maketype(TK_CPROCPTR);
    tp_cproc->basetype = maketype(TK_FUNCTION);
    tp_cproc->basetype->basetype = tp_void;
    tp_cproc->escale = 0;

    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 && !all)
      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 0
          if (mp->kind == MK_CONST)
            free_value(&mp->val);
#endif
          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, (char *)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->isref = 0;
    mp->comments = NULL;
    mp->rectype = NULL;
}



int issafename(sp, isglobal, isdefine, isfield)
Symbol *sp;
int isglobal, isdefine, isfield;
{
    Meaning *mp;

    if ((!*alternatename1 || !strcmp(alternatename1, "%s")) &&
      (!*alternatename2 || !strcmp(alternatename2, "%s")) &&
      (!*alternatename || !strcmp(alternatename, "%s")))
      return 1;
    if (isfield && (sp->flags & AVOIDFIELD) && !reusefieldnames)
      return 0;
    if (isdefine && curctx->kind != MK_FUNCTION) {
      if (sp->flags & FWDPARAM)
          return 0;
    }
    if (distinctdef) {
      mp = curctx->cbase;
      while (mp) {
          if (mp->name && !strcmp(mp->name, sp->name))
            return 0;
          mp = mp->cnext;
      }
    }
    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 && !distinctdef)
        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) {
          mp->kind = 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", (char *)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", (char *)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, 0) &&
           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, 1));
          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));
}


int israndomfile(type)
Type *type;
{
    if (type->kind == TK_POINTER)
      type = type->basetype;
    return ((type->kind == TK_FILE || type->kind == TK_BIGFILE) &&
          type->issigned);
}


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)
      if (mp->kind == MK_FIELD)
          return makeexpr_dotq(copyexpr(ex->args[0]),
                         format_s(name_FNVAR, mp->name),
                         tp_str255);
      else
          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) {
                      flags &= ~ODECL_CHARSTAR;
#ifdef PRES_PTR_ARRAY
                      type = type->basetype;
#else
                      type = type->basetype->basetype;
                      continue;
#endif
                  }
                        break;

                default:
                  break;
                }
            if (type->preserved && !(flags & ODECL_NOPRES))
                return type;
            if (type->fbase && type->fbase->wasdeclared &&
                type->basetype->kind != TK_POINTER &&
                (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, (mp->isref) ? ODECL_REF : 0);
                } else {
                  if (dopromote)
                      tp = promote_type(tp);
                  if (mp->dtype)
                      output(mp->dtype->name);
                  else
                      outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
                  outdeclarator(tp, name,
                              ODECL_CHARSTAR | ODECL_FREEARRAY |
                              ODECL_SPACE |
                              ((mp->isref) ? ODECL_REF : 0));
                }
            }
                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, spaceafter;
    Expr *dimen[30];
    Expr *ex, *maxv;
    Type *tp, *functype, *basetype;
    Expr funcdummy;   /* yow */

    anyptrs = 0;
    anyarrays = 0;
    functype = NULL;
    basetype = findbasetype(type, flags);
    depth = 0;
    if (flags & ODECL_REF)
      dimen[depth++] = NULL;
    if (new_array_size) {
      dimen[depth++] = copyexpr(new_array_size);
      anyarrays = 1;
      new_array_size = NULL;
    }
    for (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;
#ifdef PRES_PTR_ARRAY
                        if (tp->preserved && !(flags & ODECL_NOPRES))
                            continue;
#endif
                      } else {
                        continue;
                      }
                            break;

                  default:
                      break;
                    }
                }
                dimen[depth++] = NULL;
                anyptrs++;
            if (tp->kind == TK_POINTER &&
                tp->basetype->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(" ");
    spaceafter = ((spacestars == 1 || spacestars == 3 ||
               (spacestars == 2 && (flags & ODECL_REF) && depth == 1)) &&
              depth > 0 && !dimen[depth-1]);
    if ((flags & ODECL_SPACE) && !spaceafter)
      output((flags & ODECL_SPMRG) ? " \005" : " ");
    if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
      output("\003");
    for (i = depth; --i >= 0; ) {
        if (!dimen[i]) {
          if (i == 0 && (flags & ODECL_REF)) {
            if ((flags & ODECL_SPACE) && spaceafter && spacestars == 3) {
                output((flags & ODECL_SPMRG) ? " \005" : " ");
                spaceafter = 0;
            }
            output("&");
          } else
            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");
    if ((flags & ODECL_SPACE) && spaceafter)
      output((flags & ODECL_SPMRG) ? " \005" : " ");
    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));
}


int tinyexpr(ex)
Expr *ex;
{
    if (ex->kind == EK_CONST || ex->kind == EK_LONGCONST) {
      if (ex->val.type->kind == TK_INTEGER ||
          (ex->val.type->kind == TK_REAL && strlen(ex->val.s) < 8) ||
          ex->val.type->kind == TK_CHAR ||
          (ex->val.type->kind == TK_POINTER && ex->val.i == 0) ||
          (ex->val.type->kind == TK_SMALLSET && ex->val.i == 0) ||
          ex->val.type->kind == TK_BOOLEAN ||
          (ex->val.type->kind == TK_STRING && ex->val.i <= 3))
          return 1;
    } else if (ex->kind == EK_VAR) {
      if (strlen(((Meaning *)ex->val.i)->name) < 8)
          return 1;
    }
    return 0;
}


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 && tinyexpr(mp2->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, 0);
            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, flags, only_union, empty, saveindent, saveindent2;
    int isprivate = 0;
    Type *virtdestr = NULL;
    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_VARIANT) {
      if (mp->isreturn && !isprivate) {
          output("private:\n");
          isprivate = 1;
      }
      flushcomments(&mp->comments, CMT_PRE, -1);
      output(storageclassname(varstorageclass(mp) & 0x10));
      if (mp->kind == MK_FUNCTION && mp->bufferedfile)
          output("virtual ");
      if (mp->dtype)
          output(mp->dtype->name);
      else
          outbasetype(mp->type, 0);
      flags = 0;
      if (mp->dtype)
          output(" \005");
      else
          flags = ODECL_SPACE|ODECL_SPMRG;
      for (;;) {
          if (mp->dtype)
            output(mp->name);
          else
            outdeclarator(mp->type, mp->name, flags);
          flags = 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->kind == MK_FUNCTION && mp->val.s && mp->val.s[0] == 'D' &&
            mp->bufferedfile)
            virtdestr = mp->rectype;
          if (!mp->cnext || mp->cnext->kind == MK_VARIANT ||
            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("}");
          if (!anonymousunions) {
            output(" ");
            output(format_s(name_UNION, ""));
          }
            output(";\n");
        }
    }
    if (virtdestr) {
      output(format_s("virtual ~%s() { }\n", virtdestr->meaning->name));
    }
}



void declarebigfile(type)
Type *type;
{
    output("FILE *f;\n");
    if (!*declbufncname) {
      output(declbufname);
      output("(f,,");
    } else {
      output(declbufncname);
      output("(f,");
    }
    out_type(type->basetype, 0);
    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 ");
                  if (cplus > 0 && type->meaning)
                      output(format_s("%s ", type->meaning->name));
                        output("{\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 (type->issigned && type->kind == TK_RECORD)
                      output("class ");
                  else if (record_is_union(type))
                            output("union ");
                        else
                            output("struct ");
                        if (type->meaning)
                            output(format_s(name_STRUCT, type->meaning->name));
                  else if (type->smin)
                      output(type->smin->val.s);
                  if (!type->structdefd ||
                       (!type->meaning && !type->smin)) {
                      if (type->meaning || type->smin) {
                        if (type->issigned && type->basetype) {
                            output(" : public ");
                            output(type->basetype->meaning->name);
                        }
                        output(" ");
                      } else if (type->structdefd) {
                        note(format_s("Consider using TagStructs or {%s} for this [328]",
                                    tagcomment));
                      }
                      type->structdefd = 1;
                            output("{\n");
                      if (type->issigned && type->kind == TK_RECORD &&
                        type->fbase && !type->fbase->isreturn)
                        output("public:\n");
                      saveindent = outindent;
                      moreindent(tabsize);
                      moreindent(structindent);
                      if (type->kind == TK_BIGFILE) {
                        declarebigfile(type);
                      } else {
                        outfieldlist(type->fbase);
                        if (type->issigned && !turboobjects)
                            output(format_s("virtual ~%s() { }\n",
                                        format_s(name_STRUCT,
                                               type->meaning->name)));
                      }
                            outindent = saveindent;
                            output("}");
                        }
                  break;

                default:
                  break;

                }
            }
            break;
    }
}



void out_type(type, flags)
Type *type;
int flags;
{
    if ((flags & ODECL_ARRAYPTRS) && type->kind == TK_ARRAY)
        type = makepointertype(type->basetype);
    outbasetype(type, flags);
    outdeclarator(type, "", flags);    /* write an "abstract declarator" */
}



int onewordstring(cp)
char *cp;
{
    while (isalnum(*cp) || *cp == '_')
      cp++;
    return !*cp;
}


int onewordtype(type, flags)
Type *type;
int flags;
{
    Type *tp;

    if (flags & ODECL_REF)
      return 0;
    if ((flags & ODECL_ARRAYPTRS) && type->kind == TK_ARRAY)
      return 0;
    tp = findbasetype(type, flags | ODECL_DECL);
    if (tp->preserved && tp->meaning->wasdeclared)
      return 1;
    if (tp != type) {
      if (type->kind == TK_POINTER || type->kind == TK_ARRAY ||
          type->kind == TK_STRING || type->kind == TK_STRING ||
          type->kind == TK_CPROCPTR || type->kind == TK_FUNCTION)
          return 0;
    }
    if (((tp == tp_ubyte || tp == tp_uchar) && !onewordstring(ucharname)) ||
      ((tp == tp_sbyte || tp == tp_schar) && !onewordstring(scharname)) ||
      (tp->kind == TK_CHAR && !onewordstring(charname)) ||
      (tp->kind == TK_BOOLEAN &&
       !onewordstring((*name_BOOLEAN) ? name_BOOLEAN : ucharname)) ||
      tp == tp_unsigned || tp == tp_ushort || tp == tp_special_anyptr ||
      tp->kind == TK_PROCPTR || tp->kind == TK_FILE ||
      tp->kind == TK_SPECIAL)
      return 0;
    if (tp->kind == TK_INTEGER) {
      if (tp == tp_uint || tp == tp_int)
          return 1;
      if (tp == tp_sint)
          return (useAnyptrMacros != 1 && !hassignedchar);
      return onewordstring(integername);
    }
    if (type->meaning && type->meaning->kind == MK_TYPE &&
      type->meaning->wasdeclared)
      return 1;
    return 0;
}




int varstorageclass(mp)
Meaning *mp;
{
    int sclass;

    if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM ||
      mp->kind == MK_FIELD)
      sclass = 0;
    else if (useextern >= 0)
      if (useextern > 0)
          sclass = 2;   /* extern */
      else
          sclass = 0;   /* (plain) */
    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 || 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;    /* VDECL_... */
{
    int isstatic, isstructconst, saveindent, i, flags = 0;
    Strlist *sl;
    Type *tp = mp->type;

    isstructconst = checkstructconst(mp);
    isstatic = varstorageclass(mp);
    if (which & VDECL_VARSTRUCT)
      isstatic &= 0x10;   /* clear all but Volatile flags */
    flushcomments(&mp->comments, CMT_PRE, -1);
    if ((which & VDECL_VARSTRUCT) && mp->isref)
      tp = makepointertype(tp);
    if (which & VDECL_HEADER) {
        if (isstructconst)
            outsection(minorspace);
        output(storageclassname(isstatic));
      if (mp->dtype && tp == mp->type) {
          output(mp->dtype->name);
          output(" \005");
        } else {
          outbasetype(tp, 0);
          if (which & VDECL_BODY)
            flags = ODECL_SPACE|ODECL_SPMRG;
          else
            output(" \005");
      }
    }
    if (which & VDECL_BODY) {
      if (mp->dtype && tp == mp->type)
          output(mp->name);
      else
          outdeclarator(tp, mp->name, flags);
      flags = 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 & VDECL_TRAILER) {
        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, (VDECL_BODY | (first ? VDECL_HEADER : 0) |
                            (invarstruct ? VDECL_VARSTRUCT : 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, VDECL_TRAILER);
    }
    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, oflags = 0;
    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;
          if (mp->dtype)
            output(mp->dtype->name);
          else
            outbasetype(mp->othername ? mp->rectype : mp->type,
                      ODECL_CHARSTAR|ODECL_FREEARRAY);
          oflags = ODECL_SPACE|ODECL_SPMRG;
            while (mp) {
                if (!mp->wasdeclared) {
                    if (mp == mp0 ||
                  (mp->dtype == mp0->dtype &&
                   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|oflags);
                  oflags = 0;
                        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);
    if (slashslash)
      output(format_s("\n// Local variables for %s:\n", func->name));
    else
      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);
    if (which_lang == LANG_TIP && smax <= 16)
      if (smax <= 8)
          tp->basetype = tp_uchar;
      else
          tp->basetype = tp_ushort;
    else
      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, ODECL_NOPRES), &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 */
    }
}




void makestructtag(type, tname)
Type *type;
char *tname;
{
    Symbol *sym;
    char *name;
    int altnum;

    if (!type->meaning && !type->smin) {
      altnum = -1;
      do {
          altnum++;
          name = format_s(name_FAKESTRUCT, tname);
          sym = findsymbol(findaltname(name, altnum));
      } while (!issafename(sym, 1, 0, 0));
      sym->flags |= AVOIDNAME;
      type->smin = makeexpr_name(sym->name, tp_integer);
    }
}




Static void p_fieldlist(tp, flast, ispacked, tname)
Type *tp;
Meaning **flast;
int ispacked;
Meaning *tname;
{
    Meaning *firstm, *lastm, *veryfirstm, *dtype, *mp;
    Symbol *sym;
    Type *type, *tp2;
    long li1, li2;
    int aligned, constflag, volatileflag;
    short saveskipind;
    Strlist *l1;
    int isprivate = 0, turboprivate = 0;

    saveskipind = skipindices;
    skipindices = 0;
    aligned = 1;
    lastm = NULL;
    veryfirstm = NULL;
    for (;;) {
      if (curtok == TOK_PRIVATE) {
          gettok();
          /* Not safe:  Turbo uses a wider definition of "private"! */
          /* isprivate = 1; */
          turboprivate = 1;
      }
      if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION ||
          curtok == TOK_CONSTRUCTOR || curtok == TOK_DESTRUCTOR) {
          int isfunc = (curtok == TOK_FUNCTION);
          char *special = ((curtok == TOK_CONSTRUCTOR) ? "C" :
                       (curtok == TOK_DESTRUCTOR) ? "D" : NULL);
          Meaning *func, *func2;
          gettok();
          if (curtok == TOK_IDENT && curtokmeaning == tname) {
            gettok();
            wneedtok(TOK_DOT);
          }
          if (!wexpecttok(TOK_IDENT))
            skiptotoken(TOK_IDENT);
          func = addfield(curtoksym, &flast, tp, tname);
          func->kind = MK_FUNCTION;
          curtoksym = findsymbol(format_ss("%s::%s", tname->name,
                                   func->name));
          func2 = addmeaning(curtoksym, MK_FUNCTION);
          func2->name = stralloc(curtoksym->name);
          gettok();
          func->val.i = func2->val.i = 0;
          func->val.s = func2->val.s = special;
          pushctx(func2);
          func->type = func2->type = p_funcdecl(&isfunc, 0);
          popctx();
          func->isfunction = isfunc;
          func->namedfile = 0;
          func->isforward = 1;
          func->isreturn = isprivate;
          func->fakeparam = turboprivate;
          func->type->meaning = func;
          func2->isfunction = isfunc;
          func2->namedfile = 0;
          func2->isforward = 1;
          func2->rectype = tp;
          func->xnext = func2;
          func->ctx = func2->ctx;
          func->cbase = func2->cbase;
          if (turboprivate) {
            tp2 = tp->basetype;
            while (tp2) {
                mp = func->sym->fbase;
                while (mp && mp->rectype != tp2)
                  mp = mp->snext;
                if (mp && !mp->fakeparam) {
                  note(format_s("Private member %s overrides parent's public member [336]", mp->name));
                  break;
                }
                tp2 = tp2->basetype;
            }
          }
          needtok(TOK_SEMI);
          if (curtok == TOK_VIRTUAL) {
            func->bufferedfile = 1;
            gettok();
            needtok(TOK_SEMI);
          } else if (curtok == TOK_OVERRIDE) {
            gettok();
            needtok(TOK_SEMI);
          }
          if (!turboobjects)
            func->bufferedfile = 1;   /* always virtual */
          continue;
      }
      if (curtok != TOK_IDENT)
          break;
        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);
          if (tagstructs > 0)
            makestructtag(type, firstm->name);
          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;
            firstm->isreturn = isprivate;
            firstm->fakeparam = turboprivate;
            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) {
            if (curtok == TOK_SEMI)
                gettok();
            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 ||
          (which_lang == LANG_TIP &&
           (curtok != TOK_IDENT || curtokmeaning))) {
          **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;
          if (which_lang == LANG_TIP) {
            tp2->smin = p_expr(tp_integer);
            wneedtok(TOK_DOTS);
            wneedtok(TOK_QM);
            tp2->smax = makeexpr_var(mp->xnext);
          } else {
            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 = 1L<<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, israndom = 0;
    Meaning **flast;
    Meaning *mp;
    Strlist *sl;
    int num, isfunc, saveind, savenotephase, sizespec;
    Expr *ex;
    Value val;
    static int proctypecount = 0;
    int isclass;

    p_attributes();
    sizespec = size_attributes();
    ignore_attributes();
    tp = tp_integer;
    if (curtok == TOK_PACKED) {
        ispacked = 1;
        gettok();
    }
    checkkeyword(TOK_VARYING);
    checkkeyword(TOK_RANDOM);
    checkkeyword(TOK_OBJECT);
    if (curtok == TOK_RANDOM) {
      israndom = 1;
      gettok();
    }
    if (modula2)
      checkkeyword(TOK_POINTER);
    switch (curtok) {

        case TOK_RECORD:
        case TOK_OBJECT:  /* Turbo 6.0 or Object Pascal objects */
          isclass = (curtok == TOK_OBJECT);
          if (isclass) {
            if (turboobjects) {
                findsymbol("CONSTRUCTOR")->flags &= ~KWPOSS;
                findsymbol("DESTRUCTOR")->flags &= ~KWPOSS;
                findsymbol("VIRTUAL")->flags &= ~KWPOSS;
                findsymbol("PRIVATE")->flags &= ~KWPOSS;
            } else {
                findsymbol("INHERITED")->flags &= ~KWPOSS;
                findsymbol("OVERRIDE")->flags &= ~KWPOSS;
            }
          }
          taggedflag = 0;
          gettok();
          savenotephase = notephase;
          notephase = 1;
            tp = maketype(TK_RECORD);
          if (taggedflag)
            makestructtag(tp, tname ? tname->name : "struct");
          tp->issigned = isclass;
          tp->basetype = NULL;
          if (curtok == TOK_LPAR) {
            gettok();
            expecttok(TOK_IDENT);
            if (curtokmeaning && curtokmeaning->kind == MK_TYPE &&
                curtokmeaning->type->kind == TK_RECORD)
                tp->basetype = curtokmeaning->type;
            else
                warning("Expected a base object type name [329]");
            gettok();
            if (!wneedtok(TOK_RPAR))
                skippasttoken(TOK_RPAR);
          }
            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);
          tp->issigned = israndom;
            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);
                }
            } else if (curtok == TOK_LPAR) {
                gettok();
                ex = p_ord_expr();
                if (curtok == TOK_COMMA) {
                  gettok();
                  (void)p_ord_expr();
                }
                skipcloseparen();
                tp = tp_longreal;
            }
            if (tp->kind == TK_RECORD && tp->issigned && !turboobjects)
                tp = makepointertype(tp);
            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;
    Meaning *dtype;
    Type *type, *tp;
    enum meaningkind parkind;
    int anyvarflag, constflag, volatileflag, refflag, 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 = refflag = 0;
          defval = NULL;
          dtype = 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 {
                if (curtok == TOK_IDENT)
                  dtype = curtokmeaning;
                    tp = p_type(firstmp);
                dtype = validatedtype(dtype, tp);
                }
                if (!varfiles && isfiletype(tp, 0))
                    parkind = MK_PARAM;
                if (parkind == MK_VARPARAM) {
                if (userefs && !anyvarflag && tp != tp_anyptr &&
                  tp->kind != TK_STRING &&
                  tp->kind != TK_ARRAY &&
                  tp->kind != TK_SMALLARRAY &&
                  tp->kind != TK_SET &&
                  tp->kind != TK_SMALLSET) {
                  parkind = MK_PARAM;
                  refflag = 1;
                } else
                  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->dtype = dtype;
                firstmp->kind = parkind;    /* in case it changed */
                firstmp->isactive = 1;
                firstmp->anyvarflag = anyvarflag;
            firstmp->constqual = constflag;
            firstmp->volatilequal = volatileflag;
            firstmp->isref = refflag;
            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)) {
          dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
          retmp->type = type->basetype = p_type(NULL);
          dtype = validatedtype(dtype, type->basetype);
          if (dtype)
            type->smin = makeexpr_name(dtype->name, tp_integer);
          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 &&
      !curtokmeaning->isreturn) {
#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_VARIANT) {
        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));
            if (mp->type->kind == TK_INTEGER ||
                mp->type->kind == TK_SUBR ||
                mp->type->kind == TK_CHAR ||
                mp->type->kind == TK_ENUM ||
                mp->type->kind == TK_BOOLEAN ||
                mp->type->kind == TK_REAL ||
                mp->type->kind == TK_POINTER)
                cex->args[i] = makeexpr_val(make_ord(mp->type, 0));
            else
                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:
      note("Generated code for set initializer must be rearranged [342]");
      if (curtok == TOK_LBR)
          return p_setfactor(type->indextype, 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);
                        outdeclarator(mp->type, mp->name,
                              ODECL_CHARSTAR|ODECL_FREEARRAY |
                              ODECL_SPACE);
                        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);
                            outdeclarator(mp->type, mp->name,
                                ODECL_CHARSTAR|ODECL_SPACE);
                            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;

    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 (cplus <= 0)
            output("typedef ");
          if (mp->type->issigned)
            output("class ");
          else if (record_is_union(mp->type))
            output("union ");
          else
            output("struct ");
          if (cplus > 0)
            output(mp->name);
          else
            output(format_s(name_STRUCT, mp->name));
          if (mp->type->issigned && mp->type->basetype) {
            output(" : public ");
            output(mp->type->basetype->meaning->name);
          }
          output(" {\n");
          if (mp->type->issigned && mp->type->fbase &&
            !mp->type->fbase->isreturn)
            output("public:\n");
          saveindent = outindent;
          moreindent(tabsize);
          moreindent(structindent);
          if (mp->type->kind == TK_BIGFILE) {
            declarebigfile(mp->type);
          } else {
            outfieldlist(mp->type->fbase);
            if (mp->type->issigned && !turboobjects)
                output(format_s("virtual ~%s() { }\n", mp->name));
          }
          outindent = saveindent;
          if (cplus > 0)
            output("};");
          else
            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);
          outdeclarator(mp->type, mp->name, ODECL_SPACE);
      }
      output(";");
      outtrailcomment(mp->comments, -1, declcommentindent);
      break;
      
      case TK_ENUM:
      if (useenum) {
          if (cplus <= 0)
            output("typedef ");
          if (mp->type->meaning != mp)
            output(mp->type->meaning->name);
          else
            outbasetype(mp->type, 0);
          if (cplus <= 0) {
            output(" ");
            output(mp->name);
          }
          output(";");
          outtrailcomment(mp->comments, -1,
                      declcommentindent);
      }
      break;
      
      default:
      if (preservetype(mp->type)) {
          output("typedef ");
          if (mp->type->meaning != mp &&
            mp->dtype && mp->dtype != mp) {
            output(mp->dtype->name);
          } else {
            mp->type->preserved = 0;
            outbasetype(mp->type, 0);
          }
          outdeclarator(mp->type, mp->name, ODECL_SPACE);
          output(";\n");
          mp->type->preserved = 1;
          outtrailcomment(mp->comments, -1, declcommentindent);
      }
      break;
    }
    mp->wasdeclared = 1;
}



int preservetype(type)
Type *type;
{
    if (type->kind == TK_STRING && preservestrings >= 0)
      if (preservestrings == 2)
          return type->indextype->smax->kind != EK_CONST;
      else
          return preservestrings;
    if (type->kind == TK_POINTER && preservepointers >= 0)
      return preservepointers;
    return preservetypes;
}


void declaretypes(outflag)
int outflag;
{
    Meaning *mp;

    for (mp = curctx->cbase; mp; mp = mp->cnext) {
        if (mp->kind == MK_TYPE) {
          if (!mp->wasdeclared) {
            if (outflag) {
                flushcomments(&mp->comments, CMT_PRE, -1);
                declaretype(mp);
                flushcomments(&mp->comments, -1, -1);
            }
            mp->wasdeclared = 1;
          } else if (!outflag && preservetype(mp->type))
            mp->type->preserved = 1;
        }
    }
}



void p_typedecl()
{
    Meaning *mp, *dtype;
    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;
          }
          dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
          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;
          mp->type->preserved = preservetype(mp->type);
          mp->dtype = validatedtype(dtype, mp->type);
          mp->type->preserved = 0;
          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(iscommon)
int iscommon;
{
    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;
      if (curtok == TOK_IDENT && !curtokmeaning &&
          strcicmp(curtokbuf, "EXTERNAL")) {
          externflag = 1;
      }
        tp = p_type(firstmp);
      if (tagstructs > 0)
          makestructtag(tp, firstmp->name);
      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)) ||
            (iscommon && firstmp->kind != MK_VARMAC)) {
            declarevar(firstmp, (VDECL_ALL |
                             (iscommon ? 0 : VDECL_VARSTRUCT)));
            firstmp->wasdeclared = 1;
          }
            if (firstmp == lastmp)
                break;
            firstmp = firstmp->cnext;
        }
        if (!wneedtok(TOK_SEMI))
          skippasttoken(TOK_SEMI);
    }
    notephase = 0;
}



void p_commondecl()
{
    Meaning *ctx;

    ctx = curctx;
    while (curctx && curctx->kind == MK_FUNCTION)
      curctx = curctx->ctx;
    if (!curctx || curctx->kind != MK_MODULE)
      curctx = ctx;
    useextern = commonextern;
    p_vardecl(1);
    curctx = ctx;
    useextern = -1;
}



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. */



Generated by  Doxygen 1.6.0   Back to index