src/symbols.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "symbols" :  The symbols table; creating stock of reserved words        */
   3 /*                                                                           */
   4 /*   Part of Inform 6.42                                                     */
   5 /*   copyright (c) Graham Nelson 1993 - 2024                                 */
   6 /*                                                                           */
   7 /* Inform is free software: you can redistribute it and/or modify            */
   8 /* it under the terms of the GNU General Public License as published by      */
   9 /* the Free Software Foundation, either version 3 of the License, or         */
  10 /* (at your option) any later version.                                       */
  11 /*                                                                           */
  12 /* Inform is distributed in the hope that it will be useful,                 */
  13 /* but WITHOUT ANY WARRANTY; without even the implied warranty of            */
  14 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the              */
  15 /* GNU General Public License for more details.                              */
  16 /*                                                                           */
  17 /* You should have received a copy of the GNU General Public License         */
  18 /* along with Inform. If not, see https://gnu.org/licenses/                  */
  19 /*                                                                           */
  20 /* ------------------------------------------------------------------------- */
  21
  22 #include "header.h"
  23
  24 /* ------------------------------------------------------------------------- */
  25 /*   This section of Inform is a service detached from the rest.             */
  26 /*   Only two variables are accessible from the outside:                     */
  27 /* ------------------------------------------------------------------------- */
  28
  29 int no_symbols;                        /* Total number of symbols defined    */
  30 int no_named_constants;                         /* Copied into story file    */
  31
  32 /* ------------------------------------------------------------------------- */
  33 /*   Plus an array of symbolinfo.  Each symbol has its own index n (an       */
  34 /*   int32) in the array. The struct there contains:                         */
  35 /*                                                                           */
  36 /*       value   is its value. In Z-code, this holds both the 16-bit value   */
  37 /*                  and the 16-bit backpatch marker, so it is an int32.      */
  38 /*       marker   is the backpatch marker in Glulx.                          */
  39 /*       flags  holds flags (see "header.h" for a list of ?_SFLAGS)          */
  40 /*       type  is the "type", distinguishing between the data type of        */
  41 /*                  different kinds of constants/variables.                  */
  42 /*                  (A ?_T constant; see the "typename()" below.)            */
  43 /*       name   is the name of the symbol, in the same case form as          */
  44 /*                  when created.                                            */
  45 /*       line  is the source line on which the symbol value was first        */
  46 /*                  assigned                                                 */
  47 /*       next_entry  is the forward link in the symbol hash table. (See      */
  48 /*                  start_of_list, below.)                                   */
  49 /*                                                                           */
  50 /*   When generating a debug file (-k switch), we also allocate an array     */
  51 /*   of symboldebuginfo, which contains:                                     */
  52 /*                                                                           */
  53 /*       backpatch_pos                                                       */
  54 /*                  is a file position in the debug information file where   */
  55 /*                  the symbol's value should be written after backpatching, */
  56 /*                  or else the null position if the value was known and     */
  57 /*                  written beforehand                                       */
  58 /*       replacement_backpatch_pos                                           */
  59 /*                  is a file position in the debug information file where   */
  60 /*                  the symbol's name can be erased if it is replaced, or    */
  61 /*                  else null if the name will never need to be replaced     */
  62 /*                                                                           */
  63 /*   Comparison is case insensitive.                                         */
  64 /*   Note that local variable names are not entered into the symbols table,  */
  65 /*   as their numbers and scope are too limited for this to be efficient.    */
  66 /* ------------------------------------------------------------------------- */
  67
  68 symbolinfo *symbols;                           /* Allocated up to no_symbols */
  69 static memory_list symbols_memlist;
  70 symboldebuginfo *symbol_debug_info;            /* Allocated up to no_symbols */
  71 static memory_list symbol_debug_info_memlist;
  72 static char *temp_symbol_buf;        /* used in write_the_identifier_names() */
  73 static memory_list temp_symbol_buf_memlist;
  74
  75 /* ------------------------------------------------------------------------- */
  76 /*   Memory to hold the text of symbol names: note that this memory is       */
  77 /*   allocated as needed in chunks of size SYMBOLS_CHUNK_SIZE. (Or           */
  78 /*   larger, if needed for a particularly enormous symbol.)                  */
  79 /* ------------------------------------------------------------------------- */
  80
  81 #define SYMBOLS_CHUNK_SIZE (4096)
  82
  83 static char *symbols_free_space,        /* Next byte free to hold new names  */
  84            *symbols_ceiling;            /* Pointer to the end of the current
  85                                            allocation of memory for names    */
  86
  87 static char** symbol_name_space_chunks; /* For chunks of memory used to hold
  88                                            the name strings of symbols       */
  89 static int no_symbol_name_space_chunks;
  90 static memory_list symbol_name_space_chunks_memlist;
  91
  92 /* Symbol replacements (used by the "Replace X Y" directive). */
  93
  94 typedef struct value_pair_struct {
  95     int original_symbol;
  96     int renamed_symbol;
  97 } value_pair_t;
  98 static value_pair_t *symbol_replacements;
  99 static int symbol_replacements_count;
 100 static int symbol_replacements_size; /* calloced size */
 101
 102 /* Symbol definitions requested at compile time. (There may not be any.)
 103    These are set up at command-line parse time, not in init_symbols_vars().
 104    Similarly, they are not cleaned up by symbols_free_arrays(). */
 105
 106 typedef struct keyvalue_pair_struct {
 107     char *symbol;
 108     int32 value;
 109 } keyvalue_pair_t;
 110 static keyvalue_pair_t *symbol_definitions = NULL;
 111 static int symbol_definitions_count = 0;
 112 static int symbol_definitions_size = 0; /* calloced size */
 113
 114 /* ------------------------------------------------------------------------- */
 115 /*   The symbols table is "hash-coded" into a disjoint union of linked       */
 116 /*   lists, so that for any symbol i, next_entry[i] is either -1 (meaning    */
 117 /*   that it's the last in its list) or the next in the list.                */
 118 /*                                                                           */
 119 /*   Each list contains, in alphabetical order, all the symbols which share  */
 120 /*   the same "hash code" (a numerical function of the text of the symbol    */
 121 /*   name, designed with the aim that roughly equal numbers of symbols are   */
 122 /*   given each possible hash code).  The hash codes are 0 to HASH_TAB_SIZE  */
 123 /*   (which is a memory setting) minus 1: start_of_list[h] gives the first   */
 124 /*   symbol with hash code h, or -1 if no symbol exists with hash code h.    */
 125 /*                                                                           */
 126 /*   Note that the running time of the symbol search algorithm is about      */
 127 /*                                                                           */
 128 /*       O ( n^2 / HASH_TAB_SIZE )                                           */
 129 /*                                                                           */
 130 /*   (where n is the number of symbols in the program) so that it is a good  */
 131 /*   idea to choose HASH_TAB_SIZE as large as conveniently possible.         */
 132 /* ------------------------------------------------------------------------- */
 133
 134 static int32 *start_of_list; /* Allocated array of size HASH_TAB_SIZE */
 135 /* The next_entry field is part of the symbolinfo struct. */
 136
 137 /* ------------------------------------------------------------------------- */
 138 /*   Initialisation.                                                         */
 139 /* ------------------------------------------------------------------------- */
 140
 141 static void init_symbol_banks(void)
 142 {   int i;
 143     for (i=0; i<HASH_TAB_SIZE; i++) start_of_list[i] = -1;
 144 }
 145
 146 /* ------------------------------------------------------------------------- */
 147 /*   The hash coding we use is quite standard; the variable hashcode is      */
 148 /*   expected to overflow a good deal.  (The aim is to produce a number      */
 149 /*   so that similar names do not produce the same number.)  Note that       */
 150 /*   30011 is prime.  It doesn't matter if the unsigned int to int cast      */
 151 /*   behaves differently on different ports.                                 */
 152 /* ------------------------------------------------------------------------- */
 153
 154 int case_conversion_grid[128];
 155
 156 static void make_case_conversion_grid(void)
 157 {
 158     /*  Assumes that A to Z are contiguous in the host OS character set:
 159         true for ASCII but not for EBCDIC, for instance.                     */
 160
 161     int i;
 162     for (i=0; i<128; i++) case_conversion_grid[i] = i;
 163     for (i=0; i<26; i++) case_conversion_grid['A'+i]='a'+i;
 164 }
 165
 166 extern int hash_code_from_string(char *p)
 167 {   uint32 hashcode=0;
 168     for (; *p; p++) hashcode=hashcode*30011 + case_conversion_grid[(uchar)*p];
 169     return (int) (hashcode % HASH_TAB_SIZE);
 170 }
 171
 172 extern int strcmpcis(char *p, char *q)
 173 {
 174     /*  Case insensitive strcmp  */
 175
 176     int i, j, pc, qc;
 177     for (i=0;p[i] != 0;i++)
 178     {   pc = p[i]; if (isupper(pc)) pc = tolower(pc);
 179         qc = q[i]; if (isupper(qc)) qc = tolower(qc);
 180         j = pc - qc;
 181         if (j!=0) return j;
 182     }
 183     qc = q[i]; if (isupper(qc)) qc = tolower(qc);
 184     return -qc;
 185 }
 186
 187 /* ------------------------------------------------------------------------- */
 188
 189 extern void add_config_symbol_definition(char *symbol, int32 value)
 190 {   char *str;
 191
 192     if (symbol_definitions_count == symbol_definitions_size) {
 193         int oldsize = symbol_definitions_size;
 194         if (symbol_definitions_size == 0)
 195             symbol_definitions_size = 4;
 196         else
 197             symbol_definitions_size *= 2;
 198         my_recalloc(&symbol_definitions, sizeof(keyvalue_pair_t), oldsize,
 199             symbol_definitions_size, "symbol definition table");
 200     }
 201
 202     str = my_malloc(strlen(symbol)+1, "symbol name");
 203     strcpy(str, symbol);
 204
 205     symbol_definitions[symbol_definitions_count].symbol = str;
 206     symbol_definitions[symbol_definitions_count].value = value;
 207     symbol_definitions_count++;
 208 }
 209
 210 /* ------------------------------------------------------------------------- */
 211 /*   Symbol finding, creating, and removing.                                 */
 212 /* ------------------------------------------------------------------------- */
 213
 214 extern int get_symbol_index(char *p)
 215 {
 216     /*  Return the index in the symbols array of symbol "p", or -1
 217         if it isn't there. Does not create a new symbol or mark the
 218         symbol as used. */
 219
 220     int32 new_entry, this;
 221     char *r;
 222     int hashcode = hash_code_from_string(p);
 223
 224     this = start_of_list[hashcode];
 225
 226     do
 227     {   if (this == -1) break;
 228
 229         r = symbols[this].name;
 230         new_entry = strcmpcis(r, p);
 231         if (new_entry == 0)
 232         {
 233             return this;
 234         }
 235         if (new_entry > 0) break;
 236
 237         this = symbols[this].next_entry;
 238     } while (this != -1);
 239
 240     return -1;
 241 }
 242
 243 extern int symbol_index(char *p, int hashcode, int *created)
 244 {
 245     /*  Return the index in the symbols array of symbol "p", creating a
 246         new symbol with that name if it isn't already there. This
 247         always returns a valid symbol index.
 248
 249         The optional created argument receives TRUE if the symbol
 250         was newly created.
 251
 252         Pass in the hashcode of p if you know it, or -1 if you don't.
 253
 254         New symbols are created with flag UNKNOWN_SFLAG, value 0x100
 255         (a 2-byte quantity in Z-machine terms) and type CONSTANT_T.
 256
 257         The string "p" is undamaged.                                         */
 258
 259     int32 new_entry, this, last;
 260     char *r;
 261     int len;
 262
 263     if (hashcode == -1) hashcode = hash_code_from_string(p);
 264
 265     this = start_of_list[hashcode]; last = -1;
 266
 267     do
 268     {   if (this == -1) break;
 269
 270         r = symbols[this].name;
 271         new_entry = strcmpcis(r, p);
 272         if (new_entry == 0)
 273         {
 274             if (track_unused_routines)
 275                 df_note_function_symbol(this);
 276             if (created) *created = FALSE;
 277             return this;
 278         }
 279         if (new_entry > 0) break;
 280
 281         last = this;
 282         this = symbols[this].next_entry;
 283     } while (this != -1);
 284
 285     if (symdef_trace_setting)
 286         printf("%s: Encountered symbol %d '%s'\n", current_location_text(), no_symbols, p);
 287
 288     ensure_memory_list_available(&symbols_memlist, no_symbols+1);
 289     if (debugfile_switch)
 290         ensure_memory_list_available(&symbol_debug_info_memlist, no_symbols+1);
 291
 292     if (last == -1)
 293     {   symbols[no_symbols].next_entry=start_of_list[hashcode];
 294         start_of_list[hashcode]=no_symbols;
 295     }
 296     else
 297     {   symbols[no_symbols].next_entry=this;
 298         symbols[last].next_entry=no_symbols;
 299     }
 300
 301     len = strlen(p);
 302     if (!symbols_free_space || symbols_free_space+len+1 >= symbols_ceiling)
 303     {
 304         /* Allocate a new chunk whose size is big enough for the current
 305            symbol, or SYMBOLS_CHUNK_SIZE, whichever is greater. */
 306         int chunklen = SYMBOLS_CHUNK_SIZE;
 307         if (chunklen < len+1)
 308             chunklen = len+1;
 309         symbols_free_space
 310             = my_malloc(chunklen, "symbol names chunk");
 311         symbols_ceiling = symbols_free_space + chunklen;
 312         ensure_memory_list_available(&symbol_name_space_chunks_memlist, no_symbol_name_space_chunks+1);
 313         symbol_name_space_chunks[no_symbol_name_space_chunks++]
 314             = symbols_free_space;
 315     }
 316
 317     strcpy(symbols_free_space, p);
 318     symbols[no_symbols].name   = symbols_free_space;
 319     symbols_free_space += (len+1);
 320
 321     symbols[no_symbols].value   =  0x100; /* ###-wrong? Would this fix the
 322                                      unbound-symbol-causes-asm-error? */
 323     symbols[no_symbols].flags  =  UNKNOWN_SFLAG;
 324     symbols[no_symbols].marker =  0;
 325     symbols[no_symbols].type  =  CONSTANT_T;
 326     symbols[no_symbols].line  =  get_brief_location(&ErrorReport);
 327     if (debugfile_switch)
 328     {   nullify_debug_file_position
 329             (&symbol_debug_info[no_symbols].backpatch_pos);
 330         nullify_debug_file_position
 331             (&symbol_debug_info[no_symbols].replacement_backpatch_pos);
 332     }
 333
 334     if (track_unused_routines)
 335         df_note_function_symbol(no_symbols);
 336     if (created) *created = TRUE;
 337     return(no_symbols++);
 338 }
 339
 340 extern void end_symbol_scope(int k, int neveruse)
 341 {
 342     /* Remove the given symbol from the hash table, making it
 343        invisible to symbol_index. This is used by the Undef directive
 344        and put_token_back().
 345
 346        If you know the symbol has never been used, set neveruse and
 347        it will be flagged as an error if it *is* used.
 348
 349        If the symbol is not found in the hash table, this silently does
 350        nothing.
 351     */
 352
 353     int j;
 354
 355     symbols[k].flags |= UNHASHED_SFLAG;
 356     if (neveruse)
 357         symbols[k].flags |= DISCARDED_SFLAG;
 358
 359     j = hash_code_from_string(symbols[k].name);
 360     if (start_of_list[j] == k)
 361     {   start_of_list[j] = symbols[k].next_entry;
 362         return;
 363     }
 364     j = start_of_list[j];
 365     while (j != -1)
 366     {
 367         if (symbols[j].next_entry == k)
 368         {   symbols[j].next_entry = symbols[k].next_entry;
 369             return;
 370         }
 371         j = symbols[j].next_entry;
 372     }
 373 }
 374
 375 /* ------------------------------------------------------------------------- */
 376 /*   Printing diagnostics                                                    */
 377 /* ------------------------------------------------------------------------- */
 378
 379 extern char *typename(int type)
 380 {   switch(type)
 381     {
 382         /*  These are the possible symbol types.  Note that local variables
 383             do not reside in the symbol table (for scope and efficiency
 384             reasons) and actions have their own name-space (via routine
 385             names with "Sub" appended).                                      */
 386
 387         case ROUTINE_T:             return("Routine");
 388         case LABEL_T:               return("Label");
 389         case GLOBAL_VARIABLE_T:     return("Global variable");
 390         case ARRAY_T:               return("Array");
 391         case STATIC_ARRAY_T:        return("Static array");
 392         case CONSTANT_T:            return("Defined constant");
 393         case ATTRIBUTE_T:           return("Attribute");
 394         case PROPERTY_T:            return("Property");
 395         case INDIVIDUAL_PROPERTY_T: return("Individual property");
 396         case OBJECT_T:              return("Object");
 397         case CLASS_T:               return("Class");
 398         case FAKE_ACTION_T:         return("Fake action");
 399
 400         /*  These are not symbol types, but they get printed in errors. */
 401         case STRING_REQ_T:          return("String");
 402         case DICT_WORD_REQ_T:       return("Dictionary word");
 403
 404         default:                   return("(Unknown type)");
 405     }
 406 }
 407
 408 static void describe_flags(int flags)
 409 {   if (flags & UNKNOWN_SFLAG)  printf("(?) ");
 410     if (flags & REPLACE_SFLAG)  printf("(Replaced) ");
 411     if (flags & USED_SFLAG)     printf("(used) ");
 412     if (flags & DEFCON_SFLAG)   printf("(Defaulted) ");
 413     if (flags & STUB_SFLAG)     printf("(Stubbed) ");
 414     if (flags & UNHASHED_SFLAG) printf("(not in hash chain) ");
 415     if (flags & DISCARDED_SFLAG)  printf("(removed, do not use) ");
 416     if (flags & ALIASED_SFLAG)  printf("(aliased) ");
 417     if (flags & CHANGE_SFLAG)   printf("(value will change) ");
 418     if (flags & SYSTEM_SFLAG)   printf("(System) ");
 419     if (flags & INSF_SFLAG)     printf("(created in sys file) ");
 420     if (flags & UERROR_SFLAG)   printf("('Unknown' error issued) ");
 421     if (flags & ACTION_SFLAG)   printf("(Action name) ");
 422     if (flags & REDEFINABLE_SFLAG) printf("(Redefinable) ");
 423     if (flags & STAR_SFLAG)     printf("(*) ");
 424 }
 425
 426 extern void describe_symbol(int k)
 427 {   printf("%4d  %-16s  %2d:%04d  %04x  %s  ",
 428         k, (symbols[k].name),
 429         (int)(symbols[k].line.file_index),
 430         (int)(symbols[k].line.line_number),
 431         symbols[k].value, typename(symbols[k].type));
 432     describe_flags(symbols[k].flags);
 433 }
 434
 435 extern void list_symbols(int level)
 436 {   int k;
 437     for (k=0; k<no_symbols; k++)
 438     {   if ((level>=2) ||
 439             ((symbols[k].flags & (SYSTEM_SFLAG + UNKNOWN_SFLAG + INSF_SFLAG)) == 0))
 440         {   describe_symbol(k); printf("\n");
 441         }
 442     }
 443 }
 444
 445 /* Check that the operand is of the given symbol type (XXX_T). If wanttype2 is nonzero, that's a second allowable type.
 446    Generate a warning if no match. */
 447 extern void check_warn_symbol_type(const assembly_operand *AO, int wanttype, int wanttype2, char *context)
 448 {
 449     symbolinfo *sym;
 450     int symtype;
 451
 452     if (AO->symindex < 0)
 453     {
 454         /* This argument is not a symbol; it's a local variable, a literal, or a computed expression. */
 455         /* We can recognize and type-check some literals. */
 456         if (AO->marker == DWORD_MV) {
 457             if (wanttype != DICT_WORD_REQ_T && wanttype2 != DICT_WORD_REQ_T)
 458                 symtype_warning(context, NULL, typename(DICT_WORD_REQ_T), typename(wanttype));
 459         }
 460         if (AO->marker == STRING_MV) {
 461             if (wanttype != STRING_REQ_T && wanttype2 != STRING_REQ_T)
 462                 symtype_warning(context, NULL, typename(STRING_REQ_T), typename(wanttype));
 463         }
 464         return;
 465     }
 466
 467     sym = &symbols[AO->symindex];
 468     symtype = sym->type;
 469
 470     if (symtype == GLOBAL_VARIABLE_T)
 471     {
 472         /* A global variable could have any value. No way to generate a warning. */
 473         return;
 474     }
 475     if (symtype == CONSTANT_T)
 476     {
 477         /* A constant could also have any value. This case also includes forward-declared constants (UNKNOWN_SFLAG). */
 478         /* We try inferring its type by looking at the backpatch marker. Sadly, this only works for objects. (And not in Z-code, where object values are not backpatched.) */
 479         if (sym->marker == OBJECT_MV) {
 480             /* Continue with inferred type. */
 481             symtype = OBJECT_T;
 482         }
 483         else {
 484             /* Give up. */
 485             return;
 486         }
 487     }
 488
 489     if (!(   (symtype == wanttype)
 490           || (wanttype2 != 0 && symtype == wanttype2)))
 491     {
 492         symtype_warning(context, sym->name, typename(symtype), typename(wanttype));
 493     }
 494 }
 495
 496 /* Similar, but we allow any type that has a metaclass: Object, Class, String, or Routine.
 497    Generate a warning if no match. */
 498 extern void check_warn_symbol_has_metaclass(const assembly_operand *AO, char *context)
 499 {
 500     symbolinfo *sym;
 501     int symtype;
 502
 503     if (AO->symindex < 0)
 504     {
 505         /* This argument is not a symbol; it's a local variable, a literal, or a computed expression. */
 506         /* We can recognize and type-check some literals. */
 507         if (AO->marker == DWORD_MV) {
 508             symtype_warning(context, NULL, typename(DICT_WORD_REQ_T), "Object/Class/Routine/String");
 509         }
 510         if (AO->marker == STRING_MV) {
 511             /* Strings are good here. */
 512         }
 513         return;
 514     }
 515
 516     sym = &symbols[AO->symindex];
 517     symtype = sym->type;
 518
 519     if (symtype == GLOBAL_VARIABLE_T)
 520     {
 521         /* A global variable could have any value. No way to generate a warning. */
 522         return;
 523     }
 524     if (symtype == CONSTANT_T)
 525     {
 526         /* A constant could also have any value. This case also includes forward-declared constants (UNKNOWN_SFLAG). */
 527         /* We try inferring its type by looking at the backpatch marker. Sadly, this only works for objects. (And not in Z-code, where object values are not backpatched.) */
 528         if (sym->marker == OBJECT_MV) {
 529             /* Continue with inferred type. */
 530             symtype = OBJECT_T;
 531         }
 532         else {
 533             /* Give up. */
 534             return;
 535         }
 536     }
 537
 538     if (!(symtype == ROUTINE_T || symtype == CLASS_T || symtype == OBJECT_T))
 539     {
 540         symtype_warning(context, sym->name, typename(symtype), "Object/Class/Routine/String");
 541     }
 542 }
 543
 544 extern void issue_unused_warnings(void)
 545 {   int32 i;
 546
 547     /*  Update any ad-hoc variables that might help the library  */
 548     if (glulx_mode)
 549     {   global_initial_value[10]=statusline_flag;
 550     }
 551     /*  Now back to mark anything necessary as used  */
 552
 553     i = get_symbol_index("Main");
 554     if (i >= 0 && !(symbols[i].flags & UNKNOWN_SFLAG)) {
 555         symbols[i].flags |= USED_SFLAG;
 556     }
 557
 558     for (i=0;i<no_symbols;i++)
 559     {   if (((symbols[i].flags
 560              & (SYSTEM_SFLAG + UNKNOWN_SFLAG
 561                 + INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)
 562              && (symbols[i].type != OBJECT_T)) {
 563             dbnu_warning(typename(symbols[i].type), symbols[i].name, symbols[i].line);
 564         }
 565         if ((symbols[i].flags & DISCARDED_SFLAG)
 566             && (symbols[i].flags & USED_SFLAG)) {
 567             error_named_at("Symbol was removed from the symbol table, but seems to be in use anyway", symbols[i].name, symbols[i].line);
 568         }
 569     }
 570 }
 571
 572 extern void issue_debug_symbol_warnings(void)
 573 {
 574     int value = get_symbol_index("DEBUG");
 575     if (value >= 0 && (symbols[value].flags & USED_SFLAG) && !(symbols[value].flags & UNKNOWN_SFLAG)) {
 576         value = get_symbol_index("debug_flag");
 577         if (value >= 0 && (symbols[value].flags & USED_SFLAG) && (symbols[value].flags & UNKNOWN_SFLAG)) {
 578             warning("DEBUG mode is on, but this story or library does not appear to support it");
 579         }
 580     }
 581 }
 582
 583 /* ------------------------------------------------------------------------- */
 584 /*   These are arrays used only during story file creation, and not          */
 585 /*   allocated until just before write_the_identifier_names() time.          */
 586
 587        int32 *individual_name_strings; /* Packed addresses of Z-encoded
 588                                           strings of the names of the
 589                                           properties: this is an array
 590                                           indexed by the property ID         */
 591        int32 *action_name_strings;     /* Ditto for actions                  */
 592        int32 *attribute_name_strings;  /* Ditto for attributes               */
 593        int32 *array_name_strings;      /* Ditto for arrays                   */
 594
 595 extern void write_the_identifier_names(void)
 596 {   int i, j, k, t, null_value;
 597     static char unknown_attribute[20] = "<unknown attribute>";
 598
 599     for (i=0; i<no_individual_properties; i++)
 600         individual_name_strings[i] = 0;
 601
 602     veneer_mode = TRUE;
 603
 604     null_value = compile_string(unknown_attribute, STRCTX_SYMBOL);
 605     for (i=0; i<NUM_ATTR_BYTES*8; i++) attribute_name_strings[i] = null_value;
 606
 607     for (i=0; i<no_symbols; i++)
 608     {   t=symbols[i].type;
 609         if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
 610         {   if (symbols[i].flags & ALIASED_SFLAG)
 611             {   if (individual_name_strings[symbols[i].value] == 0)
 612                 {
 613                     int sleni = strlen(symbols[i].name);
 614                     ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
 615                     sprintf(temp_symbol_buf, "%s", symbols[i].name);
 616
 617                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
 618                     {   if ((symbols[j].type == symbols[i].type)
 619                             && (symbols[j].value == symbols[i].value))
 620                         {
 621                             int slenj = strlen(symbols[j].name);
 622                             ensure_memory_list_available(&temp_symbol_buf_memlist, strlen(temp_symbol_buf)+1+slenj+1);
 623                             sprintf(temp_symbol_buf+strlen(temp_symbol_buf),
 624                                 "/%s", symbols[j].name);
 625                             k++;
 626                         }
 627                     }
 628
 629                     individual_name_strings[symbols[i].value]
 630                         = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
 631                 }
 632             }
 633             else
 634             {
 635                 individual_name_strings[symbols[i].value]
 636                     = compile_string(symbols[i].name, STRCTX_SYMBOL);
 637             }
 638         }
 639         if (t == ATTRIBUTE_T)
 640         {
 641             if (symbols[i].flags & ALIASED_SFLAG)
 642             {   if (attribute_name_strings[symbols[i].value] == null_value)
 643                 {
 644                     int sleni = strlen(symbols[i].name);
 645                     ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
 646                     sprintf(temp_symbol_buf, "%s", symbols[i].name);
 647
 648                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
 649                     {   if ((symbols[j].type == symbols[i].type)
 650                             && (symbols[j].value == symbols[i].value))
 651                         {
 652                             int slenj = strlen(symbols[j].name);
 653                             ensure_memory_list_available(&temp_symbol_buf_memlist, strlen(temp_symbol_buf)+1+slenj+1);
 654                             sprintf(temp_symbol_buf+strlen(temp_symbol_buf),
 655                                 "/%s", symbols[j].name);
 656                             k++;
 657                         }
 658                     }
 659
 660                     attribute_name_strings[symbols[i].value]
 661                         = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
 662                 }
 663             }
 664             else
 665             {
 666                 attribute_name_strings[symbols[i].value]
 667                     = compile_string(symbols[i].name, STRCTX_SYMBOL);
 668             }
 669         }
 670
 671         if (symbols[i].flags & ACTION_SFLAG)
 672         {
 673             int sleni = strlen(symbols[i].name);
 674             ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
 675             sprintf(temp_symbol_buf, "%s", symbols[i].name);
 676             temp_symbol_buf[strlen(temp_symbol_buf)-3] = 0;
 677
 678             if (debugfile_switch)
 679             {   debug_file_printf("<action>");
 680                 debug_file_printf
 681                     ("<identifier>##%s</identifier>", temp_symbol_buf);
 682                 debug_file_printf("<value>%d</value>", symbols[i].value);
 683                 debug_file_printf("</action>");
 684             }
 685
 686             action_name_strings[symbols[i].value]
 687                 = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
 688         }
 689     }
 690
 691     for (i=0; i<no_symbols; i++)
 692     {   if (symbols[i].type == FAKE_ACTION_T)
 693         {
 694             int sleni = strlen(symbols[i].name);
 695             ensure_memory_list_available(&temp_symbol_buf_memlist, sleni+1);
 696             sprintf(temp_symbol_buf, "%s", symbols[i].name);
 697             temp_symbol_buf[strlen(temp_symbol_buf)-3] = 0;
 698
 699             action_name_strings[symbols[i].value
 700                     - ((grammar_version_number==1)?256:4096) + no_actions]
 701                 = compile_string(temp_symbol_buf, STRCTX_SYMBOL);
 702         }
 703     }
 704
 705     for (j=0; j<no_arrays; j++)
 706     {
 707         i = arrays[j].symbol;
 708         array_name_strings[j]
 709             = compile_string(symbols[i].name, STRCTX_SYMBOL);
 710     }
 711
 712     if (define_INFIX_switch)
 713     {
 714         for (i=0; i<no_symbols; i++)
 715         {   if (symbols[i].type == GLOBAL_VARIABLE_T)
 716             {
 717                 array_name_strings[no_arrays + symbols[i].value -16]
 718                     = compile_string(symbols[i].name, STRCTX_SYMBOL);
 719             }
 720         }
 721
 722         for (i=0; i<no_named_routines; i++)
 723         {
 724             array_name_strings[no_arrays + no_globals + i]
 725                 = compile_string(symbols[named_routine_symbols[i]].name, STRCTX_SYMBOL);
 726         }
 727
 728         for (i=0, no_named_constants=0; i<no_symbols; i++)
 729         {   if (((symbols[i].type == OBJECT_T) || (symbols[i].type == CLASS_T)
 730                  || (symbols[i].type == CONSTANT_T))
 731                 && ((symbols[i].flags & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
 732             {
 733                 array_name_strings[no_arrays + no_globals + no_named_routines
 734                                    + no_named_constants++]
 735                     = compile_string(symbols[i].name, STRCTX_SYMBOL);
 736             }
 737         }
 738     }
 739
 740     veneer_mode = FALSE;
 741 }
 742 /* ------------------------------------------------------------------------- */
 743 /*   Creating symbols                                                        */
 744 /* ------------------------------------------------------------------------- */
 745
 746 static void assign_symbol_base(int index, int32 value, int type)
 747 {   symbols[index].value  = value;
 748     symbols[index].type = type;
 749     if (symbols[index].flags & UNKNOWN_SFLAG)
 750     {   symbols[index].flags &= (~UNKNOWN_SFLAG);
 751         if (is_systemfile()) symbols[index].flags |= INSF_SFLAG;
 752         symbols[index].line = get_brief_location(&ErrorReport);
 753     }
 754 }
 755
 756 extern void assign_symbol(int index, int32 value, int type)
 757 {
 758     assign_symbol_base(index, value, type);
 759     symbols[index].marker = 0;
 760     if (symdef_trace_setting)
 761         printf("%s: Defined symbol %d '%s' as %d (%s)\n", current_location_text(), index, symbols[index].name, value, typename(type));
 762 }
 763
 764 extern void assign_marked_symbol(int index, int marker, int32 value, int type)
 765 {
 766     assign_symbol_base(index, value, type);
 767     symbols[index].marker = marker;
 768     if (symdef_trace_setting)
 769         printf("%s: Defined symbol %d '%s' as %s %d (%s)\n", current_location_text(), index, symbols[index].name, describe_mv(marker), value, typename(type));
 770 }
 771
 772 static void emit_debug_information_for_predefined_symbol
 773     (char *name, int32 symbol, int32 value, int type)
 774 {   if (debugfile_switch)
 775     {   switch (type)
 776         {   case CONSTANT_T:
 777                 debug_file_printf("<constant>");
 778                 debug_file_printf("<identifier>%s</identifier>", name);
 779                 write_debug_symbol_optional_backpatch(symbol);
 780                 debug_file_printf("</constant>");
 781                 break;
 782             case GLOBAL_VARIABLE_T:
 783                 debug_file_printf("<global-variable>");
 784                 debug_file_printf("<identifier>%s</identifier>", name);
 785                 debug_file_printf("<address>");
 786                 write_debug_global_backpatch(value);
 787                 debug_file_printf("</address>");
 788                 debug_file_printf("</global-variable>");
 789                 break;
 790             case OBJECT_T:
 791                 if (value)
 792                 {   compiler_error("Non-nothing object predefined");
 793                 }
 794                 debug_file_printf("<object>");
 795                 debug_file_printf("<identifier>%s</identifier>", name);
 796                 debug_file_printf("<value>0</value>");
 797                 debug_file_printf("</object>");
 798                 break;
 799             case ATTRIBUTE_T:
 800                 debug_file_printf("<attribute>");
 801                 debug_file_printf("<identifier>%s</identifier>", name);
 802                 debug_file_printf("<value>%d</value>", value);
 803                 debug_file_printf("</attribute>");
 804                 break;
 805             case PROPERTY_T:
 806             case INDIVIDUAL_PROPERTY_T:
 807                 debug_file_printf("<property>");
 808                 debug_file_printf("<identifier>%s</identifier>", name);
 809                 debug_file_printf("<value>%d</value>", value);
 810                 debug_file_printf("</property>");
 811                 break;
 812             default:
 813                 compiler_error
 814                     ("Unable to emit debug information for predefined symbol");
 815             break;
 816         }
 817     }
 818 }
 819
 820 static void create_symbol(char *p, int32 value, int type)
 821 {   int i = symbol_index(p, -1, NULL);
 822     if (!(symbols[i].flags & (UNKNOWN_SFLAG + REDEFINABLE_SFLAG))) {
 823         /* Symbol already defined! */
 824         if (symbols[i].value == value && symbols[i].type == type) {
 825             /* Special case: the symbol was already defined with this same
 826                value. We let it pass. */
 827             return;
 828         }
 829         else {
 830             ebf_symbol_error("new symbol", p, typename(symbols[i].type), symbols[i].line);
 831             return;
 832         }
 833     }
 834     symbols[i].value = value; symbols[i].type = type; symbols[i].line = blank_brief_location;
 835     /* If the symbol already existed with REDEFINABLE_SFLAG, we keep that. */
 836     symbols[i].flags = USED_SFLAG + SYSTEM_SFLAG + (symbols[i].flags & REDEFINABLE_SFLAG);
 837     emit_debug_information_for_predefined_symbol(p, i, value, type);
 838 }
 839
 840 static void create_rsymbol(char *p, int value, int type)
 841 {   int i = symbol_index(p, -1, NULL);
 842     /* This is only called for a few symbols with known names.
 843        They will not collide. */
 844     symbols[i].value = value; symbols[i].type = type; symbols[i].line = blank_brief_location;
 845     symbols[i].flags = USED_SFLAG + SYSTEM_SFLAG + REDEFINABLE_SFLAG;
 846     emit_debug_information_for_predefined_symbol(p, i, value, type);
 847 }
 848
 849 static void stockup_symbols(void)
 850 {
 851     if (!glulx_mode)
 852         create_symbol("TARGET_ZCODE", 0, CONSTANT_T);
 853     else
 854         create_symbol("TARGET_GLULX", 0, CONSTANT_T);
 855
 856     create_symbol("nothing",        0, OBJECT_T);
 857     create_symbol("name",           1, PROPERTY_T);
 858
 859     create_symbol("true",           1, CONSTANT_T);
 860     create_symbol("false",          0, CONSTANT_T);
 861
 862     /* Glulx defaults to GV2; Z-code to GV1 */
 863     if (!glulx_mode)
 864         create_rsymbol("Grammar__Version", 1, CONSTANT_T);
 865     else
 866         create_rsymbol("Grammar__Version", 2, CONSTANT_T);
 867     grammar_version_symbol = get_symbol_index("Grammar__Version");
 868
 869     if (runtime_error_checking_switch)
 870         create_rsymbol("STRICT_MODE",0, CONSTANT_T);
 871
 872     if (define_DEBUG_switch)
 873         create_rsymbol("DEBUG",      0, CONSTANT_T);
 874
 875     if (define_INFIX_switch)
 876     {   create_rsymbol("INFIX",      0, CONSTANT_T);
 877         create_symbol("infix__watching", 0, ATTRIBUTE_T);
 878     }
 879
 880     if (OMIT_SYMBOL_TABLE)
 881         create_symbol("OMIT_SYMBOL_TABLE", 0, CONSTANT_T);
 882
 883     create_symbol("WORDSIZE",        WORDSIZE, CONSTANT_T);
 884     /* DICT_ENTRY_BYTES must be REDEFINABLE_SFLAG because the Version directive can change it. */
 885     create_rsymbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);
 886     if (!glulx_mode) {
 887         create_symbol("DICT_WORD_SIZE", ((version_number==3)?4:6), CONSTANT_T);
 888         create_symbol("NUM_ATTR_BYTES", ((version_number==3)?4:6), CONSTANT_T);
 889     }
 890     else {
 891         create_symbol("DICT_WORD_SIZE",     DICT_WORD_SIZE, CONSTANT_T);
 892         create_symbol("DICT_CHAR_SIZE",     DICT_CHAR_SIZE, CONSTANT_T);
 893         if (DICT_CHAR_SIZE != 1)
 894             create_symbol("DICT_IS_UNICODE", 1, CONSTANT_T);
 895         create_symbol("NUM_ATTR_BYTES",     NUM_ATTR_BYTES, CONSTANT_T);
 896         create_symbol("GOBJFIELD_CHAIN",    GOBJFIELD_CHAIN(), CONSTANT_T);
 897         create_symbol("GOBJFIELD_NAME",     GOBJFIELD_NAME(), CONSTANT_T);
 898         create_symbol("GOBJFIELD_PROPTAB",  GOBJFIELD_PROPTAB(), CONSTANT_T);
 899         create_symbol("GOBJFIELD_PARENT",   GOBJFIELD_PARENT(), CONSTANT_T);
 900         create_symbol("GOBJFIELD_SIBLING",  GOBJFIELD_SIBLING(), CONSTANT_T);
 901         create_symbol("GOBJFIELD_CHILD",    GOBJFIELD_CHILD(), CONSTANT_T);
 902         create_symbol("GOBJ_EXT_START",     1+NUM_ATTR_BYTES+6*WORDSIZE, CONSTANT_T);
 903         create_symbol("GOBJ_TOTAL_LENGTH",  1+NUM_ATTR_BYTES+6*WORDSIZE+GLULX_OBJECT_EXT_BYTES, CONSTANT_T);
 904         create_symbol("INDIV_PROP_START",   INDIV_PROP_START, CONSTANT_T);
 905     }
 906
 907     if (!glulx_mode) {
 908         create_symbol("temp_global",  255, GLOBAL_VARIABLE_T);
 909         create_symbol("temp__global2", 254, GLOBAL_VARIABLE_T);
 910         create_symbol("temp__global3", 253, GLOBAL_VARIABLE_T);
 911         create_symbol("temp__global4", 252, GLOBAL_VARIABLE_T);
 912         create_symbol("self",         251, GLOBAL_VARIABLE_T);
 913         create_symbol("sender",       250, GLOBAL_VARIABLE_T);
 914         create_symbol("sw__var",      249, GLOBAL_VARIABLE_T);
 915
 916         create_symbol("sys__glob0",     16, GLOBAL_VARIABLE_T);
 917         create_symbol("sys__glob1",     17, GLOBAL_VARIABLE_T);
 918         create_symbol("sys__glob2",     18, GLOBAL_VARIABLE_T);
 919
 920         create_symbol("create",        64, INDIVIDUAL_PROPERTY_T);
 921         create_symbol("recreate",      65, INDIVIDUAL_PROPERTY_T);
 922         create_symbol("destroy",       66, INDIVIDUAL_PROPERTY_T);
 923         create_symbol("remaining",     67, INDIVIDUAL_PROPERTY_T);
 924         create_symbol("copy",          68, INDIVIDUAL_PROPERTY_T);
 925         create_symbol("call",          69, INDIVIDUAL_PROPERTY_T);
 926         create_symbol("print",         70, INDIVIDUAL_PROPERTY_T);
 927         create_symbol("print_to_array",71, INDIVIDUAL_PROPERTY_T);
 928     }
 929     else {
 930         /* In Glulx, these system globals are entered in order, not down
 931            from 255. */
 932         create_symbol("temp_global",  MAX_LOCAL_VARIABLES+0,
 933           GLOBAL_VARIABLE_T);
 934         create_symbol("temp__global2", MAX_LOCAL_VARIABLES+1,
 935           GLOBAL_VARIABLE_T);
 936         create_symbol("temp__global3", MAX_LOCAL_VARIABLES+2,
 937           GLOBAL_VARIABLE_T);
 938         create_symbol("temp__global4", MAX_LOCAL_VARIABLES+3,
 939           GLOBAL_VARIABLE_T);
 940         create_symbol("self",         MAX_LOCAL_VARIABLES+4,
 941           GLOBAL_VARIABLE_T);
 942         create_symbol("sender",       MAX_LOCAL_VARIABLES+5,
 943           GLOBAL_VARIABLE_T);
 944         create_symbol("sw__var",      MAX_LOCAL_VARIABLES+6,
 945           GLOBAL_VARIABLE_T);
 946
 947         /* These are almost certainly meaningless, and can be removed. */
 948         create_symbol("sys__glob0",     MAX_LOCAL_VARIABLES+7,
 949           GLOBAL_VARIABLE_T);
 950         create_symbol("sys__glob1",     MAX_LOCAL_VARIABLES+8,
 951           GLOBAL_VARIABLE_T);
 952         create_symbol("sys__glob2",     MAX_LOCAL_VARIABLES+9,
 953           GLOBAL_VARIABLE_T);
 954
 955         /* value of statusline_flag to be written later */
 956         create_symbol("sys_statusline_flag",  MAX_LOCAL_VARIABLES+10,
 957           GLOBAL_VARIABLE_T);
 958
 959         /* These are created in order, but not necessarily at a fixed
 960            value. */
 961         create_symbol("create",        INDIV_PROP_START+0,
 962           INDIVIDUAL_PROPERTY_T);
 963         create_symbol("recreate",      INDIV_PROP_START+1,
 964           INDIVIDUAL_PROPERTY_T);
 965         create_symbol("destroy",       INDIV_PROP_START+2,
 966           INDIVIDUAL_PROPERTY_T);
 967         create_symbol("remaining",     INDIV_PROP_START+3,
 968           INDIVIDUAL_PROPERTY_T);
 969         create_symbol("copy",          INDIV_PROP_START+4,
 970           INDIVIDUAL_PROPERTY_T);
 971         create_symbol("call",          INDIV_PROP_START+5,
 972           INDIVIDUAL_PROPERTY_T);
 973         create_symbol("print",         INDIV_PROP_START+6,
 974           INDIVIDUAL_PROPERTY_T);
 975         create_symbol("print_to_array",INDIV_PROP_START+7,
 976           INDIVIDUAL_PROPERTY_T);
 977
 978         /* Floating-point constants. Note that FLOAT_NINFINITY is not
 979            -FLOAT_INFINITY, because float negation doesn't work that
 980            way. Also note that FLOAT_NAN is just one of many possible
 981            "not-a-number" values. */
 982         create_symbol("FLOAT_INFINITY",  0x7F800000, CONSTANT_T);
 983         create_symbol("FLOAT_NINFINITY", 0xFF800000, CONSTANT_T);
 984         create_symbol("FLOAT_NAN",       0x7FC00000, CONSTANT_T);
 985         /* Same for double constants. Each of these has a high 32-bit
 986            word and a low 32-bit word. */
 987         create_symbol("DOUBLE_HI_INFINITY",  0x7FF00000, CONSTANT_T);
 988         create_symbol("DOUBLE_LO_INFINITY",  0x00000000, CONSTANT_T);
 989         create_symbol("DOUBLE_HI_NINFINITY", 0xFFF00000, CONSTANT_T);
 990         create_symbol("DOUBLE_LO_NINFINITY", 0x00000000, CONSTANT_T);
 991         create_symbol("DOUBLE_HI_NAN",       0x7FF80000, CONSTANT_T);
 992         create_symbol("DOUBLE_LO_NAN",       0x00000001, CONSTANT_T);
 993     }
 994
 995     if (symbol_definitions && symbol_definitions_count) {
 996         int ix;
 997         for (ix=0; ix<symbol_definitions_count; ix++) {
 998             char *str = symbol_definitions[ix].symbol;
 999             int32 val = symbol_definitions[ix].value;
1000             create_symbol(str, val, CONSTANT_T);
1001         }
1002     }
1003 }
1004
1005 /* ------------------------------------------------------------------------- */
1006 /*   The symbol replacement table. This is needed only for the               */
1007 /*   "Replace X Y" directive.                                                */
1008 /* ------------------------------------------------------------------------- */
1009
1010 extern void add_symbol_replacement_mapping(int original, int renamed)
1011 {
1012     int ix;
1013
1014     if (original == renamed) {
1015         error_named("A routine cannot be 'Replace'd to itself:", symbols[original].name);
1016         return;
1017     }
1018
1019     if (symbol_replacements_count == symbol_replacements_size) {
1020         int oldsize = symbol_replacements_size;
1021         if (symbol_replacements_size == 0)
1022             symbol_replacements_size = 4;
1023         else
1024             symbol_replacements_size *= 2;
1025         my_recalloc(&symbol_replacements, sizeof(value_pair_t), oldsize,
1026             symbol_replacements_size, "symbol replacement table");
1027     }
1028
1029     /* If the original form is already in our table, report an error.
1030        Same goes if the replaced form is already in the table as an
1031        original. (Other collision cases have already been
1032        detected.) */
1033
1034     for (ix=0; ix<symbol_replacements_count; ix++) {
1035         if (original == symbol_replacements[ix].original_symbol) {
1036             error_named("A routine cannot be 'Replace'd to more than one new name:", symbols[original].name);
1037         }
1038         if (renamed == symbol_replacements[ix].original_symbol) {
1039             error_named("A routine cannot be 'Replace'd to a 'Replace'd name:", symbols[original].name);
1040         }
1041     }
1042
1043     symbol_replacements[symbol_replacements_count].original_symbol = original;
1044     symbol_replacements[symbol_replacements_count].renamed_symbol = renamed;
1045     symbol_replacements_count++;
1046 }
1047
1048 extern int find_symbol_replacement(int *value)
1049 {
1050     int changed = FALSE;
1051     int ix;
1052
1053     if (!symbol_replacements)
1054         return FALSE;
1055
1056     for (ix=0; ix<symbol_replacements_count; ix++) {
1057         if (*value == symbol_replacements[ix].original_symbol) {
1058             *value = symbol_replacements[ix].renamed_symbol;
1059             changed = TRUE;
1060         }
1061     }
1062
1063     return changed;
1064 }
1065
1066 /* ------------------------------------------------------------------------- */
1067 /*   The dead-function removal optimization.                                 */
1068 /* ------------------------------------------------------------------------- */
1069
1070 int track_unused_routines; /* set if either WARN_UNUSED_ROUTINES or
1071                               OMIT_UNUSED_ROUTINES is nonzero */
1072 int df_dont_note_global_symbols; /* temporarily set at times in parsing */
1073 static int df_tables_closed; /* set at end of compiler pass */
1074
1075 typedef struct df_function_struct df_function_t;
1076 typedef struct df_reference_struct df_reference_t;
1077
1078 struct df_function_struct {
1079     char *name; /* borrowed reference, generally to the symbs[] table */
1080     brief_location source_line; /* copied from routine_starts_line */
1081     int sysfile; /* does this occur in a system file? */
1082     uint32 address; /* function offset in zcode_area (not the final address) */
1083     uint32 newaddress; /* function offset after stripping */
1084     uint32 length;
1085     int usage;
1086     df_reference_t *refs; /* chain of references made *from* this function */
1087     int processed;
1088
1089     df_function_t *funcnext; /* in forward functions order */
1090     df_function_t *todonext; /* in the todo chain */
1091     df_function_t *next; /* in the hash table */
1092 };
1093
1094 struct df_reference_struct {
1095     uint32 address; /* function offset in zcode_area (not the final address) */
1096     int symbol; /* index in symbols array */
1097
1098     df_reference_t *refsnext; /* in the function's refs chain */
1099     df_reference_t *next; /* in the hash table */
1100 };
1101
1102 /* Bitmask flags for how functions are used: */
1103 #define DF_USAGE_GLOBAL   (1<<0) /* In a global variable, array, etc */
1104 #define DF_USAGE_EMBEDDED (1<<1) /* An anonymous function in a property */
1105 #define DF_USAGE_MAIN     (1<<2) /* Main() or Main__() */
1106 #define DF_USAGE_FUNCTION (1<<3) /* Used from another used function */
1107
1108 #define DF_FUNCTION_HASH_BUCKETS (1023)
1109
1110 /* Table of all compiled functions. (Only created if track_unused_routines
1111    is set.) This is a hash table. */
1112 static df_function_t **df_functions;
1113 /* List of all compiled functions, in address order. The first entry
1114    has address DF_NOT_IN_FUNCTION, and stands in for the global namespace. */
1115 static df_function_t *df_functions_head;
1116 static df_function_t *df_functions_tail;
1117 /* Used during output_file(), to track how far the code-area output has
1118    gotten. */
1119 static df_function_t *df_iterator;
1120
1121 /* Array of all compiled functions in address order. (Does not include
1122    the global namespace entry.) This is generated only if needed. */
1123 static df_function_t **df_functions_sorted;
1124 static int df_functions_sorted_count;
1125
1126 #define DF_NOT_IN_FUNCTION ((uint32)0xFFFFFFFF)
1127 #define DF_SYMBOL_HASH_BUCKETS (4095)
1128
1129 /* Map of what functions reference what other functions. (Only created if
1130    track_unused_routines is set.) */
1131 static df_reference_t **df_symbol_map;
1132
1133 /* Globals used while a function is being compiled. When a function
1134   *isn't* being compiled, df_current_function_addr will be DF_NOT_IN_FUNCTION
1135   and df_current_function will refer to the global namespace record. */
1136 static df_function_t *df_current_function;
1137 static char *df_current_function_name;
1138 static uint32 df_current_function_addr;
1139
1140 /* Size totals for compiled code. These are only meaningful if
1141    track_unused_routines is true. (If we're only doing WARN_UNUSED_ROUTINES,
1142    these values will be set, but the "after" value will not affect the
1143    final game file.) */
1144 uint32 df_total_size_before_stripping;
1145 uint32 df_total_size_after_stripping;
1146
1147 /* When we begin compiling a function, call this to note that fact.
1148    Any symbol referenced from now on will be associated with the function.
1149 */
1150 extern void df_note_function_start(char *name, uint32 address,
1151     int embedded_flag, brief_location source_line)
1152 {
1153     df_function_t *func;
1154     int bucket;
1155
1156     if (df_tables_closed)
1157         error("Internal error in stripping: Tried to start a new function after tables were closed.");
1158
1159     /* We retain the name only for debugging output. Note that embedded
1160        functions all show up as "<embedded>" -- their "obj.prop" name
1161        never gets stored in permanent memory. */
1162     df_current_function_name = name;
1163     df_current_function_addr = address;
1164
1165     func = my_malloc(sizeof(df_function_t), "df function entry");
1166     memset(func, 0, sizeof(df_function_t));
1167     func->name = name;
1168     func->address = address;
1169     func->source_line = source_line;
1170     func->sysfile = (address == DF_NOT_IN_FUNCTION || is_systemfile());
1171     /* An embedded function is stored in an object property, so we
1172        consider it to be used a priori. */
1173     if (embedded_flag)
1174         func->usage |= DF_USAGE_EMBEDDED;
1175
1176     if (!df_functions_head) {
1177         df_functions_head = func;
1178         df_functions_tail = func;
1179     }
1180     else {
1181         df_functions_tail->funcnext = func;
1182         df_functions_tail = func;
1183     }
1184
1185     bucket = address % DF_FUNCTION_HASH_BUCKETS;
1186     func->next = df_functions[bucket];
1187     df_functions[bucket] = func;
1188
1189     df_current_function = func;
1190 }
1191
1192 /* When we're done compiling a function, call this. Any symbol referenced
1193    from now on will be associated with the global namespace.
1194 */
1195 extern void df_note_function_end(uint32 endaddress)
1196 {
1197     df_current_function->length = endaddress - df_current_function->address;
1198
1199     df_current_function_name = NULL;
1200     df_current_function_addr = DF_NOT_IN_FUNCTION;
1201     df_current_function = df_functions_head; /* the global namespace */
1202 }
1203
1204 /* Find the function record for a given address. (Addresses are offsets
1205    in zcode_area.)
1206 */
1207 static df_function_t *df_function_for_address(uint32 address)
1208 {
1209     int bucket = address % DF_FUNCTION_HASH_BUCKETS;
1210     df_function_t *func;
1211     for (func = df_functions[bucket]; func; func = func->next) {
1212         if (func->address == address)
1213             return func;
1214     }
1215     return NULL;
1216 }
1217
1218 /* Whenever a function is referenced, we call this to note who called it.
1219 */
1220 extern void df_note_function_symbol(int symbol)
1221 {
1222     int bucket, symtype;
1223     df_reference_t *ent;
1224
1225     /* If the compiler pass is over, looking up symbols does not create
1226        a global reference. */
1227     if (df_tables_closed)
1228         return;
1229     /* In certain cases during parsing, looking up symbols does not
1230        create a global reference. (For example, when reading the name
1231        of a function being defined.) */
1232     if (df_dont_note_global_symbols)
1233         return;
1234     /* If we're compiling an unreachable statement, no reference. */
1235     if (execution_never_reaches_here)
1236         return;
1237
1238     /* We are only interested in functions, or forward-declared symbols
1239        that might turn out to be functions. */
1240     symtype = symbols[symbol].type;
1241     if (symtype != ROUTINE_T && symtype != CONSTANT_T)
1242         return;
1243     if (symtype == CONSTANT_T && !(symbols[symbol].flags & UNKNOWN_SFLAG))
1244         return;
1245
1246     bucket = (df_current_function_addr ^ (uint32)symbol) % DF_SYMBOL_HASH_BUCKETS;
1247     for (ent = df_symbol_map[bucket]; ent; ent = ent->next) {
1248         if (ent->address == df_current_function_addr && ent->symbol == symbol)
1249             return;
1250     }
1251
1252     /* Create a new reference entry in df_symbol_map. */
1253     ent = my_malloc(sizeof(df_reference_t), "df symbol map entry");
1254     ent->address = df_current_function_addr;
1255     ent->symbol = symbol;
1256     ent->next = df_symbol_map[bucket];
1257     df_symbol_map[bucket] = ent;
1258
1259     /* Add the reference to the function's entry as well. */
1260     /* The current function is the most recently added, so it will be
1261        at the top of its bucket. That makes this call fast. Unless
1262        we're in global scope, in which case it might be slower.
1263        (I suppose we could cache the df_function_t pointer of the
1264        current function, to speed things up.) */
1265     if (!df_current_function || df_current_function_addr != df_current_function->address)
1266         compiler_error("DF: df_current_function does not match current address.");
1267     ent->refsnext = df_current_function->refs;
1268     df_current_function->refs = ent;
1269 }
1270
1271 /* This does the hard work of figuring out what functions are truly dead.
1272    It's called near the end of run_pass() in inform.c.
1273 */
1274 extern void locate_dead_functions(void)
1275 {
1276     df_function_t *func, *tofunc;
1277     df_reference_t *ent;
1278     int ix;
1279
1280     if (!track_unused_routines)
1281         compiler_error("DF: locate_dead_functions called, but function references have not been mapped");
1282
1283     df_tables_closed = TRUE;
1284     df_current_function = NULL;
1285
1286     /* Note that Main__ was tagged as global implicitly during
1287        compile_initial_routine(). Main was tagged during
1288        issue_unused_warnings(). But for the sake of thoroughness,
1289        we'll mark them specially. */
1290
1291     ix = get_symbol_index("Main__");
1292     if (ix >= 0 && symbols[ix].type == ROUTINE_T) {
1293         uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
1294         tofunc = df_function_for_address(addr);
1295         if (tofunc)
1296             tofunc->usage |= DF_USAGE_MAIN;
1297     }
1298     ix = get_symbol_index("Main");
1299     if (ix >= 0 && symbols[ix].type == ROUTINE_T) {
1300         uint32 addr = symbols[ix].value * (glulx_mode ? 1 : scale_factor);
1301         tofunc = df_function_for_address(addr);
1302         if (tofunc)
1303             tofunc->usage |= DF_USAGE_MAIN;
1304     }
1305
1306     /* Go through all the functions referenced at the global level;
1307        mark them as used. */
1308
1309     func = df_functions_head;
1310     if (!func || func->address != DF_NOT_IN_FUNCTION) {
1311         compiler_error("DF: Global namespace entry is not at the head of the chain.");
1312         return;
1313     }
1314
1315     for (ent = func->refs; ent; ent=ent->refsnext) {
1316         uint32 addr;
1317         int symbol = ent->symbol;
1318         if (symbols[symbol].type != ROUTINE_T)
1319             continue;
1320         addr = symbols[symbol].value * (glulx_mode ? 1 : scale_factor);
1321         tofunc = df_function_for_address(addr);
1322         if (!tofunc) {
1323             error_named("Internal error in stripping: global ROUTINE_T symbol is not found in df_function map:", symbols[symbol].name);
1324             continue;
1325         }
1326         /* A function may be marked here more than once. That's fine. */
1327         tofunc->usage |= DF_USAGE_GLOBAL;
1328     }
1329
1330     /* Perform a breadth-first search through functions, starting with
1331        the ones that are known to be used at the top level. */
1332     {
1333         df_function_t *todo, *todotail;
1334         df_function_t *func;
1335         todo = NULL;
1336         todotail = NULL;
1337
1338         for (func = df_functions_head; func; func = func->funcnext) {
1339             if (func->address == DF_NOT_IN_FUNCTION)
1340                 continue;
1341             if (func->usage == 0)
1342                 continue;
1343             if (!todo) {
1344                 todo = func;
1345                 todotail = func;
1346             }
1347             else {
1348                 todotail->todonext = func;
1349                 todotail = func;
1350             }
1351         }
1352
1353         /* todo is a linked list of functions which are known to be
1354            used. If a function's usage field is nonzero, it must be
1355            either be on the todo list or have come off already (in
1356            which case processed will be set). */
1357
1358         while (todo) {
1359             /* Pop the next function. */
1360             func = todo;
1361             todo = todo->todonext;
1362             if (!todo)
1363                 todotail = NULL;
1364
1365             if (func->processed)
1366                 error_named("Internal error in stripping: function has been processed twice:", func->name);
1367
1368             /* Go through the function's symbol references. Any
1369                reference to a routine, push it into the todo list (if
1370                it isn't there already). */
1371
1372             for (ent = func->refs; ent; ent=ent->refsnext) {
1373                 uint32 addr;
1374                 int symbol = ent->symbol;
1375                 if (symbols[symbol].type != ROUTINE_T)
1376                     continue;
1377                 addr = symbols[symbol].value * (glulx_mode ? 1 : scale_factor);
1378                 tofunc = df_function_for_address(addr);
1379                 if (!tofunc) {
1380                     error_named("Internal error in stripping: function ROUTINE_T symbol is not found in df_function map:", symbols[symbol].name);
1381                     continue;
1382                 }
1383                 if (tofunc->usage)
1384                     continue;
1385
1386                 /* Not yet known to be used. Add it to the todo list. */
1387                 tofunc->usage |= DF_USAGE_FUNCTION;
1388                 if (!todo) {
1389                     todo = tofunc;
1390                     todotail = tofunc;
1391                 }
1392                 else {
1393                     todotail->todonext = tofunc;
1394                     todotail = tofunc;
1395                 }
1396             }
1397
1398             func->processed = TRUE;
1399         }
1400     }
1401
1402     /* Go through all functions; figure out how much space is consumed,
1403        with and without useless functions. */
1404
1405     {
1406         df_function_t *func;
1407
1408         df_total_size_before_stripping = 0;
1409         df_total_size_after_stripping = 0;
1410
1411         for (func = df_functions_head; func; func = func->funcnext) {
1412             if (func->address == DF_NOT_IN_FUNCTION)
1413                 continue;
1414
1415             if (func->address != df_total_size_before_stripping)
1416                 compiler_error("DF: Address gap in function list");
1417
1418             df_total_size_before_stripping += func->length;
1419             if (func->usage) {
1420                 func->newaddress = df_total_size_after_stripping;
1421                 df_total_size_after_stripping += func->length;
1422             }
1423
1424             if (!glulx_mode && (df_total_size_after_stripping % scale_factor != 0))
1425                 compiler_error("DF: New function address is not aligned");
1426
1427             if (WARN_UNUSED_ROUTINES && !func->usage) {
1428                 if (!func->sysfile || WARN_UNUSED_ROUTINES >= 2)
1429                     uncalled_routine_warning("Routine", func->name, func->source_line);
1430             }
1431         }
1432     }
1433
1434     /* df_measure_hash_table_usage(); */
1435 }
1436
1437 /* Given an original function address, return where it winds up after
1438    unused-function stripping. The function must not itself be unused.
1439
1440    Both the input and output are offsets, and already scaled by
1441    scale_factor.
1442
1443    This is used by the backpatching system.
1444 */
1445 extern uint32 df_stripped_address_for_address(uint32 addr)
1446 {
1447     df_function_t *func;
1448
1449     if (!track_unused_routines)
1450         compiler_error("DF: df_stripped_address_for_address called, but function references have not been mapped");
1451
1452     if (!glulx_mode)
1453         func = df_function_for_address(addr*scale_factor);
1454     else
1455         func = df_function_for_address(addr);
1456
1457     if (!func) {
1458         compiler_error("DF: Unable to find function while backpatching");
1459         return 0;
1460     }
1461     if (!func->usage)
1462         compiler_error("DF: Tried to backpatch a function address which should be stripped");
1463
1464     if (!glulx_mode)
1465         return func->newaddress / scale_factor;
1466     else
1467         return func->newaddress;
1468 }
1469
1470 /* Given an address in the function area, return where it winds up after
1471    unused-function stripping. The address can be a function or anywhere
1472    within the function. If the address turns out to be in a stripped
1473    function, returns 0 (and sets *stripped).
1474
1475    The input and output are offsets, but *not* scaled.
1476
1477    This is only used by the debug-file system.
1478 */
1479 uint32 df_stripped_offset_for_code_offset(uint32 offset, int *stripped)
1480 {
1481     df_function_t *func;
1482     int count;
1483     int beg;
1484     int end;
1485
1486     if (!track_unused_routines)
1487         compiler_error("DF: df_stripped_offset_for_code_offset called, but function references have not been mapped");
1488
1489     if (!df_functions_sorted) {
1490         /* To do this efficiently, we need a binary-searchable table. Fine,
1491            we'll make one. Include both used and unused functions. */
1492
1493         for (func = df_functions_head, count = 0; func; func = func->funcnext) {
1494             if (func->address == DF_NOT_IN_FUNCTION)
1495                 continue;
1496             count++;
1497         }
1498         df_functions_sorted_count = count;
1499
1500         df_functions_sorted = my_calloc(sizeof(df_function_t *), df_functions_sorted_count, "df function sorted table");
1501
1502         for (func = df_functions_head, count = 0; func; func = func->funcnext) {
1503             if (func->address == DF_NOT_IN_FUNCTION)
1504                 continue;
1505             df_functions_sorted[count] = func;
1506             count++;
1507         }
1508     }
1509
1510     /* Do a binary search. Maintain beg <= res < end, where res is the
1511        function containing the desired address. */
1512     beg = 0;
1513     end = df_functions_sorted_count;
1514
1515     /* Set stripped flag until we decide on a non-stripped function. */
1516     *stripped = TRUE;
1517
1518     while (1) {
1519         int new;
1520         if (beg >= end) {
1521             error("DF: offset_for_code_offset: Could not locate address.");
1522             return 0;
1523         }
1524         if (beg+1 == end) {
1525             func = df_functions_sorted[beg];
1526             if (func->usage == 0)
1527                 return 0;
1528             *stripped = FALSE;
1529             return func->newaddress + (offset - func->address);
1530         }
1531         new = (beg + end) / 2;
1532         if (new <= beg || new >= end)
1533             compiler_error("DF: binary search went off the rails");
1534
1535         func = df_functions_sorted[new];
1536         if (offset >= func->address) {
1537             if (offset < func->address+func->length) {
1538                 /* We don't need to loop further; decide here. */
1539                 if (func->usage == 0)
1540                     return 0;
1541                 *stripped = FALSE;
1542                 return func->newaddress + (offset - func->address);
1543             }
1544             beg = new;
1545         }
1546         else {
1547             end = new;
1548         }
1549     }
1550 }
1551
1552 /* The output_file() routines in files.c have to run down the list of
1553    functions, deciding who is in and who is out. But I don't want to
1554    export the df_function_t list structure. Instead, I provide this
1555    silly iterator pair. Set it up with df_prepare_function_iterate();
1556    then repeatedly call df_next_function_iterate().
1557 */
1558
1559 extern void df_prepare_function_iterate(void)
1560 {
1561     df_iterator = df_functions_head;
1562     if (!df_iterator || df_iterator->address != DF_NOT_IN_FUNCTION)
1563         compiler_error("DF: Global namespace entry is not at the head of the chain.");
1564     if (!df_iterator->funcnext || df_iterator->funcnext->address != 0)
1565         compiler_error("DF: First function entry is not second in the chain.");
1566 }
1567
1568 /* This returns the end of the next function, and whether the next function
1569    is used (live).
1570 */
1571 extern uint32 df_next_function_iterate(int *funcused)
1572 {
1573     if (df_iterator)
1574         df_iterator = df_iterator->funcnext;
1575     if (!df_iterator) {
1576         *funcused = TRUE;
1577         return df_total_size_before_stripping+1;
1578     }
1579     *funcused = (df_iterator->usage != 0);
1580     return df_iterator->address + df_iterator->length;
1581 }
1582
1583 /* ========================================================================= */
1584 /*   Data structure management routines                                      */
1585 /* ------------------------------------------------------------------------- */
1586
1587 extern void init_symbols_vars(void)
1588 {
1589     symbols = NULL;
1590     start_of_list = NULL;
1591     symbol_debug_info = NULL;
1592     temp_symbol_buf = NULL;
1593
1594     symbol_name_space_chunks = NULL;
1595     no_symbol_name_space_chunks = 0;
1596     symbols_free_space = NULL;
1597     symbols_ceiling = NULL;
1598
1599     no_symbols = 0;
1600
1601     symbol_replacements = NULL;
1602     symbol_replacements_count = 0;
1603     symbol_replacements_size = 0;
1604
1605     make_case_conversion_grid();
1606
1607     track_unused_routines = (WARN_UNUSED_ROUTINES || OMIT_UNUSED_ROUTINES);
1608     df_tables_closed = FALSE;
1609     df_symbol_map = NULL;
1610     df_functions = NULL;
1611     df_functions_head = NULL;
1612     df_functions_tail = NULL;
1613     df_current_function = NULL;
1614     df_functions_sorted = NULL;
1615     df_functions_sorted_count = 0;
1616 }
1617
1618 extern void symbols_begin_pass(void)
1619 {
1620     df_total_size_before_stripping = 0;
1621     df_total_size_after_stripping = 0;
1622     df_dont_note_global_symbols = FALSE;
1623     df_iterator = NULL;
1624 }
1625
1626 extern void symbols_allocate_arrays(void)
1627 {
1628     initialise_memory_list(&symbols_memlist,
1629         sizeof(symbolinfo), 6400, (void**)&symbols,
1630         "symbols");
1631     if (debugfile_switch)
1632     {
1633         initialise_memory_list(&symbol_debug_info_memlist,
1634             sizeof(symboldebuginfo), 6400, (void**)&symbol_debug_info,
1635             "symbol debug backpatch info");
1636     }
1637
1638     initialise_memory_list(&temp_symbol_buf_memlist,
1639         sizeof(char), 64, (void**)&temp_symbol_buf,
1640         "temporary symbol name");
1641
1642     start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
1643                      "hash code list beginnings");
1644
1645     initialise_memory_list(&symbol_name_space_chunks_memlist,
1646         sizeof(char *), 32, (void**)&symbol_name_space_chunks,
1647         "symbol names chunk addresses");
1648
1649     if (track_unused_routines) {
1650         df_tables_closed = FALSE;
1651
1652         df_symbol_map = my_calloc(sizeof(df_reference_t *), DF_SYMBOL_HASH_BUCKETS, "df symbol-map hash table");
1653         memset(df_symbol_map, 0, sizeof(df_reference_t *) * DF_SYMBOL_HASH_BUCKETS);
1654
1655         df_functions = my_calloc(sizeof(df_function_t *), DF_FUNCTION_HASH_BUCKETS, "df function hash table");
1656         memset(df_functions, 0, sizeof(df_function_t *) * DF_FUNCTION_HASH_BUCKETS);
1657         df_functions_head = NULL;
1658         df_functions_tail = NULL;
1659
1660         df_functions_sorted = NULL;
1661         df_functions_sorted_count = 0;
1662
1663         df_note_function_start("<global namespace>", DF_NOT_IN_FUNCTION, FALSE, blank_brief_location);
1664         df_note_function_end(DF_NOT_IN_FUNCTION);
1665         /* Now df_current_function is df_functions_head. */
1666     }
1667
1668     init_symbol_banks();
1669     stockup_symbols();
1670
1671     /*  Allocated as needed  */
1672     symbol_replacements = NULL;
1673
1674     /*  Allocated during story file construction, not now  */
1675     individual_name_strings = NULL;
1676     attribute_name_strings = NULL;
1677     action_name_strings = NULL;
1678     array_name_strings = NULL;
1679 }
1680
1681 extern void symbols_free_arrays(void)
1682 {   int i;
1683
1684     for (i=0; i<no_symbol_name_space_chunks; i++)
1685         my_free(&(symbol_name_space_chunks[i]),
1686             "symbol names chunk");
1687
1688     deallocate_memory_list(&symbol_name_space_chunks_memlist);
1689
1690     deallocate_memory_list(&symbols_memlist);
1691     if (debugfile_switch)
1692     {
1693         deallocate_memory_list(&symbol_debug_info_memlist);
1694     }
1695     deallocate_memory_list(&temp_symbol_buf_memlist);
1696
1697     my_free(&start_of_list, "hash code list beginnings");
1698
1699     if (symbol_replacements)
1700         my_free(&symbol_replacements, "symbol replacement table");
1701
1702     if (df_symbol_map) {
1703         for (i=0; i<DF_SYMBOL_HASH_BUCKETS; i++) {
1704             df_reference_t *ent = df_symbol_map[i];
1705             while (ent) {
1706                 df_reference_t *next = ent->next;
1707                 my_free(&ent, "df symbol map entry");
1708                 ent = next;
1709             }
1710         }
1711         my_free(&df_symbol_map, "df symbol-map hash table");
1712     }
1713     if (df_functions_sorted) {
1714         my_free(&df_functions, "df function sorted table");
1715     }
1716     if (df_functions) {
1717         for (i=0; i<DF_FUNCTION_HASH_BUCKETS; i++) {
1718             df_function_t *func = df_functions[i];
1719             while (func) {
1720                 df_function_t *next = func->next;
1721                 my_free(&func, "df function entry");
1722                 func = next;
1723             }
1724         }
1725         my_free(&df_functions, "df function hash table");
1726     }
1727     df_functions_head = NULL;
1728     df_functions_tail = NULL;
1729
1730     if (individual_name_strings != NULL)
1731         my_free(&individual_name_strings, "property name strings");
1732     if (action_name_strings != NULL)
1733         my_free(&action_name_strings,     "action name strings");
1734     if (attribute_name_strings != NULL)
1735         my_free(&attribute_name_strings,  "attribute name strings");
1736     if (array_name_strings != NULL)
1737         my_free(&array_name_strings,      "array name strings");
1738 }
1739
1740 /* ========================================================================= */