symbols.c

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