src/symbols.c

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