home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / decl1.c < prev    next >
C/C++ Source or Header  |  1990-03-10  |  29KB  |  1,058 lines
  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.
  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. #define PROTO_DECL1_C
  19. #include "trans.h"
  20.  
  21. #define MAXIMPORTS 100
  22.  
  23. Static struct ptrdesc {
  24.     struct ptrdesc *next;
  25.     Symbol *sym;
  26.     Type *tp;
  27. } *ptrbase;
  28.  
  29. Static struct ctxstack {
  30.     struct ctxstack *next;
  31.     Meaning *ctx, *ctxlast;
  32.     struct tempvarlist *tempvars;
  33.     int tempvarcount, importmark;
  34. } *ctxtop;
  35.  
  36. Static struct tempvarlist {
  37.     struct tempvarlist *next;
  38.     Meaning *tvar;
  39.     int active;
  40. } *tempvars, *stmttempvars;
  41.  
  42. Static int tempvarcount;
  43.  
  44. Static int stringtypecachesize;
  45. Static Type **stringtypecache;
  46.  
  47. Static Meaning *importlist[MAXIMPORTS];
  48. Static int firstimport;
  49.  
  50. Static Type *tp_special_anyptr;
  51.  
  52. Static int wasaliased;
  53. Static int deferallptrs;
  54. Static int anydeferredptrs;
  55. Static int silentalreadydef;
  56. Static int nonloclabelcount;
  57.  
  58. Static Strlist *varstructdecllist;
  59.  
  60. Static Meaning *findstandardmeaning(kind, name)
  61. enum meaningkind kind;
  62. char *name;
  63. {
  64.     Meaning *mp;
  65.     Symbol *sym;
  66.  
  67.     sym = findsymbol(fixpascalname(name));
  68.     for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
  69.     if (mp) {
  70.     if (mp->kind == kind)
  71.         mp->refcount = 1;
  72.     else
  73.         mp = NULL;
  74.     }
  75.     return mp;
  76. }
  77.  
  78.  
  79. Static Meaning *makestandardmeaning(kind, name)
  80. enum meaningkind kind;
  81. char *name;
  82. {
  83.     Meaning *mp;
  84.     Symbol *sym;
  85.  
  86.     sym = findsymbol(fixpascalname(name));
  87.     for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
  88.     if (!mp) {
  89.         mp = addmeaning(sym, kind);
  90.         strchange(&mp->name, stralloc(name));
  91.         if (debug < 4)
  92.             mp->dumped = partialdump;     /* prevent irrelevant dumping */
  93.     } else {
  94.         mp->kind = kind;
  95.     }
  96.     mp->refcount = 1;
  97.     return mp;
  98. }
  99.  
  100.  
  101. Static Type *makestandardtype(kind, mp)
  102. enum typekind kind;
  103. Meaning *mp;
  104. {
  105.     Type *tp;
  106.  
  107.     tp = maketype(kind);
  108.     tp->meaning = mp;
  109.     if (mp)
  110.         mp->type = tp;
  111.     return tp;
  112. }
  113.  
  114.  
  115.  
  116.  
  117. Static Stmt *nullspecialproc(mp)
  118. Meaning *mp;
  119. {
  120.     warning(format_s("Procedure %s not yet supported [118]", mp->name));
  121.     if (curtok == TOK_LPAR)
  122.         skipparens();
  123.     return NULL;
  124. }
  125.  
  126. Meaning *makespecialproc(name, handler)
  127. char *name;
  128. Stmt *(*handler)();
  129. {
  130.     Meaning *mp;
  131.  
  132.     if (!handler)
  133.         handler = nullspecialproc;
  134.     mp = makestandardmeaning(MK_SPECIAL, name);
  135.     mp->handler = (Expr *(*)())handler;
  136.     return mp;
  137. }
  138.  
  139.  
  140.  
  141. Static Stmt *nullstandardproc(ex)
  142. Expr *ex;
  143. {
  144.     warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
  145.     return makestmt_call(ex);
  146. }
  147.  
  148. Meaning *makestandardproc(name, handler)
  149. char *name;
  150. Stmt *(*handler)();
  151. {
  152.     Meaning *mp;
  153.  
  154.     if (!handler)
  155.         handler = nullstandardproc;
  156.     mp = findstandardmeaning(MK_FUNCTION, name);
  157.     if (mp) {
  158.     mp->handler = (Expr *(*)())handler;
  159.     if (mp->isfunction) {
  160.         warning(format_s("Procedure %s was declared as a function [119]", name));
  161.         mp->isfunction = 0;
  162.     }
  163.     } else if (debug > 0)
  164.     warning(format_s("Procedure %s was never declared [120]", name));
  165.     return mp;
  166. }
  167.  
  168.  
  169.  
  170. Static Expr *nullspecialfunc(mp)
  171. Meaning *mp;
  172. {
  173.     warning(format_s("Function %s not yet supported [121]", mp->name));
  174.     if (curtok == TOK_LPAR)
  175.         skipparens();
  176.     return makeexpr_long(0);
  177. }
  178.  
  179. Meaning *makespecialfunc(name, handler)
  180. char *name;
  181. Expr *(*handler)();
  182. {
  183.     Meaning *mp;
  184.  
  185.     if (!handler)
  186.         handler = nullspecialfunc;
  187.     mp = makestandardmeaning(MK_SPECIAL, name);
  188.     mp->isfunction = 1;
  189.     mp->handler = handler;
  190.     return mp;
  191. }
  192.  
  193.  
  194.  
  195. Static Expr *nullstandardfunc(ex)
  196. Expr *ex;
  197. {
  198.     warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
  199.     return ex;
  200. }
  201.  
  202. Meaning *makestandardfunc(name, handler)
  203. char *name;
  204. Expr *(*handler)();
  205. {
  206.     Meaning *mp;
  207.  
  208.     if (!handler)
  209.         handler = nullstandardfunc;
  210.     mp = findstandardmeaning(MK_FUNCTION, name);
  211.     if (mp) {
  212.     mp->handler = handler;
  213.     if (!mp->isfunction) {
  214.         warning(format_s("Function %s was declared as a procedure [122]", name));
  215.         mp->isfunction = 1;
  216.     }
  217.     } else if (debug > 0)
  218.     warning(format_s("Function %s was never declared [123]", name));
  219.     return mp;
  220. }
  221.  
  222.  
  223.  
  224.  
  225. Static Expr *nullspecialvar(mp)
  226. Meaning *mp;
  227. {
  228.     warning(format_s("Variable %s not yet supported [124]", mp->name));
  229.     if (curtok == TOK_LPAR || curtok == TOK_LBR)
  230.         skipparens();
  231.     return makeexpr_var(mp);
  232. }
  233.  
  234. Meaning *makespecialvar(name, handler)
  235. char *name;
  236. Expr *(*handler)();
  237. {
  238.     Meaning *mp;
  239.  
  240.     if (!handler)
  241.         handler = nullspecialvar;
  242.     mp = makestandardmeaning(MK_SPVAR, name);
  243.     mp->handler = handler;
  244.     return mp;
  245. }
  246.  
  247.  
  248.  
  249.  
  250.  
  251. void setup_decl()
  252. {
  253.     Meaning *mp, *mp2, *mp_turbo_shortint;
  254.     Symbol *sym;
  255.     Type *tp;
  256.     int i;
  257.  
  258.     numimports = 0;
  259.     firstimport = 0;
  260.     permimports = NULL;
  261.     stringceiling = stringceiling | 1;   /* round up to odd */
  262.     stringtypecachesize = (stringceiling + 1) >> 1;
  263.     stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
  264.     curctxlast = NULL;
  265.     curctx = NULL;   /* the meta-ctx has no parent ctx */
  266.     curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
  267.     strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
  268.     ptrbase = NULL;
  269.     tempvars = NULL;
  270.     stmttempvars = NULL;
  271.     tempvarcount = 0;
  272.     deferallptrs = 0;
  273.     silentalreadydef = 0;
  274.     varstructdecllist = NULL;
  275.     nonloclabelcount = -1;
  276.     for (i = 0; i < stringtypecachesize; i++)
  277.         stringtypecache[i] = NULL;
  278.  
  279.     tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
  280.                      (integer16) ? "LONGINT" : "INTEGER"));
  281.     tp_integer->smin = makeexpr_long(MININT);             /* "long" */
  282.     tp_integer->smax = makeexpr_long(MAXINT);
  283.  
  284.     if (sizeof_int >= 32) {
  285.         tp_int = tp_integer;                              /* "int" */
  286.     } else {
  287.         tp_int = makestandardtype(TK_INTEGER,
  288.                      (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
  289.                      : NULL);
  290.         tp_int->smin = makeexpr_long(min_sshort);
  291.         tp_int->smax = makeexpr_long(max_sshort);
  292.     }
  293.     mp = makestandardmeaning(MK_TYPE, "C_INT");
  294.     mp->type = tp_int;
  295.     if (!tp_int->meaning)
  296.     tp_int->meaning = mp;
  297.  
  298.     mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
  299.     tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
  300.     tp_unsigned->smin = makeexpr_long(0);                 /* "unsigned long" */
  301.     tp_unsigned->smax = makeexpr_long(MAXINT);
  302.  
  303.     if (sizeof_int >= 32) {
  304.         tp_uint = tp_unsigned;                            /* "unsigned int" */
  305.     mp_uint = mp_unsigned;
  306.     } else {
  307.     mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
  308.         tp_uint = makestandardtype(TK_INTEGER, mp_uint);
  309.         tp_uint->smin = makeexpr_long(0);
  310.         tp_uint->smax = makeexpr_long(MAXINT);
  311.     }
  312.  
  313.     tp_sint = makestandardtype(TK_INTEGER, NULL);
  314.     tp_sint->smin = copyexpr(tp_int->smin);               /* "signed int" */
  315.     tp_sint->smax = copyexpr(tp_int->smax);
  316.  
  317.     tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
  318.     if (unsignedchar == 0) {
  319.     tp_char->smin = makeexpr_long(-128);              /* "char" */
  320.     tp_char->smax = makeexpr_long(127);
  321.     } else {
  322.     tp_char->smin = makeexpr_long(0);
  323.     tp_char->smax = makeexpr_long(255);
  324.     }
  325.  
  326.     tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
  327.     tp_charptr->basetype = tp_char;
  328.     tp_char->pointertype = tp_charptr;
  329.  
  330.     mp_schar = makestandardmeaning(MK_TYPE, "SCHAR");     /* "signed char" */
  331.     tp_schar = makestandardtype(TK_CHAR, mp_schar);
  332.     tp_schar->smin = makeexpr_long(-128);
  333.     tp_schar->smax = makeexpr_long(127);
  334.  
  335.     mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR");     /* "unsigned char" */
  336.     tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
  337.     tp_uchar->smin = makeexpr_long(0);
  338.     tp_uchar->smax = makeexpr_long(255);
  339.  
  340.     tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
  341.     tp_boolean->smin = makeexpr_long(0);                  /* "boolean" */
  342.     tp_boolean->smax = makeexpr_long(1);
  343.  
  344.     sym = findsymbol("Boolean");
  345.     sym->flags |= SSYNONYM;
  346.     strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;
  347.  
  348.     tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
  349.                                                           /* "float" or "double" */
  350.     mp = makestandardmeaning(MK_TYPE, "LONGREAL");
  351.     if (doublereals)
  352.     mp->type = tp_longreal = tp_real;
  353.     else
  354.     tp_longreal = makestandardtype(TK_REAL, mp);
  355.  
  356.     tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */
  357.  
  358.     mp = makestandardmeaning(MK_TYPE, "SINGLE");
  359.     if (doublereals)
  360.     makestandardtype(TK_REAL, mp);
  361.     else
  362.     mp->type = tp_real;
  363.     makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
  364.     mp = makestandardmeaning(MK_TYPE, "DOUBLE");
  365.     mp->type = tp_longreal;
  366.     mp = makestandardmeaning(MK_TYPE, "EXTENDED");
  367.     mp->type = tp_longreal;   /* good enough */
  368.     mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
  369.     mp->type = tp_longreal;   /* good enough */
  370.  
  371.     tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
  372.                   (integer16 == 1) ? "INTEGER" : "SWORD"));
  373.     tp_sshort->basetype = tp_integer;                     /* "short" */
  374.     tp_sshort->smin = makeexpr_long(min_sshort);
  375.     tp_sshort->smax = makeexpr_long(max_sshort);
  376.  
  377.     if (integer16) {
  378.     if (integer16 != 2) {
  379.         mp = makestandardmeaning(MK_TYPE, "SWORD");
  380.         mp->type = tp_sshort;
  381.     }
  382.     } else {
  383.     mp = makestandardmeaning(MK_TYPE, "LONGINT");
  384.     mp->type = tp_integer;
  385.     }
  386.  
  387.     tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
  388.     tp_ushort->basetype = tp_integer;                     /* "unsigned short" */
  389.     tp_ushort->smin = makeexpr_long(0);
  390.     tp_ushort->smax = makeexpr_long(max_ushort);
  391.  
  392.     mp = makestandardmeaning(MK_TYPE, "CARDINAL");
  393.     mp->type = (integer16) ? tp_ushort : tp_unsigned;
  394.     mp = makestandardmeaning(MK_TYPE, "LONGCARD");
  395.     mp->type = tp_unsigned;
  396.  
  397.     if (modula2) {
  398.     mp = makestandardmeaning(MK_TYPE, "WORD");
  399.     mp->type = tp_integer;
  400.     } else {
  401.     makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
  402.     }
  403.  
  404.     tp_sbyte = makestandardtype(TK_SUBR, NULL);           /* "signed char" */
  405.     tp_sbyte->basetype = tp_integer;
  406.     tp_sbyte->smin = makeexpr_long(min_schar);
  407.     tp_sbyte->smax = makeexpr_long(max_schar);
  408.  
  409.     mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
  410.     mp = makestandardmeaning(MK_TYPE, "SBYTE");
  411.     if (needsignedbyte || signedchars == 1 || hassignedchar) {
  412.     mp->type = tp_sbyte;
  413.     if (mp_turbo_shortint)
  414.         mp_turbo_shortint->type = tp_sbyte;
  415.     tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
  416.     } else {
  417.     mp->type = tp_sshort;
  418.     if (mp_turbo_shortint)
  419.         mp_turbo_shortint->type = tp_sshort;
  420.     }
  421.  
  422.     tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
  423.     tp_ubyte->basetype = tp_integer;                      /* "unsigned char" */
  424.     tp_ubyte->smin = makeexpr_long(0);
  425.     tp_ubyte->smax = makeexpr_long(max_uchar);
  426.  
  427.     if (signedchars == 1)
  428.         tp_abyte = tp_sbyte;                              /* "char" */
  429.     else if (signedchars == 0)
  430.         tp_abyte = tp_ubyte;
  431.     else {
  432.         tp_abyte = makestandardtype(TK_SUBR, NULL);
  433.         tp_abyte->basetype = tp_integer;
  434.         tp_abyte->smin = makeexpr_long(0);
  435.         tp_abyte->smax = makeexpr_long(max_schar);
  436.     }
  437.  
  438.     mp = makestandardmeaning(MK_TYPE, "POINTER");
  439.     mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
  440.     tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
  441.     ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
  442.     tp_anyptr->basetype = tp_void;                        /* "void *" */
  443.     tp_void->pointertype = tp_anyptr;
  444.  
  445.     if (useAnyptrMacros == 1) {
  446.         tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
  447.         tp_special_anyptr->basetype = tp_integer;
  448.         tp_special_anyptr->smin = makeexpr_long(0);
  449.         tp_special_anyptr->smax = makeexpr_long(max_schar);
  450.     } else
  451.         tp_special_anyptr = NULL;
  452.  
  453.     tp_proc = maketype(TK_PROCPTR);
  454.     tp_proc->basetype = maketype(TK_FUNCTION);
  455.     tp_proc->basetype->basetype = tp_void;
  456.     tp_proc->escale = 1;   /* saved "hasstaticlinks" */
  457.  
  458.     tp_str255 = makestandardtype(TK_STRING, NULL);             /* "Char []" */
  459.     tp_str255->basetype = tp_char;
  460.     tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
  461.     tp_str255->indextype->basetype = tp_integer;
  462.     tp_str255->indextype->smin = makeexpr_long(0);
  463.     tp_str255->indextype->smax = makeexpr_long(stringceiling);
  464.  
  465.     tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
  466.     tp_str255->pointertype = tp_strptr;
  467.     tp_strptr->basetype = tp_str255;
  468.  
  469.     mp_string = makestandardmeaning(MK_TYPE, "STRING");
  470.     tp = makestandardtype(TK_STRING, mp_string);
  471.     tp->basetype = tp_char;
  472.     tp->indextype = tp_str255->indextype;
  473.  
  474.     tp_smallset = maketype(TK_SMALLSET);
  475.     tp_smallset->basetype = tp_integer;
  476.     tp_smallset->indextype = tp_boolean;
  477.  
  478.     tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
  479.     tp_text->basetype = makestandardtype(TK_FILE, NULL);       /* "FILE *" */
  480.     tp_text->basetype->basetype = tp_char;
  481.     tp_text->basetype->pointertype = tp_text;
  482.  
  483.     tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);
  484.  
  485.     mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
  486.     mp->type = tp_text;
  487.  
  488.     mp = makestandardmeaning(MK_TYPE, "BITSET");
  489.     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  490.                         makeexpr_long(setbits-1)));
  491.     mp->type->meaning = mp;
  492.  
  493.     mp = makestandardmeaning(MK_TYPE, "INTSET");
  494.     mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
  495.                         makeexpr_long(defaultsetsize-1)));
  496.     mp->type->meaning = mp;
  497.  
  498.     mp_input = makestandardmeaning(MK_VAR, "INPUT");
  499.     mp_input->type = tp_text;
  500.     mp_input->name = stralloc("stdin");
  501.     ex_input = makeexpr_var(mp_input);
  502.  
  503.     mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
  504.     mp_output->type = tp_text;
  505.     mp_output->name = stralloc("stdout");
  506.     ex_output = makeexpr_var(mp_output);
  507.  
  508.     mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
  509.     mp_stderr->type = tp_text;
  510.     mp_stderr->name = stralloc("stderr");
  511.  
  512.     mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
  513.     mp_escapecode->type = tp_sshort;
  514.     mp_escapecode->name = stralloc(name_ESCAPECODE);
  515.  
  516.     mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
  517.     mp_ioresult->type = tp_integer;
  518.     mp_ioresult->name = stralloc(name_IORESULT);
  519.  
  520.     mp_false = makestandardmeaning(MK_CONST, "FALSE");
  521.     mp_false->type = mp_false->val.type = tp_boolean;
  522.     mp_false->val.i = 0;
  523.  
  524.     mp_true = makestandardmeaning(MK_CONST, "TRUE");
  525.     mp_true->type = mp_true->val.type = tp_boolean;
  526.     mp_true->val.i = 1;
  527.  
  528.     mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
  529.     mp_maxint->type = mp_maxint->val.type = tp_integer;
  530.     mp_maxint->val.i = MAXINT;
  531.     mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
  532.                                (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");
  533.  
  534.     mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
  535.     mp->type = mp->val.type = tp_integer;
  536.     mp->val.i = MAXINT;
  537.     mp->name = stralloc("LONG_MAX");
  538.  
  539.     mp_minint = makestandardmeaning(MK_CONST, "MININT");
  540.     mp_minint->type = mp_minint->val.type = tp_integer;
  541.     mp_minint->val.i = MININT;
  542.     mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
  543.                                (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");
  544.  
  545.     mp = makestandardmeaning(MK_CONST, "MAXCHAR");
  546.     mp->type = mp->val.type = tp_char;
  547.     mp->val.i = 127;
  548.     mp->name = stralloc("CHAR_MAX");
  549.  
  550.     mp = makestandardmeaning(MK_CONST, "MINCHAR");
  551.     mp->type = mp->val.type = tp_char;
  552.     mp->val.i = 0;
  553.     mp->anyvarflag = 1;
  554.  
  555.     mp = makestandardmeaning(MK_CONST, "BELL");
  556.     mp->type = mp->val.type = tp_char;
  557.     mp->val.i = 7;
  558.     mp->anyvarflag = 1;
  559.  
  560.     mp = makestandardmeaning(MK_CONST, "TAB");
  561.     mp->type = mp->val.type = tp_char;
  562.     mp->val.i = 9;
  563.     mp->anyvarflag = 1;
  564.  
  565.     mp_str_hp = mp_str_turbo = NULL;
  566.     mp_val_modula = mp_val_turbo = NULL;
  567.     mp_blockread_ucsd = mp_blockread_turbo = NULL;
  568.     mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
  569.     mp_dec_dec = mp_dec_turbo = NULL;
  570. }
  571.  
  572.  
  573.  
  574. /* This makes sure that if A imports B and then C, C's interface is not
  575.    parsed in the environment of B */
  576. int push_imports()
  577. {
  578.     int mark = firstimport;
  579.     Meaning *mp;
  580.  
  581.     while (firstimport < numimports) {
  582.     if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
  583.         for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  584.         mp->isactive = 0;
  585.     }
  586.         firstimport++;
  587.     }
  588.     return mark;
  589. }
  590.  
  591.  
  592.  
  593. void pop_imports(mark)
  594. int mark;
  595. {
  596.     Meaning *mp;
  597.  
  598.     while (firstimport > mark) {
  599.         firstimport--;
  600.         for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
  601.             mp->isactive = 1;
  602.     }
  603. }
  604.  
  605.  
  606.  
  607. void import_ctx(ctx)
  608. Meaning *ctx;
  609. {
  610.     Meaning *mp;
  611.     int i;
  612.  
  613.     for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
  614.     if (i >= numimports) {
  615.         if (numimports == MAXIMPORTS)
  616.             error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
  617.         importlist[numimports++] = ctx;
  618.     }
  619.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  620.         if (mp->exported)
  621.             mp->isactive = 1;
  622.     }
  623. }
  624.  
  625.  
  626.  
  627. void perm_import(ctx)
  628. Meaning *ctx;
  629. {
  630.     Meaning *mp;
  631.  
  632.     /* Import permanently, as in Turbo's "system" unit */
  633.     for (mp = ctx->cbase; mp; mp = mp->cnext) {
  634.         if (mp->exported)
  635.             mp->isactive = 1;
  636.     }
  637. }
  638.  
  639.  
  640.  
  641. void unimport(mark)
  642. int mark;
  643. {
  644.     Meaning *mp;
  645.  
  646.     while (numimports > mark) {
  647.         numimports--;
  648.     if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
  649.         for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
  650.         mp->isactive = 0;
  651.     }
  652.     }
  653. }
  654.  
  655.  
  656.  
  657.  
  658. void activatemeaning(mp)
  659. Meaning *mp;
  660. {
  661.     Meaning *mp2;
  662.  
  663.     if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
  664.     mp->isactive = 1;
  665.     if (mp->sym->mbase != mp) {     /* move to front of symbol list */
  666.         mp2 = mp->sym->mbase;
  667.         for (;;) {
  668.             if (!mp2) {
  669.         /* Not on symbol list: must be a special kludge meaning */
  670.                 return;
  671.             }
  672.             if (mp2->snext == mp)
  673.                 break;
  674.             mp2 = mp2->snext;
  675.         }
  676.         mp2->snext = mp->snext;
  677.         mp->snext = mp->sym->mbase;
  678.         mp->sym->mbase = mp;
  679.     }
  680. }
  681.  
  682.  
  683.  
  684. void pushctx(ctx)
  685. Meaning *ctx;
  686. {
  687.     struct ctxstack *top;
  688.  
  689.     top = ALLOC(1, struct ctxstack, ctxstacks);
  690.     top->ctx = curctx;
  691.     top->ctxlast = curctxlast;
  692.     top->tempvars = tempvars;
  693.     top->tempvarcount = tempvarcount;
  694.     top->importmark = numimports;
  695.     top->next = ctxtop;
  696.     ctxtop = top;
  697.     curctx = ctx;
  698.     curctxlast = ctx->cbase;
  699.     if (curctxlast) {
  700.         activatemeaning(curctxlast);
  701.         while (curctxlast->cnext) {
  702.             curctxlast = curctxlast->cnext;
  703.             activatemeaning(curctxlast);
  704.         }
  705.     }
  706.     tempvars = NULL;
  707.     tempvarcount = 0;
  708.     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  709.     progress();
  710. }
  711.  
  712.  
  713.  
  714. void popctx()
  715. {
  716.     struct ctxstack *top;
  717.     struct tempvarlist *tv;
  718.     Meaning *mp;
  719.  
  720.     if (!strlist_cifind(permimports, curctx->sym->name)) {
  721.     for (mp = curctx->cbase; mp; mp = mp->cnext) {
  722.         if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
  723.         mp->isactive = 0;
  724.     }
  725.     }
  726.     top = ctxtop;
  727.     ctxtop = top->next;
  728.     curctx = top->ctx;
  729.     curctxlast = top->ctxlast;
  730.     while (tempvars) {
  731.         tv = tempvars->next;
  732.         FREE(tempvars);
  733.         tempvars = tv;
  734.     }
  735.     tempvars = top->tempvars;
  736.     tempvarcount = top->tempvarcount;
  737.     unimport(top->importmark);
  738.     FREE(top);
  739.     if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
  740.     progress();
  741. }
  742.  
  743.  
  744.  
  745. void forget_ctx(ctx, all)
  746. Meaning *ctx;
  747. int all;
  748. {
  749.     register Meaning *mp, **mpprev, *mp2, **mpp2;
  750.  
  751.     if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
  752.     mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
  753.     else
  754.     mpprev = &ctx->cbase;
  755.     while ((mp = *mpprev) != NULL) {
  756.     if (all ||
  757.         (mp->kind != MK_PARAM &&
  758.          mp->kind != MK_VARPARAM)) {
  759.         *mpprev = mp->cnext;
  760.         mpp2 = &mp->sym->mbase;
  761.         while ((mp2 = *mpp2) != NULL && mp2 != mp)
  762.         mpp2 = &mp2->snext;
  763.         if (mp2)
  764.         *mpp2 = mp2->snext;
  765.         if (mp->kind == MK_CONST)
  766.         free_value(&mp->val);
  767.         freeexpr(mp->constdefn);
  768.         if (mp->cbase)
  769.         forget_ctx(mp, 1);
  770.         if (mp->kind == MK_FUNCTION && mp->val.i)
  771.         free_stmt((Stmt *)mp->val.i);
  772.         strlist_empty(&mp->comments);
  773.         if (mp->name)
  774.         FREE(mp->name);
  775.         if (mp->othername)
  776.         FREE(mp->othername);
  777.         FREE(mp);
  778.     } else
  779.         mpprev = &mp->cnext;
  780.     }
  781. }
  782.  
  783.  
  784.  
  785.  
  786. void handle_nameof()
  787. {
  788.     Strlist *sl, *sl2;
  789.     Symbol *sp;
  790.     char *cp;
  791.  
  792.     for (sl = nameoflist; sl; sl = sl->next) {
  793.         cp = my_strchr(sl->s, '.');
  794.         if (cp) {
  795.             sp = findsymbol(fixpascalname(cp + 1));
  796.             sl2 = strlist_add(&sp->symbolnames, 
  797.                               format_ds("%.*s", (int)(cp - sl->s), sl->s));
  798.         } else {
  799.             sp = findsymbol(fixpascalname(sl->s));
  800.             sl2 = strlist_add(&sp->symbolnames, "");
  801.         }
  802.         sl2->value = sl->value;
  803.         if (debug > 0)
  804.             fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
  805.                           sp->name, sl2->s, sl2->value);
  806.     }
  807.     strlist_empty(&nameoflist);
  808. }
  809.  
  810.  
  811.  
  812. Static void initmeaning(mp)
  813. Meaning *mp;
  814. {
  815. /*    mp->serial = curserial = ++serialcount;    */
  816.     mp->cbase = NULL;
  817.     mp->xnext = NULL;
  818.     mp->othername = NULL;
  819.     mp->type = NULL;
  820.     mp->needvarstruct = 0;
  821.     mp->varstructflag = 0;
  822.     mp->wasdeclared = 0;
  823.     mp->isforward = 0;
  824.     mp->isfunction = 0;
  825.     mp->istemporary = 0;
  826.     mp->volatilequal = 0;
  827.     mp->constqual = 0;
  828.     mp->warnifused = (warnnames > 0);
  829.     mp->constdefn = NULL;
  830.     mp->val.i = 0;
  831.     mp->val.s = NULL;
  832.     mp->val.type = NULL;
  833.     mp->refcount = 1;
  834.     mp->anyvarflag = 0;
  835.     mp->isactive = 1;
  836.     mp->exported = 0;
  837.     mp->handler = NULL;
  838.     mp->dumped = 0;
  839.     mp->isreturn = 0;
  840.     mp->fakeparam = 0;
  841.     mp->namedfile = 0;
  842.     mp->bufferedfile = 0;
  843.     mp->comments = NULL;
  844. }
  845.  
  846.  
  847.  
  848. int issafename(sp, isglobal, isdefine)
  849. Symbol *sp;
  850. int isglobal, isdefine;
  851. {
  852.     if (isdefine && curctx->kind != MK_FUNCTION) {
  853.     if (sp->flags & FWDPARAM)
  854.         return 0;
  855.     }
  856.     if ((sp->flags & AVOIDNAME) ||
  857.     (isdefine && (sp->flags & AVOIDFIELD)) ||
  858.         (isglobal && (sp->flags & AVOIDGLOB)))
  859.         return 0;
  860.     else
  861.         return 1;
  862. }
  863.  
  864. Meaning *enum_tname;
  865.  
  866. void setupmeaning(mp, sym, kind, namekind)
  867. Meaning *mp;
  868. Symbol *sym;
  869. enum meaningkind kind, namekind;
  870. {
  871.     char *name, *symfmt, *editfmt, *cp, *cp2;
  872.     int altnum, isglobal, isdefine;
  873.     Symbol *sym2;
  874.     Strlist *sl;
  875.  
  876.     if (!sym)
  877.     sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
  878.     if (sym->mbase && sym->mbase->ctx == curctx &&
  879.     curctx != NULL && !silentalreadydef)
  880.         alreadydef(sym);
  881.     mp->sym = sym;
  882.     mp->snext = sym->mbase;
  883.     sym->mbase = mp;
  884.     if (sym == curtoksym) {
  885.     sym->kwtok = TOK_NONE;
  886.     sym->flags &= ~KWPOSS;
  887.     }
  888.     mp->ctx = curctx;
  889.     mp->kind = kind;
  890.     if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
  891.     strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
  892.     Meaning *mp2;
  893.     if (islower(sym->name[0]))
  894.         sym2 = findsymbol(strupper(sym->name));
  895.     else
  896.         sym2 = findsymbol(strlower(sym->name));
  897.     mp2 = addmeaning(sym2, MK_SYNONYM);
  898.     mp2->xnext = mp;
  899.     }
  900.     if (kind == MK_VAR) {
  901.         sl = strlist_find(varmacros, sym->name);
  902.         if (sl) {
  903.             kind = namekind = MK_VARMAC;
  904.             mp->constdefn = (Expr *)sl->value;
  905.             strlist_delete(&varmacros, sl);
  906.         }
  907.     }
  908.     if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
  909.         sl = strlist_find(funcmacros, sym->name);
  910.         if (sl) {
  911.             mp->constdefn = (Expr *)sl->value;
  912.             strlist_delete(&funcmacros, sl);
  913.         }
  914.     }
  915.     if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
  916.     kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
  917.         mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
  918.     if (blockkind == TOK_IMPORT)
  919.         mp->wasdeclared = 1;   /* suppress future declaration */
  920.     } else
  921.         mp->exported = 0;
  922.     if (sym == curtoksym)
  923.         name = curtokcase;
  924.     else
  925.         name = sym->name;
  926.     isdefine = (namekind == MK_CONST);
  927.     isglobal = (!curctx ||
  928.         curctx->kind != MK_FUNCTION ||
  929.                 namekind == MK_FUNCTION ||
  930.         namekind == MK_TYPE ||
  931.                 isdefine) &&
  932.                (curctx != nullctx);
  933.     mp->refcount = isglobal ? 1 : 0;   /* make sure globals don't disappear */
  934.     if (namekind == MK_SYNONYM)
  935.     return;
  936.     if (!mp->exported || !*exportsymbol)
  937.         symfmt = "";
  938.     else if (*export_symbol && my_strchr(name, '_'))
  939.         symfmt = export_symbol;
  940.     else
  941.         symfmt = exportsymbol;
  942.     wasaliased = 0;
  943.     if (*externalias && !my_strchr(externalias, '%')) {
  944.         register int i;
  945.         name = format_s("%s", externalias);
  946.         i = numparams;
  947.         while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
  948.         if (i < 0 || !undooption(i, ""))
  949.             *externalias = 0;
  950.         wasaliased = 1;
  951.     } else if (sym->symbolnames) {
  952.         if (curctx) {
  953.             if (debug > 2)
  954.                 fprintf(outf, "checking for \"%s\" of %s\n", curctx->name, sym->name);
  955.             sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
  956.             if (sl) {
  957.                 if (debug > 2)
  958.                     fprintf(outf, "found \"%s\"\n", sl->value);
  959.                 name = (char *)sl->value;
  960.                 wasaliased = 1;
  961.             }
  962.         }
  963.         if (!wasaliased) {
  964.             if (debug > 2)
  965.                 fprintf(outf, "checking for \"\" of %s\n", sym->name);
  966.             sl = strlist_find(sym->symbolnames, "");
  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.     }
  975.     if (!*symfmt || wasaliased)
  976.     symfmt = "%s";
  977.     altnum = -1;
  978.     do {
  979.         altnum++;
  980.         cp = format_ss(symfmt, name, curctx ? curctx->name : "");
  981.     switch (namekind) {
  982.  
  983.       case MK_CONST:
  984.         editfmt = constformat;
  985.         break;
  986.  
  987.       case MK_MODULE:
  988.         editfmt = moduleformat;
  989.         break;
  990.  
  991.       case MK_FUNCTION:
  992.         editfmt = functionformat;
  993.         break;
  994.  
  995.       case MK_VAR:
  996.       case MK_VARPARAM:
  997.       case MK_VARREF:
  998.       case MK_VARMAC:
  999.       case MK_SPVAR:
  1000.         editfmt = varformat;
  1001.         break;
  1002.  
  1003.       case MK_TYPE:
  1004.         editfmt = typeformat;
  1005.         break;
  1006.  
  1007.       case MK_VARIANT:   /* A true kludge! */
  1008.         editfmt = enumformat;
  1009.         break;
  1010.  
  1011.       default:
  1012.         editfmt = "";
  1013.     }
  1014.     if (!*editfmt)
  1015.         editfmt = symbolformat;
  1016.     if (*editfmt)
  1017.         if (editfmt == enumformat)
  1018.         cp = format_ss(editfmt, cp,
  1019.                    enum_tname ? enum_tname->name : "ENUM");
  1020.         else
  1021.         cp = format_ss(editfmt, cp,
  1022.                    curctx ? curctx->name : "");
  1023.     if (dollar_idents == 2) {
  1024.         for (cp2 = cp; *cp2; cp2++)
  1025.         if (*cp2 == '$' || *cp2 == '%')
  1026.             *cp2 = '_';
  1027.     }
  1028.         sym2 = findsymbol(findaltname(cp, altnum));
  1029.     } while (!issafename(sym2, isglobal, isdefine) &&
  1030.          namekind != MK_MODULE && !wasaliased);
  1031.     mp->name = stralloc(sym2->name);
  1032.     if (sym2->flags & WARNNAME)
  1033.         note(format_s("A symbol named %s was defined [100]", mp->name));
  1034.     if (isglobal) {
  1035.         switch (namekind) {     /* prevent further name conflicts */
  1036.  
  1037.             case MK_CONST:
  1038.         case MK_VARIANT:
  1039.             case MK_TYPE:
  1040.                 sym2->flags |= AVOIDNAME;
  1041.                 break;
  1042.  
  1043.             case MK_VAR:
  1044.             case MK_VARREF:
  1045.             case MK_FUNCTION:
  1046.                 sym2->flags |= AVOIDGLOB;
  1047.                 break;
  1048.  
  1049.         default:
  1050.         /* name is completely local */
  1051.         break;
  1052.         }
  1053.     }
  1054.     if (debug > 4)
  1055.     fprintf(outf, "Created meaning %s\n", mp->name);
  1056. }
  1057.  
  1058.