lang/cem/cemcom/stack.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  */
   5 /* $Id: stack.c,v 3.24 1994/06/24 12:06:05 ceriel Exp $ */
   6 /*      S T A C K / U N S T A C K  R O U T I N E S      */
   7
   8 #include        "lint.h"
   9 #include        "nofloat.h"
  10 #include        <system.h>
  11 #ifndef LINT
  12 #include        <em.h>
  13 #else
  14 #include        "l_em.h"
  15 #endif  /* LINT */
  16 #include        "debug.h"
  17 #include        "botch_free.h"
  18 #include        <alloc.h>
  19 #include        "Lpars.h"
  20 #include        "arith.h"
  21 #include        "stack.h"
  22 #include        "type.h"
  23 #include        "idf.h"
  24 #include        "def.h"
  25 #include        "struct.h"
  26 #include        "level.h"
  27 #include        "mes.h"
  28 #include        "noRoption.h"
  29
  30 extern char options[];
  31
  32 static struct stack_level UniversalLevel;
  33 struct stack_level *local_level = &UniversalLevel;
  34 /*      The main reason for having this secondary stacking
  35         mechanism besides the linked lists pointed to by the idf's
  36         is efficiency.
  37         To remove the idf's of a given level, one could scan the
  38         hash table and chase down the idf chains; with a hash
  39         table size of 100 this is feasible, but with a size of say
  40         100000 this becomes painful. Therefore all idf's are also
  41         kept in a stack of sets, one set for each level.
  42 */
  43
  44 int level;      /* Always equal to local_level->sl_level. */
  45
  46 stack_level()   {
  47         /*      A new level is added on top of the identifier stack.
  48         */
  49         register struct stack_level *stl = new_stack_level();
  50         register struct stack_level *loclev = local_level;
  51
  52         loclev->sl_next = stl;
  53         stl->sl_previous = loclev;
  54         stl->sl_level = ++level;
  55         stl->sl_max_block = loclev->sl_max_block;
  56         local_level = stl;
  57 #ifdef  LINT
  58         lint_start_local();
  59 #endif  /* LINT */
  60 }
  61
  62 stack_idf(idf, stl)
  63         struct idf *idf;
  64         register struct stack_level *stl;
  65 {
  66         /*      The identifier idf is inserted in the stack on level stl.
  67         */
  68         register struct stack_entry *se = new_stack_entry();
  69
  70         /* link it into the stack level */
  71         se->next = stl->sl_entry;
  72         se->se_idf = idf;
  73         stl->sl_entry = se;
  74 }
  75
  76 struct stack_level *
  77 stack_level_of(lvl)
  78 {
  79         /*      The stack_level corresponding to level lvl is returned.
  80                 The stack should probably be an array, to be extended with
  81                 realloc where needed.
  82         */
  83         register struct stack_level *stl;
  84
  85         if (lvl == level)
  86                 return local_level;
  87         stl = &UniversalLevel;
  88
  89         while (stl->sl_level != lvl)
  90                 stl = stl->sl_next;
  91         return stl;
  92 }
  93
  94 unstack_level()
  95 {
  96         /*      The top level of the identifier stack is removed.
  97         */
  98         struct stack_level *lastlvl;
  99
 100 #ifdef  DEBUG
 101         if (options['t'])
 102                 dumpidftab("before unstackidfs", 0);
 103 #endif  /* DEBUG */
 104
 105 #ifdef  LINT
 106         lint_end_local(local_level);
 107 #endif  /* LINT */
 108
 109         /*      The implementation below is more careful than strictly
 110                 necessary. Optimists may optimize it afterwards.
 111         */
 112         while (local_level->sl_entry)   {
 113                 register struct stack_entry *se = local_level->sl_entry;
 114                 register struct idf *idf = se->se_idf;
 115                 register struct def *def;
 116                 register struct sdef *sdef;
 117                 register struct tag *tag;
 118
 119                 /* unlink it from the local stack level */
 120                 local_level->sl_entry = se->next;
 121                 free_stack_entry(se);
 122
 123                 while ((def = idf->id_def) && def->df_level >= level)   {
 124                         /* unlink it from the def list under the idf block */
 125                         if (def->df_sc == LABEL)
 126                                 unstack_label(idf);
 127                         else if (def->df_sc == REGISTER || def->df_sc == AUTO)
 128                                 FreeLocal(def->df_address);
 129                         idf->id_def = def->next;
 130                         free_def(def);
 131                         update_ahead(idf);
 132                 }
 133                 while ( (sdef = idf->id_sdef)
 134                 &&      sdef->sd_level >= level
 135                 )       {
 136                         /* unlink it from the sdef list under the idf block */
 137                         idf->id_sdef = sdef->next;
 138                         free_sdef(sdef);
 139                 }
 140                 while ( (tag = idf->id_struct)
 141                 &&      tag->tg_level >= level
 142                 )       {
 143                         /* unlink it from the struct list under the idf block */
 144                         idf->id_struct = tag->next;
 145                         free_tag(tag);
 146                 }
 147                 while ((tag = idf->id_enum) && tag->tg_level >= level)  {
 148                         /* unlink it from the enum list under the idf block */
 149                         idf->id_enum = tag->next;
 150                         free_tag(tag);
 151                 }
 152         }
 153         /*      Unlink the local stack level from the stack.
 154         */
 155         lastlvl = local_level;
 156         local_level = local_level->sl_previous;
 157         if (level >= L_LOCAL)   {
 158                 local_level->sl_max_block = lastlvl->sl_max_block;
 159         }
 160         free_stack_level(lastlvl);
 161         local_level->sl_next = (struct stack_level *) 0;
 162         level = local_level->sl_level;
 163
 164 #ifdef  DEBUG
 165         if (options['t'])
 166                 dumpidftab("after unstackidfs", 0);
 167 #endif  /* DEBUG */
 168 }
 169
 170 unstack_world()
 171 {
 172         /*      The global level of identifiers is scanned, and final
 173                 decisions are taken about such issues as
 174                 extern/static/global and un/initialized.
 175                 Effects on the code generator: initialised variables
 176                 have already been encoded while the uninitialised ones
 177                 are not and have to be encoded at this moment.
 178         */
 179         register struct stack_entry *se = local_level->sl_entry;
 180
 181 #ifdef  LINT
 182         lint_end_global(local_level);
 183 #endif  /* LINT */
 184
 185         open_name_list();
 186
 187         while (se)      {
 188                 register struct idf *idf = se->se_idf;
 189                 register struct def *def = idf->id_def;
 190
 191                 if (!def)       {
 192                         /* global selectors, etc. */
 193                         se = se->next;
 194                         continue;
 195                 }
 196
 197 #ifdef DEBUG
 198                 if (options['a']) {
 199                         char *symbol2str();
 200
 201                         print("\"%s\", %s, %s, %s, %s\n",
 202                                 idf->id_text,
 203                                 (def->df_alloc == 0) ? "no alloc" :
 204                                 (def->df_alloc == ALLOC_SEEN) ? "alloc seen" :
 205                                 (def->df_alloc == ALLOC_DONE) ? "alloc done" :
 206                                 "illegal alloc info",
 207                                 symbol2str(def->df_sc),
 208                                 def->df_initialized ? "init" : "no init",
 209                                 def->df_used ? "used" : "not used");
 210                 }
 211 #endif /* DEBUG */
 212                 /*
 213                 /_* find final storage class *_/
 214                 if (def->df_sc == GLOBAL || def->df_sc == IMPLICIT)
 215                         /_* even now we still don't know *_/
 216                         def->df_sc = EXTERN;
 217                 */
 218
 219                 if (    def->df_sc == STATIC
 220                         && def->df_type->tp_fund == FUNCTION
 221                         && !def->df_initialized
 222                 )       {
 223                         /* orphaned static function */
 224 #ifndef NOROPTION
 225                         if (options['R'])
 226                                 warning("static function %s never defined, %s",
 227                                         idf->id_text,
 228                                         "changed to extern"
 229                                 );
 230 #endif
 231                         def->df_sc = EXTERN;
 232                 }
 233
 234                 if (
 235                         def->df_alloc == ALLOC_SEEN &&
 236                         !def->df_initialized
 237                 )       {
 238                         /* space must be allocated */
 239                         bss(idf);
 240                         if (def->df_sc != STATIC)
 241                                 namelist(idf->id_text); /* may be common */
 242                         def->df_alloc = ALLOC_DONE;     /* see Note below */
 243                 }
 244                 se = se->next;
 245         }
 246         /*      Note:
 247                 df_alloc must be set to ALLOC_DONE because the idf entry
 248                 may occur several times in the list.
 249                 The reason for this is that the same name may be used
 250                 for different purposes on the same level, e.g.
 251                         struct s {int s;} s;
 252                 is a legal definition and contains 3 defining occurrences
 253                 of s.
 254                 Each definition has been entered into the identifier stack.
 255                 Although only one of them concerns a variable, we meet the
 256                 s 3 times when scanning the identifier stack.
 257         */
 258 }
 259
 260 /*      A list of potential common names is kept, to be fed to
 261         an understanding loader.  The list is written to a file
 262         the name of which is nmlist.  If nmlist == NULL, no name
 263         list is generated.
 264 */
 265 extern char *nmlist;    /* BAH! -- main.c       */
 266 static File *nfp = 0;
 267
 268 open_name_list()
 269 {
 270         if (nmlist && sys_open(nmlist, OP_WRITE, &nfp) == 0)
 271                 fatal("cannot create namelist %s", nmlist);
 272 }
 273
 274 namelist(nm)
 275         char *nm;
 276 {
 277         if (nmlist)     {
 278                 sys_write(nfp, nm, strlen(nm));
 279                 sys_write(nfp, "\n", 1);
 280         }
 281 }