text: /* "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. */
  
  
  