开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 编译器/解释器 > 查看源码
decl.c.1
资源名称：pascal2c.tar.Z　[点击查看]
上传用户：upcnvip
上传日期：2007-01-06
资源大小：474k
文件大小：48k
源码类别：

编译器/解释器

开发平台：

C/C++

decl.c.1：源码内容
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  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).
  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.
  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. */
  20. #define PROTO_DECL_C
  21. #include "trans.h"
  25. #define MAXIMPORTS 100
  29. Static struct ptrdesc {
  30.     struct ptrdesc *next;
  31.     Symbol *sym;
  32.     Type *tp;
  33. } *ptrbase;
  35. Static struct ctxstack {
  36.     struct ctxstack *next;
  37.     Meaning *ctx, *ctxlast;
  38.     struct tempvarlist *tempvars;
  39.     int tempvarcount, importmark;
  40. } *ctxtop;
  42. Static struct tempvarlist {
  43.     struct tempvarlist *next;
  44.     Meaning *tvar;
  45.     int active;
  46. } *tempvars, *stmttempvars;
  48. Static int tempvarcount;
  50. Static int stringtypecachesize;
  51. Static Type **stringtypecache;
  53. Static Meaning *importlist[MAXIMPORTS];
  54. Static int firstimport;
  56. Static Type *tp_special_anyptr;
  58. Static int wasaliased;
  59. Static int deferallptrs;
  60. Static int anydeferredptrs;
  61. Static int silentalreadydef;
  62. Static int nonloclabelcount;
  64. Static Strlist *varstructdecllist;
  69. Static Meaning *findstandardmeaning(kind, name)
  70. enum meaningkind kind;
  71. char *name;
  72. {
  73.     Meaning *mp;
  74.     Symbol *sym;
  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. }
  88. Static Meaning *makestandardmeaning(kind, name)
  89. enum meaningkind kind;
  90. char *name;
  91. {
  92.     Meaning *mp;
  93.     Symbol *sym;
  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, stralloc(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. }
  110. Static Type *makestandardtype(kind, mp)
  111. enum typekind kind;
  112. Meaning *mp;
  113. {
  114.     Type *tp;
  116.     tp = maketype(kind);
  117.     tp->meaning = mp;
  118.     if (mp)
  119.         mp->type = tp;
  120.     return tp;
  121. }
  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. }
  135. Meaning *makespecialproc(name, handler)
  136. char *name;
  137. Stmt *(*handler)();
  138. {
  139.     Meaning *mp;
  141.     if (!handler)
  142.         handler = nullspecialproc;
  143.     mp = makestandardmeaning(MK_SPECIAL, name);
  144.     mp->handler = (Expr *(*)())handler;
  145.     return mp;
  146. }
  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. }
  157. Meaning *makestandardproc(name, handler)
  158. char *name;
  159. Stmt *(*handler)();
  160. {
  161.     Meaning *mp;
  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. }
  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. }
  188. Meaning *makespecialfunc(name, handler)
  189. char *name;
  190. Expr *(*handler)();
  191. {
  192.     Meaning *mp;
  194.     if (!handler)
  195.         handler = nullspecialfunc;
  196.     mp = makestandardmeaning(MK_SPECIAL, name);
  197.     mp->isfunction = 1;
  198.     mp->handler = handler;
  199.     return mp;
  200. }
  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. }
  211. Meaning *makestandardfunc(name, handler)
  212. char *name;
  213. Expr *(*handler)();
  214. {
  215.     Meaning *mp;
  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. }
  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. }
  243. Meaning *makespecialvar(name, handler)
  244. char *name;
  245. Expr *(*handler)();
  246. {
  247.     Meaning *mp;
  249.     if (!handler)
  250.         handler = nullspecialvar;
  251.     mp = makestandardmeaning(MK_SPVAR, name);
  252.     mp->handler = handler;
  253.     return mp;
  254. }
  260. void setup_decl()
  261. {
  262.     Meaning *mp, *mp2, *mp_turbo_shortint;
  263.     Symbol *sym;
  264.     Type *tp;
  265.     int i;
  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;
  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);
  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;
  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);
  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.     }
  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);
  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.     }
  335.     tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
  336.     tp_charptr->basetype = tp_char;
  337.     tp_char->pointertype = tp_charptr;
  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);
  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);
  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);
  353.     sym = findsymbol("Boolean");
  354.     sym->flags |= SSYNONYM;
  355.     strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;
  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);
  365.     tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */
  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 */
  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);
  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.     }
  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);
  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;
  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.     }
  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);
  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.     }
  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);
  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.     }
  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;
  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;
  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" */
  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);
  474.     tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
  475.     tp_str255->pointertype = tp_strptr;
  476.     tp_strptr->basetype = tp_str255;
  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;
  483.     tp_smallset = maketype(TK_SMALLSET);
  484.     tp_smallset->basetype = tp_integer;
  485.     tp_smallset->indextype = tp_boolean;
  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;
  492.     tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);
  494.     mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
  495.     mp->type = tp_text;
  497.     mp = makestandardmeaning(MK_TYPE, "BITSET");
  498.     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  499.     makeexpr_long(setbits-1)));
  500.     mp->type->meaning = mp;
  502.     mp = makestandardmeaning(MK_TYPE, "INTSET");
  503.     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  504.     makeexpr_long(defaultsetsize-1)));
  505.     mp->type->meaning = mp;
  507.     mp_input = makestandardmeaning(MK_VAR, "INPUT");
  508.     mp_input->type = tp_text;
  509.     mp_input->name = stralloc("stdin");
  510.     ex_input = makeexpr_var(mp_input);
  512.     mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
  513.     mp_output->type = tp_text;
  514.     mp_output->name = stralloc("stdout");
  515.     ex_output = makeexpr_var(mp_output);
  517.     mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
  518.     mp_stderr->type = tp_text;
  519.     mp_stderr->name = stralloc("stderr");
  521.     mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
  522.     mp_escapecode->type = tp_sshort;
  523.     mp_escapecode->name = stralloc(name_ESCAPECODE);
  525.     mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
  526.     mp_ioresult->type = tp_integer;
  527.     mp_ioresult->name = stralloc(name_IORESULT);
  529.     mp_false = makestandardmeaning(MK_CONST, "FALSE");
  530.     mp_false->type = mp_false->val.type = tp_boolean;
  531.     mp_false->val.i = 0;
  533.     mp_true = makestandardmeaning(MK_CONST, "TRUE");
  534.     mp_true->type = mp_true->val.type = tp_boolean;
  535.     mp_true->val.i = 1;
  537.     mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
  538.     mp_maxint->type = mp_maxint->val.type = tp_integer;
  539.     mp_maxint->val.i = MAXINT;
  540.     mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
  541.                                (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");
  543.     mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
  544.     mp->type = mp->val.type = tp_integer;
  545.     mp->val.i = MAXINT;
  546.     mp->name = stralloc("LONG_MAX");
  548.     mp_minint = makestandardmeaning(MK_CONST, "MININT");
  549.     mp_minint->type = mp_minint->val.type = tp_integer;
  550.     mp_minint->val.i = MININT;
  551.     mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
  552.                                (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");
  554.     mp = makestandardmeaning(MK_CONST, "MAXCHAR");
  555.     mp->type = mp->val.type = tp_char;
  556.     mp->val.i = 127;
  557.     mp->name = stralloc("CHAR_MAX");
  559.     mp = makestandardmeaning(MK_CONST, "MINCHAR");
  560.     mp->type = mp->val.type = tp_char;
  561.     mp->val.i = 0;
  562.     mp->anyvarflag = 1;
  564.     mp = makestandardmeaning(MK_CONST, "BELL");
  565.     mp->type = mp->val.type = tp_char;
  566.     mp->val.i = 7;
  567.     mp->anyvarflag = 1;
  569.     mp = makestandardmeaning(MK_CONST, "TAB");
  570.     mp->type = mp->val.type = tp_char;
  571.     mp->val.i = 9;
  572.     mp->anyvarflag = 1;
  574.     mp_str_hp = mp_str_turbo = NULL;
  575.     mp_val_modula = mp_val_turbo = NULL;
  576.     mp_blockread_ucsd = mp_blockread_turbo = NULL;
  577.     mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
  578.     mp_dec_dec = mp_dec_turbo = NULL;
  579. }
  583. /* This makes sure that if A imports B and then C, C's interface is not
  584.    parsed in the environment of B */
  585. int push_imports()
  586. {
  587.     int mark = firstimport;
  588.     Meaning *mp;
  590.     while (firstimport < numimports) {
  591. if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
  592.     for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  593. mp->isactive = 0;
  594. }
  595.         firstimport++;
  596.     }
  597.     return mark;
  598. }
  602. void pop_imports(mark)
  603. int mark;
  604. {
  605.     Meaning *mp;
  607.     while (firstimport > mark) {
  608.         firstimport--;
  609.         for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  610.             mp->isactive = 1;
  611.     }
  612. }
  616. void import_ctx(ctx)
  617. Meaning *ctx;
  618. {
  619.     Meaning *mp;
  620.     int i;
  622.     for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
  623.     if (i >= numimports) {
  624.         if (numimports == MAXIMPORTS)
  625.             error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
  626.         importlist[numimports++] = ctx;
  627.     }
  628.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  629.         if (mp->exported)
  630.             mp->isactive = 1;
  631.     }
  632. }
  636. void perm_import(ctx)
  637. Meaning *ctx;
  638. {
  639.     Meaning *mp;
  641.     /* Import permanently, as in Turbo's "system" unit */
  642.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  643.         if (mp->exported)
  644.             mp->isactive = 1;
  645.     }
  646. }
  650. void unimport(mark)
  651. int mark;
  652. {
  653.     Meaning *mp;
  655.     while (numimports > mark) {
  656.         numimports--;
  657. if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
  658.     for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
  659. mp->isactive = 0;
  660. }
  661.     }
  662. }
  667. void activatemeaning(mp)
  668. Meaning *mp;
  669. {
  670.     Meaning *mp2;
  672.     if (debug>1) fprintf(outf, "Reviving %sn", curctxlast->name);
  673.     mp->isactive = 1;
  674.     if (mp->sym->mbase != mp) {     /* move to front of symbol list */
  675.         mp2 = mp->sym->mbase;
  676.         for (;;) {
  677.             if (!mp2) {
  678. /* Not on symbol list: must be a special kludge meaning */
  679.                 return;
  680.             }
  681.             if (mp2->snext == mp)
  682.                 break;
  683.             mp2 = mp2->snext;
  684.         }
  685.         mp2->snext = mp->snext;
  686.         mp->snext = mp->sym->mbase;
  687.         mp->sym->mbase = mp;
  688.     }
  689. }
  693. void pushctx(ctx)
  694. Meaning *ctx;
  695. {
  696.     struct ctxstack *top;
  698.     top = ALLOC(1, struct ctxstack, ctxstacks);
  699.     top->ctx = curctx;
  700.     top->ctxlast = curctxlast;
  701.     top->tempvars = tempvars;
  702.     top->tempvarcount = tempvarcount;
  703.     top->importmark = numimports;
  704.     top->next = ctxtop;
  705.     ctxtop = top;
  706.     curctx = ctx;
  707.     curctxlast = ctx->cbase;
  708.     if (curctxlast) {
  709.         activatemeaning(curctxlast);
  710.         while (curctxlast->cnext) {
  711.             curctxlast = curctxlast->cnext;
  712.             activatemeaning(curctxlast);
  713.         }
  714.     }
  715.     tempvars = NULL;
  716.     tempvarcount = 0;
  717.     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  718. progress();
  719. }
  723. void popctx()
  724. {
  725.     struct ctxstack *top;
  726.     struct tempvarlist *tv;
  727.     Meaning *mp;
  729.     if (!strlist_cifind(permimports, curctx->sym->name)) {
  730. for (mp = curctx->cbase; mp; mp = mp->cnext) {
  731.     if (debug>1) fprintf(outf, "Hiding %sn", mp->name);
  732.     mp->isactive = 0;
  733. }
  734.     }
  735.     top = ctxtop;
  736.     ctxtop = top->next;
  737.     curctx = top->ctx;
  738.     curctxlast = top->ctxlast;
  739.     while (tempvars) {
  740.         tv = tempvars->next;
  741.         FREE(tempvars);
  742.         tempvars = tv;
  743.     }
  744.     tempvars = top->tempvars;
  745.     tempvarcount = top->tempvarcount;
  746.     unimport(top->importmark);
  747.     FREE(top);
  748.     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  749. progress();
  750. }
  754. void forget_ctx(ctx, all)
  755. Meaning *ctx;
  756. int all;
  757. {
  758.     register Meaning *mp, **mpprev, *mp2, **mpp2;
  760.     if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
  761. mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
  762.     else
  763. mpprev = &ctx->cbase;
  764.     while ((mp = *mpprev) != NULL) {
  765. if (all ||
  766.     (mp->kind != MK_PARAM &&
  767.      mp->kind != MK_VARPARAM)) {
  768.     *mpprev = mp->cnext;
  769.     mpp2 = &mp->sym->mbase;
  770.     while ((mp2 = *mpp2) != NULL && mp2 != mp)
  771. mpp2 = &mp2->snext;
  772.     if (mp2)
  773. *mpp2 = mp2->snext;
  774.     if (mp->kind == MK_CONST)
  775. free_value(&mp->val);
  776.     freeexpr(mp->constdefn);
  777.     if (mp->cbase)
  778. forget_ctx(mp, 1);
  779.     if (mp->kind == MK_FUNCTION && mp->val.i)
  780. free_stmt((Stmt *)mp->val.i);
  781.     strlist_empty(&mp->comments);
  782.     if (mp->name)
  783. FREE(mp->name);
  784.     if (mp->othername)
  785. FREE(mp->othername);
  786.     FREE(mp);
  787. } else
  788.     mpprev = &mp->cnext;
  789.     }
  790. }
  795. void handle_nameof()
  796. {
  797.     Strlist *sl, *sl2;
  798.     Symbol *sp;
  799.     char *cp;
  801.     for (sl = nameoflist; sl; sl = sl->next) {
  802.         cp = my_strchr(sl->s, '.');
  803.         if (cp) {
  804.             sp = findsymbol(fixpascalname(cp + 1));
  805.             sl2 = strlist_add(&sp->symbolnames, 
  806.                               format_ds("%.*s", (int)(cp - sl->s), sl->s));
  807.         } else {
  808.             sp = findsymbol(fixpascalname(sl->s));
  809.             sl2 = strlist_add(&sp->symbolnames, "");
  810.         }
  811.         sl2->value = sl->value;
  812.         if (debug > 0)
  813.             fprintf(outf, "symbol %s gets "%s" -> "%s"n",
  814.                           sp->name, sl2->s, sl2->value);
  815.     }
  816.     strlist_empty(&nameoflist);
  817. }
  821. Static void initmeaning(mp)
  822. Meaning *mp;
  823. {
  824. /*    mp->serial = curserial = ++serialcount;    */
  825.     mp->cbase = NULL;
  826.     mp->xnext = NULL;
  827.     mp->othername = NULL;
  828.     mp->type = NULL;
  829.     mp->needvarstruct = 0;
  830.     mp->varstructflag = 0;
  831.     mp->wasdeclared = 0;
  832.     mp->isforward = 0;
  833.     mp->isfunction = 0;
  834.     mp->istemporary = 0;
  835.     mp->volatilequal = 0;
  836.     mp->constqual = 0;
  837.     mp->warnifused = (warnnames > 0);
  838.     mp->constdefn = NULL;
  839.     mp->val.i = 0;
  840.     mp->val.s = NULL;
  841.     mp->val.type = NULL;
  842.     mp->refcount = 1;
  843.     mp->anyvarflag = 0;
  844.     mp->isactive = 1;
  845.     mp->exported = 0;
  846.     mp->handler = NULL;
  847.     mp->dumped = 0;
  848.     mp->isreturn = 0;
  849.     mp->fakeparam = 0;
  850.     mp->namedfile = 0;
  851.     mp->bufferedfile = 0;
  852.     mp->comments = NULL;
  853. }
  857. int issafename(sp, isglobal, isdefine)
  858. Symbol *sp;
  859. int isglobal, isdefine;
  860. {
  861.     if (isdefine && curctx->kind != MK_FUNCTION) {
  862. if (sp->flags & FWDPARAM)
  863.     return 0;
  864.     }
  865.     if ((sp->flags & AVOIDNAME) ||
  866. (isdefine && (sp->flags & AVOIDFIELD)) ||
  867.         (isglobal && (sp->flags & AVOIDGLOB)))
  868.         return 0;
  869.     else
  870.         return 1;
  871. }
  875. static Meaning *enum_tname;
  877. void setupmeaning(mp, sym, kind, namekind)
  878. Meaning *mp;
  879. Symbol *sym;
  880. enum meaningkind kind, namekind;
  881. {
  882.     char *name, *symfmt, *editfmt, *cp, *cp2;
  883.     int altnum, isglobal, isdefine;
  884.     Symbol *sym2;
  885.     Strlist *sl;
  887.     if (!sym)
  888. sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
  889.     if (sym->mbase && sym->mbase->ctx == curctx &&
  890. curctx != NULL && !silentalreadydef)
  891.         alreadydef(sym);
  892.     mp->sym = sym;
  893.     mp->snext = sym->mbase;
  894.     sym->mbase = mp;
  895.     if (sym == curtoksym) {
  896. sym->kwtok = TOK_NONE;
  897. sym->flags &= ~KWPOSS;
  898.     }
  899.     mp->ctx = curctx;
  900.     mp->kind = kind;
  901.     if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
  902. strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
  903. Meaning *mp2;
  904. if (islower(sym->name[0]))
  905.     sym2 = findsymbol(strupper(sym->name));
  906. else
  907.     sym2 = findsymbol(strlower(sym->name));
  908. mp2 = addmeaning(sym2, MK_SYNONYM);
  909. mp2->xnext = mp;
  910.     }
  911.     if (kind == MK_VAR) {
  912.         sl = strlist_find(varmacros, sym->name);
  913.         if (sl) {
  914.             kind = namekind = MK_VARMAC;
  915.             mp->constdefn = (Expr *)sl->value;
  916.             strlist_delete(&varmacros, sl);
  917.         }
  918.     }
  919.     if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
  920.         sl = strlist_find(funcmacros, sym->name);
  921.         if (sl) {
  922.             mp->constdefn = (Expr *)sl->value;
  923.             strlist_delete(&funcmacros, sl);
  924.         }
  925.     }
  926.     if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
  927. kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
  928.         mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
  929. if (blockkind == TOK_IMPORT)
  930.     mp->wasdeclared = 1;   /* suppress future declaration */
  931.     } else
  932.         mp->exported = 0;
  933.     if (sym == curtoksym)
  934.         name = curtokcase;
  935.     else
  936.         name = sym->name;
  937.     isdefine = (namekind == MK_CONST);
  938.     isglobal = (!curctx ||
  939. curctx->kind != MK_FUNCTION ||
  940.                 namekind == MK_FUNCTION ||
  941. namekind == MK_TYPE ||
  942.                 isdefine) &&
  943.                (curctx != nullctx);
  944.     mp->refcount = isglobal ? 1 : 0;   /* make sure globals don't disappear */
  945.     if (namekind == MK_SYNONYM)
  946. return;
  947.     if (!mp->exported || !*exportsymbol)
  948.         symfmt = "";
  949.     else if (*export_symbol && my_strchr(name, '_'))
  950.         symfmt = export_symbol;
  951.     else
  952.         symfmt = exportsymbol;
  953.     wasaliased = 0;
  954.     if (*externalias && !my_strchr(externalias, '%')) {
  955.         register int i;
  956.         name = format_s("%s", externalias);
  957.         i = numparams;
  958.         while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
  959.         if (i < 0 || !undooption(i, ""))
  960.             *externalias = 0;
  961.         wasaliased = 1;
  962.     } else if (sym->symbolnames) {
  963.         if (curctx) {
  964.             if (debug > 2)
  965.                 fprintf(outf, "checking for "%s" of %sn", curctx->name, sym->name);
  966.             sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
  967.             if (sl) {
  968.                 if (debug > 2)
  969.                     fprintf(outf, "found "%s"n", sl->value);
  970.                 name = (char *)sl->value;
  971.                 wasaliased = 1;
  972.             }
  973.         }
  974.         if (!wasaliased) {
  975.             if (debug > 2)
  976.                 fprintf(outf, "checking for "" of %sn", sym->name);
  977.             sl = strlist_find(sym->symbolnames, "");
  978.             if (sl) {
  979.                 if (debug > 2)
  980.                     fprintf(outf, "found "%s"n", sl->value);
  981.                 name = (char *)sl->value;
  982.                 wasaliased = 1;
  983.             }
  984.         }
  985.     }
  986.     if (!*symfmt || wasaliased)
  987. symfmt = "%s";
  988.     altnum = -1;
  989.     do {
  990.         altnum++;
  991.         cp = format_ss(symfmt, name, curctx ? curctx->name : "");
  992. switch (namekind) {
  994.   case MK_CONST:
  995.     editfmt = constformat;
  996.     break;
  998.   case MK_MODULE:
  999.     editfmt = moduleformat;
  1000.     break;
  1002.   case MK_FUNCTION:
  1003.     editfmt = functionformat;
  1004.     break;
  1006.   case MK_VAR:
  1007.   case MK_VARPARAM:
  1008.   case MK_VARREF:
  1009.   case MK_VARMAC:
  1010.   case MK_SPVAR:
  1011.     editfmt = varformat;
  1012.     break;
  1014.   case MK_TYPE:
  1015.     editfmt = typeformat;
  1016.     break;
  1018.   case MK_VARIANT:   /* A true kludge! */
  1019.     editfmt = enumformat;
  1020.     break;
  1022.   default:
  1023.     editfmt = "";
  1024. }
  1025. if (!*editfmt)
  1026.     editfmt = symbolformat;
  1027. if (*editfmt)
  1028.     if (editfmt == enumformat)
  1029. cp = format_ss(editfmt, cp,
  1030.        enum_tname ? enum_tname->name : "ENUM");
  1031.     else
  1032. cp = format_ss(editfmt, cp,
  1033.        curctx ? curctx->name : "");
  1034. if (dollar_idents == 2) {
  1035.     for (cp2 = cp; *cp2; cp2++)
  1036. if (*cp2 == '$' || *cp2 == '%')
  1037.     *cp2 = '_';
  1038. }
  1039.         sym2 = findsymbol(findaltname(cp, altnum));
  1040.     } while (!issafename(sym2, isglobal, isdefine) &&
  1041.      namekind != MK_MODULE && !wasaliased);
  1042.     mp->name = stralloc(sym2->name);
  1043.     if (sym2->flags & WARNNAME)
  1044.         note(format_s("A symbol named %s was defined [100]", mp->name));
  1045.     if (isglobal) {
  1046.         switch (namekind) {     /* prevent further name conflicts */
  1048.             case MK_CONST:
  1049.     case MK_VARIANT:
  1050.             case MK_TYPE:
  1051.                 sym2->flags |= AVOIDNAME;
  1052.                 break;
  1054.             case MK_VAR:
  1055.             case MK_VARREF:
  1056.             case MK_FUNCTION:
  1057.                 sym2->flags |= AVOIDGLOB;
  1058.                 break;
  1060.     default:
  1061. /* name is completely local */
  1062. break;
  1063.         }
  1064.     }
  1065.     if (debug > 4)
  1066. fprintf(outf, "Created meaning %sn", mp->name);
  1067. }
  1071. Meaning *addmeaningas(sym, kind, namekind)
  1072. Symbol *sym;
  1073. enum meaningkind kind, namekind;
  1074. {
  1075.     Meaning *mp;
  1077.     mp = ALLOC(1, Meaning, meanings);
  1078.     initmeaning(mp);
  1079.     setupmeaning(mp, sym, kind, namekind);
  1080.     mp->cnext = NULL;
  1081.     if (curctx) {
  1082.         if (curctxlast)
  1083.             curctxlast->cnext = mp;
  1084.         else
  1085.             curctx->cbase = mp;
  1086.         curctxlast = mp;
  1087.     }
  1088.     return mp;
  1089. }
  1093. Meaning *addmeaning(sym, kind)
  1094. Symbol *sym;
  1095. enum meaningkind kind;
  1096. {
  1097.     return addmeaningas(sym, kind, kind);
  1098. }
  1102. Meaning *addmeaningafter(mpprev, sym, kind)
  1103. Meaning *mpprev;
  1104. Symbol *sym;
  1105. enum meaningkind kind;
  1106. {
  1107.     Meaning *mp;
  1109.     if (!mpprev->cnext && mpprev->ctx == curctx)
  1110.         return addmeaning(sym, kind);
  1111.     mp = ALLOC(1, Meaning, meanings);
  1112.     initmeaning(mp);
  1113.     setupmeaning(mp, sym, kind, kind);
  1114.     mp->ctx = mpprev->ctx;
  1115.     mp->cnext = mpprev->cnext;
  1116.     mpprev->cnext = mp;
  1117.     return mp;
  1118. }
  1121. void unaddmeaning(mp)
  1122. Meaning *mp;
  1123. {
  1124.     Meaning *prev;
  1126.     prev = mp->ctx;
  1127.     while (prev && prev != mp)
  1128. prev = prev->cnext;
  1129.     if (prev)
  1130. prev->cnext = mp->cnext;
  1131.     else
  1132. mp->ctx = mp->cnext;
  1133.     if (!mp->cnext && mp->ctx == curctx)
  1134. curctxlast = prev;
  1135. }
  1138. void readdmeaning(mp)
  1139. Meaning *mp;
  1140. {
  1141.     mp->cnext = NULL;
  1142.     if (curctx) {
  1143.         if (curctxlast)
  1144.             curctxlast->cnext = mp;
  1145.         else
  1146.             curctx->cbase = mp;
  1147.         curctxlast = mp;
  1148.     }
  1149. }
  1152. Meaning *addfield(sym, flast, rectype, tname)
  1153. Symbol *sym;
  1154. Meaning ***flast;
  1155. Type *rectype;
  1156. Meaning *tname;
  1157. {
  1158.     Meaning *mp;
  1159.     int altnum;
  1160.     Symbol *sym2;
  1161.     Strlist *sl;
  1162.     char *name, *name2;
  1164.     mp = ALLOC(1, Meaning, meanings);
  1165.     initmeaning(mp);
  1166.     mp->sym = sym;
  1167.     if (sym) {
  1168.         mp->snext = sym->fbase;
  1169.         sym->fbase = mp;
  1170.         if (sym == curtoksym)
  1171.             name2 = curtokcase;
  1172.         else
  1173.             name2 = sym->name;
  1174. name = name2;
  1175.         if (tname)
  1176.             sl = strlist_find(fieldmacros,
  1177.                               format_ss("%s.%s", tname->sym->name, sym->name));
  1178.         else
  1179.             sl = NULL;
  1180.         if (sl) {
  1181.             mp->constdefn = (Expr *)sl->value;
  1182.             strlist_delete(&fieldmacros, sl);
  1183.             altnum = 0;
  1184.         } else {
  1185.             altnum = -1;
  1186.             do {
  1187.                 altnum++;
  1188. if (*fieldformat)
  1189.     name = format_ss(fieldformat, name2,
  1190.      tname && tname->name ? tname->name
  1191.                           : "FIELD");
  1192.                 sym2 = findsymbol(findaltname(name, altnum));
  1193.             } while (!issafename(sym2, 0, 0) ||
  1194.      ((sym2->flags & AVOIDFIELD) && !reusefieldnames));
  1195.     sym2->flags |= AVOIDFIELD;
  1196.         }
  1197.         mp->kind = MK_FIELD;
  1198.         mp->name = stralloc(findaltname(name, altnum));
  1199.     } else {
  1200.         mp->name = stralloc("(variant)");
  1201.         mp->kind = MK_VARIANT;
  1202.     }
  1203.     mp->cnext = NULL;
  1204.     **flast = mp;
  1205.     *flast = &(mp->cnext);
  1206.     mp->ctx = NULL;
  1207.     mp->rectype = rectype;
  1208.     mp->val.i = 0;
  1209.     return mp;
  1210. }
  1216. int isfiletype(type)
  1217. Type *type;
  1218. {
  1219.     return (type->kind == TK_POINTER &&
  1220.             type->basetype->kind == TK_FILE);
  1221. }
  1224. Meaning *isfilevar(ex)
  1225. Expr *ex;
  1226. {
  1227.     Meaning *mp;
  1229.     if (ex->kind == EK_VAR) {
  1230. mp = (Meaning *)ex->val.i;
  1231. if (mp->kind == MK_VAR)
  1232.     return mp;
  1233.     } else if (ex->kind == EK_DOT) {
  1234. mp = (Meaning *)ex->val.i;
  1235. if (mp && mp->kind == MK_FIELD)
  1236.     return mp;
  1237.     }
  1238.     return NULL;
  1239. }
  1243. Type *findbasetype_(type, flags)
  1244. Type *type;
  1245. int flags;
  1246. {
  1247.     long smin, smax;
  1249.     for (;;) {
  1250.         switch (type->kind) {
  1252.             case TK_POINTER:
  1253.                 if (type->basetype == tp_void) {     /* ANYPTR */
  1254.                     if (tp_special_anyptr)
  1255.                         return tp_special_anyptr;   /* write "Anyptr" */
  1256.                     if (!voidstar)
  1257.                         return tp_abyte;    /* write "char *", not "void *" */
  1258.                 }
  1259.                 switch (type->basetype->kind) {
  1261.                     case TK_ARRAY:       /* use basetype's basetype: */
  1262.                     case TK_STRING:      /* ^array[5] of array[3] of integer */
  1263.                     case TK_SET:         /*  => int (*a)[3]; */
  1264.         if (stararrays == 1 ||
  1265.     !(flags & ODECL_FREEARRAY) ||
  1266.     type->basetype->structdefd) {
  1267.     type = type->basetype;
  1268.     flags &= ~ODECL_CHARSTAR;
  1269. }
  1270.                         break;
  1272.     default:
  1273. break;
  1274.                 }
  1275.                 break;
  1277.             case TK_FUNCTION:
  1278.             case TK_STRING:
  1279.             case TK_SET:
  1280.             case TK_SMALLSET:
  1281.             case TK_SMALLARRAY:
  1282.                 if (!type->basetype)
  1283.                     return type;
  1284.                 break;
  1286.             case TK_ARRAY:
  1287.                 if (type->meaning && type->meaning->kind == MK_TYPE &&
  1288.                     type->meaning->wasdeclared)
  1289.                     return type;
  1290.                 break;
  1292.             case TK_FILE:
  1293.                 return tp_text->basetype;
  1295.             case TK_PROCPTR:
  1296. return tp_proc;
  1298.     case TK_CPROCPTR:
  1299. type = type->basetype->basetype;
  1300. continue;
  1302.             case TK_ENUM:
  1303.                 if (useenum)
  1304.                     return type;
  1305.                 else if (!enumbyte ||
  1306.  type->smax->kind != EK_CONST ||
  1307.  type->smax->val.i > 255)
  1308.     return tp_sshort;
  1309. else if (type->smax->val.i > 127)
  1310.                     return tp_ubyte;
  1311. else
  1312.                     return tp_abyte;
  1314.             case TK_BOOLEAN:
  1315.                 if (*name_BOOLEAN)
  1316.                     return type;
  1317.                 else
  1318.                     return tp_ubyte;
  1320.             case TK_SUBR:
  1321.                 if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte ||
  1322.                     type == tp_ushort || type == tp_sshort) {
  1323.                     return type;
  1324.                 } else if ((type->basetype->kind == TK_ENUM && useenum) ||
  1325.                            type->basetype->kind == TK_BOOLEAN && *name_BOOLEAN) {
  1326.                     return type->basetype;
  1327.                 } else {
  1328.                     if (ord_range(type, &smin, &smax)) {
  1329.                         if (squeezesubr != 0) {
  1330.                             if (smin >= 0 && smax <= max_schar)
  1331.                                 return tp_abyte;
  1332.                             else if (smin >= 0 && smax <= max_uchar)
  1333.                                 return tp_ubyte;
  1334.                             else if (smin >= min_schar && smax <= max_schar &&
  1335.      (signedchars == 1 || hassignedchar))
  1336.                                 return tp_sbyte;
  1337.                             else if (smin >= min_sshort && smax <= max_sshort)
  1338.                                 return tp_sshort;
  1339.                             else if (smin >= 0 && smax <= max_ushort)
  1340.                                 return tp_ushort;
  1341.                             else
  1342.                                 return tp_integer;
  1343.                         } else {
  1344.                             if (smin >= min_sshort && smax <= max_sshort)
  1345.                                 return tp_sshort;
  1346.                             else
  1347.                                 return tp_integer;
  1348.                         }
  1349.                     } else
  1350.                         return tp_integer;
  1351.                 }
  1353.     case TK_CHAR:
  1354. if (type == tp_schar &&
  1355.     (signedchars != 1 && !hassignedchar)) {
  1356.     return tp_sshort;
  1357. }
  1358. return type;
  1360.             default:
  1361.                 return type;
  1362.         }
  1363.         type = type->basetype;
  1364.     }
  1365. }
  1368. Type *findbasetype(type, flags)
  1369. Type *type;
  1370. int flags;
  1371. {
  1372.     if (debug>1) {
  1373. fprintf(outf, "findbasetype(");
  1374. dumptypename(type, 1);
  1375. fprintf(outf, ",%d) = ", flags);
  1376. type = findbasetype_(type, flags);
  1377. dumptypename(type, 1);
  1378. fprintf(outf, "n");
  1379. return type;
  1380.     }
  1381.     return findbasetype_(type, flags);
  1382. }
  1386. Expr *arraysize(tp, incskipped)
  1387. Type *tp;
  1388. int incskipped;
  1389. {
  1390.     Expr *ex, *minv, *maxv;
  1391.     int denom;
  1393.     ord_range_expr(tp->indextype, &minv, &maxv);
  1394.     if (maxv->kind == EK_VAR && maxv->val.i == (long)mp_maxint &&
  1395. !exprdependsvar(minv, mp_maxint)) {
  1396.         return NULL;
  1397.     } else {
  1398.         ex = makeexpr_plus(makeexpr_minus(copyexpr(maxv),
  1399.                                           copyexpr(minv)),
  1400.                            makeexpr_long(1));
  1401.         if (tp->smin && !incskipped) {
  1402.             ex = makeexpr_minus(ex, copyexpr(tp->smin));
  1403.         }
  1404.         if (tp->smax) {
  1405.             denom = (tp->basetype == tp_sshort) ? 16 : 8;
  1406.             denom >>= tp->escale;
  1407.             ex = makeexpr_div(makeexpr_plus(ex, makeexpr_long(denom-1)),
  1408.                               makeexpr_long(denom));
  1409.         }
  1410.         return ex;
  1411.     }
  1412. }
  1416. Type *promote_type(tp)
  1417. Type *tp;
  1418. {
  1419.     Type *tp2;
  1421.     if (tp->kind == TK_ENUM) {
  1422. if (promote_enums == 0 ||
  1423.     (promote_enums < 0 &&
  1424.      (useenum)))
  1425.     return tp;
  1426.     }
  1427.     if (tp->kind == TK_ENUM ||
  1428.          tp->kind == TK_SUBR ||
  1429.          tp->kind == TK_INTEGER ||
  1430.          tp->kind == TK_CHAR ||
  1431.          tp->kind == TK_BOOLEAN) {
  1432.         tp2 = findbasetype(tp, 0);
  1433. if (tp2 == tp_ushort && sizeof_int == 16)
  1434.     return tp_uint;
  1435.         else if (tp2 == tp_sbyte || tp2 == tp_ubyte ||
  1436.  tp2 == tp_abyte || tp2 == tp_char ||
  1437.  tp2 == tp_sshort || tp2 == tp_ushort ||
  1438.  tp2 == tp_boolean || tp2->kind == TK_ENUM) {
  1439.             return tp_int;
  1440.         }
  1441.     }
  1442.     if (tp == tp_real)
  1443. return tp_longreal;
  1444.     return tp;
  1445. }
  1448. Type *promote_type_bin(t1, t2)
  1449. Type *t1, *t2;
  1450. {
  1451.     t1 = promote_type(t1);
  1452.     t2 = promote_type(t2);
  1453.     if (t1 == tp_longreal || t2 == tp_longreal)
  1454. return tp_longreal;
  1455.     if (t1 == tp_unsigned || t2 == tp_unsigned)
  1456. return tp_unsigned;
  1457.     if (t1 == tp_integer || t2 == tp_integer) {
  1458. if ((t1 == tp_uint || t2 == tp_uint) &&
  1459.     sizeof_int > 0 &&
  1460.     sizeof_int < (sizeof_long > 0 ? sizeof_long : 32))
  1461.     return tp_uint;
  1462. return tp_integer;
  1463.     }
  1464.     if (t1 == tp_uint || t2 == tp_uint)
  1465. return tp_uint;
  1466.     return t1;
  1467. }
  1471. #if 0
  1472. void predeclare_varstruct(mp)
  1473. Meaning *mp;
  1474. {
  1475.     if (mp->ctx &&
  1476.  mp->ctx->kind == MK_FUNCTION &&
  1477.  mp->ctx->varstructflag &&
  1478.  (usePPMacros != 0 || prototypes != 0) &&
  1479.  !strlist_find(varstructdecllist, mp->ctx->name)) {
  1480. output("struct ");
  1481. output(format_s(name_LOC, mp->ctx->name));
  1482. output(" ;n");
  1483. strlist_insert(&varstructdecllist, mp->ctx->name);
  1484.     }
  1485. }
  1486. #endif
  1489. Static void declare_args(type, isheader, isforward)
  1490. Type *type;
  1491. int isheader, isforward;
  1492. {
  1493.     Meaning *mp = type->fbase;
  1494.     Type *tp;
  1495.     int firstflag = 0;
  1496.     int usePP, dopromote, proto, showtypes, shownames;
  1497.     int staticlink;
  1498.     char *name;
  1500. #if 1   /* This seems to work better! */
  1501.     isforward = !isheader;
  1502. #endif
  1503.     usePP = (isforward && usePPMacros != 0);
  1504.     dopromote = (promoteargs == 1 ||
  1505.  (promoteargs < 0 && (usePP || !fullprototyping)));
  1506.     if (ansiC == 1 && blockkind != TOK_EXPORT)
  1507. usePP = 0;
  1508.     if (usePP)
  1509.         proto = (prototypes) ? prototypes : 1;
  1510.     else
  1511.         proto = (isforward || fullprototyping) ? prototypes : 0;
  1512.     showtypes = (proto > 0);
  1513.     shownames = (proto == 1 || isheader);
  1514.     staticlink = (type->issigned ||
  1515.                   (type->meaning &&
  1516.                    type->meaning->ctx->kind == MK_FUNCTION &&
  1517.                    type->meaning->ctx->varstructflag));
  1518.     if (mp || staticlink) {
  1519.         if (usePP)
  1520.             output(" PP(");
  1521.         output("(");
  1522.         if (showtypes || shownames) {
  1523.             firstflag = 0;
  1524.             while (mp) {
  1525.                 if (firstflag++) output(",02 ");
  1526.                 name = (mp->othername && isheader) ? mp->othername : mp->name;
  1527.                 tp = (mp->othername) ? mp->rectype : mp->type;
  1528.                 if (!showtypes) {
  1529.                     output(name);
  1530.                 } else {
  1531.     output(storageclassname(varstorageclass(mp)));
  1532.     if (!shownames || (isforward && *name == '_')) {
  1533. out_type(tp, 1);
  1534.     } else {
  1535. if (dopromote)
  1536.     tp = promote_type(tp);
  1537. outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
  1538. output(" ");
  1539. outdeclarator(tp, name,
  1540.       ODECL_CHARSTAR|ODECL_FREEARRAY);
  1541.     }
  1542. }
  1543.                 if (isheader)
  1544.                     mp->wasdeclared = showtypes;
  1545.                 if (mp->type == tp_strptr && mp->anyvarflag) {     /* VAR STRING parameter */
  1546.                     output(",02 ");
  1547.                     if (showtypes) {
  1548. if (useAnyptrMacros == 1 || useconsts == 2)
  1549.     output("Const ");
  1550. else if (ansiC > 0)
  1551.     output("const ");
  1552.                         output("int");
  1553.     }
  1554.                     if (shownames) {
  1555.                         if (showtypes)
  1556.                             output(" ");
  1557.                         output(format_s(name_STRMAX, mp->name));
  1558.                     }
  1559.                 }
  1560.                 mp = mp->xnext;
  1561.             }
  1562.             if (staticlink) {     /* sub-procedure with static link */
  1563.                 if (firstflag++) output(",02 ");
  1564.                 if (type->issigned) {
  1565.                     if (showtypes)
  1566. if (tp_special_anyptr)
  1567.     output("Anyptr ");
  1568. else if (voidstar)
  1569.     output("void *");
  1570. else
  1571.     output("char *");
  1572.                     if (shownames)
  1573.                         output("_link");
  1574.                 } else {
  1575.                     mp = type->meaning->ctx;
  1576.                     if (showtypes) {
  1577.                         output("struct ");
  1578.                         output(format_s(name_LOC, mp->name));
  1579.                         output(" *");
  1580.                     }
  1581.                     if (shownames) {
  1582.                         output(format_s(name_LINK, mp->name));
  1583.                     }
  1584.                 }
  1585.             }
  1586.         }
  1587.         output(")");
  1588.         if (usePP)
  1589.             output(")");
  1590.     } else {
  1591.         if (usePP)
  1592.             output(" PV()");
  1593.         else if (void_args)
  1594.             output("(void)");
  1595.         else
  1596.             output("()");
  1597.     }
  1598. }
  1602. void outdeclarator(type, name, flags)
  1603. Type *type;
  1604. char *name;
  1605. int flags;
  1606. {
  1607.     int i, depth, anyptrs, anyarrays;
  1608.     Expr *dimen[30];
  1609.     Expr *ex, *maxv;
  1610.     Type *tp, *functype;
  1611.     Expr funcdummy;   /* yow */
  1613.     anyptrs = 0;
  1614.     anyarrays = 0;
  1615.     functype = NULL;
  1616.     for (depth = 0, tp = type; tp; tp = tp->basetype) {
  1617.         switch (tp->kind) {
  1619.             case TK_POINTER:
  1620.                 if (tp->basetype) {
  1621.                     switch (tp->basetype->kind) {
  1623.         case TK_VOID:
  1624.     if (tp->basetype == tp_void &&
  1625. tp_special_anyptr) {
  1626. tp = tp_special_anyptr;
  1627. continue;
  1628.     }
  1629.     break;
  1631.                         case TK_ARRAY:    /* ptr to array of x => ptr to x */
  1632.                         case TK_STRING:   /*                or => array of x */
  1633.                         case TK_SET:
  1634.     if (stararrays == 1 ||
  1635. !(flags & ODECL_FREEARRAY) ||
  1636. (tp->basetype->structdefd &&
  1637.  stararrays != 2)) {
  1638. tp = tp->basetype;
  1639. flags &= ~ODECL_CHARSTAR;
  1640.     } else {
  1641. continue;
  1642.     }
  1643.                             break;
  1645. default:
  1646.     break;
  1647.                     }
  1648.                 }
  1649.                 dimen[depth++] = NULL;
  1650.                 anyptrs++;
  1651.                 continue;
  1653.             case TK_ARRAY:
  1654. flags &= ~ODECL_CHARSTAR;
  1655.                 if (tp->meaning && tp->meaning->kind == MK_TYPE &&
  1656.                     tp->meaning->wasdeclared)
  1657.                     break;
  1658. if (tp->structdefd) {    /* conformant array */
  1659.     if (!variablearrays &&
  1660. !(tp->basetype->kind == TK_ARRAY &&
  1661.   tp->basetype->structdefd))   /* avoid mult. notes */
  1662. note("Conformant array code may not work in all compilers [101]");
  1663. }
  1664.                 ex = arraysize(tp, 1);
  1665.                 if (!ex)
  1666.                     ex = makeexpr_name("", tp_integer);
  1667.                 dimen[depth++] = ex;
  1668. anyarrays++;
  1669.                 continue;
  1671.             case TK_SET:
  1672.                 ord_range_expr(tp->indextype, NULL, &maxv);
  1673.                 maxv = enum_to_int(copyexpr(maxv));
  1674.                 if (ord_type(maxv->val.type)->kind == TK_CHAR)
  1675.                     maxv->val.type = tp_integer;
  1676.                 dimen[depth++] = makeexpr_plus(makeexpr_div(maxv, makeexpr_setbits()),
  1677.                                                makeexpr_long(2));
  1678.                 break;
  1680.             case TK_STRING:
  1681.                 if ((flags & ODECL_CHARSTAR) && stararrays == 1) {
  1682.                     dimen[depth++] = NULL;
  1683.                 } else {
  1684.                     ord_range_expr(tp->indextype, NULL, &maxv);
  1685.                     dimen[depth++] = makeexpr_plus(copyexpr(maxv), makeexpr_long(1));
  1686.                 }
  1687.                 continue;
  1689.             case TK_FILE:
  1690.                 break;
  1692.     case TK_CPROCPTR:
  1693. dimen[depth++] = NULL;
  1694. anyptrs++;
  1695. if (procptrprototypes)
  1696.     continue;
  1697.                 dimen[depth++] = &funcdummy;
  1698. break;
  1700.             case TK_FUNCTION:
  1701.                 dimen[depth++] = &funcdummy;
  1702.                 if (!functype)
  1703.                     functype = tp;
  1704.                 continue;
  1706.     default:
  1707. break;
  1708.         }
  1709.         break;
  1710.     }
  1711.     if (!*name && depth && (spaceexprs > 0 ||
  1712.                             (spaceexprs != 0 && !dimen[depth-1])))
  1713.         output(" ");    /* spacing for abstract declarator */
  1714.     if ((flags & ODECL_FUNCTION) && anyptrs)
  1715.         output(" ");
  1716.     if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
  1717. output("03");
  1718.     for (i = depth; --i >= 0; ) {
  1719.         if (!dimen[i])
  1720.             output("*");
  1721.         if (i > 0 &&
  1722.             ((dimen[i] && !dimen[i-1]) ||
  1723.              (dimen[i-1] && !dimen[i] && extraparens > 0)))
  1724.             output("(");
  1725.     }
  1726.     if (flags & ODECL_FUNCTION)
  1727.         output("n");
  1728.     if (anyarrays > 1 && (flags & ODECL_FUNCTION))
  1729. output("03");
  1730.     output(name);
  1731.     for (i = 0; i < depth; i++) {
  1732.         if (i > 0 &&
  1733.             ((dimen[i] && !dimen[i-1]) ||
  1734.              (dimen[i-1] && !dimen[i] && extraparens > 0)))
  1735.             output(")");
  1736.         if (dimen[i]) {
  1737.             if (dimen[i] == &funcdummy) {
  1738. if (lookback(1) == ')')
  1739.     output("02");
  1740. if (functype)
  1741.     declare_args(functype, (flags & ODECL_HEADER) != 0,
  1742.            (flags & ODECL_FORWARD) != 0);
  1743. else
  1744.     output("()");
  1745.             } else {
  1746. if (lookback(1) == ']')
  1747.     output("02");
  1748.                 output("[");
  1749.                 if (!(flags & ODECL_FREEARRAY) || stararrays == 0 || i > 0)
  1750.                     out_expr(dimen[i]);
  1751.                 freeexpr(dimen[i]);
  1752.                 output("]");
  1753.             }
  1754.         }
  1755.     }
  1756.     if (anyarrays > 1)
  1757. output("04");
  1758. }
  1765. /* Find out if types t1 and t2 will work out to be the same C type,
  1766.    for purposes of type-casting */
  1768. Type *canonicaltype(type)
  1769. Type *type;
  1770. {
  1771.     if (type->kind == TK_SUBR || type->kind == TK_ENUM ||
  1772.         type->kind == TK_PROCPTR)
  1773.         type = findbasetype(type, 0);
  1774.     if (type == tp_char)
  1775.         return tp_ubyte;
  1776.     if (type->kind == TK_POINTER) {
  1777.         if (type->basetype->kind == TK_ARRAY ||
  1778.             type->basetype->kind == TK_STRING ||
  1779.             type->basetype->kind == TK_SET)
  1780.             return makepointertype(canonicaltype(type->basetype->basetype));
  1781.         else if (type->basetype == tp_void)
  1782.             return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
  1783.         else if (type->basetype->kind == TK_FILE)
  1784.             return tp_text;
  1785.         else
  1786.             return makepointertype(canonicaltype(type->basetype));
  1787.     }
  1788.     return type;
  1789. }
  1792. int similartypes(t1, t2)
  1793. Type *t1, *t2;
  1794. {
  1795.     t1 = canonicaltype(t1);
  1796.     t2 = canonicaltype(t2);
  1797.     return (t1 == t2);
  1798. }
  1804. Static int checkstructconst(mp)
  1805. Meaning *mp;
  1806. {
  1807.     return (mp->kind == MK_VAR &&
  1808.     mp->constdefn &&
  1809.             mp->constdefn->kind == EK_CONST &&
  1810.             (mp->constdefn->val.type->kind == TK_ARRAY ||
  1811.              mp->constdefn->val.type->kind == TK_RECORD));
  1812. }
  1815. Static int mixable(mp1, mp2, args, flags)
  1816. Meaning *mp1, *mp2;
  1817. int args, flags;
  1818. {
  1819.     Type *tp1 = mp1->type, *tp2 = mp2->type;
  1821.     if (mixvars == 0)
  1822.         return 0;
  1823.     if (mp1->kind == MK_FIELD &&
  1824.         (mp1->val.i || mp2->val.i) && mixfields == 0)
  1825.         return 0;
  1826.     if (checkstructconst(mp1) || checkstructconst(mp2))
  1827.         return 0;
  1828.     if (mp1->comments) {
  1829. if (findcomment(mp1->comments, CMT_NOT | CMT_PRE, -1))
  1830.     return 0;
  1831.     }
  1832.     if (mp2->comments) {
  1833. if (findcomment(mp2->comments, CMT_PRE, -1))
  1834.     return 0;
  1835.     }
  1836.     if ((mp1->constdefn && (mp1->kind == MK_VAR || mp1->kind == MK_VARREF)) ||
  1837. (mp2->constdefn && (mp2->kind == MK_VAR || mp2->kind == MK_VARREF))) {
  1838.         if (mixinits == 0)
  1839.             return 0;
  1840.         if (mixinits != 1 &&
  1841.             (!mp1->constdefn || !mp2->constdefn))