home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / pascal2c / decl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-03  |  146.5 KB  |  5,445 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18.  
  19.  
  20. #define PROTO_DECL_C
  21. #include "trans.h"
  22.  
  23.  
  24.  
  25. #define MAXIMPORTS 100
  26.  
  27.  
  28.  
  29. Static struct ptrdesc {
  30.     struct ptrdesc *next;
  31.     Symbol *sym;
  32.     Type *tp;
  33. } *ptrbase;
  34.  
  35. Static struct ctxstack {
  36.     struct ctxstack *next;
  37.     Meaning *ctx, *ctxlast;
  38.     struct tempvarlist *tempvars;
  39.     int tempvarcount, importmark;
  40. } *ctxtop;
  41.  
  42. Static struct tempvarlist {
  43.     struct tempvarlist *next;
  44.     Meaning *tvar;
  45.     int active;
  46. } *tempvars, *stmttempvars;
  47.  
  48. Static int tempvarcount;
  49.  
  50. Static int stringtypecachesize;
  51. Static Type **stringtypecache;
  52.  
  53. Static Meaning *importlist[MAXIMPORTS];
  54. Static int firstimport;
  55.  
  56. Static Type *tp_special_anyptr;
  57.  
  58. Static int wasaliased;
  59. Static int deferallptrs;
  60. Static int anydeferredptrs;
  61. Static int silentalreadydef;
  62. Static int nonloclabelcount;
  63.  
  64. Static Strlist *varstructdecllist;
  65.  
  66.  
  67.  
  68.  
  69. Static Meaning *findstandardmeaning(kind, name)
  70. enum meaningkind kind;
  71. char *name;
  72. {
  73.     Meaning *mp;
  74.     Symbol *sym;
  75.  
  76.     sym = findsymbol(fixpascalname(name));
  77.     for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
  78.     if (mp) {
  79.     if (mp->kind == kind)
  80.         mp->refcount = 1;
  81.     else
  82.         mp = NULL;
  83.     }
  84.     return mp;
  85. }
  86.  
  87.  
  88. Static Meaning *makestandardmeaning(kind, name)
  89. enum meaningkind kind;
  90. char *name;
  91. {
  92.     Meaning *mp;
  93.     Symbol *sym;
  94.  
  95.     sym = findsymbol(fixpascalname(name));
  96.     for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
  97.     if (!mp) {
  98.         mp = addmeaning(sym, kind);
  99.         strchange(&mp->name, name);
  100.         if (debug < 4)
  101.             mp->dumped = partialdump;     /* prevent irrelevant dumping */
  102.     } else {
  103.         mp->kind = kind;
  104.     }
  105.     mp->refcount = 1;
  106.     return mp;
  107. }
  108.  
  109.  
  110. Static Type *makestandardtype(kind, mp)
  111. enum typekind kind;
  112. Meaning *mp;
  113. {
  114.     Type *tp;
  115.  
  116.     tp = maketype(kind);
  117.     tp->meaning = mp;
  118.     if (mp)
  119.         mp->type = tp;
  120.     return tp;
  121. }
  122.  
  123.  
  124.  
  125.  
  126. Static Stmt *nullspecialproc(mp)
  127. Meaning *mp;
  128. {
  129.     warning(format_s("Procedure %s not yet supported [118]", mp->name));
  130.     if (curtok == TOK_LPAR)
  131.         skipparens();
  132.     return NULL;
  133. }
  134.  
  135. Meaning *makespecialproc(name, handler)
  136. char *name;
  137. Stmt *(*handler)();
  138. {
  139.     Meaning *mp;
  140.  
  141.     if (!handler)
  142.         handler = nullspecialproc;
  143.     mp = makestandardmeaning(MK_SPECIAL, name);
  144.     mp->handler = (Expr *(*)())handler;
  145.     return mp;
  146. }
  147.  
  148.  
  149.  
  150. Static Stmt *nullstandardproc(ex)
  151. Expr *ex;
  152. {
  153.     warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
  154.     return makestmt_call(ex);
  155. }
  156.  
  157. Meaning *makestandardproc(name, handler)
  158. char *name;
  159. Stmt *(*handler)();
  160. {
  161.     Meaning *mp;
  162.  
  163.     if (!handler)
  164.         handler = nullstandardproc;
  165.     mp = findstandardmeaning(MK_FUNCTION, name);
  166.     if (mp) {
  167.     mp->handler = (Expr *(*)())handler;
  168.     if (mp->isfunction) {
  169.         warning(format_s("Procedure %s was declared as a function [119]", name));
  170.         mp->isfunction = 0;
  171.     }
  172.     } else if (debug > 0)
  173.     warning(format_s("Procedure %s was never declared [120]", name));
  174.     return mp;
  175. }
  176.  
  177.  
  178.  
  179. Static Expr *nullspecialfunc(mp)
  180. Meaning *mp;
  181. {
  182.     warning(format_s("Function %s not yet supported [121]", mp->name));
  183.     if (curtok == TOK_LPAR)
  184.         skipparens();
  185.     return makeexpr_long(0);
  186. }
  187.  
  188. Meaning *makespecialfunc(name, handler)
  189. char *name;
  190. Expr *(*handler)();
  191. {
  192.     Meaning *mp;
  193.  
  194.     if (!handler)
  195.         handler = nullspecialfunc;
  196.     mp = makestandardmeaning(MK_SPECIAL, name);
  197.     mp->isfunction = 1;
  198.     mp->handler = handler;
  199.     return mp;
  200. }
  201.  
  202.  
  203.  
  204. Static Expr *nullstandardfunc(ex)
  205. Expr *ex;
  206. {
  207.     warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
  208.     return ex;
  209. }
  210.  
  211. Meaning *makestandardfunc(name, handler)
  212. char *name;
  213. Expr *(*handler)();
  214. {
  215.     Meaning *mp;
  216.  
  217.     if (!handler)
  218.         handler = nullstandardfunc;
  219.     mp = findstandardmeaning(MK_FUNCTION, name);
  220.     if (mp) {
  221.     mp->handler = handler;
  222.     if (!mp->isfunction) {
  223.         warning(format_s("Function %s was declared as a procedure [122]", name));
  224.         mp->isfunction = 1;
  225.     }
  226.     } else if (debug > 0)
  227.     warning(format_s("Function %s was never declared [123]", name));
  228.     return mp;
  229. }
  230.  
  231.  
  232.  
  233.  
  234. Static Expr *nullspecialvar(mp)
  235. Meaning *mp;
  236. {
  237.     warning(format_s("Variable %s not yet supported [124]", mp->name));
  238.     if (curtok == TOK_LPAR || curtok == TOK_LBR)
  239.         skipparens();
  240.     return makeexpr_var(mp);
  241. }
  242.  
  243. Meaning *makespecialvar(name, handler)
  244. char *name;
  245. Expr *(*handler)();
  246. {
  247.     Meaning *mp;
  248.  
  249.     if (!handler)
  250.         handler = nullspecialvar;
  251.     mp = makestandardmeaning(MK_SPVAR, name);
  252.     mp->handler = handler;
  253.     return mp;
  254. }
  255.  
  256.  
  257.  
  258.  
  259.  
  260. void setup_decl()
  261. {
  262.     Meaning *mp, *mp2, *mp_turbo_shortint;
  263.     Symbol *sym;
  264.     Type *tp;
  265.     int i;
  266.  
  267.     numimports = 0;
  268.     firstimport = 0;
  269.     permimports = NULL;
  270.     stringceiling = stringceiling | 1;   /* round up to odd */
  271.     stringtypecachesize = (stringceiling + 1) >> 1;
  272.     stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
  273.     curctxlast = NULL;
  274.     curctx = NULL;   /* the meta-ctx has no parent ctx */
  275.     curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
  276.     strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
  277.     ptrbase = NULL;
  278.     tempvars = NULL;
  279.     stmttempvars = NULL;
  280.     tempvarcount = 0;
  281.     deferallptrs = 0;
  282.     silentalreadydef = 0;
  283.     varstructdecllist = NULL;
  284.     nonloclabelcount = -1;
  285.     for (i = 0; i < stringtypecachesize; i++)
  286.         stringtypecache[i] = NULL;
  287.  
  288.     tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
  289.                      (integer16) ? "LONGINT" : "INTEGER"));
  290.     tp_integer->smin = makeexpr_long(MININT);             /* "long" */
  291.     tp_integer->smax = makeexpr_long(MAXINT);
  292.  
  293.     if (sizeof_int >= 32) {
  294.         tp_int = tp_integer;                              /* "int" */
  295.     } else {
  296.         tp_int = makestandardtype(TK_INTEGER,
  297.                      (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
  298.                      : NULL);
  299.         tp_int->smin = makeexpr_long(min_sshort);
  300.         tp_int->smax = makeexpr_long(max_sshort);
  301.     }
  302.     mp = makestandardmeaning(MK_TYPE, "C_INT");
  303.     mp->type = tp_int;
  304.     if (!tp_int->meaning)
  305.     tp_int->meaning = mp;
  306.  
  307.     mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
  308.     tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
  309.     tp_unsigned->smin = makeexpr_long(0);                 /* "unsigned long" */
  310.     tp_unsigned->smax = makeexpr_long(MAXINT);
  311.  
  312.     if (sizeof_int >= 32) {
  313.         tp_uint = tp_unsigned;                            /* "unsigned int" */
  314.     mp_uint = mp_unsigned;
  315.     } else {
  316.     mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
  317.         tp_uint = makestandardtype(TK_INTEGER, mp_uint);
  318.         tp_uint->smin = makeexpr_long(0);
  319.         tp_uint->smax = makeexpr_long(MAXINT);
  320.     }
  321.  
  322.     tp_sint = makestandardtype(TK_INTEGER, NULL);
  323.     tp_sint->smin = copyexpr(tp_int->smin);               /* "signed int" */
  324.     tp_sint->smax = copyexpr(tp_int->smax);
  325.  
  326.     tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
  327.     if (unsignedchar == 0) {
  328.     tp_char->smin = makeexpr_long(-128);              /* "char" */
  329.     tp_char->smax = makeexpr_long(127);
  330.     } else {
  331.     tp_char->smin = makeexpr_long(0);
  332.     tp_char->smax = makeexpr_long(255);
  333.     }
  334.  
  335.     tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
  336.     tp_charptr->basetype = tp_char;
  337.     tp_char->pointertype = tp_charptr;
  338.  
  339.     mp_schar = makestandardmeaning(MK_TYPE, "SCHAR");     /* "signed char" */
  340.     tp_schar = makestandardtype(TK_CHAR, mp_schar);
  341.     tp_schar->smin = makeexpr_long(-128);
  342.     tp_schar->smax = makeexpr_long(127);
  343.  
  344.     mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR");     /* "unsigned char" */
  345.     tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
  346.     tp_uchar->smin = makeexpr_long(0);
  347.     tp_uchar->smax = makeexpr_long(255);
  348.  
  349.     tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
  350.     tp_boolean->smin = makeexpr_long(0);                  /* "boolean" */
  351.     tp_boolean->smax = makeexpr_long(1);
  352.  
  353.     sym = findsymbol("Boolean");
  354.     sym->flags |= SSYNONYM;
  355.     strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;
  356.  
  357.     tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
  358.                                                           /* "float" or "double" */
  359.     mp = makestandardmeaning(MK_TYPE, "LONGREAL");
  360.     if (doublereals)
  361.     mp->type = tp_longreal = tp_real;
  362.     else
  363.     tp_longreal = makestandardtype(TK_REAL, mp);
  364.  
  365.     tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */
  366.  
  367.     mp = makestandardmeaning(MK_TYPE, "SINGLE");
  368.     if (doublereals)
  369.     makestandardtype(TK_REAL, mp);
  370.     else
  371.     mp->type = tp_real;
  372.     makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
  373.     mp = makestandardmeaning(MK_TYPE, "DOUBLE");
  374.     mp->type = tp_longreal;
  375.     mp = makestandardmeaning(MK_TYPE, "EXTENDED");
  376.     mp->type = tp_longreal;   /* good enough */
  377.     mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
  378.     mp->type = tp_longreal;   /* good enough */
  379.  
  380.     tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
  381.                   (integer16 == 1) ? "INTEGER" : "SWORD"));
  382.     tp_sshort->basetype = tp_integer;                     /* "short" */
  383.     tp_sshort->smin = makeexpr_long(min_sshort);
  384.     tp_sshort->smax = makeexpr_long(max_sshort);
  385.  
  386.     if (integer16) {
  387.     if (integer16 != 2) {
  388.         mp = makestandardmeaning(MK_TYPE, "SWORD");
  389.         mp->type = tp_sshort;
  390.     }
  391.     } else {
  392.     mp = makestandardmeaning(MK_TYPE, "LONGINT");
  393.     mp->type = tp_integer;
  394.     }
  395.  
  396.     tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
  397.     tp_ushort->basetype = tp_integer;                     /* "unsigned short" */
  398.     tp_ushort->smin = makeexpr_long(0);
  399.     tp_ushort->smax = makeexpr_long(max_ushort);
  400.  
  401.     mp = makestandardmeaning(MK_TYPE, "CARDINAL");
  402.     mp->type = (integer16) ? tp_ushort : tp_unsigned;
  403.     mp = makestandardmeaning(MK_TYPE, "LONGCARD");
  404.     mp->type = tp_unsigned;
  405.  
  406.     if (modula2) {
  407.     mp = makestandardmeaning(MK_TYPE, "WORD");
  408.     mp->type = tp_integer;
  409.     } else {
  410.     makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
  411.     }
  412.  
  413.     tp_sbyte = makestandardtype(TK_SUBR, NULL);           /* "signed char" */
  414.     tp_sbyte->basetype = tp_integer;
  415.     tp_sbyte->smin = makeexpr_long(min_schar);
  416.     tp_sbyte->smax = makeexpr_long(max_schar);
  417.  
  418.     mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
  419.     mp = makestandardmeaning(MK_TYPE, "SBYTE");
  420.     if (needsignedbyte || signedchars == 1 || hassignedchar) {
  421.     mp->type = tp_sbyte;
  422.     if (mp_turbo_shortint)
  423.         mp_turbo_shortint->type = tp_sbyte;
  424.     tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
  425.     } else {
  426.     mp->type = tp_sshort;
  427.     if (mp_turbo_shortint)
  428.         mp_turbo_shortint->type = tp_sshort;
  429.     }
  430.  
  431.     tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
  432.     tp_ubyte->basetype = tp_integer;                      /* "unsigned char" */
  433.     tp_ubyte->smin = makeexpr_long(0);
  434.     tp_ubyte->smax = makeexpr_long(max_uchar);
  435.  
  436.     if (signedchars == 1)
  437.         tp_abyte = tp_sbyte;                              /* "char" */
  438.     else if (signedchars == 0)
  439.         tp_abyte = tp_ubyte;
  440.     else {
  441.         tp_abyte = makestandardtype(TK_SUBR, NULL);
  442.         tp_abyte->basetype = tp_integer;
  443.         tp_abyte->smin = makeexpr_long(0);
  444.         tp_abyte->smax = makeexpr_long(max_schar);
  445.     }
  446.  
  447.     mp = makestandardmeaning(MK_TYPE, "POINTER");
  448.     mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
  449.     tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
  450.     ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
  451.     tp_anyptr->basetype = tp_void;                        /* "void *" */
  452.     tp_void->pointertype = tp_anyptr;
  453.  
  454.     if (useAnyptrMacros == 1) {
  455.         tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
  456.         tp_special_anyptr->basetype = tp_integer;
  457.         tp_special_anyptr->smin = makeexpr_long(0);
  458.         tp_special_anyptr->smax = makeexpr_long(max_schar);
  459.     } else
  460.         tp_special_anyptr = NULL;
  461.  
  462.     tp_proc = maketype(TK_PROCPTR);
  463.     tp_proc->basetype = maketype(TK_FUNCTION);
  464.     tp_proc->basetype->basetype = tp_void;
  465.     tp_proc->escale = 1;   /* saved "hasstaticlinks" */
  466.  
  467.     tp_str255 = makestandardtype(TK_STRING, NULL);             /* "Char []" */
  468.     tp_str255->basetype = tp_char;
  469.     tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
  470.     tp_str255->indextype->basetype = tp_integer;
  471.     tp_str255->indextype->smin = makeexpr_long(0);
  472.     tp_str255->indextype->smax = makeexpr_long(stringceiling);
  473.  
  474.     tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
  475.     tp_str255->pointertype = tp_strptr;
  476.     tp_strptr->basetype = tp_str255;
  477.  
  478.     mp_string = makestandardmeaning(MK_TYPE, "STRING");
  479.     tp = makestandardtype(TK_STRING, mp_string);
  480.     tp->basetype = tp_char;
  481.     tp->indextype = tp_str255->indextype;
  482.  
  483.     tp_smallset = maketype(TK_SMALLSET);
  484.     tp_smallset->basetype = tp_integer;
  485.     tp_smallset->indextype = tp_boolean;
  486.  
  487.     tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
  488.     tp_text->basetype = makestandardtype(TK_FILE, NULL);       /* "FILE *" */
  489.     tp_text->basetype->basetype = tp_char;
  490.     tp_text->basetype->pointertype = tp_text;
  491.  
  492.     tp_bigtext = makestandardtype(TK_BIGFILE, makestandardmeaning(MK_TYPE, "BIGTEXT"));
  493.     tp_bigtext->basetype = tp_char;
  494.     tp_bigtext->meaning->name = stralloc("_TEXT");
  495.     tp_bigtext->meaning->wasdeclared = 1;
  496.  
  497.     tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);
  498.  
  499.     mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
  500.     mp->type = tp_text;
  501.  
  502.     mp = makestandardmeaning(MK_TYPE, "BITSET");
  503.     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  504.                         makeexpr_long(setbits-1)));
  505.     mp->type->meaning = mp;
  506.  
  507.     mp = makestandardmeaning(MK_TYPE, "INTSET");
  508.     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  509.                         makeexpr_long(defaultsetsize-1)));
  510.     mp->type->meaning = mp;
  511.  
  512.     mp_input = makestandardmeaning(MK_VAR, "INPUT");
  513.     mp_input->type = tp_text;
  514.     mp_input->name = stralloc("stdin");
  515.     ex_input = makeexpr_var(mp_input);
  516.  
  517.     mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
  518.     mp_output->type = tp_text;
  519.     mp_output->name = stralloc("stdout");
  520.     ex_output = makeexpr_var(mp_output);
  521.  
  522.     mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
  523.     mp_stderr->type = tp_text;
  524.     mp_stderr->name = stralloc("stderr");
  525.  
  526.     mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
  527.     mp_escapecode->type = tp_sshort;
  528.     mp_escapecode->name = stralloc(name_ESCAPECODE);
  529.  
  530.     mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
  531.     mp_ioresult->type = tp_integer;
  532.     mp_ioresult->name = stralloc(name_IORESULT);
  533.  
  534.     mp_false = makestandardmeaning(MK_CONST, "FALSE");
  535.     mp_false->type = mp_false->val.type = tp_boolean;
  536.     mp_false->val.i = 0;
  537.  
  538.     mp_true = makestandardmeaning(MK_CONST, "TRUE");
  539.     mp_true->type = mp_true->val.type = tp_boolean;
  540.     mp_true->val.i = 1;
  541.  
  542.     mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
  543.     mp_maxint->type = mp_maxint->val.type = tp_integer;
  544.     mp_maxint->val.i = MAXINT;
  545.     mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
  546.                                (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");
  547.  
  548.     mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
  549.     mp->type = mp->val.type = tp_integer;
  550.     mp->val.i = MAXINT;
  551.     mp->name = stralloc("LONG_MAX");
  552.  
  553.     mp_minint = makestandardmeaning(MK_CONST, "MININT");
  554.     mp_minint->type = mp_minint->val.type = tp_integer;
  555.     mp_minint->val.i = MININT;
  556.     mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
  557.                                (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");
  558.  
  559.     mp = makestandardmeaning(MK_CONST, "MAXCHAR");
  560.     mp->type = mp->val.type = tp_char;
  561.     mp->val.i = 127;
  562.     mp->name = stralloc("CHAR_MAX");
  563.  
  564.     mp = makestandardmeaning(MK_CONST, "MINCHAR");
  565.     mp->type = mp->val.type = tp_char;
  566.     mp->val.i = 0;
  567.     mp->anyvarflag = 1;
  568.  
  569.     mp = makestandardmeaning(MK_CONST, "BELL");
  570.     mp->type = mp->val.type = tp_char;
  571.     mp->val.i = 7;
  572.     mp->anyvarflag = 1;
  573.  
  574.     mp = makestandardmeaning(MK_CONST, "TAB");
  575.     mp->type = mp->val.type = tp_char;
  576.     mp->val.i = 9;
  577.     mp->anyvarflag = 1;
  578.  
  579.     mp_str_hp = mp_str_turbo = NULL;
  580.     mp_val_modula = mp_val_turbo = NULL;
  581.     mp_blockread_ucsd = mp_blockread_turbo = NULL;
  582.     mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
  583.     mp_dec_dec = mp_dec_turbo = NULL;
  584. }
  585.  
  586.  
  587.  
  588. /* This makes sure that if A imports B and then C, C's interface is not
  589.    parsed in the environment of B */
  590. int push_imports()
  591. {
  592.     int mark = firstimport;
  593.     Meaning *mp;
  594.  
  595.     while (firstimport < numimports) {
  596.     if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
  597.         for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  598.         mp->isactive = 0;
  599.     }
  600.         firstimport++;
  601.     }
  602.     return mark;
  603. }
  604.  
  605.  
  606.  
  607. void pop_imports(mark)
  608. int mark;
  609. {
  610.     Meaning *mp;
  611.  
  612.     while (firstimport > mark) {
  613.         firstimport--;
  614.         for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  615.             mp->isactive = 1;
  616.     }
  617. }
  618.  
  619.  
  620.  
  621. void import_ctx(ctx)
  622. Meaning *ctx;
  623. {
  624.     Meaning *mp;
  625.     int i;
  626.  
  627.     for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
  628.     if (i >= numimports) {
  629.         if (numimports == MAXIMPORTS)
  630.             error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
  631.         importlist[numimports++] = ctx;
  632.     }
  633.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  634.         if (mp->exported)
  635.             mp->isactive = 1;
  636.     }
  637. }
  638.  
  639.  
  640.  
  641. void perm_import(ctx)
  642. Meaning *ctx;
  643. {
  644.     Meaning *mp;
  645.  
  646.     /* Import permanently, as in Turbo's "system" unit */
  647.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  648.         if (mp->exported)
  649.             mp->isactive = 1;
  650.     }
  651. }
  652.  
  653.  
  654.  
  655. void unimport(mark)
  656. int mark;
  657. {
  658.     Meaning *mp;
  659.  
  660.     while (numimports > mark) {
  661.         numimports--;
  662.     if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
  663.         for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
  664.         mp->isactive = 0;
  665.     }
  666.     }
  667. }
  668.  
  669.  
  670.  
  671.  
  672. void activatemeaning(mp)
  673. Meaning *mp;
  674. {
  675.     Meaning *mp2;
  676.  
  677.     if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
  678.     mp->isactive = 1;
  679.     if (mp->sym->mbase != mp) {     /* move to front of symbol list */
  680.         mp2 = mp->sym->mbase;
  681.         for (;;) {
  682.             if (!mp2) {
  683.         /* Not on symbol list: must be a special kludge meaning */
  684.                 return;
  685.             }
  686.             if (mp2->snext == mp)
  687.                 break;
  688.             mp2 = mp2->snext;
  689.         }
  690.         mp2->snext = mp->snext;
  691.         mp->snext = mp->sym->mbase;
  692.         mp->sym->mbase = mp;
  693.     }
  694. }
  695.  
  696.  
  697.  
  698. void pushctx(ctx)
  699. Meaning *ctx;
  700. {
  701.     struct ctxstack *top;
  702.  
  703.     top = ALLOC(1, struct ctxstack, ctxstacks);
  704.     top->ctx = curctx;
  705.     top->ctxlast = curctxlast;
  706.     top->tempvars = tempvars;
  707.     top->tempvarcount = tempvarcount;
  708.     top->importmark = numimports;
  709.     top->next = ctxtop;
  710.     ctxtop = top;
  711.     curctx = ctx;
  712.     curctxlast = ctx->cbase;
  713.     if (curctxlast) {
  714.         activatemeaning(curctxlast);
  715.         while (curctxlast->cnext) {
  716.             curctxlast = curctxlast->cnext;
  717.             activatemeaning(curctxlast);
  718.         }
  719.     }
  720.     tempvars = NULL;
  721.     tempvarcount = 0;
  722.     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  723.     progress();
  724. }
  725.  
  726.  
  727.  
  728. void popctx()
  729. {
  730.     struct ctxstack *top;
  731.     struct tempvarlist *tv;
  732.     Meaning *mp;
  733.  
  734.     if (!strlist_cifind(permimports, curctx->sym->name)) {
  735.     for (mp = curctx->cbase; mp; mp = mp->cnext) {
  736.         if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
  737.         mp->isactive = 0;
  738.     }
  739.     }
  740.     top = ctxtop;
  741.     ctxtop = top->next;
  742.     curctx = top->ctx;
  743.     curctxlast = top->ctxlast;
  744.     while (tempvars) {
  745.         tv = tempvars->next;
  746.         FREE(tempvars);
  747.         tempvars = tv;
  748.     }
  749.     tempvars = top->tempvars;
  750.     tempvarcount = top->tempvarcount;
  751.     unimport(top->importmark);
  752.     FREE(top);
  753.     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  754.     progress();
  755. }
  756.  
  757.  
  758.  
  759. void forget_ctx(ctx, all)
  760. Meaning *ctx;
  761. int all;
  762. {
  763.     register Meaning *mp, **mpprev, *mp2, **mpp2;
  764.  
  765.     if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
  766.     mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
  767.     else
  768.     mpprev = &ctx->cbase;
  769.     while ((mp = *mpprev) != NULL) {
  770.     if (all ||
  771.         (mp->kind != MK_PARAM &&
  772.          mp->kind != MK_VARPARAM)) {
  773.         *mpprev = mp->cnext;
  774.         mpp2 = &mp->sym->mbase;
  775.         while ((mp2 = *mpp2) != NULL && mp2 != mp)
  776.         mpp2 = &mp2->snext;
  777.         if (mp2)
  778.         *mpp2 = mp2->snext;
  779.         if (mp->kind == MK_CONST)
  780.         free_value(&mp->val);
  781.         freeexpr(mp->constdefn);
  782.         if (mp->cbase)
  783.         forget_ctx(mp, 1);
  784.         if (mp->kind == MK_FUNCTION && mp->val.i)
  785.         free_stmt((Stmt *)mp->val.i);
  786.         strlist_empty(&mp->comments);
  787.         if (mp->name)
  788.         FREE(mp->name);
  789.         if (mp->othername)
  790.         FREE(mp->othername);
  791.         FREE(mp);
  792.     } else
  793.         mpprev = &mp->cnext;
  794.     }
  795. }
  796.  
  797.  
  798.  
  799.  
  800. void handle_nameof()
  801. {
  802.     Strlist *sl, *sl2;
  803.     Symbol *sp;
  804.     char *cp;
  805.  
  806.     for (sl = nameoflist; sl; sl = sl->next) {
  807.         cp = my_strchr(sl->s, '.');
  808.         if (cp) {
  809.             sp = findsymbol(fixpascalname(cp + 1));
  810.             sl2 = strlist_add(&sp->symbolnames, 
  811.                               format_ds("%.*s", (int)(cp - sl->s), sl->s));
  812.         } else {
  813.             sp = findsymbol(fixpascalname(sl->s));
  814.             sl2 = strlist_add(&sp->symbolnames, "");
  815.         }
  816.         sl2->value = sl->value;
  817.         if (debug > 0)
  818.             fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
  819.                           sp->name, sl2->s, sl2->value);
  820.     }
  821.     strlist_empty(&nameoflist);
  822. }
  823.  
  824.  
  825.  
  826. Static void initmeaning(mp)
  827. Meaning *mp;
  828. {
  829. /*    mp->serial = curserial = ++serialcount;    */
  830.     mp->cbase = NULL;
  831.     mp->xnext = NULL;
  832.     mp->othername = NULL;
  833.     mp->type = NULL;
  834.     mp->dtype = NULL;
  835.     mp->needvarstruct = 0;
  836.     mp->varstructflag = 0;
  837.     mp->wasdeclared = 0;
  838.     mp->isforward = 0;
  839.     mp->isfunction = 0;
  840.     mp->istemporary = 0;
  841.     mp->volatilequal = 0;
  842.     mp->constqual = 0;
  843.     mp->warnifused = (warnnames > 0);
  844.     mp->constdefn = NULL;
  845.     mp->val.i = 0;
  846.     mp->val.s = NULL;
  847.     mp->val.type = NULL;
  848.     mp->refcount = 1;
  849.     mp->anyvarflag = 0;
  850.     mp->isactive = 1;
  851.     mp->exported = 0;
  852.     mp->handler = NULL;
  853.     mp->dumped = 0;
  854.     mp->isreturn = 0;
  855.     mp->fakeparam = 0;
  856.     mp->namedfile = 0;
  857.     mp->bufferedfile = 0;
  858.     mp->comments = NULL;
  859. }
  860.  
  861.  
  862.  
  863. int issafename(sp, isglobal, isdefine)
  864. Symbol *sp;
  865. int isglobal, isdefine;
  866. {
  867.     if (isdefine && curctx->kind != MK_FUNCTION) {
  868.     if (sp->flags & FWDPARAM)
  869.         return 0;
  870.     }
  871.     if ((sp->flags & AVOIDNAME) ||
  872.     (isdefine && (sp->flags & AVOIDFIELD)) ||
  873.         (isglobal && (sp->flags & AVOIDGLOB)))
  874.         return 0;
  875.     else
  876.         return 1;
  877. }
  878.  
  879.  
  880.  
  881. static Meaning *enum_tname;
  882.  
  883. void setupmeaning(mp, sym, kind, namekind)
  884. Meaning *mp;
  885. Symbol *sym;
  886. enum meaningkind kind, namekind;
  887. {
  888.     char *name, *symfmt, *editfmt, *cp, *cp2;
  889.     int altnum, isglobal, isdefine;
  890.     Symbol *sym2;
  891.     Strlist *sl;
  892.  
  893.     if (!sym)
  894.     sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
  895.     if (sym->mbase && sym->mbase->ctx == curctx &&
  896.     curctx != NULL && !silentalreadydef)
  897.         alreadydef(sym);
  898.     mp->sym = sym;
  899.     mp->snext = sym->mbase;
  900.     sym->mbase = mp;
  901.     if (sym == curtoksym) {
  902.     sym->kwtok = TOK_NONE;
  903.     sym->flags &= ~KWPOSS;
  904.     }
  905.     mp->ctx = curctx;
  906.     mp->kind = kind;
  907.     if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
  908.     strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
  909.     Meaning *mp2;
  910.     if (islower(sym->name[0]))
  911.         sym2 = findsymbol(strupper(sym->name));
  912.     else
  913.         sym2 = findsymbol(strlower(sym->name));
  914.     mp2 = addmeaning(sym2, MK_SYNONYM);
  915.     mp2->xnext = mp;
  916.     }
  917.     if (kind == MK_VAR) {
  918.         sl = strlist_find(varmacros, sym->name);
  919.         if (sl) {
  920.             kind = namekind = MK_VARMAC;
  921.             mp->constdefn = (Expr *)sl->value;
  922.             strlist_delete(&varmacros, sl);
  923.         }
  924.     }
  925.     if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
  926.         sl = strlist_find(funcmacros, sym->name);
  927.         if (sl) {
  928.             mp->constdefn = (Expr *)sl->value;
  929.             strlist_delete(&funcmacros, sl);
  930.         }
  931.     }
  932.     if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
  933.     kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
  934.         mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
  935.     if (blockkind == TOK_IMPORT)
  936.         mp->wasdeclared = 1;   /* suppress future declaration */
  937.     } else
  938.         mp->exported = 0;
  939.     if (sym == curtoksym)
  940.         name = curtokcase;
  941.     else
  942.         name = sym->name;
  943.     isdefine = (namekind == MK_CONST || (namekind == MK_VARIANT && !useenum));
  944.     isglobal = (!curctx ||
  945.         curctx->kind != MK_FUNCTION ||
  946.                 namekind == MK_FUNCTION ||
  947.         namekind == MK_TYPE ||
  948.         namekind == MK_VARIANT ||
  949.                 isdefine) &&
  950.                (curctx != nullctx);
  951.     mp->refcount = isglobal ? 1 : 0;   /* make sure globals don't disappear */
  952.     if (namekind == MK_SYNONYM)
  953.     return;
  954.     if (!mp->exported || !*exportsymbol)
  955.         symfmt = "";
  956.     else if (*export_symbol && my_strchr(name, '_'))
  957.         symfmt = export_symbol;
  958.     else
  959.         symfmt = exportsymbol;
  960.     wasaliased = 0;
  961.     if (*externalias && !my_strchr(externalias, '%')) {
  962.         register int i;
  963.         name = format_s("%s", externalias);
  964.         i = numparams;
  965.         while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
  966.         if (i < 0 || !undooption(i, ""))
  967.             *externalias = 0;
  968.         wasaliased = 1;
  969.     } else if (sym->symbolnames) {
  970.         if (curctx) {
  971.             if (debug > 2)
  972.                 fprintf(outf, "checking for \"%s\" of %s\n", curctx->name, sym->name);
  973.             sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
  974.             if (sl) {
  975.                 if (debug > 2)
  976.                     fprintf(outf, "found \"%s\"\n", sl->value);
  977.                 name = (char *)sl->value;
  978.                 wasaliased = 1;
  979.             }
  980.         }
  981.         if (!wasaliased) {
  982.             if (debug > 2)
  983.                 fprintf(outf, "checking for \"\" of %s\n", sym->name);
  984.             sl = strlist_find(sym->symbolnames, "");
  985.             if (sl) {
  986.                 if (debug > 2)
  987.                     fprintf(outf, "found \"%s\"\n", sl->value);
  988.                 name = (char *)sl->value;
  989.                 wasaliased = 1;
  990.             }
  991.         }
  992.     }
  993.     if (!*symfmt || wasaliased)
  994.     symfmt = "%s";
  995.     altnum = -1;
  996.     do {
  997.         altnum++;
  998.         cp = format_ss(symfmt, name, curctx ? curctx->name : "");
  999.     switch (namekind) {
  1000.  
  1001.       case MK_CONST:
  1002.         editfmt = constformat;
  1003.         break;
  1004.  
  1005.       case MK_MODULE:
  1006.         editfmt = moduleformat;
  1007.         break;
  1008.  
  1009.       case MK_FUNCTION:
  1010.         editfmt = functionformat;
  1011.         break;
  1012.  
  1013.       case MK_VAR:
  1014.       case MK_VARPARAM:
  1015.       case MK_VARREF:
  1016.       case MK_VARMAC:
  1017.       case MK_SPVAR:
  1018.         editfmt = varformat;
  1019.         break;
  1020.  
  1021.       case MK_TYPE:
  1022.         editfmt = typeformat;
  1023.         break;
  1024.  
  1025.       case MK_VARIANT:   /* A true kludge! */
  1026.         editfmt = enumformat;
  1027.         if (!*editfmt)
  1028.         editfmt = useenum ? varformat : constformat;
  1029.         break;
  1030.  
  1031.       default:
  1032.         editfmt = "";
  1033.     }
  1034.     if (!*editfmt)
  1035.         editfmt = symbolformat;
  1036.     if (*editfmt)
  1037.         if (editfmt == enumformat)
  1038.         cp = format_ss(editfmt, cp,
  1039.                    enum_tname ? enum_tname->name : "ENUM");
  1040.         else
  1041.         cp = format_ss(editfmt, cp,
  1042.                    curctx ? curctx->name : "");
  1043.     if (dollar_idents == 2) {
  1044.         for (cp2 = cp; *cp2; cp2++)
  1045.         if (*cp2 == '$' || *cp2 == '%')
  1046.             *cp2 = '_';
  1047.     }
  1048.         sym2 = findsymbol(findaltname(cp, altnum));
  1049.     } while (!issafename(sym2, isglobal, isdefine) &&
  1050.          namekind != MK_MODULE && !wasaliased);
  1051.     mp->name = stralloc(sym2->name);
  1052.     if (sym2->flags & WARNNAME)
  1053.         note(format_s("A symbol named %s was defined [100]", mp->name));
  1054.     if (isglobal) {
  1055.         switch (namekind) {     /* prevent further name conflicts */
  1056.  
  1057.             case MK_CONST:
  1058.         case MK_VARIANT:
  1059.             case MK_TYPE:
  1060.                 sym2->flags |= AVOIDNAME;
  1061.                 break;
  1062.  
  1063.             case MK_VAR:
  1064.             case MK_VARREF:
  1065.             case MK_FUNCTION:
  1066.                 sym2->flags |= AVOIDGLOB;
  1067.                 break;
  1068.  
  1069.         default:
  1070.         /* name is completely local */
  1071.         break;
  1072.         }
  1073.     }
  1074.     if (debug > 4)
  1075.     fprintf(outf, "Created meaning %s\n", mp->name);
  1076. }
  1077.  
  1078.  
  1079.  
  1080. Meaning *addmeaningas(sym, kind, namekind)
  1081. Symbol *sym;
  1082. enum meaningkind kind, namekind;
  1083. {
  1084.     Meaning *mp;
  1085.  
  1086.     mp = ALLOC(1, Meaning, meanings);
  1087.     initmeaning(mp);
  1088.     setupmeaning(mp, sym, kind, namekind);
  1089.     mp->cnext = NULL;
  1090.     if (curctx) {
  1091.         if (curctxlast)
  1092.             curctxlast->cnext = mp;
  1093.         else
  1094.             curctx->cbase = mp;
  1095.         curctxlast = mp;
  1096.     }
  1097.     return mp;
  1098. }
  1099.  
  1100.  
  1101.  
  1102. Meaning *addmeaning(sym, kind)
  1103. Symbol *sym;
  1104. enum meaningkind kind;
  1105. {
  1106.     return addmeaningas(sym, kind, kind);
  1107. }
  1108.  
  1109.  
  1110.  
  1111. Meaning *addmeaningafter(mpprev, sym, kind)
  1112. Meaning *mpprev;
  1113. Symbol *sym;
  1114. enum meaningkind kind;
  1115. {
  1116.     Meaning *mp;
  1117.  
  1118.     if (!mpprev->cnext && mpprev->ctx == curctx)
  1119.         return addmeaning(sym, kind);
  1120.     mp = ALLOC(1, Meaning, meanings);
  1121.     initmeaning(mp);
  1122.     setupmeaning(mp, sym, kind, kind);
  1123.     mp->ctx = mpprev->ctx;
  1124.     mp->cnext = mpprev->cnext;
  1125.     mpprev->cnext = mp;
  1126.     return mp;
  1127. }
  1128.  
  1129.  
  1130. void unaddmeaning(mp)
  1131. Meaning *mp;
  1132. {
  1133.     Meaning *prev;
  1134.  
  1135.     prev = mp->ctx;
  1136.     while (prev && prev != mp)
  1137.     prev = prev->cnext;
  1138.     if (prev)
  1139.     prev->cnext = mp->cnext;
  1140.     else
  1141.     mp->ctx = mp->cnext;
  1142.     if (!mp->cnext && mp->ctx == curctx)
  1143.     curctxlast = prev;
  1144. }
  1145.  
  1146.  
  1147. void readdmeaning(mp)
  1148. Meaning *mp;
  1149. {
  1150.     mp->cnext = NULL;
  1151.     if (curctx) {
  1152.         if (curctxlast)
  1153.             curctxlast->cnext = mp;
  1154.         else
  1155.             curctx->cbase = mp;
  1156.         curctxlast = mp;
  1157.     }
  1158. }
  1159.  
  1160.  
  1161. Meaning *addfield(sym, flast, rectype, tname)
  1162. Symbol *sym;
  1163. Meaning ***flast;
  1164. Type *rectype;
  1165. Meaning *tname;
  1166. {
  1167.     Meaning *mp;
  1168.     int altnum;
  1169.     Symbol *sym2;
  1170.     Strlist *sl;
  1171.     char *name, *name2;
  1172.  
  1173.     mp = ALLOC(1, Meaning, meanings);
  1174.     initmeaning(mp);
  1175.     mp->sym = sym;
  1176.     if (sym) {
  1177.         mp->snext = sym->fbase;
  1178.         sym->fbase = mp;
  1179.         if (sym == curtoksym)
  1180.             name2 = curtokcase;
  1181.         else
  1182.             name2 = sym->name;
  1183.     name = name2;
  1184.         if (tname)
  1185.             sl = strlist_find(fieldmacros,
  1186.                               format_ss("%s.%s", tname->sym->name, sym->name));
  1187.         else
  1188.             sl = NULL;
  1189.         if (sl) {
  1190.             mp->constdefn = (Expr *)sl->value;
  1191.             strlist_delete(&fieldmacros, sl);
  1192.             altnum = 0;
  1193.         } else {
  1194.             altnum = -1;
  1195.             do {
  1196.                 altnum++;
  1197.         if (*fieldformat)
  1198.             name = format_ss(fieldformat, name2,
  1199.                      tname && tname->name ? tname->name
  1200.                                           : "FIELD");
  1201.                 sym2 = findsymbol(findaltname(name, altnum));
  1202.             } while (!issafename(sym2, 0, 0) ||
  1203.              ((sym2->flags & AVOIDFIELD) && !reusefieldnames));
  1204.         sym2->flags |= AVOIDFIELD;
  1205.         }
  1206.         mp->kind = MK_FIELD;
  1207.         mp->name = stralloc(findaltname(name, altnum));
  1208.     } else {
  1209.         mp->name = stralloc("(variant)");
  1210.         mp->kind = MK_VARIANT;
  1211.     }
  1212.     mp->cnext = NULL;
  1213.     **flast = mp;
  1214.     *flast = &(mp->cnext);
  1215.     mp->ctx = NULL;
  1216.     mp->rectype = rectype;
  1217.     mp->val.i = 0;
  1218.     return mp;
  1219. }
  1220.  
  1221.  
  1222.  
  1223.  
  1224.  
  1225. int isfiletype(type, big)
  1226. Type *type;
  1227. int big;   /* 0=TK_FILE, 1=TK_BIGFILE, -1=either */
  1228. {
  1229.     return ((type->kind == TK_POINTER &&
  1230.          type->basetype->kind == TK_FILE && big != 1) ||
  1231.         (type->kind == TK_BIGFILE && big != 0));
  1232. }
  1233.  
  1234.  
  1235. Meaning *isfilevar(ex)
  1236. Expr *ex;
  1237. {
  1238.     Meaning *mp;
  1239.  
  1240.     if (ex->kind == EK_VAR) {
  1241.     mp = (Meaning *)ex->val.i;
  1242.     if (mp->kind == MK_VAR)
  1243.         return mp;
  1244.     } else if (ex->kind == EK_DOT) {
  1245.     mp = (Meaning *)ex->val.i;
  1246.     if (mp && mp->kind == MK_FIELD)
  1247.         return mp;
  1248.     }
  1249.     return NULL;
  1250. }
  1251.  
  1252.  
  1253. Type *filebasetype(type)
  1254. Type *type;
  1255. {
  1256.     if (type->kind == TK_BIGFILE)
  1257.     return type->basetype;
  1258.     else
  1259.     return type->basetype->basetype;
  1260. }
  1261.  
  1262.  
  1263. Expr *filebasename(ex)
  1264. Expr *ex;
  1265. {
  1266.     if (ex->val.type->kind == TK_BIGFILE)
  1267.     return makeexpr_dotq(ex, "f", ex->val.type);
  1268.     else
  1269.     return ex;
  1270. }
  1271.  
  1272.  
  1273. Expr *filenamepart(ex)
  1274. Expr *ex;
  1275. {
  1276.     Meaning *mp;
  1277.  
  1278.     if (ex->val.type->kind == TK_BIGFILE)
  1279.     return makeexpr_dotq(copyexpr(ex), "name", tp_str255);
  1280.     else if ((mp = isfilevar(ex)) && mp->namedfile)
  1281.     return makeexpr_name(format_s(name_FNVAR, mp->name), tp_str255);
  1282.     else
  1283.     return NULL;
  1284. }
  1285.  
  1286.  
  1287. int fileisbuffered(ex, maybe)
  1288. Expr *ex;
  1289. int maybe;
  1290. {
  1291.     Meaning *mp;
  1292.  
  1293.     return (ex->val.type->kind == TK_BIGFILE ||
  1294.         ((mp = isfilevar(ex)) && (maybe || mp->bufferedfile)));
  1295. }
  1296.  
  1297.  
  1298.  
  1299. Type *findbasetype_(type, flags)
  1300. Type *type;
  1301. int flags;
  1302. {
  1303.     long smin, smax;
  1304.     static Type typename;
  1305.  
  1306.     for (;;) {
  1307.     if (type->preserved && (type->kind != TK_POINTER) &&
  1308.         !(flags & ODECL_NOPRES))
  1309.         return type;
  1310.         switch (type->kind) {
  1311.  
  1312.             case TK_POINTER:
  1313.             if (type->smin)    /* unresolved forward */
  1314.             return type;
  1315.                 if (type->basetype == tp_void) {     /* ANYPTR */
  1316.                     if (tp_special_anyptr)
  1317.                         return tp_special_anyptr;   /* write "Anyptr" */
  1318.                     if (!voidstar)
  1319.                         return tp_abyte;    /* write "char *", not "void *" */
  1320.                 }
  1321.                 switch (type->basetype->kind) {
  1322.  
  1323.                     case TK_ARRAY:       /* use basetype's basetype: */
  1324.                     case TK_STRING:      /* ^array[5] of array[3] of integer */
  1325.                     case TK_SET:         /*  => int (*a)[3]; */
  1326.                 if (stararrays == 1 ||
  1327.                 !(flags & ODECL_FREEARRAY) ||
  1328.                 type->basetype->structdefd) {
  1329.                 type = type->basetype->basetype;
  1330.                 flags &= ~ODECL_CHARSTAR;
  1331.                 continue;
  1332.             }
  1333.                         break;
  1334.  
  1335.             default:
  1336.             break;
  1337.                 }
  1338.         if (type->preserved && !(flags & ODECL_NOPRES))
  1339.             return type;
  1340.         if (type->fbase && type->fbase->wasdeclared &&
  1341.             (flags & ODECL_DECL)) {
  1342.             typename.meaning = type->fbase;
  1343.             typename.preserved = 1;
  1344.             return &typename;
  1345.         }
  1346.                 break;
  1347.  
  1348.             case TK_FUNCTION:
  1349.             case TK_STRING:
  1350.             case TK_SET:
  1351.             case TK_SMALLSET:
  1352.             case TK_SMALLARRAY:
  1353.                 if (!type->basetype)
  1354.                     return type;
  1355.                 break;
  1356.  
  1357.             case TK_ARRAY:
  1358.                 if (type->meaning && type->meaning->kind == MK_TYPE &&
  1359.                     type->meaning->wasdeclared)
  1360.                     return type;
  1361.         if (type->fbase && type->fbase->wasdeclared &&
  1362.             (flags & ODECL_DECL)) {
  1363.             typename.meaning = type->fbase;
  1364.             typename.preserved = 1;
  1365.             return &typename;
  1366.         }
  1367.                 break;
  1368.  
  1369.             case TK_FILE:
  1370.                 return tp_text->basetype;
  1371.  
  1372.             case TK_PROCPTR:
  1373.         return tp_proc;
  1374.  
  1375.         case TK_CPROCPTR:
  1376.         type = type->basetype->basetype;
  1377.         continue;
  1378.  
  1379.             case TK_ENUM:
  1380.                 if (useenum)
  1381.                     return type;
  1382.                 else if (!enumbyte ||
  1383.              type->smax->kind != EK_CONST ||
  1384.              type->smax->val.i > 255)
  1385.             return tp_sshort;
  1386.         else if (type->smax->val.i > 127)
  1387.                     return tp_ubyte;
  1388.         else
  1389.                     return tp_abyte;
  1390.  
  1391.             case TK_BOOLEAN:
  1392.                 if (*name_BOOLEAN)
  1393.                     return type;
  1394.                 else
  1395.                     return tp_ubyte;
  1396.  
  1397.             case TK_SUBR:
  1398.                 if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte ||
  1399.                     type == tp_ushort || type == tp_sshort) {
  1400.                     return type;
  1401.                 } else if ((type->basetype->kind == TK_ENUM && useenum) ||
  1402.                            type->basetype->kind == TK_BOOLEAN && *name_BOOLEAN) {
  1403.                     return type->basetype;
  1404.                 } else {
  1405.                     if (ord_range(type, &smin, &smax)) {
  1406.                         if (squeezesubr != 0) {
  1407.                             if (smin >= 0 && smax <= max_schar)
  1408.                                 return tp_abyte;
  1409.                             else if (smin >= 0 && smax <= max_uchar)
  1410.                                 return tp_ubyte;
  1411.                             else if (smin >= min_schar && smax <= max_schar &&
  1412.                      (signedchars == 1 || hassignedchar))
  1413.                                 return tp_sbyte;
  1414.                             else if (smin >= min_sshort && smax <= max_sshort)
  1415.                                 return tp_sshort;
  1416.                             else if (smin >= 0 && smax <= max_ushort)
  1417.                                 return tp_ushort;
  1418.                             else
  1419.                                 return tp_integer;
  1420.                         } else {
  1421.                             if (smin >= min_sshort && smax <= max_sshort)
  1422.                                 return tp_sshort;
  1423.                             else
  1424.                                 return tp_integer;
  1425.                         }
  1426.                     } else
  1427.                         return tp_integer;
  1428.                 }
  1429.  
  1430.         case TK_CHAR:
  1431.         if (type == tp_schar &&
  1432.             (signedchars != 1 && !hassignedchar)) {
  1433.             return tp_sshort;
  1434.         }
  1435.         return type;
  1436.  
  1437.             default:
  1438.                 return type;
  1439.         }
  1440.         type = type->basetype;
  1441.     }
  1442. }
  1443.  
  1444.  
  1445. Type *findbasetype(type, flags)
  1446. Type *type;
  1447. int flags;
  1448. {
  1449.     if (debug>1) {
  1450.     fprintf(outf, "findbasetype(");
  1451.     dumptypename(type, 1);
  1452.     fprintf(outf, ",%d) = ", flags);
  1453.     type = findbasetype_(type, flags);
  1454.     dumptypename(type, 1);
  1455.     fprintf(outf, "\n");
  1456.     return type;
  1457.     }
  1458.     return findbasetype_(type, flags);
  1459. }
  1460.  
  1461.  
  1462.  
  1463. Expr *arraysize(tp, incskipped)
  1464. Type *tp;
  1465. int incskipped;
  1466. {
  1467.     Expr *ex, *minv, *maxv;
  1468.     int denom;
  1469.  
  1470.     ord_range_expr(tp->indextype, &minv, &maxv);
  1471.     if (maxv->kind == EK_VAR && maxv->val.i == (long)mp_maxint &&
  1472.     !exprdependsvar(minv, mp_maxint)) {
  1473.         return NULL;
  1474.     } else {
  1475.         ex = makeexpr_plus(makeexpr_minus(copyexpr(maxv),
  1476.                                           copyexpr(minv)),
  1477.                            makeexpr_long(1));
  1478.         if (tp->smin && !incskipped) {
  1479.             ex = makeexpr_minus(ex, copyexpr(tp->smin));
  1480.         }
  1481.         if (tp->smax) {
  1482.             denom = (tp->basetype == tp_sshort) ? 16 : 8;
  1483.             denom >>= tp->escale;
  1484.             ex = makeexpr_div(makeexpr_plus(ex, makeexpr_long(denom-1)),
  1485.                               makeexpr_long(denom));
  1486.         }
  1487.         return ex;
  1488.     }
  1489. }
  1490.  
  1491.  
  1492.  
  1493. Type *promote_type(tp)
  1494. Type *tp;
  1495. {
  1496.     Type *tp2;
  1497.  
  1498.     if (tp->kind == TK_ENUM) {
  1499.     if (promote_enums == 0 ||
  1500.         (promote_enums < 0 &&
  1501.          (useenum)))
  1502.         return tp;
  1503.     }
  1504.     if (tp->kind == TK_ENUM ||
  1505.          tp->kind == TK_SUBR ||
  1506.          tp->kind == TK_INTEGER ||
  1507.          tp->kind == TK_CHAR ||
  1508.          tp->kind == TK_BOOLEAN) {
  1509.         tp2 = findbasetype(tp, ODECL_NOPRES);
  1510.     if (tp2 == tp_ushort && sizeof_int == 16)
  1511.         return tp_uint;
  1512.         else if (tp2 == tp_sbyte || tp2 == tp_ubyte ||
  1513.          tp2 == tp_abyte || tp2 == tp_char ||
  1514.          tp2 == tp_sshort || tp2 == tp_ushort ||
  1515.          tp2 == tp_boolean || tp2->kind == TK_ENUM) {
  1516.             return tp_int;
  1517.         }
  1518.     }
  1519.     if (tp == tp_real)
  1520.     return tp_longreal;
  1521.     return tp;
  1522. }
  1523.  
  1524.  
  1525. Type *promote_type_bin(t1, t2)
  1526. Type *t1, *t2;
  1527. {
  1528.     t1 = promote_type(t1);
  1529.     t2 = promote_type(t2);
  1530.     if (t1 == tp_longreal || t2 == tp_longreal)
  1531.     return tp_longreal;
  1532.     if (t1 == tp_unsigned || t2 == tp_unsigned)
  1533.     return tp_unsigned;
  1534.     if (t1 == tp_integer || t2 == tp_integer) {
  1535.     if ((t1 == tp_uint || t2 == tp_uint) &&
  1536.         sizeof_int > 0 &&
  1537.         sizeof_int < (sizeof_long > 0 ? sizeof_long : 32))
  1538.         return tp_uint;
  1539.     return tp_integer;
  1540.     }
  1541.     if (t1 == tp_uint || t2 == tp_uint)
  1542.     return tp_uint;
  1543.     return t1;
  1544. }
  1545.  
  1546.  
  1547.  
  1548. #if 0
  1549. void predeclare_varstruct(mp)
  1550. Meaning *mp;
  1551. {
  1552.     if (mp->ctx &&
  1553.      mp->ctx->kind == MK_FUNCTION &&
  1554.      mp->ctx->varstructflag &&
  1555.      (usePPMacros != 0 || prototypes != 0) &&
  1556.      !strlist_find(varstructdecllist, mp->ctx->name)) {
  1557.     output("struct ");
  1558.     output(format_s(name_LOC, mp->ctx->name));
  1559.     output(" ;\n");
  1560.     strlist_insert(&varstructdecllist, mp->ctx->name);
  1561.     }
  1562. }
  1563. #endif
  1564.  
  1565.  
  1566. Static void declare_args(type, isheader, isforward)
  1567. Type *type;
  1568. int isheader, isforward;
  1569. {
  1570.     Meaning *mp = type->fbase;
  1571.     Type *tp;
  1572.     int firstflag = 0;
  1573.     int usePP, dopromote, proto, showtypes, shownames;
  1574.     int staticlink;
  1575.     char *name;
  1576.  
  1577. #if 1   /* This seems to work better! */
  1578.     isforward = !isheader;
  1579. #endif
  1580.     usePP = (isforward && usePPMacros != 0);
  1581.     dopromote = (promoteargs == 1 ||
  1582.          (promoteargs < 0 && (usePP || !fullprototyping)));
  1583.     if (ansiC == 1 && blockkind != TOK_EXPORT)
  1584.     usePP = 0;
  1585.     if (usePP)
  1586.         proto = (prototypes) ? prototypes : 1;
  1587.     else
  1588.         proto = (isforward || fullprototyping) ? prototypes : 0;
  1589.     showtypes = (proto > 0);
  1590.     shownames = (proto == 1 || isheader);
  1591.     staticlink = (type->issigned ||
  1592.                   (type->meaning &&
  1593.                    type->meaning->ctx->kind == MK_FUNCTION &&
  1594.                    type->meaning->ctx->varstructflag));
  1595.     if (mp || staticlink) {
  1596.         if (usePP)
  1597.             output(" PP(");
  1598.     else if (spacefuncs)
  1599.         output(" ");
  1600.         output("(");
  1601.         if (showtypes || shownames) {
  1602.             firstflag = 0;
  1603.             while (mp) {
  1604.                 if (firstflag++)
  1605.             if (spacecommas)
  1606.             output(",\002 ");
  1607.             else
  1608.             output(",\002");
  1609.                 name = (mp->othername && isheader) ? mp->othername : mp->name;
  1610.                 tp = (mp->othername) ? mp->rectype : mp->type;
  1611.                 if (!showtypes) {
  1612.                     output(name);
  1613.                 } else {
  1614.             output(storageclassname(varstorageclass(mp)));
  1615.             if (!shownames || (isforward && *name == '_')) {
  1616.             out_type(tp, 1);
  1617.             } else {
  1618.             if (dopromote)
  1619.                 tp = promote_type(tp);
  1620.             outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
  1621.             output(" ");
  1622.             outdeclarator(tp, name,
  1623.                       ODECL_CHARSTAR|ODECL_FREEARRAY);
  1624.             }
  1625.         }
  1626.                 if (isheader)
  1627.                     mp->wasdeclared = showtypes;
  1628.                 if (mp->type == tp_strptr && mp->anyvarflag) {     /* VAR STRING parameter */
  1629.             if (spacecommas)
  1630.             output(",\002 ");
  1631.             else
  1632.             output(",\002");
  1633.                     if (showtypes) {
  1634.             if (useAnyptrMacros == 1 || useconsts == 2)
  1635.                 output("Const ");
  1636.             else if (ansiC > 0)
  1637.                 output("const ");
  1638.                         output("int");
  1639.             }
  1640.                     if (shownames) {
  1641.                         if (showtypes)
  1642.                             output(" ");
  1643.                         output(format_s(name_STRMAX, mp->name));
  1644.                     }
  1645.                 }
  1646.                 mp = mp->xnext;
  1647.             }
  1648.             if (staticlink) {     /* sub-procedure with static link */
  1649.                 if (firstflag++)
  1650.             if (spacecommas)
  1651.             output(",\002 ");
  1652.             else
  1653.             output(",\002");
  1654.                 if (type->issigned) {
  1655.                     if (showtypes)
  1656.             if (tp_special_anyptr)
  1657.                 output("Anyptr ");
  1658.             else if (voidstar)
  1659.                 output("void *");
  1660.             else
  1661.                 output("char *");
  1662.                     if (shownames)
  1663.                         output("_link");
  1664.                 } else {
  1665.                     mp = type->meaning->ctx;
  1666.                     if (showtypes) {
  1667.                         output("struct ");
  1668.                         output(format_s(name_LOC, mp->name));
  1669.                         output(" *");
  1670.                     }
  1671.                     if (shownames) {
  1672.                         output(format_s(name_LINK, mp->name));
  1673.                     }
  1674.                 }
  1675.             }
  1676.         }
  1677.         output(")");
  1678.         if (usePP)
  1679.             output(")");
  1680.     } else {
  1681.         if (usePP)
  1682.             output(" PV()");
  1683.         else {
  1684.         if (spacefuncs)
  1685.         output(" ");
  1686.         if (void_args)
  1687.         output("(void)");
  1688.         else
  1689.         output("()");
  1690.     }
  1691.     }
  1692. }
  1693.  
  1694.  
  1695.  
  1696. void outdeclarator(type, name, flags)
  1697. Type *type;
  1698. char *name;
  1699. int flags;
  1700. {
  1701.     int i, depth, anyptrs, anyarrays;
  1702.     Expr *dimen[30];
  1703.     Expr *ex, *maxv;
  1704.     Type *tp, *functype, *basetype;
  1705.     Expr funcdummy;   /* yow */
  1706.  
  1707.     anyptrs = 0;
  1708.     anyarrays = 0;
  1709.     functype = NULL;
  1710.     basetype = findbasetype(type, flags);
  1711.     for (depth = 0, tp = type; tp && tp != basetype; tp = tp->basetype) {
  1712.         switch (tp->kind) {
  1713.  
  1714.             case TK_POINTER:
  1715.                 if (tp->basetype) {
  1716.                     switch (tp->basetype->kind) {
  1717.  
  1718.                 case TK_VOID:
  1719.                 if (tp->basetype == tp_void &&
  1720.                 tp_special_anyptr) {
  1721.                 tp = tp_special_anyptr;
  1722.                 continue;
  1723.                 }
  1724.                 break;
  1725.  
  1726.                         case TK_ARRAY:    /* ptr to array of x => ptr to x */
  1727.                         case TK_STRING:   /*                or => array of x */
  1728.                         case TK_SET:
  1729.                 if (stararrays == 1 ||
  1730.                 !(flags & ODECL_FREEARRAY) ||
  1731.                 (tp->basetype->structdefd &&
  1732.                  stararrays != 2)) {
  1733.                 tp = tp->basetype;
  1734.                 flags &= ~ODECL_CHARSTAR;
  1735.                 } else {
  1736.                 continue;
  1737.                 }
  1738.                             break;
  1739.  
  1740.             default:
  1741.                 break;
  1742.                     }
  1743.                 }
  1744.                 dimen[depth++] = NULL;
  1745.                 anyptrs++;
  1746.         if (tp->kind == TK_POINTER &&
  1747.             tp->fbase && tp->fbase->wasdeclared)
  1748.             break;
  1749.                 continue;
  1750.  
  1751.             case TK_ARRAY:
  1752.         flags &= ~ODECL_CHARSTAR;
  1753.                 if (tp->meaning && tp->meaning->kind == MK_TYPE &&
  1754.                     tp->meaning->wasdeclared)
  1755.                     break;
  1756.         if (tp->structdefd) {    /* conformant array */
  1757.             if (!variablearrays &&
  1758.             !(tp->basetype->kind == TK_ARRAY &&
  1759.               tp->basetype->structdefd))   /* avoid mult. notes */
  1760.             note("Conformant array code may not work in all compilers [101]");
  1761.         }
  1762.                 ex = arraysize(tp, 1);
  1763.                 if (!ex)
  1764.                     ex = makeexpr_name("", tp_integer);
  1765.                 dimen[depth++] = ex;
  1766.         anyarrays++;
  1767.         if (tp->fbase && tp->fbase->wasdeclared)
  1768.             break;
  1769.                 continue;
  1770.  
  1771.             case TK_SET:
  1772.                 ord_range_expr(tp->indextype, NULL, &maxv);
  1773.                 maxv = enum_to_int(copyexpr(maxv));
  1774.                 if (ord_type(maxv->val.type)->kind == TK_CHAR)
  1775.                     maxv->val.type = tp_integer;
  1776.                 dimen[depth++] = makeexpr_plus(makeexpr_div(maxv, makeexpr_setbits()),
  1777.                                                makeexpr_long(2));
  1778.                 break;
  1779.  
  1780.             case TK_STRING:
  1781.                 if ((flags & ODECL_CHARSTAR) && stararrays == 1) {
  1782.                     dimen[depth++] = NULL;
  1783.                 } else {
  1784.                     ord_range_expr(tp->indextype, NULL, &maxv);
  1785.                     dimen[depth++] = makeexpr_plus(copyexpr(maxv), makeexpr_long(1));
  1786.                 }
  1787.                 continue;
  1788.  
  1789.             case TK_FILE:
  1790.                 break;
  1791.  
  1792.         case TK_CPROCPTR:
  1793.         dimen[depth++] = NULL;
  1794.         anyptrs++;
  1795.         if (procptrprototypes)
  1796.             continue;
  1797.                 dimen[depth++] = &funcdummy;
  1798.         break;
  1799.  
  1800.             case TK_FUNCTION:
  1801.                 dimen[depth++] = &funcdummy;
  1802.                 if (!functype)
  1803.                     functype = tp;
  1804.                 continue;
  1805.  
  1806.         default:
  1807.         break;
  1808.         }
  1809.         break;
  1810.     }
  1811.     if (!*name && depth && (spaceexprs > 0 ||
  1812.                             (spaceexprs != 0 && !dimen[depth-1])))
  1813.         output(" ");    /* spacing for abstract declarator */
  1814.     if ((flags & ODECL_FUNCTION) && anyptrs)
  1815.         output(" ");
  1816.     if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
  1817.     output("\003");
  1818.     for (i = depth; --i >= 0; ) {
  1819.         if (!dimen[i])
  1820.             output("*");
  1821.         if (i > 0 &&
  1822.             ((dimen[i] && !dimen[i-1]) ||
  1823.              (dimen[i-1] && !dimen[i] && extraparens > 0)))
  1824.             output("(");
  1825.     }
  1826.     if (flags & ODECL_FUNCTION)
  1827.         output("\n");
  1828.     if (anyarrays > 1 && (flags & ODECL_FUNCTION))
  1829.     output("\003");
  1830.     output(name);
  1831.     for (i = 0; i < depth; i++) {
  1832.         if (i > 0 &&
  1833.             ((dimen[i] && !dimen[i-1]) ||
  1834.              (dimen[i-1] && !dimen[i] && extraparens > 0)))
  1835.             output(")");
  1836.         if (dimen[i]) {
  1837.             if (dimen[i] == &funcdummy) {
  1838.         if (lookback(1) == ')')
  1839.             output("\002");
  1840.         if (functype)
  1841.             declare_args(functype, (flags & ODECL_HEADER) != 0,
  1842.                            (flags & ODECL_FORWARD) != 0);
  1843.         else if (spacefuncs)
  1844.             output(" ()");
  1845.         else
  1846.             output("()");
  1847.             } else {
  1848.         if (lookback(1) == ']')
  1849.             output("\002");
  1850.                 output("[");
  1851.                 if (!(flags & ODECL_FREEARRAY) || stararrays == 0 || i > 0)
  1852.                     out_expr(dimen[i]);
  1853.                 freeexpr(dimen[i]);
  1854.                 output("]");
  1855.             }
  1856.         }
  1857.     }
  1858.     if (anyarrays > 1)
  1859.     output("\004");
  1860. }
  1861.  
  1862.  
  1863.  
  1864.  
  1865.  
  1866.  
  1867. /* Find out if types t1 and t2 will work out to be the same C type,
  1868.    for purposes of type-casting */
  1869.  
  1870. Type *canonicaltype(type)
  1871. Type *type;
  1872. {
  1873.     if (type->kind == TK_SUBR || type->kind == TK_ENUM ||
  1874.         type->kind == TK_PROCPTR)
  1875.         type = findbasetype(type, 0);
  1876.     if (type == tp_char)
  1877.         return tp_ubyte;
  1878.     if (type->kind == TK_POINTER) {
  1879.     if (type->smin)
  1880.         return type;
  1881.         else if (type->basetype->kind == TK_ARRAY ||
  1882.          type->basetype->kind == TK_STRING ||
  1883.          type->basetype->kind == TK_SET)
  1884.             return makepointertype(canonicaltype(type->basetype->basetype));
  1885.         else if (type->basetype == tp_void)
  1886.             return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
  1887.         else if (type->basetype->kind == TK_FILE)
  1888.             return tp_text;
  1889.         else
  1890.             return makepointertype(canonicaltype(type->basetype));
  1891.     }
  1892.     return type;
  1893. }
  1894.  
  1895.  
  1896. int identicaltypes(t1, t2)
  1897. Type *t1, *t2;
  1898. {
  1899.     if (t1 == t2)
  1900.     return 1;
  1901.     if (t1->kind == t2->kind) {
  1902.     if (t1->kind == TK_SUBR)
  1903.         return (identicaltypes(t1->basetype, t2->basetype) &&
  1904.             exprsame(t1->smin, t2->smin, 2) &&
  1905.             exprsame(t1->smax, t2->smax, 2));
  1906.     if (t1->kind == TK_SET ||
  1907.         t1->kind == TK_SMALLSET)
  1908.         return (exprsame(t1->indextype->smax,
  1909.                  t2->indextype->smax, 2));
  1910.     if (t1->kind == TK_ARRAY ||
  1911.         t1->kind == TK_STRING ||
  1912.         t1->kind == TK_SMALLARRAY)
  1913.         return (identicaltypes(t1->basetype, t2->basetype) &&
  1914.             identicaltypes(t1->indextype, t2->indextype) &&
  1915.             t1->structdefd == t2->structdefd &&
  1916.             ((!t1->smin && !t2->smin) ||
  1917.              (t1->smin && t2->smin &&
  1918.               exprsame(t1->smin, t2->smin, 2))) &&
  1919.             ((!t1->smax && !t2->smax) ||
  1920.              (t1->smax && t2->smax &&
  1921.               exprsame(t1->smax, t2->smax, 2) &&
  1922.               t1->escale == t2->escale &&
  1923.               t1->issigned == t2->issigned)));
  1924.     }
  1925.     return 0;
  1926. }
  1927.  
  1928.  
  1929. int similartypes(t1, t2)
  1930. Type *t1, *t2;
  1931. {
  1932.     if (debug > 3) { fprintf(outf, "similartypes("); dumptypename(t1,1); fprintf(outf, ","); dumptypename(t2,1); fprintf(outf, ") = %d\n", identicaltypes(t1, t2)); }
  1933.     if (identicaltypes(t1, t2))
  1934.     return 1;
  1935.     t1 = canonicaltype(t1);
  1936.     t2 = canonicaltype(t2);
  1937.     return (t1 == t2);
  1938. }
  1939.  
  1940.  
  1941.  
  1942.  
  1943.  
  1944. Static int checkstructconst(mp)
  1945. Meaning *mp;
  1946. {
  1947.     return (mp->kind == MK_VAR &&
  1948.         mp->constdefn &&
  1949.             mp->constdefn->kind == EK_CONST &&
  1950.             (mp->constdefn->val.type->kind == TK_ARRAY ||
  1951.              mp->constdefn->val.type->kind == TK_RECORD));
  1952. }
  1953.  
  1954.  
  1955. Static int mixable(mp1, mp2, args, flags)
  1956. Meaning *mp1, *mp2;
  1957. int args, flags;
  1958. {
  1959.     Type *tp1 = mp1->type, *tp2 = mp2->type;
  1960.  
  1961.     if (mixvars == 0)
  1962.         return 0;
  1963.     if (mp1->kind == MK_FIELD &&
  1964.         (mp1->val.i || mp2->val.i) && mixfields == 0)
  1965.         return 0;
  1966.     if (checkstructconst(mp1) || checkstructconst(mp2))
  1967.         return 0;
  1968.     if (mp1->comments) {
  1969.     if (findcomment(mp1->comments, CMT_NOT | CMT_PRE, -1))
  1970.         return 0;
  1971.     }
  1972.     if (mp2->comments) {
  1973.     if (findcomment(mp2->comments, CMT_PRE, -1))
  1974.         return 0;
  1975.     }
  1976.     if ((mp1->constdefn && (mp1->kind == MK_VAR || mp1->kind == MK_VARREF)) ||
  1977.     (mp2->constdefn && (mp2->kind == MK_VAR || mp2->kind == MK_VARREF))) {
  1978.         if (mixinits == 0)
  1979.             return 0;
  1980.         if (mixinits != 1 &&
  1981.             (!mp1->constdefn || !mp2->constdefn))
  1982.             return 0;
  1983.     }
  1984.     if (args) {
  1985.         if (mp1->kind == MK_PARAM && mp1->othername)
  1986.             tp1 = mp1->rectype;
  1987.         if (mp2->kind == MK_PARAM && mp2->othername)
  1988.             tp2 = mp2->rectype;
  1989.     }
  1990.     if (tp1 == tp2)
  1991.         return 1;
  1992.     switch (mixtypes) {
  1993.         case 0:
  1994.             return 0;
  1995.         case 1:
  1996.             return (findbasetype(tp1, flags) == findbasetype(tp2, flags));
  1997.         default:
  1998.             if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
  1999.         return 0;
  2000.             while (tp1->kind == TK_POINTER && !tp1->smin && tp1->basetype)
  2001.                 tp1 = tp1->basetype;
  2002.             while (tp2->kind == TK_POINTER && !tp2->smin && tp2->basetype)
  2003.                 tp2 = tp2->basetype;
  2004.             return (tp1 == tp2);
  2005.     }
  2006. }
  2007.  
  2008.  
  2009.  
  2010. void declarefiles(fnames)
  2011. Strlist *fnames;
  2012. {
  2013.     Meaning *mp;
  2014.     char *cp;
  2015.  
  2016.     while (fnames) {
  2017.     mp = (Meaning *)fnames->value;
  2018.     if (mp->kind == MK_VAR || mp->kind == MK_FIELD) {
  2019.         if (mp->namedfile) {
  2020.         output(storageclassname(varstorageclass(mp)));
  2021.         output(format_ss("%s %s", charname,
  2022.                  format_s(name_FNVAR, fnames->s)));
  2023.         output(format_s("[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
  2024.         }
  2025.         if (mp->bufferedfile && *declbufname) {
  2026.         cp = format_s("%s", storageclassname(varstorageclass(mp)));
  2027.         if (*cp && isspace(cp[strlen(cp)-1]))
  2028.           cp[strlen(cp)-1] = 0;
  2029.         if (*cp || !*declbufncname) {
  2030.             output(declbufname);
  2031.             output("(");
  2032.             output(fnames->s);
  2033.             output(",");
  2034.             output(cp);
  2035.         } else {
  2036.             output(declbufncname);
  2037.             output("(");
  2038.             output(fnames->s);
  2039.         }
  2040.         output(",");
  2041.         out_type(mp->type->basetype->basetype, 1);
  2042.         output(");\n");
  2043.         }
  2044.     }
  2045.     strlist_eat(&fnames);
  2046.     }
  2047. }
  2048.  
  2049.  
  2050.  
  2051. char *variantfieldname(num)
  2052. int num;
  2053. {
  2054.     if (num >= 0)
  2055.         return format_d("U%d", num);
  2056.     else
  2057.         return format_d("UM%d", -num);
  2058. }
  2059.  
  2060.  
  2061. int record_is_union(tp)
  2062. Type *tp;
  2063. {
  2064.     return (tp->kind == TK_RECORD &&
  2065.         tp->fbase && tp->fbase->kind == MK_VARIANT);
  2066. }
  2067.  
  2068.  
  2069. void outfieldlist(mp)
  2070. Meaning *mp;
  2071. {
  2072.     Meaning *mp0;
  2073.     int num, only_union, empty, saveindent, saveindent2;
  2074.     Strlist *fnames, *fn;
  2075.  
  2076.     if (!mp) {
  2077.     output("int empty_struct;   /* Pascal record was empty */\n");
  2078.     return;
  2079.     }
  2080.     only_union = (mp && mp->kind == MK_VARIANT);
  2081.     fnames = NULL;
  2082.     while (mp && mp->kind == MK_FIELD) {
  2083.     flushcomments(&mp->comments, CMT_PRE, -1);
  2084.     output(storageclassname(varstorageclass(mp) & 0x10));
  2085.     if (mp->dtype)
  2086.         output(mp->dtype->name);
  2087.     else
  2088.         outbasetype(mp->type, 0);
  2089.         output(" \005");
  2090.     for (;;) {
  2091.         if (mp->dtype)
  2092.         output(mp->name);
  2093.         else
  2094.         outdeclarator(mp->type, mp->name, 0);
  2095.         if (mp->val.i && (mp->type != tp_abyte || mp->val.i != 8))
  2096.         output(format_d(" : %d", mp->val.i));
  2097.         if (isfiletype(mp->type, 0)) {
  2098.         fn = strlist_append(&fnames, mp->name);
  2099.         fn->value = (long)mp;
  2100.         }
  2101.         mp->wasdeclared = 1;
  2102.         if (!mp->cnext || mp->cnext->kind != MK_FIELD ||
  2103.         mp->dtype != mp->cnext->dtype ||
  2104.         varstorageclass(mp) != varstorageclass(mp->cnext) ||
  2105.         !mixable(mp, mp->cnext, 0, 0))
  2106.         break;
  2107.             mp = mp->cnext;
  2108.         if (spacecommas)
  2109.         output(",\001 ");
  2110.         else
  2111.         output(",\001");
  2112.         }
  2113.         output(";");
  2114.     outtrailcomment(mp->comments, -1, declcommentindent);
  2115.     flushcomments(&mp->comments, -1, -1);
  2116.         mp = mp->cnext;
  2117.     }
  2118.     declarefiles(fnames);
  2119.     if (mp) {
  2120.     saveindent = outindent;
  2121.     empty = 1;
  2122.         if (!only_union) {
  2123.             output("union {\n");
  2124.         moreindent(tabsize);
  2125.         moreindent(structindent);
  2126.         }
  2127.         while (mp) {
  2128.             mp0 = mp->ctx;
  2129.             num = ord_value(mp->val);
  2130.             while (mp && mp->ctx == mp0)
  2131.                 mp = mp->cnext;
  2132.             if (mp0) {
  2133.         empty = 0;
  2134.                 if (!mp0->cnext && mp0->kind == MK_FIELD) {
  2135.             mp0->val.i = 0;   /* no need for bit fields in a union! */
  2136.                     outfieldlist(mp0);
  2137.                 } else {
  2138.                     if (mp0->kind == MK_VARIANT)
  2139.                         output("union {\n");
  2140.                     else
  2141.                         output("struct {\n");
  2142.             saveindent2 = outindent;
  2143.             moreindent(tabsize);
  2144.             moreindent(structindent);
  2145.                     outfieldlist(mp0);
  2146.             outindent = saveindent2;
  2147.                     output("} ");
  2148.                     output(format_s(name_VARIANT, variantfieldname(num)));
  2149.                     output(";\n");
  2150.                 }
  2151.         flushcomments(&mp0->comments, -1, -1);
  2152.             }
  2153.         }
  2154.     if (empty)
  2155.         output("int empty_union;   /* Pascal variant record was empty */\n");
  2156.         if (!only_union) {
  2157.             outindent = saveindent;
  2158.             output("} ");
  2159.             output(format_s(name_UNION, ""));
  2160.             output(";\n");
  2161.         }
  2162.     }
  2163. }
  2164.  
  2165.  
  2166.  
  2167. void declarebigfile(type)
  2168. Type *type;
  2169. {
  2170.     output("FILE *f;\n");
  2171.     if (!*declbufncname) {
  2172.     output(declbufname);
  2173.     output("(f,,");
  2174.     } else {
  2175.     output(declbufncname);
  2176.     output("(f,");
  2177.     }
  2178.     out_type(type->basetype, 1);
  2179.     output(");\n");
  2180.     output(charname);
  2181.     output(format_s(" name[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
  2182. }
  2183.  
  2184.  
  2185.  
  2186. void outbasetype(type, flags)
  2187. Type *type;
  2188. int flags;
  2189. {
  2190.     Meaning *mp;
  2191.     int saveindent;
  2192.  
  2193.     type = findbasetype(type, flags | ODECL_DECL);
  2194.     if (type->preserved && type->meaning->wasdeclared) {
  2195.     output(type->meaning->name);
  2196.     return;
  2197.     }
  2198.     switch (type->kind) {
  2199.  
  2200.         case TK_INTEGER:
  2201.             if (type == tp_uint) {
  2202.                 output("unsigned");
  2203.             } else if (type == tp_sint) {
  2204.                 if (useAnyptrMacros == 1)
  2205.                     output("Signed int");
  2206.                 else if (hassignedchar)
  2207.                     output("signed int");
  2208.                 else
  2209.                     output("int");   /* will sign-extend by hand */
  2210.             } else if (type == tp_unsigned) {
  2211.                 output("unsigned long");
  2212.             } else if (type != tp_int)
  2213.                 output(integername);
  2214.             else
  2215.                 output("int");
  2216.             break;
  2217.  
  2218.         case TK_SUBR:
  2219.             if (type == tp_special_anyptr) {
  2220.                 output("Anyptr");
  2221.             } else if (type == tp_abyte) {
  2222.                 output("char");
  2223.             } else if (type == tp_ubyte) {
  2224.                 output(ucharname);
  2225.             } else if (type == tp_sbyte) {
  2226.                 output(scharname);
  2227.                 if (signedchars != 1 && !hassignedchar)
  2228.                     note("'signed char' may not be valid in all compilers [102]");
  2229.             } else {
  2230.                 if (type == tp_ushort)
  2231.                     output("unsigned ");
  2232.                 output("short");
  2233.             }
  2234.             break;
  2235.  
  2236.         case TK_CHAR:
  2237.             if (type == tp_uchar) {
  2238.                 output(ucharname);
  2239.             } else if (type == tp_schar) {
  2240.                 output(scharname);
  2241.                 if (signedchars != 1 && !hassignedchar)
  2242.                     note("'signed char' may not be valid in all compilers [102]");
  2243.         } else
  2244.         output(charname);
  2245.             break;
  2246.  
  2247.         case TK_BOOLEAN:
  2248.             output((*name_BOOLEAN) ? name_BOOLEAN : ucharname);
  2249.             break;
  2250.  
  2251.         case TK_REAL:
  2252.         if (type == tp_longreal)
  2253.         output("double");
  2254.         else
  2255.         output("float");
  2256.             break;
  2257.  
  2258.         case TK_VOID:
  2259.             if (ansiC == 0)
  2260.                 output("int");
  2261.             else if (useAnyptrMacros == 1)
  2262.                 output("Void");
  2263.             else
  2264.                 output("void");
  2265.             break;
  2266.  
  2267.         case TK_PROCPTR:
  2268.         output(name_PROCEDURE);
  2269.         break;
  2270.  
  2271.         case TK_FILE:
  2272.             output("FILE");
  2273.             break;
  2274.  
  2275.     case TK_SPECIAL:
  2276.         if (type == tp_jmp_buf)
  2277.         output("jmp_buf");
  2278.         break;
  2279.  
  2280.         default:
  2281.         if (type->kind == TK_POINTER && type->smin) {
  2282.         note("Forward pointer reference assumes struct type [323]");
  2283.         output("struct ");
  2284.         output(format_s(name_STRUCT, type->smin->val.s));
  2285.         } else if (type->meaning && type->meaning->kind == MK_TYPE &&
  2286.                 type->meaning->wasdeclared) {
  2287.                 output(type->meaning->name);
  2288.             } else {
  2289.                 switch (type->kind) {
  2290.  
  2291.                     case TK_ENUM:
  2292.                         output("enum {\n");
  2293.             saveindent = outindent;
  2294.             moreindent(tabsize);
  2295.             moreindent(structindent);
  2296.                         mp = type->fbase;
  2297.                         while (mp) {
  2298.                             output(mp->name);
  2299.                             mp = mp->xnext;
  2300.                             if (mp)
  2301.                 if (spacecommas)
  2302.                     output(",\001 ");
  2303.                 else
  2304.                     output(",\001");
  2305.                         }
  2306.                         outindent = saveindent;
  2307.                         output("\n}");
  2308.                         break;
  2309.  
  2310.                     case TK_RECORD:
  2311.                     case TK_BIGFILE:
  2312.                         if (record_is_union(type))
  2313.                             output("union ");
  2314.                         else
  2315.                             output("struct ");
  2316.                         if (type->meaning)
  2317.                             output(format_s(name_STRUCT, type->meaning->name));
  2318.             if (!type->structdefd) {
  2319.                 if (type->meaning) {
  2320.                 type->structdefd = 1;
  2321.                 output(" ");
  2322.                 }
  2323.                             output("{\n");
  2324.                 saveindent = outindent;
  2325.                 moreindent(tabsize);
  2326.                 moreindent(structindent);
  2327.                 if (type->kind == TK_BIGFILE)
  2328.                 declarebigfile(type);
  2329.                 else
  2330.                 outfieldlist(type->fbase);
  2331.                             outindent = saveindent;
  2332.                             output("}");
  2333.                         }
  2334.             break;
  2335.  
  2336.             default:
  2337.             break;
  2338.  
  2339.                 }
  2340.             }
  2341.             break;
  2342.     }
  2343. }
  2344.  
  2345.  
  2346.  
  2347. void out_type(type, witharrays)
  2348. Type *type;
  2349. int witharrays;
  2350. {
  2351.     if (!witharrays && type->kind == TK_ARRAY)
  2352.         type = makepointertype(type->basetype);
  2353.     outbasetype(type, 0);
  2354.     outdeclarator(type, "", 0);    /* write an "abstract declarator" */
  2355. }
  2356.  
  2357.  
  2358.  
  2359.  
  2360. int varstorageclass(mp)
  2361. Meaning *mp;
  2362. {
  2363.     int sclass;
  2364.  
  2365.     if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM ||
  2366.     mp->kind == MK_FIELD)
  2367.     sclass = 0;
  2368.     else if (blockkind == TOK_EXPORT)
  2369.         if (usevextern)
  2370.         if (mp->constdefn &&
  2371.         (mp->kind == MK_VAR ||
  2372.          mp->kind == MK_VARREF))
  2373.         sclass = 2;    /* extern */
  2374.         else
  2375.         sclass = 1;    /* vextern */
  2376.         else
  2377.             sclass = 0;                         /* (plain) */
  2378.     else if (mp->isfunction && mp->kind != MK_FUNCTION)
  2379.     sclass = 2;   /* extern */
  2380.     else if (mp->ctx->kind == MK_MODULE &&
  2381.          (var_static != 0 ||
  2382.           (findsymbol(mp->name)->flags & NEEDSTATIC)) &&
  2383.          !mp->exported && !mp->istemporary && blockkind != TOK_END)
  2384.         sclass = (useAnyptrMacros) ? 4 : 3;     /* (private) */
  2385.     else if (mp->isforward)
  2386.         sclass = 3;   /* static */
  2387.     else
  2388.     sclass = 0;   /* (plain) */
  2389.     if (mp->volatilequal)
  2390.     sclass |= 0x10;
  2391.     if (mp->constqual)
  2392.     sclass |= 0x20;
  2393.     if (debug>2) fprintf(outf, "varstorageclass(%s) = %d\n", mp->name, sclass);
  2394.     return sclass;
  2395. }
  2396.  
  2397.  
  2398. char *storageclassname(i)
  2399. int i;
  2400. {
  2401.     char *scname;
  2402.  
  2403.     switch (i & 0xf) {
  2404.         case 1:
  2405.             scname = "vextern ";
  2406.         break;
  2407.         case 2:
  2408.             scname = "extern ";
  2409.         break;
  2410.         case 3:
  2411.             scname = "static ";
  2412.         break;
  2413.         case 4:
  2414.             scname = "Static ";
  2415.         break;
  2416.         default:
  2417.             scname = "";
  2418.         break;
  2419.     }
  2420.     if (i & 0x10)
  2421.     if (useAnyptrMacros == 1)
  2422.         scname = format_s("%sVolatile ", scname);
  2423.     else if (ansiC > 0)
  2424.         scname = format_s("%svolatile ", scname);
  2425.     if (i & 0x20)
  2426.     if (useAnyptrMacros == 1)
  2427.         scname = format_s("%sConst ", scname);
  2428.     else if (ansiC > 0)
  2429.         scname = format_s("%sconst ", scname);
  2430.     return scname;
  2431. }
  2432.  
  2433.  
  2434.  
  2435. Static int var_mixable;
  2436.  
  2437. void declarevar(mp, which)
  2438. Meaning *mp;
  2439. int which;    /* 0x1=header, 0x2=body, 0x4=trailer, 0x8=in varstruct */
  2440. {
  2441.     int isstatic, isstructconst, saveindent, i;
  2442.     Strlist *sl;
  2443.  
  2444.     isstructconst = checkstructconst(mp);
  2445.     isstatic = varstorageclass(mp);
  2446.     if (which & 0x8)
  2447.     isstatic &= 0x10;   /* clear all but Volatile flags */
  2448.     flushcomments(&mp->comments, CMT_PRE, -1);
  2449.     if (which & 0x1) {
  2450.         if (isstructconst)
  2451.             outsection(minorspace);
  2452.         output(storageclassname(isstatic));
  2453.     if (mp->dtype)
  2454.         output(mp->dtype->name);
  2455.         else
  2456.         outbasetype(mp->type, 0);
  2457.         output(" \005");
  2458.     }
  2459.     if (which & 0x2) {
  2460.     if (mp->dtype)
  2461.         output(mp->name);
  2462.     else
  2463.         outdeclarator(mp->type, mp->name, 0);
  2464.         if (mp->constdefn && blockkind != TOK_EXPORT &&
  2465.         (mp->kind == MK_VAR || mp->kind == MK_VARREF)) {
  2466.             if (mp->varstructflag) {    /* move init code into function body */
  2467.                 intwarning("declarevar",
  2468.                     format_s("Variable %s initializer not removed [125]", mp->name));
  2469.             } else {
  2470.                 if (isstructconst) {
  2471.                     output(" = {\n");
  2472.             saveindent = outindent;
  2473.             moreindent(tabsize);
  2474.             moreindent(structinitindent);
  2475.                     out_expr((Expr *)mp->constdefn->val.i);
  2476.                     outindent = saveindent;
  2477.                     output("\n}");
  2478.             var_mixable = 0;
  2479.         } else if (mp->type->kind == TK_ARRAY &&
  2480.                mp->constdefn->val.type->kind == TK_STRING &&
  2481.                !initpacstrings) {
  2482.             if (mp->ctx->kind == MK_MODULE) {
  2483.             sl = strlist_append(&initialcalls,
  2484.                         format_sss("memcpy(%s,\002 %s,\002 sizeof(%s))",
  2485.                                mp->name,
  2486.                                makeCstring(mp->constdefn->val.s,
  2487.                                    mp->constdefn->val.i),
  2488.                                mp->name));
  2489.             sl->value = 1;
  2490.             } else if (mp->isforward) {
  2491.             output(" = {\005");
  2492.             for (i = 0; i < mp->constdefn->val.i; i++) {
  2493.                 if (i > 0)
  2494.                 output(",\001");
  2495.                 output(makeCchar(mp->constdefn->val.s[i]));
  2496.             }
  2497.             output("}");
  2498.             mp->constdefn = NULL;
  2499.             var_mixable = 0;
  2500.             }
  2501.                 } else {
  2502.             output(" = ");
  2503.                     out_expr(mp->constdefn);
  2504.         }
  2505.             }
  2506.         }
  2507.     }
  2508.     if (which & 0x4) {
  2509.         output(";");
  2510.     outtrailcomment(mp->comments, -1, declcommentindent);
  2511.     flushcomments(&mp->comments, -1, -1);
  2512.         if (isstructconst)
  2513.             outsection(minorspace);
  2514.     }
  2515. }
  2516.  
  2517.  
  2518.  
  2519.  
  2520. Static int checkvarmacdef(ex, mp)
  2521. Expr *ex;
  2522. Meaning *mp;
  2523. {
  2524.     int i;
  2525.  
  2526.     if ((ex->kind == EK_NAME || ex->kind == EK_BICALL) &&
  2527.     !strcmp(ex->val.s, mp->name)) {
  2528.     ex->kind = EK_VAR;
  2529.     ex->val.i = (long)mp;
  2530.     ex->val.type = mp->type;
  2531.     return 1;
  2532.     }
  2533.     if (ex->kind == EK_VAR && ex->val.i == (long)mp)
  2534.     return 1;
  2535.     i = ex->nargs;
  2536.     while (--i >= 0)
  2537.     if (checkvarmacdef(ex->args[i], mp))
  2538.         return 1;
  2539.     return 0;
  2540. }
  2541.  
  2542.  
  2543. int checkvarmac(mp)
  2544. Meaning *mp;
  2545. {
  2546.     if (mp->kind != MK_VARMAC && mp->kind != MK_FUNCTION)
  2547.     return 0;
  2548.     if (!mp->constdefn)
  2549.     return 0;
  2550.     return checkvarmacdef(mp->constdefn, mp);
  2551. }
  2552.  
  2553.  
  2554.  
  2555. #define varkind(k) ((k)==MK_VAR||(k)==MK_VARREF||(k)==MK_PARAM||(k)==MK_VARPARAM)
  2556.  
  2557. int declarevars(ctx, invarstruct)
  2558. Meaning *ctx;
  2559. int invarstruct;
  2560. {
  2561.     Meaning *mp, *mp0, *mp2;
  2562.     Strlist *fnames, *fn;
  2563.     int flag, first;
  2564.  
  2565.     if (ctx->kind == MK_FUNCTION && ctx->varstructflag && !invarstruct) {
  2566.         output("struct ");
  2567.         output(format_s(name_LOC, ctx->name));
  2568.         output(" ");
  2569.         output(format_s(name_VARS, ctx->name));
  2570.         output(";\n");
  2571.         flag = 1;
  2572.     } else
  2573.         flag = 0;
  2574.     if (debug>2) {
  2575.         fprintf(outf,"declarevars:\n");
  2576.         for (mp = ctx->cbase; mp; mp = mp->xnext) {
  2577.             fprintf(outf, "  %-22s%-15s%3d", mp->name,
  2578.                                              meaningkindname(mp->kind),
  2579.                                              mp->refcount);
  2580.             if (mp->wasdeclared)
  2581.                 fprintf(outf, " [decl]");
  2582.             if (mp->varstructflag)
  2583.                 fprintf(outf, " [struct]");
  2584.             fprintf(outf, "\n");
  2585.         }
  2586.     }
  2587.     fnames = NULL;
  2588.     for (;;) {
  2589.         mp = ctx->cbase;
  2590.         while (mp && (!(varkind(mp->kind) || checkvarmac(mp)) ||
  2591.               mp->wasdeclared || mp->varstructflag != invarstruct ||
  2592.               mp->refcount <= 0))
  2593.             mp = mp->cnext;
  2594.         if (!mp)
  2595.             break;
  2596.         flag = 1;
  2597.         first = 1;
  2598.         mp0 = mp2 = mp;
  2599.     var_mixable = 1;
  2600.         while (mp) {
  2601.             if ((varkind(mp->kind) || checkvarmac(mp)) &&
  2602.         !mp->wasdeclared && var_mixable &&
  2603.         mp->dtype == mp0->dtype &&
  2604.                 varstorageclass(mp) == varstorageclass(mp0) &&
  2605.                 mp->varstructflag == invarstruct && mp->refcount > 0) {
  2606.                 if (mixable(mp2, mp, 0, 0) || first) {
  2607.                     if (!first)
  2608.             if (spacecommas)
  2609.                 output(",\001 ");
  2610.             else
  2611.                 output(",\001");
  2612.                     declarevar(mp, (first ? 0x3 : 0x2) |
  2613.                        (invarstruct ? 0x8 : 0));
  2614.             mp2 = mp;
  2615.                     mp->wasdeclared = 1;
  2616.                     if (isfiletype(mp->type, 0)) {
  2617.                         fn = strlist_append(&fnames, mp->name);
  2618.                         fn->value = (long)mp;
  2619.                     }
  2620.                     first = 0;
  2621.                 } else
  2622.                     if (mixvars != 1)
  2623.                         break;
  2624.             }
  2625.         if (first) {
  2626.         intwarning("declarevars",
  2627.                format_s("Unable to declare %s [126]", mp->name));
  2628.         mp->wasdeclared = 1;
  2629.         first = 0;
  2630.         }
  2631.             if (mixvars == 0)
  2632.                 break;
  2633.             mp = mp->cnext;
  2634.         }
  2635.         declarevar(mp2, 0x4);
  2636.     }
  2637.     declarefiles(fnames);
  2638.     return flag;
  2639. }
  2640.  
  2641.  
  2642.  
  2643. void redeclarevars(ctx)
  2644. Meaning *ctx;
  2645. {
  2646.     Meaning *mp;
  2647.  
  2648.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  2649.         if ((mp->kind == MK_VAR || mp->kind == MK_VARREF) &&
  2650.             mp->constdefn) {
  2651.             mp->wasdeclared = 0;    /* mark for redeclaration, this time */
  2652.         }                           /*  with its initializer */
  2653.     }
  2654. }
  2655.  
  2656.  
  2657.  
  2658.  
  2659.  
  2660. void out_argdecls(ftype)
  2661. Type *ftype;
  2662. {
  2663.     Meaning *mp, *mp0;
  2664.     Type *tp;
  2665.     int done;
  2666.     int flag = 1;
  2667.     char *name;
  2668.  
  2669.     done = 0;
  2670.     do {
  2671.         mp = ftype->fbase;
  2672.         while (mp && mp->wasdeclared)
  2673.             mp = mp->xnext;
  2674.         if (mp) {
  2675.             if (flag)
  2676.                 output("\n");
  2677.             flag = 0;
  2678.             mp0 = mp;
  2679.             outbasetype(mp->othername ? mp->rectype : mp->type,
  2680.             ODECL_CHARSTAR|ODECL_FREEARRAY);
  2681.             output(" \005");
  2682.             while (mp) {
  2683.                 if (!mp->wasdeclared) {
  2684.                     if (mp == mp0 ||
  2685.             mixable(mp0, mp, 1, ODECL_CHARSTAR|ODECL_FREEARRAY)) {
  2686.                         if (mp != mp0)
  2687.                 if (spacecommas)
  2688.                 output(",\001 ");
  2689.                 else
  2690.                 output(",\001");
  2691.                         name = (mp->othername) ? mp->othername : mp->name;
  2692.                         tp = (mp->othername) ? mp->rectype : mp->type;
  2693.                         outdeclarator(tp, name,
  2694.                       ODECL_CHARSTAR|ODECL_FREEARRAY);
  2695.                         mp->wasdeclared = 1;
  2696.                     } else
  2697.                         if (mixvars != 1)
  2698.                             break;
  2699.                 }
  2700.                 mp = mp->xnext;
  2701.             }
  2702.             output(";\n");
  2703.         } else
  2704.             done = 1;
  2705.     } while (!done);
  2706.     for (mp0 = ftype->fbase; mp0 && (mp0->type != tp_strptr ||
  2707.                                      !mp0->anyvarflag); mp0 = mp0->xnext) ;
  2708.     if (mp0) {
  2709.         output("int ");
  2710.         for (mp = mp0; mp; mp = mp->xnext) {
  2711.             if (mp->type == tp_strptr && mp->anyvarflag) {
  2712.                 if (mp != mp0) {
  2713.                     if (mixvars == 0)
  2714.                         output(";\nint ");
  2715.                     else if (spacecommas)
  2716.                         output(",\001 ");
  2717.             else
  2718.                         output(",\001");
  2719.                 }
  2720.                 output(format_s(name_STRMAX, mp->name));
  2721.             }
  2722.         }
  2723.         output(";\n");
  2724.     }
  2725.     if (ftype->meaning && ftype->meaning->ctx->kind == MK_FUNCTION &&
  2726.                           ftype->meaning->ctx->varstructflag) {
  2727.         if (flag)
  2728.             output("\n");
  2729.         output("struct ");
  2730.         output(format_s(name_LOC, ftype->meaning->ctx->name));
  2731.         output(" *");
  2732.         output(format_s(name_LINK, ftype->meaning->ctx->name));
  2733.         output(";\n");
  2734.     }
  2735. }
  2736.  
  2737.  
  2738.  
  2739.  
  2740. void makevarstruct(func)
  2741. Meaning *func;
  2742. {
  2743.     int flag = 0;
  2744.     int saveindent;
  2745.  
  2746.     outsection(minfuncspace);
  2747.     output(format_s("\n/* Local variables for %s: */\n", func->name));
  2748.     output("struct ");
  2749.     output(format_s(name_LOC, func->name));
  2750.     output(" {\n");
  2751.     saveindent = outindent;
  2752.     moreindent(tabsize);
  2753.     moreindent(structindent);
  2754.     if (func->ctx->kind == MK_FUNCTION && func->ctx->varstructflag) {
  2755.         output("struct ");
  2756.         output(format_s(name_LOC, func->ctx->name));
  2757.         output(" *");
  2758.         output(format_s(name_LINK, func->ctx->name));
  2759.         output(";\n");
  2760.         flag++;
  2761.     }
  2762.     flag += declarevars(func, 1);
  2763.     if (!flag)                       /* Avoid generating an empty struct */
  2764.         output("int _meef_;\n");     /* (I don't think this will ever happen) */
  2765.     outindent = saveindent;
  2766.     output("} ;\n");
  2767.     outsection(minfuncspace);
  2768.     strlist_insert(&varstructdecllist, func->name);
  2769. }
  2770.  
  2771.  
  2772.  
  2773.  
  2774.  
  2775.  
  2776. Type *maketype(kind)
  2777. enum typekind kind;
  2778. {
  2779.     Type *tp;
  2780.     tp = ALLOC(1, Type, types);
  2781.     tp->kind = kind;
  2782.     tp->basetype = NULL;
  2783.     tp->indextype = NULL;
  2784.     tp->pointertype = NULL;
  2785.     tp->meaning = NULL;
  2786.     tp->fbase = NULL;
  2787.     tp->smin = NULL;
  2788.     tp->smax = NULL;
  2789.     tp->issigned = 0;
  2790.     tp->dumped = 0;
  2791.     tp->structdefd = 0;
  2792.     tp->preserved = 0;
  2793.     return tp;
  2794. }
  2795.  
  2796.  
  2797.  
  2798.  
  2799. Type *makesubrangetype(type, smin, smax)
  2800. Type *type;
  2801. Expr *smin, *smax;
  2802. {
  2803.     Type *tp;
  2804.  
  2805.     if (type->kind == TK_SUBR)
  2806.         type = type->basetype;
  2807.     tp = maketype(TK_SUBR);
  2808.     tp->basetype = type;
  2809.     tp->smin = smin;
  2810.     tp->smax = smax;
  2811.     return tp;
  2812. }
  2813.  
  2814.  
  2815.  
  2816. Type *makesettype(setof)
  2817. Type *setof;
  2818. {
  2819.     Type *tp;
  2820.     long smax;
  2821.  
  2822.     if (ord_range(setof, NULL, &smax) && smax < setbits && smallsetconst >= 0)
  2823.         tp = maketype(TK_SMALLSET);
  2824.     else
  2825.         tp = maketype(TK_SET);
  2826.     tp->basetype = tp_integer;
  2827.     tp->indextype = setof;
  2828.     return tp;
  2829. }
  2830.  
  2831.  
  2832.  
  2833. Type *makestringtype(len)
  2834. int len;
  2835. {
  2836.     Type *type;
  2837.     int index;
  2838.  
  2839.     len |= 1;
  2840.     if (len >= stringceiling)
  2841.         type = tp_str255;
  2842.     else {
  2843.         index = (len-1) / 2;
  2844.         if (stringtypecache[index])
  2845.             return stringtypecache[index];
  2846.         type = maketype(TK_STRING);
  2847.         type->basetype = tp_char;
  2848.         type->indextype = makesubrangetype(tp_integer, 
  2849.                                            makeexpr_long(0), 
  2850.                                            makeexpr_long(len));
  2851.         stringtypecache[index] = type;
  2852.     }
  2853.     return type;
  2854. }
  2855.  
  2856.  
  2857.  
  2858. Type *makepointertype(type)
  2859. Type *type;
  2860. {
  2861.     Type *tp;
  2862.  
  2863.     if (type->pointertype)
  2864.         return type->pointertype;
  2865.     tp = maketype(TK_POINTER);
  2866.     tp->basetype = type;
  2867.     type->pointertype = tp;
  2868.     return tp;
  2869. }
  2870.  
  2871.  
  2872.  
  2873.  
  2874.  
  2875. Value p_constant(type)
  2876. Type *type;
  2877. {
  2878.     Value val;
  2879.     Expr *ex;
  2880.  
  2881.     ex = p_expr(type);
  2882.     if (type)
  2883.         ex = gentle_cast(ex, type);
  2884.     val = eval_expr(ex);
  2885.     freeexpr(ex);
  2886.     if (!val.type) {
  2887.         warning("Expected a constant [127]");
  2888.         val.type = (type) ? type : tp_integer;
  2889.     }
  2890.     return val;
  2891. }
  2892.  
  2893.  
  2894.  
  2895.  
  2896. int typebits(smin, smax)
  2897. long smin, smax;
  2898. {
  2899.     unsigned long size;
  2900.     int bits;
  2901.  
  2902.     if (smin >= 0 || (smin == -1 && smax == 0)) {
  2903.         bits = 1;
  2904.         size = smax;
  2905.     } else {
  2906.         bits = 2;
  2907.         smin = -1L - smin;
  2908.         if (smin >= smax)
  2909.             size = smin;
  2910.         else
  2911.             size = smax;
  2912.     }
  2913.     while (size > 1) {
  2914.         bits++;
  2915.         size >>= 1;
  2916.     }
  2917.     return bits;
  2918. }
  2919.  
  2920.  
  2921. int packedsize(fname, typep, sizep, mode)
  2922. char *fname;
  2923. Type **typep;
  2924. long *sizep;
  2925. int mode;
  2926. {
  2927.     Type *tp = *typep;
  2928.     long smin, smax;
  2929.     int res, issigned;
  2930.     short savefold;
  2931.     long size;
  2932.  
  2933.     if (packing == 0)   /* suppress packing */
  2934.         return 0;
  2935.     if (tp->kind != TK_SUBR && tp->kind != TK_INTEGER && tp->kind != TK_ENUM &&
  2936.         tp->kind != TK_CHAR && tp->kind != TK_BOOLEAN)
  2937.         return 0;
  2938.     if (tp == tp_unsigned)
  2939.     return 0;
  2940.     if (!ord_range(tp, &smin, &smax)) {
  2941.         savefold = foldconsts;
  2942.         foldconsts = 1;
  2943.         res = ord_range(tp, &smin, &smax);
  2944.         foldconsts = savefold;
  2945.         if (res) {
  2946.             note(format_s("Field width for %s is based on expansion of #defines [103]",
  2947.                           fname));
  2948.         } else {
  2949.             note(format_ss("Cannot compute size of field %s; assuming %s [104]",
  2950.                            fname, integername));
  2951.             return 0;
  2952.         }
  2953.     } else {
  2954.         if (tp->kind == TK_ENUM)
  2955.             note(format_ssd("Field width for %s assumes enum%s has %d elements [105]",
  2956.                             fname,
  2957.                             (tp->meaning) ? format_s(" %s", tp->meaning->name) : "",
  2958.                             smax + 1));
  2959.     }
  2960.     issigned = (smin < 0);
  2961.     size = typebits(smin, smax);
  2962.     if (size >= ((sizeof_long > 0) ? sizeof_long : 32))
  2963.         return 0;
  2964.     if (packing != 1) {
  2965.         if (size <= 8)
  2966.             size = 8;
  2967.         else if (size <= 16)
  2968.             size = 16;
  2969.         else
  2970.             return 0;
  2971.     }
  2972.     if (!issigned) {
  2973.         *typep = (mode == 0) ? tp_int : tp_uint;
  2974.     } else {
  2975.         if (mode == 2 && !hassignedchar && !*signextname)
  2976.             return 0;
  2977.         *typep = (mode == 1) ? tp_int : tp_sint;
  2978.     }
  2979.     *sizep = size;
  2980.     return issigned;
  2981. }
  2982.  
  2983.  
  2984.  
  2985. Static void fielddecl(mp, type, tp2, val, ispacked, aligned)
  2986. Meaning *mp;
  2987. Type **type, **tp2;
  2988. long *val;
  2989. int ispacked, *aligned;
  2990. {
  2991.     long smin, smax, smin2, smax2;
  2992.  
  2993.     *tp2 = *type;
  2994.     *val = 0;
  2995.     if (ispacked && !mp->constdefn && *type != tp_unsigned) {
  2996.         (void)packedsize(mp->sym->name, tp2, val, signedfield);
  2997.         if (*aligned && *val &&
  2998.             (ord_type(*type)->kind == TK_CHAR ||
  2999.              ord_type(*type)->kind == TK_INTEGER) &&
  3000.             ord_range(findbasetype(*type, 0), &smin, &smax)) {
  3001.         if (ord_range(*type, &smin2, &smax2)) {
  3002.         if (typebits(smin, smax) == 16 &&
  3003.             typebits(smin2, smax2) == 8 && *val == 8) {
  3004.             *tp2 = tp_abyte;
  3005.         }
  3006.         }
  3007.         if (typebits(smin, smax) == *val &&
  3008.         *val != 7) {    /* don't be fooled by tp_abyte */
  3009.         /* don't need to use a bit-field for this field */
  3010.         /* so not specifying one may make it more efficient */
  3011.         /* (and also helps to simulate HP's $allow_packed$ mode) */
  3012.         *val = 0;
  3013.         *tp2 = *type;
  3014.         } 
  3015.         }
  3016.         if (*aligned && *val == 8 &&
  3017.             (ord_type(*type)->kind == TK_BOOLEAN ||
  3018.              ord_type(*type)->kind == TK_ENUM)) {
  3019.             *val = 0;
  3020.             *tp2 = tp_ubyte;
  3021.         }
  3022.     }
  3023.     if (*val != 8 && *val != 16)
  3024.     *aligned = (*val == 0);
  3025. }
  3026.  
  3027.  
  3028.  
  3029. /* This function locates byte-sized fields which were unaligned, but which
  3030.    are followed by aligned quantities so that they can be made aligned
  3031.    with no loss in storage efficiency. */
  3032.  
  3033. Static void realignfields(firstmp, stopmp)
  3034. Meaning *firstmp, *stopmp;
  3035. {
  3036.     Meaning *mp;
  3037.  
  3038.     for (mp = firstmp; mp && mp != stopmp; mp = mp->cnext) {
  3039.     if (mp->kind == MK_FIELD) {
  3040.         if (mp->val.i == 16) {
  3041.         if (mp->type == tp_uint)
  3042.             mp->type = tp_ushort;
  3043.         else
  3044.             mp->type = tp_sshort;
  3045.         mp->val.i = 0;
  3046.         } else if (mp->val.i == 8) {
  3047.         if (mp->type == tp_uint) {
  3048.             mp->type = tp_ubyte;
  3049.             mp->val.i = 0;
  3050.         } else if (hassignedchar || signedchars == 1) {
  3051.             mp->type = tp_sbyte;
  3052.             mp->val.i = 0;
  3053.         } else
  3054.             mp->type = tp_abyte;
  3055.         }
  3056.     }
  3057.     }
  3058. }
  3059.  
  3060. static void tryrealignfields(firstmp)
  3061. Meaning *firstmp;
  3062. {
  3063.     Meaning *mp, *head;
  3064.  
  3065.     head = NULL;
  3066.     for (mp = firstmp; mp; mp = mp->cnext) {
  3067.     if (mp->kind == MK_FIELD) {
  3068.         if ((mp->val.i == 8 &&
  3069.          (mp->type == tp_uint ||
  3070.           hassignedchar || signedchars == 1)) ||
  3071.         mp->val.i == 16) {
  3072.         if (!head)
  3073.             head = mp;
  3074.         } else {
  3075.         if (mp->val.i == 0)
  3076.             realignfields(head, mp);
  3077.         head = NULL;
  3078.         }
  3079.     }
  3080.     }
  3081.     realignfields(head, NULL);
  3082. }
  3083.  
  3084.  
  3085.  
  3086. void decl_comments(mp)
  3087. Meaning *mp;
  3088. {
  3089.     Strlist *cmt;
  3090.  
  3091.     if (spitcomments != 1) {
  3092.     changecomments(curcomments, -1, -1, CMT_PRE, 0);
  3093.     strlist_mix(&mp->comments, curcomments);
  3094.     curcomments = NULL;
  3095.     cmt = grabcomment(CMT_TRAIL);
  3096.     if (cmt) {
  3097.         changecomments(mp->comments, CMT_TRAIL, -1, CMT_PRE, -1);
  3098.         strlist_mix(&mp->comments, cmt);
  3099.     }
  3100.     if (mp->comments)
  3101.         mp->refcount++;   /* force it to be included if it has comments */
  3102.     }
  3103. }
  3104.  
  3105.  
  3106.  
  3107.  
  3108.  
  3109. Static void p_fieldlist(tp, flast, ispacked, tname)
  3110. Type *tp;
  3111. Meaning **flast;
  3112. int ispacked;
  3113. Meaning *tname;
  3114. {
  3115.     Meaning *firstm, *lastm, *veryfirstm, *dtype;
  3116.     Symbol *sym;
  3117.     Type *type, *tp2;
  3118.     long li1, li2;
  3119.     int aligned, constflag, volatileflag;
  3120.     short saveskipind;
  3121.     Strlist *l1;
  3122.  
  3123.     saveskipind = skipindices;
  3124.     skipindices = 0;
  3125.     aligned = 1;
  3126.     lastm = NULL;
  3127.     veryfirstm = NULL;
  3128.     while (curtok == TOK_IDENT) {
  3129.         firstm = addfield(curtoksym, &flast, tp, tname);
  3130.     if (!veryfirstm)
  3131.         veryfirstm = firstm;
  3132.         lastm = firstm;
  3133.         gettok();
  3134.     decl_comments(lastm);
  3135.         while (curtok == TOK_COMMA) {
  3136.             gettok();
  3137.             if (wexpecttok(TOK_IDENT))
  3138.         lastm = addfield(curtoksym, &flast, tp, tname);
  3139.             gettok();
  3140.         decl_comments(lastm);
  3141.         }
  3142.         if (wneedtok(TOK_COLON)) {
  3143.         constflag = volatileflag = 0;
  3144.         p_attributes();
  3145.         if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  3146.         constflag = 1;
  3147.         strlist_delete(&attrlist, l1);
  3148.         }
  3149.         if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  3150.         volatileflag = 1;
  3151.         strlist_delete(&attrlist, l1);
  3152.         }
  3153.         dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
  3154.         type = p_type(firstm);
  3155.         decl_comments(lastm);
  3156.         fielddecl(firstm, &type, &tp2, &li1, ispacked, &aligned);
  3157.         dtype = validatedtype(dtype, type);
  3158.         for (;;) {
  3159.         firstm->type = tp2;
  3160.         firstm->dtype = dtype;
  3161.         firstm->val.type = type;
  3162.         firstm->val.i = li1;
  3163.         firstm->constqual = constflag;
  3164.         firstm->volatilequal = volatileflag;
  3165.         tp->meaning = tname;
  3166.         setupfilevar(firstm);
  3167.         tp->meaning = NULL;
  3168.         if (firstm == lastm)
  3169.             break;
  3170.         firstm = firstm->cnext;
  3171.         }
  3172.     } else
  3173.         skiptotoken2(TOK_SEMI, TOK_CASE);
  3174.         if (curtok == TOK_SEMI)
  3175.             gettok();
  3176.     }
  3177.     if (curtok == TOK_CASE) {
  3178.         gettok();
  3179.     if (curtok == TOK_COLON)
  3180.         gettok();
  3181.     wexpecttok(TOK_IDENT);
  3182.     sym = curtoksym;
  3183.     if (curtokmeaning)
  3184.         type = curtokmeaning->type;
  3185.     gettok();
  3186.         if (curtok == TOK_COLON) {
  3187.             firstm = addfield(sym, &flast, tp, tname);
  3188.         if (!veryfirstm)
  3189.         veryfirstm = firstm;
  3190.             gettok();
  3191.         firstm->isforward = 1;
  3192.             firstm->val.type = type = p_type(firstm);
  3193.             fielddecl(firstm, &firstm->val.type, &firstm->type, &firstm->val.i, 
  3194.                       ispacked, &aligned);
  3195.         } else {
  3196.         firstm = NULL;
  3197.     }
  3198.         if (!wneedtok(TOK_OF)) {
  3199.         skiptotoken2(TOK_END, TOK_RPAR);
  3200.         goto bounce;
  3201.     }
  3202.     if (firstm)
  3203.         decl_comments(firstm);
  3204.     while (curtok == TOK_VBAR)
  3205.         gettok();
  3206.         while (curtok != TOK_END && curtok != TOK_RPAR) {
  3207.             firstm = NULL;
  3208.             for (;;) {
  3209.         lastm = addfield(NULL, &flast, tp, tname);
  3210.         if (!firstm)
  3211.             firstm = lastm;
  3212.         checkkeyword(TOK_OTHERWISE);
  3213.         if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
  3214.             lastm->val = make_ord(type, 999);
  3215.             break;
  3216.         } else {
  3217.             lastm->val = p_constant(type);
  3218.             if (curtok == TOK_DOTS) {
  3219.             gettok();
  3220.             li1 = ord_value(lastm->val);
  3221.             li2 = ord_value(p_constant(type));
  3222.             while (++li1 <= li2) {
  3223.                 lastm = addfield(NULL, &flast, tp, tname);
  3224.                 lastm->val = make_ord(type, li1);
  3225.             }
  3226.             }
  3227.         }
  3228.                 if (curtok == TOK_COMMA)
  3229.                     gettok();
  3230.                 else
  3231.                     break;
  3232.             }
  3233.         if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
  3234.         gettok();
  3235.             } else if (!wneedtok(TOK_COLON) ||
  3236.              (!modula2 && !wneedtok(TOK_LPAR))) {
  3237.         skiptotoken2(TOK_END, TOK_RPAR);
  3238.         goto bounce;
  3239.         }
  3240.             p_fieldlist(tp, &lastm->ctx, ispacked, tname);
  3241.             while (firstm != lastm) {
  3242.                 firstm->ctx = lastm->ctx;
  3243.                 firstm = firstm->cnext;
  3244.             }
  3245.         if (modula2) {
  3246.         while (curtok == TOK_VBAR)
  3247.             gettok();
  3248.         } else {
  3249.         if (!wneedtok(TOK_RPAR))
  3250.             skiptotoken(TOK_RPAR);
  3251.         }
  3252.             if (curtok == TOK_SEMI)
  3253.                 gettok();
  3254.         }
  3255.     if (modula2) {
  3256.         wneedtok(TOK_END);
  3257.         if (curtok == TOK_IDENT) {
  3258.         note("Record variants supported only at end of record [106]");
  3259.         p_fieldlist(tp, &lastm->ctx, ispacked, tname);
  3260.         }
  3261.     }
  3262.     }
  3263.     tryrealignfields(veryfirstm);
  3264.     if (lastm && curtok == TOK_END) {
  3265.     strlist_mix(&lastm->comments, curcomments);
  3266.     curcomments = NULL;
  3267.     }
  3268.  
  3269.   bounce:
  3270.     skipindices = saveskipind;
  3271. }
  3272.  
  3273.  
  3274.  
  3275. Static Type *p_arraydecl(tname, ispacked, confp)
  3276. char *tname;
  3277. int ispacked;
  3278. Meaning ***confp;
  3279. {
  3280.     Type *tp, *tp2;
  3281.     Meaning *mp;
  3282.     Expr *ex;
  3283.     long size, smin, smax, bitsize, fullbitsize;
  3284.     int issigned, bpower, hasrange;
  3285.  
  3286.     tp = maketype(TK_ARRAY);
  3287.     if (confp == NULL) {
  3288.     tp->indextype = p_type(NULL);
  3289.     if (tp->indextype->kind == TK_SUBR) {
  3290.         if (ord_range(tp->indextype, &smin, NULL) &&
  3291.         smin > 0 && smin <= skipindices && !ispacked) {
  3292.         tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
  3293.         ex = makeexpr_val(make_ord(tp->indextype->basetype, 0));
  3294.         tp->indextype = makesubrangetype(tp->indextype->basetype,
  3295.                          ex,
  3296.                          copyexpr(tp->indextype->smax));
  3297.         }
  3298.     }
  3299.     } else {
  3300.     if (modula2) {
  3301.         **confp = mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
  3302.         mp->fakeparam = 1;
  3303.         mp->constqual = 1;
  3304.         mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
  3305.         mp->xnext->fakeparam = 1;
  3306.         mp->xnext->constqual = 1;
  3307.         *confp = &mp->xnext->xnext;
  3308.         tp2 = maketype(TK_SUBR);
  3309.         tp2->basetype = tp_integer;
  3310.         mp->type = tp_integer;
  3311.         mp->xnext->type = mp->type;
  3312.         tp2->smin = makeexpr_long(0);
  3313.         tp2->smax = makeexpr_minus(makeexpr_var(mp->xnext),
  3314.                        makeexpr_var(mp));
  3315.         tp->indextype = tp2;
  3316.         tp->structdefd = 1;
  3317.     } else {
  3318.         wexpecttok(TOK_IDENT);
  3319.         tp2 = maketype(TK_SUBR);
  3320.         if (peeknextchar() != ',' &&
  3321.         (!curtokmeaning || curtokmeaning->kind != MK_TYPE)) {
  3322.         mp = addmeaning(curtoksym, MK_PARAM);
  3323.         gettok();
  3324.         wneedtok(TOK_DOTS);
  3325.         wexpecttok(TOK_IDENT);
  3326.         mp->xnext = addmeaning(curtoksym, MK_PARAM);
  3327.         gettok();
  3328.         if (wneedtok(TOK_COLON)) {
  3329.             tp2->basetype = p_type(NULL);
  3330.         } else {
  3331.             tp2->basetype = tp_integer;
  3332.         }
  3333.         } else {
  3334.         mp = addmeaning(findsymbol(format_s(name_ALOW, tname)), MK_PARAM);
  3335.         mp->xnext = addmeaning(findsymbol(format_s(name_AHIGH, tname)), MK_PARAM);
  3336.         tp2->basetype = p_type(NULL);
  3337.         }
  3338.         mp->fakeparam = 1;
  3339.         mp->constqual = 1;
  3340.         mp->xnext->fakeparam = 1;
  3341.         mp->xnext->constqual = 1;
  3342.         **confp = mp;
  3343.         *confp = &mp->xnext->xnext;
  3344.         mp->type = tp2->basetype;
  3345.         mp->xnext->type = tp2->basetype;
  3346.         tp2->smin = makeexpr_var(mp);
  3347.         tp2->smax = makeexpr_var(mp->xnext);
  3348.         tp->indextype = tp2;
  3349.         tp->structdefd = 1;     /* conformant array flag */
  3350.     }
  3351.     }
  3352.     if (curtok == TOK_COMMA || curtok == TOK_SEMI) {
  3353.         gettok();
  3354.         tp->basetype = p_arraydecl(tname, ispacked, confp);
  3355.         return tp;
  3356.     } else {
  3357.     if (!modula2) {
  3358.         if (!wneedtok(TOK_RBR))
  3359.         skiptotoken(TOK_OF);
  3360.     }
  3361.         if (!wneedtok(TOK_OF))
  3362.         skippasttotoken(TOK_OF, TOK_COMMA);
  3363.     checkkeyword(TOK_VARYING);
  3364.     if (confp != NULL &&
  3365.         (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
  3366.          curtok == TOK_VARYING)) {
  3367.         tp->basetype = p_conformant_array(tname, confp);
  3368.     } else {
  3369.         tp->fbase = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
  3370.         tp->basetype = p_type(NULL);
  3371.         tp->fbase = validatedtype(tp->fbase, tp->basetype);
  3372.     }
  3373.         if (!ispacked)
  3374.             return tp;
  3375.         size = 0;
  3376.         tp2 = tp->basetype;
  3377.         if (!tname)
  3378.             tname = "array";
  3379.         issigned = packedsize(tname, &tp2, &size, 1);
  3380.         if (!size || size > 8 ||
  3381.             (issigned && !packsigned) ||
  3382.             (size > 4 &&
  3383.              (!issigned || (signedchars == 1 || hassignedchar))))
  3384.             return tp;
  3385.         bpower = 0;
  3386.         while ((1<<bpower) < size)
  3387.             bpower++;        /* round size up to power of two */
  3388.         size = 1<<bpower;    /* size = # bits in an array element */
  3389.         tp->escale = bpower;
  3390.         tp->issigned = issigned;
  3391.         hasrange = ord_range(tp->indextype, &smin, &smax) &&
  3392.                    (smax < 100000);    /* don't be confused by giant arrays */
  3393.         if (hasrange &&
  3394.         (bitsize = (smax - smin + 1) * size)
  3395.             <= ((sizeof_integer > 0) ? sizeof_integer : 32)) {
  3396.             if (bitsize > ((sizeof_short > 0) ? sizeof_short : 16)) {
  3397.                 tp2 = (issigned) ? tp_integer : tp_unsigned;
  3398.                 fullbitsize = ((sizeof_integer > 0) ? sizeof_integer : 32);
  3399.             } else if (bitsize > ((sizeof_char > 0) ? sizeof_char : 8) ||
  3400.                        (issigned && !(signedchars == 1 || hassignedchar))) {
  3401.                 tp2 = (issigned) ? tp_sshort : tp_ushort;
  3402.                 fullbitsize = ((sizeof_short > 0) ? sizeof_short : 16);
  3403.             } else {
  3404.                 tp2 = (issigned) ? tp_sbyte : tp_ubyte;
  3405.                 fullbitsize = ((sizeof_char > 0) ? sizeof_char : 8);
  3406.             }
  3407.             tp->kind = TK_SMALLARRAY;
  3408.             if (ord_range(tp->indextype, &smin, NULL) &&
  3409.                 smin > 0 && smin <= fullbitsize - bitsize) {
  3410.                 tp->smin = makeexpr_val(make_ord(tp->indextype->basetype, smin));
  3411.         ex = makeexpr_val(make_ord(tp->indextype->basetype, 0));
  3412.                 tp->indextype = makesubrangetype(tp->indextype->basetype, ex,
  3413.                                                  copyexpr(tp->indextype->smax));
  3414.             }
  3415.         } else {
  3416.             if (!issigned)
  3417.                 tp2 = tp_ubyte;
  3418.             else if (signedchars == 1 || hassignedchar)
  3419.                 tp2 = tp_sbyte;
  3420.             else
  3421.                 tp2 = tp_sshort;
  3422.         }
  3423.         tp->smax = makeexpr_type(tp->basetype);
  3424.         tp->basetype = tp2;
  3425.         return tp;
  3426.     }
  3427. }
  3428.  
  3429.  
  3430.  
  3431. Static Type *p_conformant_array(tname, confp)
  3432. char *tname;
  3433. Meaning ***confp;
  3434. {
  3435.     int ispacked;
  3436.     Meaning *mp;
  3437.     Type *tp, *tp2;
  3438.  
  3439.     p_attributes();
  3440.     ignore_attributes();
  3441.     if (curtok == TOK_PACKED) {
  3442.     ispacked = 1;
  3443.     gettok();
  3444.     } else
  3445.     ispacked = 0;
  3446.     checkkeyword(TOK_VARYING);
  3447.     if (curtok == TOK_VARYING) {
  3448.     gettok();
  3449.     wneedtok(TOK_LBR);
  3450.     wexpecttok(TOK_IDENT);
  3451.     mp = addmeaning(curtoksym, MK_PARAM);
  3452.     mp->fakeparam = 1;
  3453.     mp->constqual = 1;
  3454.     **confp = mp;
  3455.     *confp = &mp->xnext;
  3456.     mp->type = tp_integer;
  3457.     tp2 = maketype(TK_SUBR);
  3458.     tp2->basetype = tp_integer;
  3459.     tp2->smin = makeexpr_long(1);
  3460.     tp2->smax = makeexpr_var(mp);
  3461.     tp = maketype(TK_STRING);
  3462.     tp->indextype = tp2;
  3463.     tp->basetype = tp_char;
  3464.     tp->structdefd = 1;     /* conformant array flag */
  3465.     gettok();
  3466.     wneedtok(TOK_RBR);
  3467.     skippasttoken(TOK_OF);
  3468.     tp->basetype = p_type(NULL);
  3469.     return tp;
  3470.     }
  3471.     if (wneedtok(TOK_ARRAY) &&
  3472.     (modula2 || wneedtok(TOK_LBR))) {
  3473.     return p_arraydecl(tname, ispacked, confp);
  3474.     } else {
  3475.     return tp_integer;
  3476.     }
  3477. }
  3478.  
  3479.  
  3480.  
  3481.  
  3482. /* VAX Pascal: */
  3483. void p_attributes()
  3484. {
  3485.     Strlist *l1;
  3486.  
  3487.     if (modula2)
  3488.     return;
  3489.     while (curtok == TOK_LBR) {
  3490.     implementationmodules = 1;    /* auto-detect VAX Pascal */
  3491.     do {
  3492.         gettok();
  3493.         if (!wexpecttok(TOK_IDENT)) {
  3494.         skippasttoken(TOK_RBR);
  3495.         return;
  3496.         }
  3497.         l1 = strlist_append(&attrlist, strupper(curtokbuf));
  3498.         l1->value = -1;
  3499.         gettok();
  3500.         if (curtok == TOK_LPAR) {
  3501.         gettok();
  3502.         if (!strcmp(l1->s, "CHECK") ||
  3503.             !strcmp(l1->s, "OPTIMIZE") ||
  3504.             !strcmp(l1->s, "KEY") ||
  3505.             !strcmp(l1->s, "COMMON") ||
  3506.             !strcmp(l1->s, "PSECT") ||
  3507.             !strcmp(l1->s, "EXTERNAL") ||
  3508.             !strcmp(l1->s, "GLOBAL") ||
  3509.             !strcmp(l1->s, "WEAK_EXTERNAL") ||
  3510.             !strcmp(l1->s, "WEAK_GLOBAL")) {
  3511.             l1->value = (long)stralloc(curtokbuf);
  3512.             gettok();
  3513.             while (curtok == TOK_COMMA) {
  3514.             gettok();
  3515.             gettok();
  3516.             }
  3517.         } else if (!strcmp(l1->s, "INHERIT") ||
  3518.                !strcmp(l1->s, "IDENT") ||
  3519.                !strcmp(l1->s, "ENVIRONMENT")) {
  3520.             p_expr(NULL);
  3521.             while (curtok == TOK_COMMA) {
  3522.             gettok();
  3523.             p_expr(NULL);
  3524.             }
  3525.         } else {
  3526.             l1->value = ord_value(p_constant(tp_integer));
  3527.             while (curtok == TOK_COMMA) {
  3528.             gettok();
  3529.             p_expr(NULL);
  3530.             }
  3531.         }
  3532.         if (!wneedtok(TOK_RPAR)) {
  3533.             skippasttotoken(TOK_RPAR, TOK_LBR);
  3534.         }
  3535.         }
  3536.     } while (curtok == TOK_COMMA);
  3537.     if (!wneedtok(TOK_RBR)) {
  3538.         skippasttoken(TOK_RBR);
  3539.     }
  3540.     }
  3541. }
  3542.  
  3543.  
  3544. void ignore_attributes()
  3545. {
  3546.     while (attrlist) {
  3547.     if (strcmp(attrlist->s, "HIDDEN") &&
  3548.         strcmp(attrlist->s, "INHERIT") &&
  3549.         strcmp(attrlist->s, "ENVIRONMENT"))
  3550.         warning(format_s("Type attribute %s ignored [128]", attrlist->s));
  3551.     strlist_eat(&attrlist);
  3552.     }
  3553. }
  3554.  
  3555.  
  3556. int size_attributes()
  3557. {
  3558.     int size = -1;
  3559.     Strlist *l1;
  3560.  
  3561.     if ((l1 = strlist_find(attrlist, "BIT")) != NULL)
  3562.     size = 1;
  3563.     else if ((l1 = strlist_find(attrlist, "BYTE")) != NULL)
  3564.     size = 8;
  3565.     else if ((l1 = strlist_find(attrlist, "WORD")) != NULL)
  3566.     size = 16;
  3567.     else if ((l1 = strlist_find(attrlist, "LONG")) != NULL)
  3568.     size = 32;
  3569.     else if ((l1 = strlist_find(attrlist, "QUAD")) != NULL)
  3570.     size = 64;
  3571.     else if ((l1 = strlist_find(attrlist, "OCTA")) != NULL)
  3572.     size = 128;
  3573.     else
  3574.     return -1;
  3575.     if (l1->value >= 0)
  3576.     size *= l1->value;
  3577.     strlist_delete(&attrlist, l1);
  3578.     return size;
  3579. }
  3580.  
  3581.  
  3582. void p_mech_spec(doref)
  3583. int doref;
  3584. {
  3585.     if (curtok == TOK_IDENT && doref &&
  3586.     !strcicmp(curtokbuf, "%REF")) {
  3587.     note("Mechanism specified %REF treated like VAR [107]");
  3588.     curtok = TOK_VAR;
  3589.     return;
  3590.     }
  3591.     if (curtok == TOK_IDENT &&
  3592.     (!strcicmp(curtokbuf, "%REF") ||
  3593.      !strcicmp(curtokbuf, "%IMMED") ||
  3594.      !strcicmp(curtokbuf, "%DESCR") ||
  3595.      !strcicmp(curtokbuf, "%STDESCR"))) {
  3596.     note(format_s("Mechanism specifier %s ignored [108]", curtokbuf));
  3597.     gettok();
  3598.     }
  3599. }
  3600.  
  3601.  
  3602. Type *p_modula_subrange(basetype)
  3603. Type *basetype;
  3604. {
  3605.     Type *tp;
  3606.     Value val;
  3607.  
  3608.     wneedtok(TOK_LBR);
  3609.     tp = maketype(TK_SUBR);
  3610.     tp->smin = p_ord_expr();
  3611.     if (basetype)
  3612.     tp->smin = gentle_cast(tp->smin, basetype);
  3613.     if (wexpecttok(TOK_DOTS)) {
  3614.     gettok();
  3615.     tp->smax = p_ord_expr();
  3616.     if (tp->smax->val.type->kind == TK_REAL &&
  3617.         tp->smax->kind == EK_CONST &&
  3618.         strlen(tp->smax->val.s) == 12 &&
  3619.         strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
  3620.         strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
  3621.         tp = tp_unsigned;
  3622.     } else if (basetype) {
  3623.         tp->smin = gentle_cast(tp->smin, basetype);
  3624.         tp->basetype = basetype;
  3625.     } else {
  3626.         basetype = ord_type(tp->smin->val.type);
  3627.         if (basetype->kind == TK_INTEGER) {
  3628.         val = eval_expr(tp->smin);
  3629.         if (val.type && val.i >= 0)
  3630.             basetype = tp_unsigned;
  3631.         else
  3632.             basetype = tp_integer;
  3633.         }
  3634.         tp->basetype = basetype;
  3635.     }
  3636.     } else {
  3637.     tp = tp_integer;
  3638.     }
  3639.     if (!wneedtok(TOK_RBR))
  3640.     skippasttotoken(TOK_RBR, TOK_SEMI);
  3641.     return tp;
  3642. }
  3643.  
  3644.  
  3645. void makefakestruct(tp, tname)
  3646. Type *tp;
  3647. Meaning *tname;
  3648. {
  3649.     Symbol *sym;
  3650.  
  3651.     if (!tname || blockkind == TOK_IMPORT)
  3652.     return;
  3653.     while (tp && (tp->kind == TK_ARRAY || tp->kind == TK_FILE))
  3654.     tp = tp->basetype;
  3655.     if (tp && tp->kind == TK_RECORD && !tp->meaning) {
  3656.     sym = findsymbol(format_s(name_FAKESTRUCT, tname->name));
  3657.     silentalreadydef++;
  3658.     tp->meaning = addmeaning(sym, MK_TYPE);
  3659.     silentalreadydef--;
  3660.     tp->meaning->type = tp;
  3661.     tp->meaning->refcount++;
  3662.     declaretype(tp->meaning);
  3663.     }
  3664. }
  3665.  
  3666.  
  3667. Type *p_type(tname)
  3668. Meaning *tname;
  3669. {
  3670.     Type *tp;
  3671.     int ispacked = 0;
  3672.     Meaning **flast;
  3673.     Meaning *mp;
  3674.     Strlist *sl;
  3675.     int num, isfunc, saveind, savenotephase, sizespec;
  3676.     Expr *ex;
  3677.     Value val;
  3678.     static int proctypecount = 0;
  3679.  
  3680.     p_attributes();
  3681.     sizespec = size_attributes();
  3682.     ignore_attributes();
  3683.     tp = tp_integer;
  3684.     if (curtok == TOK_PACKED) {
  3685.         ispacked = 1;
  3686.         gettok();
  3687.     }
  3688.     checkkeyword(TOK_VARYING);
  3689.     if (modula2)
  3690.     checkkeyword(TOK_POINTER);
  3691.     switch (curtok) {
  3692.  
  3693.         case TOK_RECORD:
  3694.             gettok();
  3695.         savenotephase = notephase;
  3696.         notephase = 1;
  3697.             tp = maketype(TK_RECORD);
  3698.             p_fieldlist(tp, &(tp->fbase), ispacked, tname);
  3699.         notephase = savenotephase;
  3700.             if (!wneedtok(TOK_END)) {
  3701.         skippasttoken(TOK_END);
  3702.         }
  3703.             break;
  3704.  
  3705.         case TOK_ARRAY:
  3706.             gettok();
  3707.         if (!modula2) {
  3708.         if (!wneedtok(TOK_LBR))
  3709.             break;
  3710.         }
  3711.         tp = p_arraydecl(tname ? tname->name : NULL, ispacked, NULL);
  3712.         makefakestruct(tp, tname);
  3713.             break;
  3714.  
  3715.     case TOK_VARYING:
  3716.         gettok();
  3717.         tp = maketype(TK_STRING);
  3718.         if (wneedtok(TOK_LBR)) {
  3719.         ex = p_ord_expr();
  3720.         if (!wneedtok(TOK_RBR))
  3721.             skippasttoken(TOK_RBR);
  3722.         } else
  3723.         ex = makeexpr_long(stringdefault);
  3724.         if (wneedtok(TOK_OF))
  3725.         tp->basetype = p_type(NULL);
  3726.         else
  3727.         tp->basetype = tp_char;
  3728.         val = eval_expr(ex);
  3729.         if (val.type) {
  3730.         if (val.i > 255 && val.i > stringceiling) {
  3731.             note(format_d("Strings longer than %d may have problems [109]",
  3732.                   stringceiling));
  3733.         }
  3734.         if (stringceiling != 255 &&
  3735.             (val.i >= 255 || val.i > stringceiling)) {
  3736.             freeexpr(ex);
  3737.             ex = makeexpr_long(stringceiling);
  3738.         }
  3739.         }
  3740.         tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
  3741.         break;
  3742.  
  3743.         case TOK_SET:
  3744.             gettok();
  3745.             if (!wneedtok(TOK_OF))
  3746.         break;
  3747.         tp = p_type(NULL);
  3748.         if (tp == tp_integer || tp == tp_unsigned)
  3749.         tp = makesubrangetype(tp, makeexpr_long(0),
  3750.                       makeexpr_long(defaultsetsize-1));
  3751.         if (tp->kind == TK_ENUM && !tp->meaning && useenum) {
  3752.         outbasetype(tp, 0);
  3753.         output(";");
  3754.         }
  3755.             tp = makesettype(tp);
  3756.             break;
  3757.  
  3758.         case TOK_FILE:
  3759.             gettok();
  3760.         if (structfilesflag ||
  3761.         (tname && strlist_cifind(structfiles, tname->name)))
  3762.         tp = maketype(TK_BIGFILE);
  3763.         else
  3764.         tp = maketype(TK_FILE);
  3765.             if (curtok == TOK_OF) {
  3766.                 gettok();
  3767.                 tp->basetype = p_type(NULL);
  3768.             } else {
  3769.                 tp->basetype = tp_abyte;
  3770.             }
  3771.         if (tp->basetype->kind == TK_CHAR && charfiletext) {
  3772.         if (tp->kind == TK_FILE)
  3773.             tp = tp_text;
  3774.         else
  3775.             tp = tp_bigtext;
  3776.         } else {
  3777.         if (tp->kind == TK_FILE) {
  3778.             makefakestruct(tp, tname);
  3779.             tp = makepointertype(tp);
  3780.         }
  3781.         }
  3782.             break;
  3783.  
  3784.         case TOK_PROCEDURE:
  3785.     case TOK_FUNCTION:
  3786.         isfunc = (curtok == TOK_FUNCTION);
  3787.             gettok();
  3788.         if (curtok != TOK_LPAR && !isfunc && hasstaticlinks == 1) {
  3789.         tp = tp_proc;
  3790.         break;
  3791.         }
  3792.         proctypecount++;
  3793.         mp = addmeaning(findsymbol(format_d("__PROCPTR%d",
  3794.                         proctypecount)),
  3795.                 MK_FUNCTION);
  3796.         pushctx(mp);
  3797.         tp = maketype((hasstaticlinks != 0) ? TK_PROCPTR : TK_CPROCPTR);
  3798.         tp->basetype = p_funcdecl(&isfunc, 1);
  3799.         tp->fbase = mp;   /* (saved, but not currently used) */
  3800.         tp->escale = hasstaticlinks;
  3801.         popctx();
  3802.             break;
  3803.  
  3804.         case TOK_HAT:
  3805.     case TOK_ADDR:
  3806.     case TOK_POINTER:
  3807.         if (curtok == TOK_POINTER) {
  3808.         gettok();
  3809.         wneedtok(TOK_TO);
  3810.         if (curtok == TOK_IDENT && !strcmp(curtokbuf, "WORD")) {
  3811.             tp = tp_anyptr;
  3812.             gettok();
  3813.             break;
  3814.         }
  3815.         } else
  3816.         gettok();
  3817.         p_attributes();
  3818.         ignore_attributes();
  3819.             tp = maketype(TK_POINTER);
  3820.             if (curtok == TOK_IDENT &&
  3821.         (!curtokmeaning || curtokmeaning->kind != MK_TYPE ||
  3822.          (deferallptrs && curtokmeaning->ctx != curctx &&
  3823.           curtokmeaning->ctx != nullctx))) {
  3824.                 struct ptrdesc *pd;
  3825.                 pd = ALLOC(1, struct ptrdesc, ptrdescs);
  3826.                 pd->sym = curtoksym;
  3827.                 pd->tp = tp;
  3828.                 pd->next = ptrbase;
  3829.                 ptrbase = pd;
  3830.                 tp->basetype = tp_abyte;
  3831.         tp->smin = makeexpr_name(curtokcase, tp_integer);
  3832.         anydeferredptrs = 1;
  3833.                 gettok();
  3834.             } else {
  3835.         tp->fbase = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
  3836.                 tp->basetype = p_type(NULL);
  3837.         tp->fbase = validatedtype(tp->fbase, tp->basetype);
  3838.                 if (!tp->basetype->pointertype)
  3839.                     tp->basetype->pointertype = tp;
  3840.             }
  3841.             break;
  3842.  
  3843.         case TOK_LPAR:
  3844.             if (!useenum)
  3845.                 outsection(minorspace);
  3846.         enum_tname = tname;
  3847.             tp = maketype(TK_ENUM);
  3848.             flast = &(tp->fbase);
  3849.             num = 0;
  3850.             do {
  3851.                 gettok();
  3852.                 if (!wexpecttok(TOK_IDENT)) {
  3853.             skiptotoken(TOK_RPAR);
  3854.             break;
  3855.         }
  3856.                 sl = strlist_find(constmacros, curtoksym->name);
  3857.                 mp = addmeaningas(curtoksym, MK_CONST, MK_VARIANT);
  3858.                 mp->val.type = tp;
  3859.                 mp->val.i = num++;
  3860.                 mp->type = tp;
  3861.                 if (sl) {
  3862.                     mp->constdefn = (Expr *)sl->value;
  3863.                     mp->anyvarflag = 1;    /* Make sure constant is folded */
  3864.                     strlist_delete(&constmacros, sl);
  3865.                     if (mp->constdefn->kind == EK_NAME)
  3866.                         strchange(&mp->name, mp->constdefn->val.s);
  3867.                 } else {
  3868.                     if (!useenum) {
  3869.             output(format_s("#define %s", mp->name));
  3870.             mp->isreturn = 1;
  3871.             out_spaces(constindent, 0, 0, 0);
  3872.             saveind = outindent;
  3873.             outindent = cur_column();
  3874.             output(format_d("%d\n", mp->val.i));
  3875.             outindent = saveind;
  3876.             }
  3877.         }
  3878.                 *flast = mp;
  3879.                 flast = &(mp->xnext);
  3880.                 gettok();
  3881.             } while (curtok == TOK_COMMA);
  3882.         if (!wneedtok(TOK_RPAR))
  3883.         skippasttoken(TOK_RPAR);
  3884.             tp->smin = makeexpr_long(0);
  3885.             tp->smax = makeexpr_long(num-1);
  3886.             if (!useenum)
  3887.                 outsection(minorspace);
  3888.             break;
  3889.  
  3890.     case TOK_LBR:
  3891.         tp = p_modula_subrange(NULL);
  3892.         break;
  3893.  
  3894.         case TOK_IDENT:
  3895.             if (!curtokmeaning) {
  3896.                 undefsym(curtoksym);
  3897.                 tp = tp_integer;
  3898.                 mp = addmeaning(curtoksym, MK_TYPE);
  3899.                 mp->type = tp;
  3900.                 gettok();
  3901.                 break;
  3902.             } else if (curtokmeaning == mp_string) {
  3903.                 gettok();
  3904.                 tp = maketype(TK_STRING);
  3905.                 tp->basetype = tp_char;
  3906.                 if (curtok == TOK_LBR) {
  3907.                     gettok();
  3908.                     ex = p_ord_expr();
  3909.                     if (!wneedtok(TOK_RBR))
  3910.             skippasttoken(TOK_RBR);
  3911.                 } else {
  3912.             ex = makeexpr_long(stringdefault);
  3913.                 }
  3914.                 val = eval_expr(ex);
  3915.                 if (val.type && stringceiling != 255 &&
  3916.                     (val.i >= 255 || val.i > stringceiling)) {
  3917.                     freeexpr(ex);
  3918.                     ex = makeexpr_long(stringceiling);
  3919.                 }
  3920.                 tp->indextype = makesubrangetype(tp_integer, makeexpr_long(0), ex);
  3921.                 break;
  3922.             } else if (curtokmeaning->kind == MK_TYPE) {
  3923.                 tp = curtokmeaning->type;
  3924.         if (sizespec > 0) {
  3925.             if (ord_type(tp)->kind == TK_INTEGER && sizespec <= 32) {
  3926.             if (checkconst(tp->smin, 0)) {
  3927.                 if (sizespec == 32)
  3928.                 tp = tp_unsigned;
  3929.                 else
  3930.                 tp = makesubrangetype(tp_unsigned,
  3931.                      makeexpr_long(0),
  3932.                          makeexpr_long((1L << sizespec) - 1));
  3933.             } else {
  3934.                 tp = makesubrangetype(tp_integer,
  3935.                      makeexpr_long(- ((1L << (sizespec-1)))),
  3936.                      makeexpr_long((1L << (sizespec-1)) - 1));
  3937.             }
  3938.             sizespec = -1;
  3939.             }
  3940.         }
  3941.                 gettok();
  3942.         if (curtok == TOK_LBR) {
  3943.             if (modula2) {
  3944.             tp = p_modula_subrange(tp);
  3945.             } else {
  3946.             gettok();
  3947.             ex = p_expr(tp_integer);
  3948.             note("UCSD size spec ignored; using 'long int' [110]");
  3949.             if (ord_type(tp)->kind == TK_INTEGER)
  3950.                 tp = tp_integer;
  3951.             if (!wneedtok(TOK_RBR))
  3952.                 skippasttotoken(TOK_RBR, TOK_SEMI);
  3953.             }
  3954.         }
  3955.         if (tp == tp_text &&
  3956.             (structfilesflag ||
  3957.              (tname && strlist_cifind(structfiles, tname->name))))
  3958.             tp = tp_bigtext;
  3959.                 break;
  3960.             }
  3961.  
  3962.         /* fall through */
  3963.         default:
  3964.             tp = maketype(TK_SUBR);
  3965.             tp->smin = p_ord_expr();
  3966.         if (curtok == TOK_COLON)
  3967.         curtok = TOK_DOTS;    /* UCSD Pascal */
  3968.         if (wexpecttok(TOK_DOTS)) {
  3969.         gettok();
  3970.         tp->smax = p_ord_expr();
  3971.         if (tp->smax->val.type->kind == TK_REAL &&
  3972.             tp->smax->kind == EK_CONST &&
  3973.             strlen(tp->smax->val.s) == 12 &&
  3974.             strcmp(tp->smax->val.s, "2147483648.0") >= 0 &&
  3975.             strcmp(tp->smax->val.s, "4294967295.0") <= 0) {
  3976.             tp = tp_unsigned;
  3977.             break;
  3978.         }
  3979.         tp->basetype = ord_type(tp->smin->val.type);
  3980.         if (sizespec >= 0) {
  3981.             long smin, smax;
  3982.             if (ord_range(tp, &smin, &smax) &&
  3983.             typebits(smin, smax) == sizespec)
  3984.             sizespec = -1;
  3985.         }
  3986.         } else {
  3987.         tp = tp_integer;
  3988.         }
  3989.             break;
  3990.     }
  3991.     if (sizespec >= 0)
  3992.     note(format_d("Don't know how to interpret size = %d bits [111]", sizespec));
  3993.     return tp;
  3994. }
  3995.  
  3996.  
  3997.  
  3998.  
  3999.  
  4000. Type *p_funcdecl(isfunc, istype)
  4001. int *isfunc, istype;
  4002. {
  4003.     Meaning *retmp = NULL, *mp, *firstmp, *lastmp, **prevm, **oldprevm;
  4004.     Type *type, *tp;
  4005.     enum meaningkind parkind;
  4006.     int anyvarflag, constflag, volatileflag, num = 0;
  4007.     Symbol *sym;
  4008.     Expr *defval;
  4009.     Token savetok;
  4010.     Strlist *l1;
  4011.  
  4012.     if (*isfunc || modula2) {
  4013.         sym = findsymbol(format_s(name_RETV, curctx->name));
  4014.         retmp = addmeaning(sym, MK_VAR);
  4015.     retmp->isreturn = 1;
  4016.     }
  4017.     type = maketype(TK_FUNCTION);
  4018.     if (curtok == TOK_LPAR) {
  4019.         prevm = &type->fbase;
  4020.         do {
  4021.             gettok();
  4022.         if (curtok == TOK_RPAR)
  4023.         break;
  4024.         p_mech_spec(1);
  4025.         p_attributes();
  4026.         checkkeyword(TOK_ANYVAR);
  4027.             if (curtok == TOK_VAR || curtok == TOK_ANYVAR) {
  4028.                 parkind = MK_VARPARAM;
  4029.                 anyvarflag = (curtok == TOK_ANYVAR);
  4030.                 gettok();
  4031.             } else if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION) {
  4032.         savetok = curtok;
  4033.         gettok();
  4034.         wexpecttok(TOK_IDENT);
  4035.         *prevm = firstmp = addmeaning(curtoksym, MK_PARAM);
  4036.         prevm = &firstmp->xnext;
  4037.         firstmp->anyvarflag = 0;
  4038.         curtok = savetok;   /* rearrange tokens to a proc ptr type! */
  4039.         firstmp->type = p_type(firstmp);
  4040.         continue;
  4041.             } else {
  4042.                 parkind = MK_PARAM;
  4043.                 anyvarflag = 0;
  4044.             }
  4045.         oldprevm = prevm;
  4046.         if (modula2 && istype) {
  4047.         firstmp = addmeaning(findsymbol(format_d("_A%d", ++num)), parkind);
  4048.         } else {
  4049.         wexpecttok(TOK_IDENT);
  4050.         firstmp = addmeaning(curtoksym, parkind);
  4051.         gettok();
  4052.         }
  4053.             *prevm = firstmp;
  4054.             prevm = &firstmp->xnext;
  4055.             firstmp->isactive = 0;   /* nit-picking Turbo compatibility */
  4056.         lastmp = firstmp;
  4057.             while (curtok == TOK_COMMA) {
  4058.                 gettok();
  4059.                 if (wexpecttok(TOK_IDENT)) {
  4060.             *prevm = lastmp = addmeaning(curtoksym, parkind);
  4061.             prevm = &lastmp->xnext;
  4062.             lastmp->isactive = 0;
  4063.         }
  4064.                 gettok();
  4065.             }
  4066.         constflag = volatileflag = 0;
  4067.         defval = NULL;
  4068.             if (curtok != TOK_COLON && !modula2) {
  4069.         if (parkind != MK_VARPARAM)
  4070.             wexpecttok(TOK_COLON);
  4071.         parkind = MK_VARPARAM;
  4072.                 tp = tp_anyptr;
  4073.                 anyvarflag = 1;
  4074.             } else {
  4075.         if (curtok == TOK_COLON)
  4076.             gettok();
  4077.         if (curtok == TOK_IDENT && !curtokmeaning &&
  4078.             !strcicmp(curtokbuf, "UNIV")) {
  4079.             if (parkind == MK_PARAM)
  4080.             note("UNIV may not work for non-VAR parameters [112]");
  4081.             anyvarflag = 1;
  4082.             gettok();
  4083.         }
  4084.         p_attributes();
  4085.         if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  4086.             constflag = 1;
  4087.             strlist_delete(&attrlist, l1);
  4088.         }
  4089.         if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  4090.             volatileflag = 1;
  4091.             strlist_delete(&attrlist, l1);
  4092.         }
  4093.         if ((l1 = strlist_find(attrlist, "UNSAFE")) != NULL &&
  4094.             parkind == MK_VARPARAM) {
  4095.             anyvarflag = 1;
  4096.             strlist_delete(&attrlist, l1);
  4097.         }
  4098.         if ((l1 = strlist_find(attrlist, "REFERENCE")) != NULL) {
  4099.             note("REFERENCE attribute treated like VAR [107]");
  4100.             parkind = MK_VARPARAM;
  4101.             strlist_delete(&attrlist, l1);
  4102.         }
  4103.         checkkeyword(TOK_VARYING);
  4104.                 if (curtok == TOK_IDENT && curtokmeaning == mp_string &&
  4105.                     !anyvarflag && parkind == MK_VARPARAM) {
  4106.                     anyvarflag = (varstrings > 0);
  4107.                     tp = tp_str255;
  4108.                     gettok();
  4109.             if (curtok == TOK_LBR) {
  4110.             wexpecttok(TOK_SEMI);
  4111.             skipparens();
  4112.             }
  4113.         } else if (curtok == TOK_ARRAY || curtok == TOK_PACKED ||
  4114.                curtok == TOK_VARYING) {
  4115.             prevm = oldprevm;
  4116.             tp = p_conformant_array(firstmp->name, &prevm);
  4117.             *prevm = firstmp;
  4118.             while (*prevm)
  4119.             prevm = &(*prevm)->xnext;
  4120.                 } else {
  4121.                     tp = p_type(firstmp);
  4122.                 }
  4123.                 if (!varfiles && isfiletype(tp, 0))
  4124.                     parkind = MK_PARAM;
  4125.                 if (parkind == MK_VARPARAM)
  4126.                     tp = makepointertype(tp);
  4127.             }
  4128.         if (curtok == TOK_ASSIGN) {    /* check for parameter default */
  4129.         gettok();
  4130.         p_mech_spec(0);
  4131.         defval = gentle_cast(p_expr(tp), tp);
  4132.         if ((tp->kind == TK_STRING || tp->kind == TK_ARRAY) &&
  4133.             tp->basetype->kind == TK_CHAR &&
  4134.             tp->structdefd &&     /* conformant string */
  4135.             defval->val.type->kind == TK_STRING) {
  4136.             mp = *oldprevm;
  4137.             if (tp->kind == TK_ARRAY) {
  4138.             mp->constdefn = makeexpr_long(1);
  4139.             mp = mp->xnext;
  4140.             }
  4141.             mp->constdefn = strmax_func(defval);
  4142.         }
  4143.         }
  4144.             while (firstmp) {
  4145.                 firstmp->type = tp;
  4146.                 firstmp->kind = parkind;    /* in case it changed */
  4147.                 firstmp->isactive = 1;
  4148.                 firstmp->anyvarflag = anyvarflag;
  4149.         firstmp->constqual = constflag;
  4150.         firstmp->volatilequal = volatileflag;
  4151.         if (defval) {
  4152.             if (firstmp == lastmp)
  4153.             firstmp->constdefn = defval;
  4154.             else
  4155.             firstmp->constdefn = copyexpr(defval);
  4156.         }
  4157.                 if (parkind == MK_PARAM &&
  4158.                     (tp->kind == TK_STRING ||
  4159.                      tp->kind == TK_ARRAY ||
  4160.                      tp->kind == TK_SET ||
  4161.                      ((tp->kind == TK_RECORD ||
  4162.                tp->kind == TK_BIGFILE ||
  4163.                tp->kind == TK_PROCPTR) && copystructs < 2))) {
  4164.                     firstmp->othername = stralloc(format_s(name_COPYPAR,
  4165.                                firstmp->name));
  4166.                     firstmp->rectype = makepointertype(tp);
  4167.                 }
  4168.         if (firstmp == lastmp)
  4169.             break;
  4170.                 firstmp = firstmp->xnext;
  4171.             }
  4172.         } while (curtok == TOK_SEMI || curtok == TOK_COMMA);
  4173.         if (!wneedtok(TOK_RPAR))
  4174.         skippasttotoken(TOK_RPAR, TOK_SEMI);
  4175.     }
  4176.     if (modula2) {
  4177.     if (curtok == TOK_COLON) {
  4178.         *isfunc = 1;
  4179.     } else {
  4180.         unaddmeaning(retmp);
  4181.     }
  4182.     }
  4183.     if (*isfunc) {
  4184.         if (wneedtok(TOK_COLON)) {
  4185.         retmp->type = type->basetype = p_type(NULL);
  4186.         switch (retmp->type->kind) {
  4187.         
  4188.           case TK_RECORD:
  4189.           case TK_BIGFILE:
  4190.           case TK_PROCPTR:
  4191.                 if (copystructs >= 3)
  4192.                     break;
  4193.         
  4194.         /* fall through */
  4195.           case TK_ARRAY:
  4196.           case TK_STRING:
  4197.           case TK_SET:
  4198.                 type->basetype = retmp->type = makepointertype(retmp->type);
  4199.                 retmp->kind = MK_VARPARAM;
  4200.                 retmp->anyvarflag = 0;
  4201.                 retmp->xnext = type->fbase;
  4202.                 type->fbase = retmp;
  4203.                 retmp->refcount++;
  4204.                 break;
  4205.  
  4206.           default:
  4207.         break;
  4208.         }
  4209.     } else
  4210.         retmp->type = type->basetype = tp_integer;
  4211.     } else
  4212.         type->basetype = tp_void;
  4213.     return type;
  4214. }
  4215.  
  4216.  
  4217.  
  4218.  
  4219.  
  4220. Symbol *findlabelsym()
  4221. {
  4222.     if (curtok == TOK_IDENT && 
  4223.         curtokmeaning && curtokmeaning->kind == MK_LABEL) {
  4224. #if 0
  4225.     if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
  4226.         curtokmeaning->val.i = --nonloclabelcount;
  4227. #endif
  4228.     } else if (curtok == TOK_INTLIT) {
  4229.         strcpy(curtokcase, curtokbuf);
  4230.         curtoksym = findsymbol(curtokbuf);
  4231.         curtokmeaning = curtoksym->mbase;
  4232.         while (curtokmeaning && !curtokmeaning->isactive)
  4233.             curtokmeaning = curtokmeaning->snext;
  4234.         if (!curtokmeaning || curtokmeaning->kind != MK_LABEL)
  4235.             return NULL;
  4236. #if 0
  4237.     if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0)
  4238.         if (curtokint == 0)
  4239.         curtokmeaning->val.i = -1;
  4240.         else
  4241.         curtokmeaning->val.i = curtokint;
  4242. #endif
  4243.     } else
  4244.     return NULL;
  4245.     return curtoksym;
  4246. }
  4247.  
  4248.  
  4249. void p_labeldecl()
  4250. {
  4251.     Symbol *sp;
  4252.     Meaning *mp;
  4253.  
  4254.     do {
  4255.         gettok();
  4256.         if (curtok != TOK_IDENT)
  4257.             wexpecttok(TOK_INTLIT);
  4258.         sp = findlabelsym();
  4259.         mp = addmeaning(curtoksym, MK_LABEL);
  4260.     mp->val.i = 0;
  4261.     mp->xnext = addmeaning(findsymbol(format_s(name_LABVAR,
  4262.                            mp->name)),
  4263.                    MK_VAR);
  4264.     mp->xnext->type = tp_jmp_buf;
  4265.     mp->xnext->refcount = 0;
  4266.         gettok();
  4267.     } while (curtok == TOK_COMMA);
  4268.     if (!wneedtok(TOK_SEMI))
  4269.     skippasttoken(TOK_SEMI);
  4270. }
  4271.  
  4272.  
  4273.  
  4274.  
  4275.  
  4276. Meaning *findfieldname(sym, variants, nvars)
  4277. Symbol *sym;
  4278. Meaning **variants;
  4279. int *nvars;
  4280. {
  4281.     Meaning *mp, *mp0;
  4282.  
  4283.     mp = variants[*nvars-1];
  4284.     while (mp && mp->kind == MK_FIELD) {
  4285.         if (mp->sym == sym) {
  4286.             return mp;
  4287.         }
  4288.         mp = mp->cnext;
  4289.     }
  4290.     while (mp) {
  4291.         variants[(*nvars)++] = mp->ctx;
  4292.         mp0 = findfieldname(sym, variants, nvars);
  4293.         if (mp0)
  4294.             return mp0;
  4295.         (*nvars)--;
  4296.         while (mp->cnext && mp->cnext->ctx == mp->ctx)
  4297.             mp = mp->cnext;
  4298.         mp = mp->cnext;
  4299.     }
  4300.     return NULL;
  4301. }
  4302.  
  4303.  
  4304.  
  4305.  
  4306. Expr *p_constrecord(type, style)
  4307. Type *type;
  4308. int style;   /* 0=HP, 1=Turbo, 2=Oregon+VAX */
  4309. {
  4310.     Meaning *mp, *mp0, *variants[20], *newvariants[20], *curfield;
  4311.     Symbol *sym;
  4312.     Value val;
  4313.     Expr *ex, *cex;
  4314.     int i, j, nvars, newnvars, varcounts[20];
  4315.  
  4316.     if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
  4317.     return makeexpr_long(0);
  4318.     cex = makeexpr(EK_STRUCTCONST, 0);
  4319.     nvars = 0;
  4320.     varcounts[0] = 0;
  4321.     curfield = type->fbase;
  4322.     for (;;) {
  4323.     if (style == 2) {
  4324.         if (curfield) {
  4325.         mp = curfield;
  4326.         if (mp->kind == MK_VARIANT || mp->isforward) {
  4327.             val = p_constant(mp->type);
  4328.             if (mp->kind == MK_FIELD) {
  4329.             insertarg(&cex, cex->nargs, makeexpr_val(val));
  4330.             mp = mp->cnext;
  4331.             }
  4332.             val.type = mp->val.type;
  4333.             if (!valuesame(val, mp->val)) {
  4334.             while (mp && !valuesame(val, mp->val))
  4335.                 mp = mp->cnext;
  4336.             if (mp) {
  4337.                 note("Attempting to initialize union member other than first [113]");
  4338.                 curfield = mp->ctx;
  4339.             } else {
  4340.                 warning("Tag value does not exist in record [129]");
  4341.                 curfield = NULL;
  4342.             }
  4343.             } else
  4344.             curfield = mp->ctx;
  4345.             goto ignorefield;
  4346.         } else {
  4347.             i = cex->nargs;
  4348.             insertarg(&cex, i, NULL);
  4349.             if (mp->isforward && curfield->cnext)
  4350.             curfield = curfield->cnext->ctx;
  4351.             else
  4352.             curfield = curfield->cnext;
  4353.         }
  4354.         } else {
  4355.         warning("Too many fields in record constructor [130]");
  4356.         ex = p_expr(NULL);
  4357.         freeexpr(ex);
  4358.         goto ignorefield;
  4359.         }
  4360.     } else {
  4361.         if (!wexpecttok(TOK_IDENT)) {
  4362.         skiptotoken2(TOK_RPAR, TOK_RBR);
  4363.         break;
  4364.         }
  4365.         sym = curtoksym;
  4366.         gettok();
  4367.         if (!wneedtok(TOK_COLON)) {
  4368.         skiptotoken2(TOK_RPAR, TOK_RBR);
  4369.         break;
  4370.         }
  4371.         newnvars = 1;
  4372.         newvariants[0] = type->fbase;
  4373.         mp = findfieldname(sym, newvariants, &newnvars);
  4374.         if (!mp) {
  4375.         warning(format_s("Field %s not in record [131]", sym->name));
  4376.         ex = p_expr(NULL);   /* good enough */
  4377.         freeexpr(ex);
  4378.         goto ignorefield;
  4379.         }
  4380.         for (i = 0; i < nvars && i < newnvars; i++) {
  4381.         if (variants[i] != newvariants[i]) {
  4382.             warning("Fields are members of incompatible variants [132]");
  4383.             ex = p_subconst(mp->type, style);
  4384.             freeexpr(ex);
  4385.             goto ignorefield;
  4386.         }
  4387.         }
  4388.         while (nvars < newnvars) {
  4389.         variants[nvars] = newvariants[nvars];
  4390.         if (nvars > 0) {
  4391.             for (mp0 = variants[nvars-1]; mp0->kind != MK_VARIANT; mp0 = mp0->cnext) ;
  4392.             if (mp0->ctx != variants[nvars])
  4393.             note("Attempting to initialize union member other than first [113]");
  4394.         }
  4395.         i = varcounts[nvars];
  4396.         for (mp0 = variants[nvars]; mp0 && mp0->kind == MK_FIELD; mp0 = mp0->cnext)
  4397.             i++;
  4398.         nvars++;
  4399.         varcounts[nvars] = i;
  4400.         while (cex->nargs < i)
  4401.             insertarg(&cex, cex->nargs, NULL);
  4402.         }
  4403.         i = varcounts[newnvars-1];
  4404.         for (mp0 = variants[newnvars-1]; mp0->sym != sym; mp0 = mp0->cnext)
  4405.         i++;
  4406.         if (cex->args[i])
  4407.         warning(format_s("Two constructors for %s [133]", mp->name));
  4408.     }
  4409.     ex = p_subconst(mp->type, style);
  4410.     if (ex->kind == EK_CONST &&
  4411.         (ex->val.type->kind == TK_RECORD ||
  4412.          ex->val.type->kind == TK_ARRAY))
  4413.         ex = (Expr *)ex->val.i;
  4414.     cex->args[i] = ex;
  4415. ignorefield:
  4416.         if (curtok == TOK_COMMA || curtok == TOK_SEMI)
  4417.             gettok();
  4418.         else
  4419.             break;
  4420.     }
  4421.     if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
  4422.     skippasttoken2(TOK_RPAR, TOK_RBR);
  4423.     if (style != 2) {
  4424.     j = 0;
  4425.     mp = variants[0];
  4426.     for (i = 0; i < cex->nargs; i++) {
  4427.         while (!mp || mp->kind != MK_FIELD)
  4428.         mp = variants[++j];
  4429.         if (!cex->args[i]) {
  4430.         warning(format_s("No constructor for %s [134]", mp->name));
  4431.         cex->args[i] = makeexpr_name("<oops>", mp->type);
  4432.         }
  4433.         mp = mp->cnext;
  4434.     }
  4435.     }
  4436.     val.type = type;
  4437.     val.i = (long)cex;
  4438.     val.s = NULL;
  4439.     return makeexpr_val(val);
  4440. }
  4441.  
  4442.  
  4443.  
  4444.  
  4445. Expr *p_constarray(type, style)
  4446. Type *type;
  4447. int style;
  4448. {
  4449.     Value val;
  4450.     Expr *ex, *cex;
  4451.     int nvals, skipped;
  4452.     long smin, smax;
  4453.  
  4454.     if (type->kind == TK_SMALLARRAY)
  4455.         warning("Small-array constructors not yet implemented [135]");
  4456.     if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
  4457.     return makeexpr_long(0);
  4458.     if (type->smin && type->smin->kind == EK_CONST)
  4459.         skipped = type->smin->val.i;
  4460.     else
  4461.         skipped = 0;
  4462.     cex = NULL;
  4463.     for (;;) {
  4464.         if (style && (curtok == TOK_LPAR || curtok == TOK_LBR)) {
  4465.             ex = p_subconst(type->basetype, style);
  4466.             nvals = 1;
  4467.     } else if (curtok == TOK_REPEAT) {
  4468.         gettok();
  4469.         ex = p_expr(type->basetype);
  4470.         if (ord_range(type->indextype, &smin, &smax)) {
  4471.         nvals = smax - smin + 1;
  4472.         if (cex)
  4473.             nvals -= cex->nargs;
  4474.         } else {
  4475.         nvals = 1;
  4476.         note("REPEAT not translatable for non-constant array bounds [114]");
  4477.         }
  4478.             ex = gentle_cast(ex, type->basetype);
  4479.         } else {
  4480.             ex = p_expr(type->basetype);
  4481.             if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
  4482.                 ex->val.i > 1 && !skipped && style == 0 && !cex &&
  4483.                 type->basetype->kind == TK_CHAR &&
  4484.                 checkconst(type->indextype->smin, 1)) {
  4485.                 if (!wneedtok(TOK_RBR))
  4486.             skippasttoken2(TOK_RBR, TOK_RPAR);
  4487.                 return ex;   /* not quite right, but close enough */
  4488.             }
  4489.             if (curtok == TOK_OF) {
  4490.                 ex = gentle_cast(ex, tp_integer);
  4491.                 val = eval_expr(ex);
  4492.                 freeexpr(ex);
  4493.                 if (!val.type)
  4494.                     warning("Expected a constant [127]");
  4495.                 nvals = val.i;
  4496.                 gettok();
  4497.                 ex = p_expr(type->basetype);
  4498.             } else
  4499.                 nvals = 1;
  4500.             ex = gentle_cast(ex, type->basetype);
  4501.         }
  4502.         nvals += skipped;
  4503.         skipped = 0;
  4504.         if (ex->kind == EK_CONST &&
  4505.             (ex->val.type->kind == TK_RECORD ||
  4506.              ex->val.type->kind == TK_ARRAY))
  4507.             ex = (Expr *)ex->val.i;
  4508.         if (nvals != 1) {
  4509.             ex = makeexpr_un(EK_STRUCTOF, type->basetype, ex);
  4510.             ex->val.i = nvals;
  4511.         }
  4512.         if (cex)
  4513.             insertarg(&cex, cex->nargs, ex);
  4514.         else
  4515.             cex = makeexpr_un(EK_STRUCTCONST, type, ex);
  4516.         if (curtok == TOK_COMMA)
  4517.             gettok();
  4518.         else
  4519.             break;
  4520.     }
  4521.     if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
  4522.     skippasttoken2(TOK_RPAR, TOK_RBR);
  4523.     val.type = type;
  4524.     val.i = (long)cex;
  4525.     val.s = NULL;
  4526.     return makeexpr_val(val);
  4527. }
  4528.  
  4529.  
  4530.  
  4531.  
  4532. Expr *p_conststring(type, style)
  4533. Type *type;
  4534. int style;
  4535. {
  4536.     Expr *ex;
  4537.     Token close = (style ? TOK_RPAR : TOK_RBR);
  4538.  
  4539.     if (curtok != (style ? TOK_LPAR : TOK_LBR))
  4540.     return p_expr(type);
  4541.     gettok();
  4542.     ex = p_expr(tp_integer);  /* should handle "OF" and "," for constructors */
  4543.     if (curtok == TOK_OF || curtok == TOK_COMMA) {
  4544.         warning("Multi-element string constructors not yet supported [136]");
  4545.     skiptotoken(close);
  4546.     }
  4547.     if (!wneedtok(close))
  4548.     skippasttoken(close);
  4549.     return ex;
  4550. }
  4551.  
  4552.  
  4553.  
  4554.  
  4555. Expr *p_subconst(type, style)
  4556. Type *type;
  4557. int style;
  4558. {
  4559.     Value val;
  4560.  
  4561.     if (curtok == TOK_IDENT && curtokmeaning &&
  4562.     curtokmeaning->kind == MK_TYPE) {
  4563.     if (curtokmeaning->type != type)
  4564.         warning("Type conflict in constant [137]");
  4565.     gettok();
  4566.     }
  4567.     if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
  4568.     !curtokmeaning) {   /* VAX Pascal foolishness */
  4569.     gettok();
  4570.     if (type->kind == TK_STRING)
  4571.         return makeexpr_string("");
  4572.     if (type->kind == TK_REAL)
  4573.         return makeexpr_real("0.0");
  4574.     val.type = type;
  4575.     if (type->kind == TK_RECORD || type->kind == TK_ARRAY ||
  4576.         type->kind == TK_SET)
  4577.         val.i = (long)makeexpr_un(EK_STRUCTCONST, type, makeexpr_long(0));
  4578.     else
  4579.         val.i = 0;
  4580.     val.s = NULL;
  4581.     return makeexpr_val(val);
  4582.     }
  4583.     switch (type->kind) {
  4584.     
  4585.       case TK_RECORD:
  4586.     if (curtok == (style ? TOK_LPAR : TOK_LBR))
  4587.         return p_constrecord(type, style);
  4588.     break;
  4589.     
  4590.       case TK_SMALLARRAY:
  4591.       case TK_ARRAY:
  4592.     if (curtok == (style ? TOK_LPAR : TOK_LBR))
  4593.         return p_constarray(type, style);
  4594.     break;
  4595.     
  4596.       case TK_SMALLSET:
  4597.       case TK_SET:
  4598.     if (curtok == TOK_LBR)
  4599.         return p_setfactor(type, 1);
  4600.     break;
  4601.     
  4602.       default:
  4603.     break;
  4604.     
  4605.     }
  4606.     return gentle_cast(p_expr(type), type);
  4607. }
  4608.  
  4609.  
  4610.  
  4611. void p_constdecl()
  4612. {
  4613.     Meaning *mp;
  4614.     Expr *ex, *ex2;
  4615.     Type *oldtype;
  4616.     char savetokcase[sizeof(curtokcase)];
  4617.     Symbol *savetoksym;
  4618.     Strlist *sl;
  4619.     int i, saveindent, outflag = (blockkind != TOK_IMPORT);
  4620.  
  4621.     if (outflag)
  4622.         outsection(majorspace);
  4623.     flushcomments(NULL, -1, -1);
  4624.     gettok();
  4625.     oldtype = NULL;
  4626.     while (curtok == TOK_IDENT) {
  4627.         strcpy(savetokcase, curtokcase);
  4628.         savetoksym = curtoksym;
  4629.         gettok();
  4630.         strcpy(curtokcase, savetokcase);   /* what a kludge! */
  4631.         curtoksym = savetoksym;
  4632.         if (curtok == TOK_COLON) {     /* Turbo Pascal typed constant */
  4633.             mp = addmeaning(curtoksym, MK_VAR);
  4634.         decl_comments(mp);
  4635.             gettok();
  4636.             mp->type = p_type(mp);
  4637.             if (wneedtok(TOK_EQ)) {
  4638.         if (mp->kind == MK_VARMAC) {
  4639.             freeexpr(p_subconst(mp->type, 1));
  4640.             note("Initializer ignored for variable with VarMacro [115]");
  4641.         } else {
  4642.             mp->constdefn = p_subconst(mp->type, 1);
  4643.             if (blockkind == TOK_EXPORT) {
  4644.             /*  nothing  */
  4645.             } else {
  4646.             mp->isforward = 1;   /* static variable */
  4647.             }
  4648.         }
  4649.         }
  4650.         decl_comments(mp);
  4651.         } else {
  4652.             sl = strlist_find(constmacros, curtoksym->name);
  4653.             if (sl) {
  4654.                 mp = addmeaning(curtoksym, MK_VARMAC);
  4655.                 mp->constdefn = (Expr *)sl->value;
  4656.                 strlist_delete(&constmacros, sl);
  4657.             } else {
  4658.                 mp = addmeaning(curtoksym, MK_CONST);
  4659.             }
  4660.         decl_comments(mp);
  4661.             if (!wexpecttok(TOK_EQ)) {
  4662.         skippasttoken(TOK_SEMI);
  4663.         continue;
  4664.         }
  4665.         mp->isactive = 0;   /* A fine point indeed (see below) */
  4666.         gettok();
  4667.         if (curtok == TOK_IDENT &&
  4668.         curtokmeaning && curtokmeaning->kind == MK_TYPE &&
  4669.         (curtokmeaning->type->kind == TK_RECORD ||
  4670.          curtokmeaning->type->kind == TK_SMALLARRAY ||
  4671.          curtokmeaning->type->kind == TK_ARRAY)) {
  4672.         oldtype = curtokmeaning->type;
  4673.         gettok();
  4674.         ex = p_subconst(oldtype, (curtok == TOK_LBR) ? 0 : 2);
  4675.         } else {
  4676.         ex = p_expr(NULL);
  4677.         if (charconsts)
  4678.             ex = makeexpr_charcast(ex);
  4679.         }
  4680.         mp->isactive = 1;   /* Re-enable visibility of the new constant */
  4681.             if (mp->kind == MK_CONST)
  4682.                 mp->constdefn = ex;
  4683.             if (ord_type(ex->val.type)->kind == TK_INTEGER) {
  4684.                 i = exprlongness(ex);
  4685.                 if (i > 0)
  4686.                     ex->val.type = tp_integer;
  4687.         else if (i < 0)
  4688.                     ex->val.type = tp_int;
  4689.             }
  4690.         decl_comments(mp);
  4691.             mp->type = ex->val.type;
  4692.             mp->val = eval_expr(ex);
  4693.             if (mp->kind == MK_CONST) {
  4694.                 switch (ex->val.type->kind) {
  4695.  
  4696.                     case TK_INTEGER:
  4697.                     case TK_BOOLEAN:
  4698.                     case TK_CHAR:
  4699.                     case TK_ENUM:
  4700.                     case TK_SUBR:
  4701.                     case TK_REAL:
  4702.                         if (foldconsts > 0)
  4703.                             mp->anyvarflag = 1;
  4704.                         break;
  4705.  
  4706.                     case TK_STRING:
  4707.                         if (foldstrconsts > 0)
  4708.                             mp->anyvarflag = 1;
  4709.                         break;
  4710.  
  4711.             default:
  4712.             break;
  4713.                 }
  4714.             }
  4715.         flushcomments(&mp->comments, CMT_PRE, -1);
  4716.             if (ex->val.type->kind == TK_SET) {
  4717.                 mp->val.type = NULL;
  4718.         if (mp->kind == MK_CONST) {
  4719.             ex2 = makeexpr(EK_MACARG, 0);
  4720.             ex2->val.type = ex->val.type;
  4721.             mp->constdefn = makeexpr_assign(ex2, ex);
  4722.         }
  4723.             } else if (mp->kind == MK_CONST && outflag) {
  4724.                 if (ex->val.type != oldtype) {
  4725.                     outsection(minorspace);
  4726.                     oldtype = ex->val.type;
  4727.                 }
  4728.                 switch (ex->val.type->kind) {
  4729.  
  4730.                     case TK_ARRAY:
  4731.                     case TK_RECORD:
  4732.                         select_outfile(codef);
  4733.                         outsection(minorspace);
  4734.                         if (blockkind == TOK_IMPLEMENT || blockkind == TOK_PROGRAM)
  4735.                             output("static ");
  4736.                         if (useAnyptrMacros == 1 || useconsts == 2)
  4737.                             output("Const ");
  4738.                         else if (useconsts > 0)
  4739.                             output("const ");
  4740.                         outbasetype(mp->type, ODECL_CHARSTAR|ODECL_FREEARRAY);
  4741.                         output(" ");
  4742.                         outdeclarator(mp->type, mp->name,
  4743.                       ODECL_CHARSTAR|ODECL_FREEARRAY);
  4744.                         output(" = {");
  4745.             outtrailcomment(mp->comments, -1, declcommentindent);
  4746.             saveindent = outindent;
  4747.             moreindent(tabsize);
  4748.             moreindent(structinitindent);
  4749.                      /*   if (mp->val.s)
  4750.                             output(mp->val.s);
  4751.                         else  */
  4752.                             out_expr((Expr *)mp->val.i);
  4753.                         outindent = saveindent;
  4754.                         output("\n};\n");
  4755.                         outsection(minorspace);
  4756.                         if (blockkind == TOK_EXPORT) {
  4757.                             select_outfile(hdrf);
  4758.                             if (usevextern)
  4759.                                 output("vextern ");
  4760.                             if (useAnyptrMacros == 1 || useconsts == 2)
  4761.                                 output("Const ");
  4762.                             else if (useconsts > 0)
  4763.                                 output("const ");
  4764.                             outbasetype(mp->type, ODECL_CHARSTAR);
  4765.                             output(" ");
  4766.                             outdeclarator(mp->type, mp->name, ODECL_CHARSTAR);
  4767.                             output(";\n");
  4768.                         }
  4769.                         break;
  4770.  
  4771.                     default:
  4772.                         if (foldconsts > 0) break;
  4773.                         output(format_s("#define %s", mp->name));
  4774.             mp->isreturn = 1;
  4775.                         out_spaces(constindent, 0, 0, 0);
  4776.             saveindent = outindent;
  4777.             outindent = cur_column();
  4778.                         out_expr_factor(ex);
  4779.             outindent = saveindent;
  4780.             outtrailcomment(mp->comments, -1, declcommentindent);
  4781.                         break;
  4782.  
  4783.                 }
  4784.             }
  4785.         flushcomments(&mp->comments, -1, -1);
  4786.             if (mp->kind == MK_VARMAC)
  4787.                 freeexpr(ex);
  4788.             mp->wasdeclared = 1;
  4789.         }
  4790.         if (!wneedtok(TOK_SEMI))
  4791.         skippasttoken(TOK_SEMI);
  4792.     }
  4793.     if (outflag)
  4794.         outsection(majorspace);
  4795. }
  4796.  
  4797.  
  4798.  
  4799.  
  4800. void declaresubtypes(mp)
  4801. Meaning *mp;
  4802. {
  4803.     Meaning *mp2;
  4804.     Type *tp;
  4805.     struct ptrdesc *pd;
  4806.  
  4807.     while (mp) {
  4808.     if (mp->kind == MK_VARIANT) {
  4809.         declaresubtypes(mp->ctx);
  4810.     } else {
  4811.         tp = mp->type;
  4812.         while (tp->basetype && !tp->meaning && tp->kind != TK_POINTER)
  4813.         tp = tp->basetype;
  4814.         if (tp->meaning && !tp->meaning->wasdeclared &&
  4815.         (tp->kind == TK_RECORD || tp->kind == TK_ENUM) &&
  4816.         tp->meaning->ctx && tp->meaning->ctx != nullctx) {
  4817.         pd = ptrbase;   /* Do this now, just in case */
  4818.         while (pd) {
  4819.             if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
  4820.             pd->tp->smin = NULL;
  4821.             mp2 = pd->sym->mbase;
  4822.             while (mp2 && !mp2->isactive)
  4823.                 mp2 = mp2->snext;
  4824.             if (mp2 && mp2->kind == MK_TYPE) {
  4825.                 pd->tp->basetype = mp2->type;
  4826.                 pd->tp->fbase = mp2;
  4827.                 if (!mp2->type->pointertype)
  4828.                 mp2->type->pointertype = pd->tp;
  4829.             }
  4830.             }
  4831.             pd = pd->next;
  4832.         }
  4833.         declaretype(tp->meaning);
  4834.         }
  4835.     }
  4836.     mp = mp->cnext;
  4837.     }
  4838. }
  4839.  
  4840.  
  4841. void declaretype(mp)
  4842. Meaning *mp;
  4843. {
  4844.     int saveindent, pres;
  4845.  
  4846.     switch (mp->type->kind) {
  4847.     
  4848.       case TK_RECORD:
  4849.       case TK_BIGFILE:
  4850.     if (mp->type->meaning != mp) {
  4851.         output(format_ss("typedef %s %s;",
  4852.                  mp->type->meaning->name,
  4853.                  mp->name));
  4854.     } else {
  4855.         declaresubtypes(mp->type->fbase);
  4856.         outsection(minorspace);
  4857.         if (record_is_union(mp->type))
  4858.         output("typedef union ");
  4859.         else
  4860.         output("typedef struct ");
  4861.         output(format_s("%s {\n", format_s(name_STRUCT, mp->name)));
  4862.         saveindent = outindent;
  4863.         moreindent(tabsize);
  4864.         moreindent(structindent);
  4865.         if (mp->type->kind == TK_BIGFILE)
  4866.         declarebigfile(mp->type);
  4867.         else
  4868.         outfieldlist(mp->type->fbase);
  4869.         outindent = saveindent;
  4870.         output(format_s("} %s;", mp->name));
  4871.     }
  4872.     outtrailcomment(mp->comments, -1, declcommentindent);
  4873.     mp->type->structdefd = 1;
  4874.     if (mp->type->meaning == mp)
  4875.         outsection(minorspace);
  4876.     break;
  4877.     
  4878.       case TK_ARRAY:
  4879.       case TK_SMALLARRAY:
  4880.     output("typedef ");
  4881.     if (mp->type->meaning != mp) {
  4882.         output(format_ss("%s %s",
  4883.                  mp->type->meaning->name,
  4884.                  mp->name));
  4885.     } else {
  4886.         outbasetype(mp->type, 0);
  4887.         output(" ");
  4888.         outdeclarator(mp->type, mp->name, 0);
  4889.     }
  4890.     output(";");
  4891.     outtrailcomment(mp->comments, -1, declcommentindent);
  4892.     break;
  4893.     
  4894.       case TK_ENUM:
  4895.     if (useenum) {
  4896.         output("typedef ");
  4897.         if (mp->type->meaning != mp)
  4898.         output(mp->type->meaning->name);
  4899.         else
  4900.         outbasetype(mp->type, 0);
  4901.         output(" ");
  4902.         output(mp->name);
  4903.         output(";");
  4904.         outtrailcomment(mp->comments, -1,
  4905.                 declcommentindent);
  4906.     }
  4907.     break;
  4908.     
  4909.       default:
  4910.     pres = preservetypes;
  4911.     if (mp->type->kind == TK_POINTER && preservepointers >= 0)
  4912.         pres = preservepointers;
  4913.     if (mp->type->kind == TK_STRING && preservestrings >= 0)
  4914.         if (preservestrings == 2)
  4915.         pres = mp->type->indextype->smax->kind != EK_CONST;
  4916.         else
  4917.         pres = preservestrings;
  4918.     if (pres) {
  4919.         output("typedef ");
  4920.         mp->type->preserved = 0;
  4921.         outbasetype(mp->type, 0);
  4922.         output(" ");
  4923.         outdeclarator(mp->type, mp->name, 0);
  4924.         output(";\n");
  4925.         mp->type->preserved = 1;
  4926.         outtrailcomment(mp->comments, -1, declcommentindent);
  4927.     }
  4928.     break;
  4929.     }
  4930.     mp->wasdeclared = 1;
  4931. }
  4932.  
  4933.  
  4934.  
  4935. void declaretypes(outflag)
  4936. int outflag;
  4937. {
  4938.     Meaning *mp;
  4939.  
  4940.     for (mp = curctx->cbase; mp; mp = mp->cnext) {
  4941.         if (mp->kind == MK_TYPE && !mp->wasdeclared) {
  4942.             if (outflag) {
  4943.         flushcomments(&mp->comments, CMT_PRE, -1);
  4944.         declaretype(mp);
  4945.         flushcomments(&mp->comments, -1, -1);
  4946.             }
  4947.             mp->wasdeclared = 1;
  4948.         }
  4949.     }
  4950. }
  4951.  
  4952.  
  4953.  
  4954. void p_typedecl()
  4955. {
  4956.     Meaning *mp;
  4957.     int outflag = (blockkind != TOK_IMPORT);
  4958.     struct ptrdesc *pd;
  4959.  
  4960.     if (outflag)
  4961.         outsection(majorspace);
  4962.     flushcomments(NULL, -1, -1);
  4963.     gettok();
  4964.     outsection(minorspace);
  4965.     deferallptrs = 1;
  4966.     anydeferredptrs = 0;
  4967.     notephase = 1;
  4968.     while (curtok == TOK_IDENT) {
  4969.         mp = addmeaning(curtoksym, MK_TYPE);
  4970.     mp->type = tp_integer;    /* in case of syntax errors */
  4971.         gettok();
  4972.     decl_comments(mp);
  4973.     if (curtok == TOK_SEMI) {
  4974.         mp->type = tp_anyptr;    /* Modula-2 opaque type */
  4975.     } else {
  4976.         if (!wneedtok(TOK_EQ)) {
  4977.         skippasttoken(TOK_SEMI);
  4978.         continue;
  4979.         }
  4980.         mp->type = p_type(mp);
  4981.         decl_comments(mp);
  4982.         if (!mp->type->meaning)
  4983.         mp->type->meaning = mp;
  4984.         if (mp->type->kind == TK_RECORD ||
  4985.         mp->type->kind == TK_BIGFILE)
  4986.         mp->type->structdefd = 1;
  4987.         if (!anydeferredptrs)
  4988.         declaretypes(outflag);
  4989.     }
  4990.     if (!wneedtok(TOK_SEMI))
  4991.         skippasttoken(TOK_SEMI);
  4992.     }
  4993.     notephase = 0;
  4994.     deferallptrs = 0;
  4995.     while (ptrbase) {
  4996.         pd = ptrbase;
  4997.     if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
  4998.         pd->tp->smin = NULL;
  4999.         mp = pd->sym->mbase;
  5000.         while (mp && !mp->isactive)
  5001.         mp = mp->snext;
  5002.         if (!mp || mp->kind != MK_TYPE) {
  5003.         warning(format_s("Unsatisfied forward reference to type %s [138]", pd->sym->name));
  5004.         } else {
  5005.         pd->tp->basetype = mp->type;
  5006.         pd->tp->fbase = mp;
  5007.         if (!mp->type->pointertype)
  5008.             mp->type->pointertype = pd->tp;
  5009.         }
  5010.         }
  5011.         ptrbase = ptrbase->next;
  5012.         FREE(pd);
  5013.     }
  5014.     declaretypes(outflag);
  5015.     outsection(minorspace);
  5016.     flushcomments(NULL, -1, -1);
  5017.     if (outflag)
  5018.         outsection(majorspace);
  5019. }
  5020.  
  5021.  
  5022.  
  5023.  
  5024.  
  5025. Static void nameexternalvar(mp, name)
  5026. Meaning *mp;
  5027. char *name;
  5028. {
  5029.     if (!wasaliased) {
  5030.     if (*externalias && my_strchr(externalias, '%'))
  5031.         strchange(&mp->name, format_s(externalias, name));
  5032.     else
  5033.         strchange(&mp->name, name);
  5034.     }
  5035. }
  5036.  
  5037.  
  5038. Static void handlebrackets(mp, skip, wasaliased)
  5039. Meaning *mp;
  5040. int skip, wasaliased;
  5041. {
  5042.     Expr *ex;
  5043.  
  5044.     checkkeyword(TOK_ORIGIN);
  5045.     if (curtok == TOK_ORIGIN) {
  5046.     gettok();
  5047.     ex = p_expr(tp_integer);
  5048.     mp->kind = MK_VARREF;
  5049.     mp->constdefn = gentle_cast(ex, tp_integer);
  5050.     } else if (curtok == TOK_LBR) {
  5051.         gettok();
  5052.         ex = p_expr(tp_integer);
  5053.         if (!wneedtok(TOK_RBR))
  5054.         skippasttotoken(TOK_RBR, TOK_SEMI);
  5055.         if (skip) {
  5056.             freeexpr(ex);
  5057.             return;
  5058.         }
  5059.         if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
  5060.         nameexternalvar(mp, ex->val.s);
  5061.         mp->isfunction = 1;   /* make it extern */
  5062.         } else {
  5063.             note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
  5064.             mp->kind = MK_VARREF;
  5065.             mp->constdefn = gentle_cast(ex, tp_integer);
  5066.         }
  5067.     }
  5068. }
  5069.  
  5070.  
  5071.  
  5072. Static void handleabsolute(mp, skip)
  5073. Meaning *mp;
  5074. int skip;
  5075. {
  5076.     Expr *ex;
  5077.     Value val;
  5078.     long i;
  5079.  
  5080.     checkkeyword(TOK_ABSOLUTE);
  5081.     if (curtok == TOK_ABSOLUTE) {
  5082.         gettok();
  5083.         if (skip) {
  5084.             freeexpr(p_expr(tp_integer));
  5085.             if (curtok == TOK_COLON) {
  5086.                 gettok();
  5087.                 freeexpr(p_expr(tp_integer));
  5088.             }
  5089.             return;
  5090.         }
  5091.         note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
  5092.         mp->kind = MK_VARREF;
  5093.         if (curtok == TOK_IDENT && 
  5094.             curtokmeaning && (curtokmeaning->kind != MK_CONST ||
  5095.                               ord_type(curtokmeaning->type)->kind != TK_INTEGER)) {
  5096.             mp->constdefn = makeexpr_addr(p_expr(NULL));
  5097.         mp->isfunction = 1;   /* make it extern */
  5098.         } else {
  5099.             ex = gentle_cast(p_expr(tp_integer), tp_integer);
  5100.             if (curtok == TOK_COLON) {
  5101.                 val = eval_expr(ex);
  5102.                 if (!val.type)
  5103.                     warning("Expected a constant [127]");
  5104.                 i = val.i & 0xffff;
  5105.                 gettok();
  5106.                 val = p_constant(tp_integer);
  5107.                 i = (i<<16) | (val.i & 0xffff);   /* as good a notation as any! */
  5108.                 ex = makeexpr_long(i);
  5109.                 insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  5110.             }
  5111.             mp->constdefn = ex;
  5112.         }
  5113.     }
  5114. }
  5115.  
  5116.  
  5117.  
  5118. void setupfilevar(mp)
  5119. Meaning *mp;
  5120. {
  5121.     if (mp->kind != MK_VARMAC) {
  5122.     if (isfiletype(mp->type, 0)) {
  5123.         if (storefilenames && *name_FNVAR)
  5124.         mp->namedfile = 1;
  5125.         if (checkvarinlists(bufferedfiles, unbufferedfiles, 0, mp))
  5126.         mp->bufferedfile = 1;
  5127.     } else if (isfiletype(mp->type, 1)) {
  5128.         mp->namedfile = 1;
  5129.         mp->bufferedfile = 1;
  5130.     }
  5131.     }
  5132. }
  5133.  
  5134.  
  5135.  
  5136. Meaning *validatedtype(dtype, type)
  5137. Meaning *dtype;
  5138. Type *type;
  5139. {
  5140.     if (dtype &&
  5141.     (!type->preserved || !type->meaning ||
  5142.      dtype->kind != MK_TYPE || dtype->type != type ||
  5143.      type->meaning == dtype))
  5144.     return NULL;
  5145.     return dtype;
  5146. }
  5147.  
  5148.  
  5149. void p_vardecl()
  5150. {
  5151.     Meaning *firstmp, *lastmp, *dtype;
  5152.     Type *tp;
  5153.     int aliasflag, volatileflag, constflag, staticflag, globalflag, externflag;
  5154.     Strlist *l1;
  5155.     Expr *initexpr;
  5156.  
  5157.     gettok();
  5158.     notephase = 1;
  5159.     while (curtok == TOK_IDENT) {
  5160.         firstmp = lastmp = addmeaning(curtoksym, MK_VAR);
  5161.     lastmp->type = tp_integer;    /* in case of syntax errors */
  5162.         aliasflag = wasaliased;
  5163.         gettok();
  5164.         handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
  5165.     decl_comments(lastmp);
  5166.         while (curtok == TOK_COMMA) {
  5167.             gettok();
  5168.             if (wexpecttok(TOK_IDENT)) {
  5169.         lastmp = addmeaning(curtoksym, MK_VAR);
  5170.         lastmp->type = tp_integer;
  5171.         aliasflag = wasaliased;
  5172.         gettok();
  5173.         handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
  5174.         decl_comments(lastmp);
  5175.         }
  5176.         }
  5177.         if (!wneedtok(TOK_COLON)) {
  5178.         skippasttoken(TOK_SEMI);
  5179.         continue;
  5180.     }
  5181.     p_attributes();
  5182.     volatileflag = constflag = staticflag = globalflag = externflag = 0;
  5183.     if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
  5184.         constflag = 1;
  5185.         strlist_delete(&attrlist, l1);
  5186.     }
  5187.     if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
  5188.         volatileflag = 1;
  5189.         strlist_delete(&attrlist, l1);
  5190.     }
  5191.     if ((l1 = strlist_find(attrlist, "STATIC")) != NULL) {
  5192.         staticflag = 1;
  5193.         strlist_delete(&attrlist, l1);
  5194.     }
  5195.     if ((l1 = strlist_find(attrlist, "AUTOMATIC")) != NULL) {
  5196.         /* This is the default! */
  5197.         strlist_delete(&attrlist, l1);
  5198.     }
  5199.     if ((l1 = strlist_find(attrlist, "AT")) != NULL) {
  5200.             note(format_s("Absolute-addressed variable %s was generated [116]", lastmp->name));
  5201.             lastmp->kind = MK_VARREF;
  5202.             lastmp->constdefn = makeexpr_long(l1->value);
  5203.         strlist_delete(&attrlist, l1);
  5204.     }
  5205.     if ((l1 = strlist_find(attrlist, "GLOBAL")) != NULL ||
  5206.         (l1 = strlist_find(attrlist, "WEAK_GLOBAL")) != NULL) {
  5207.         globalflag = 1;
  5208.         if (l1->value != -1)
  5209.         nameexternalvar(lastmp, (char *)l1->value);
  5210.         if (l1->s[0] != 'W')
  5211.         strlist_delete(&attrlist, l1);
  5212.     }
  5213.     if ((l1 = strlist_find(attrlist, "EXTERNAL")) != NULL ||
  5214.         (l1 = strlist_find(attrlist, "WEAK_EXTERNAL")) != NULL) {
  5215.         externflag = 1;
  5216.         if (l1->value != -1)
  5217.         nameexternalvar(lastmp, (char *)l1->value);
  5218.         if (l1->s[0] != 'W')
  5219.         strlist_delete(&attrlist, l1);
  5220.     }
  5221.     dtype = (curtok == TOK_IDENT) ? curtokmeaning : NULL;
  5222.         tp = p_type(firstmp);
  5223.     decl_comments(lastmp);
  5224.         handleabsolute(lastmp, (lastmp->kind != MK_VAR));
  5225.     initexpr = NULL;
  5226.     if (curtok == TOK_ASSIGN) {    /* VAX Pascal initializer */
  5227.         gettok();
  5228.         initexpr = p_subconst(tp, 2);
  5229.         if (lastmp->kind == MK_VARMAC) {
  5230.         freeexpr(initexpr);
  5231.         initexpr = NULL;
  5232.         note("Initializer ignored for variable with VarMacro [115]");
  5233.         }
  5234.     }
  5235.     dtype = validatedtype(dtype, tp);
  5236.         for (;;) {
  5237.             if (firstmp->kind == MK_VARREF) {
  5238.                 firstmp->type = makepointertype(tp);
  5239.                 firstmp->constdefn = makeexpr_cast(firstmp->constdefn, firstmp->type);
  5240.             } else {
  5241.                 firstmp->type = tp;
  5242.         setupfilevar(firstmp);
  5243.         if (initexpr) {
  5244.             if (firstmp == lastmp)
  5245.             firstmp->constdefn = initexpr;
  5246.             else
  5247.             firstmp->constdefn = copyexpr(initexpr);
  5248.         }
  5249.             }
  5250.         firstmp->dtype = dtype;
  5251.         firstmp->volatilequal = volatileflag;
  5252.         firstmp->constqual = constflag;
  5253.         firstmp->isforward |= staticflag;
  5254.         firstmp->isfunction |= externflag;
  5255.         firstmp->exported |= globalflag;
  5256.         if (globalflag && (curctx->kind != MK_MODULE || mainlocals))
  5257.         declarevar(firstmp, -1);
  5258.             if (firstmp == lastmp)
  5259.                 break;
  5260.             firstmp = firstmp->cnext;
  5261.         }
  5262.         if (!wneedtok(TOK_SEMI))
  5263.         skippasttoken(TOK_SEMI);
  5264.     }
  5265.     notephase = 0;
  5266. }
  5267.  
  5268.  
  5269.  
  5270.  
  5271. void p_valuedecl()
  5272. {
  5273.     Meaning *mp;
  5274.  
  5275.     gettok();
  5276.     while (curtok == TOK_IDENT) {
  5277.     if (!curtokmeaning ||
  5278.         curtokmeaning->kind != MK_VAR) {
  5279.         warning(format_s("Initializer ignored for variable %s [139]",
  5280.                  curtokbuf));
  5281.         skippasttoken(TOK_SEMI);
  5282.     } else {
  5283.         mp = curtokmeaning;
  5284.         gettok();
  5285.         if (curtok == TOK_DOT || curtok == TOK_LBR) {
  5286.         note("Partial structure initialization not supported [117]");
  5287.         skippasttoken(TOK_SEMI);
  5288.         } else if (wneedtok(TOK_ASSIGN)) {
  5289.         mp->constdefn = p_subconst(mp->type, 2);
  5290.         if (!wneedtok(TOK_SEMI))
  5291.             skippasttoken(TOK_SEMI);
  5292.         } else
  5293.         skippasttoken(TOK_SEMI);
  5294.     }
  5295.     }
  5296. }
  5297.  
  5298.  
  5299.  
  5300.  
  5301.  
  5302.  
  5303.  
  5304. /* Make a temporary variable that must be freed manually (or at the end of
  5305.    the current function by default) */
  5306.  
  5307. Meaning *maketempvar(type, name)
  5308. Type *type;
  5309. char *name;
  5310. {
  5311.     struct tempvarlist *tv, **tvp;
  5312.     Symbol *sym;
  5313.     Meaning *mp;
  5314.     char *fullname;
  5315.  
  5316.     tvp = &tempvars;   /* find a freed but allocated temporary */
  5317.     while ((tv = *tvp) && (!similartypes(tv->tvar->type, type) ||
  5318.                            tv->tvar->refcount == 0 ||
  5319.                            strcmp(tv->tvar->val.s, name)))
  5320.         tvp = &(tv->next);
  5321.     if (!tv) {
  5322.         tvp = &tempvars;    /* take over a now-cancelled temporary */
  5323.         while ((tv = *tvp) && (tv->tvar->refcount > 0 || 
  5324.                                strcmp(tv->tvar->val.s, name)))
  5325.             tvp = &(tv->next);
  5326.     }
  5327.     if (tv) {
  5328.         tv->tvar->type = type;
  5329.         *tvp = tv->next;
  5330.         mp = tv->tvar;
  5331.         FREE(tv);
  5332.         mp->refcount++;
  5333.         if (debug>1) { fprintf(outf,"maketempvar revives %s\n", mp->name); }
  5334.     } else {
  5335.         tempvarcount = 0;    /***/  /* experimental... */
  5336.         for (;;) {
  5337.             if (tempvarcount)
  5338.                 fullname = format_s(name, format_d("%d", tempvarcount));
  5339.             else
  5340.                 fullname = format_s(name, "");
  5341.             ++tempvarcount;
  5342.             sym = findsymbol(fullname);
  5343.             mp = sym->mbase;
  5344.             while (mp && !mp->isactive)
  5345.                 mp = mp->snext;
  5346.             if (!mp)
  5347.                 break;
  5348.             if (debug>1) { fprintf(outf,"maketempvar rejects %s\n", fullname); }
  5349.         }
  5350.     mp = addmeaning(sym, MK_VAR);
  5351.         mp->istemporary = 1;
  5352.         mp->type = type;
  5353.         mp->refcount = 1;
  5354.         mp->val.s = stralloc(name);
  5355.         if (debug>1) { fprintf(outf,"maketempvar creates %s\n", mp->name); }
  5356.     }
  5357.     return mp;
  5358. }
  5359.  
  5360.  
  5361.  
  5362. /* Make a temporary variable that will be freed at the end of this statement
  5363.    (rather than at the end of the function) by default */
  5364.  
  5365. Meaning *makestmttempvar(type, name)
  5366. Type *type;
  5367. char *name;
  5368. {
  5369.     struct tempvarlist *tv;
  5370.     Meaning *tvar;
  5371.  
  5372.     tvar = maketempvar(type, name);
  5373.     tv = ALLOC(1, struct tempvarlist, tempvars);
  5374.     tv->tvar = tvar;
  5375.     tv->active = 1;
  5376.     tv->next = stmttempvars;
  5377.     stmttempvars = tv;
  5378.     return tvar;
  5379. }
  5380.  
  5381.  
  5382.  
  5383. Meaning *markstmttemps()
  5384. {
  5385.     return (stmttempvars) ? stmttempvars->tvar : NULL;
  5386. }
  5387.  
  5388.  
  5389. void freestmttemps(mark)
  5390. Meaning *mark;
  5391. {
  5392.     struct tempvarlist *tv;
  5393.  
  5394.     while ((tv = stmttempvars) && tv->tvar != mark) {
  5395.         if (tv->active)
  5396.             freetempvar(tv->tvar);
  5397.         stmttempvars = tv->next;
  5398.         FREE(tv);
  5399.     }
  5400. }
  5401.  
  5402.  
  5403.  
  5404. /* This temporary variable is no longer used */
  5405.  
  5406. void freetempvar(tvar)
  5407. Meaning *tvar;
  5408. {
  5409.     struct tempvarlist *tv;
  5410.  
  5411.     if (debug>1) { fprintf(outf,"freetempvar frees %s\n", tvar->name); }
  5412.     tv = stmttempvars;
  5413.     while (tv && tv->tvar != tvar)
  5414.         tv = tv->next;
  5415.     if (tv)
  5416.         tv->active = 0;
  5417.     tv = ALLOC(1, struct tempvarlist, tempvars);
  5418.     tv->tvar = tvar;
  5419.     tv->next = tempvars;
  5420.     tempvars = tv;
  5421. }
  5422.  
  5423.  
  5424.  
  5425. /* The code that used this temporary variable has been deleted */
  5426.  
  5427. void canceltempvar(tvar)
  5428. Meaning *tvar;
  5429. {
  5430.     if (debug>1) { fprintf(outf,"canceltempvar cancels %s\n", tvar->name); }
  5431.     tvar->refcount--;
  5432.     freetempvar(tvar);
  5433. }
  5434.  
  5435.  
  5436.  
  5437.  
  5438.  
  5439.  
  5440.  
  5441.  
  5442. /* End. */
  5443.  
  5444.  
  5445.