src/symbols.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "symbols" :  The symbols table; creating stock of reserved words        */
   3 /*                                                                           */
   4 /* Copyright (c) Graham Nelson 1993 - 2020                                   */
   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 STATIC_ARRAY_T:        return("Static array");
 301         case CONSTANT_T:            return("Defined constant");
 302         case ATTRIBUTE_T:           return("Attribute");
 303         case PROPERTY_T:            return("Property");
 304         case INDIVIDUAL_PROPERTY_T: return("Individual property");
 305         case OBJECT_T:              return("Object");
 306         case CLASS_T:               return("Class");
 307         case FAKE_ACTION_T:         return("Fake action");
 308
 309         default:                   return("(Unknown type)");
 310     }
 311 }
 312
 313 static void describe_flags(int flags)
 314 {   if (flags & UNKNOWN_SFLAG)  printf("(?) ");
 315     if (flags & USED_SFLAG)     printf("(used) ");
 316     if (flags & REPLACE_SFLAG)  printf("(Replaced) ");
 317     if (flags & DEFCON_SFLAG)   printf("(Defaulted) ");
 318     if (flags & STUB_SFLAG)     printf("(Stubbed) ");
 319     if (flags & CHANGE_SFLAG)   printf("(value will change) ");
 320     if (flags & IMPORT_SFLAG)   printf("(Imported) ");
 321     if (flags & EXPORT_SFLAG)   printf("(Exported) ");
 322     if (flags & SYSTEM_SFLAG)   printf("(System) ");
 323     if (flags & INSF_SFLAG)     printf("(created in sys file) ");
 324     if (flags & UERROR_SFLAG)   printf("('Unknown' error issued) ");
 325     if (flags & ALIASED_SFLAG)  printf("(aliased) ");
 326     if (flags & ACTION_SFLAG)   printf("(Action name) ");
 327     if (flags & REDEFINABLE_SFLAG) printf("(Redefinable) ");
 328 }
 329
 330 extern void describe_symbol(int k)
 331 {   printf("%4d  %-16s  %2d:%04d  %04x  %s  ",
 332         k, (char *) (symbs[k]),
 333         (int)(slines[k].file_index),
 334         (int)(slines[k].line_number),
 335         svals[k], typename(stypes[k]));
 336     describe_flags(sflags[k]);
 337 }
 338
 339 extern void list_symbols(int level)
 340 {   int k;
 341     for (k=0; k<no_symbols; k++)
 342     {   if ((level==2) ||
 343             ((sflags[k] & (SYSTEM_SFLAG + UNKNOWN_SFLAG + INSF_SFLAG)) == 0))
 344         {   describe_symbol(k); printf("\n");
 345         }
 346     }
 347 }
 348
 349 extern void issue_unused_warnings(void)
 350 {   int32 i;
 351
 352     if (module_switch) return;
 353
 354     /*  Update any ad-hoc variables that might help the library  */
 355     if (glulx_mode)
 356     {   global_initial_value[10]=statusline_flag;
 357     }
 358     /*  Now back to mark anything necessary as used  */
 359
 360     i = symbol_index("Main", -1);
 361     if (!(sflags[i] & UNKNOWN_SFLAG)) sflags[i] |= USED_SFLAG;
 362
 363     for (i=0;i<no_symbols;i++)
 364     {   if (((sflags[i]
 365              & (SYSTEM_SFLAG + UNKNOWN_SFLAG + EXPORT_SFLAG
 366                 + INSF_SFLAG + USED_SFLAG + REPLACE_SFLAG)) == 0)
 367              && (stypes[i] != OBJECT_T))
 368             dbnu_warning(typename(stypes[i]), (char *) symbs[i], slines[i]);
 369     }
 370 }
 371
 372 /* ------------------------------------------------------------------------- */
 373 /*   These are arrays used only during story file (never module) creation,   */
 374 /*   and not allocated until then.                                           */
 375
 376        int32 *individual_name_strings; /* Packed addresses of Z-encoded
 377                                           strings of the names of the
 378                                           properties: this is an array
 379                                           indexed by the property ID         */
 380        int32 *action_name_strings;     /* Ditto for actions                  */
 381        int32 *attribute_name_strings;  /* Ditto for attributes               */
 382        int32 *array_name_strings;      /* Ditto for arrays                   */
 383
 384 extern void write_the_identifier_names(void)
 385 {   int i, j, k, t, null_value; char idname_string[256];
 386     static char unknown_attribute[20] = "<unknown attribute>";
 387
 388     for (i=0; i<no_individual_properties; i++)
 389         individual_name_strings[i] = 0;
 390
 391     if (module_switch) return;
 392
 393     veneer_mode = TRUE;
 394
 395     null_value = compile_string(unknown_attribute, FALSE, FALSE);
 396     for (i=0; i<NUM_ATTR_BYTES*8; i++) attribute_name_strings[i] = null_value;
 397
 398     for (i=0; i<no_symbols; i++)
 399     {   t=stypes[i];
 400         if ((t == INDIVIDUAL_PROPERTY_T) || (t == PROPERTY_T))
 401         {   if (sflags[i] & ALIASED_SFLAG)
 402             {   if (individual_name_strings[svals[i]] == 0)
 403                 {   sprintf(idname_string, "%s", (char *) symbs[i]);
 404
 405                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
 406                     {   if ((stypes[j] == stypes[i])
 407                             && (svals[j] == svals[i]))
 408                         {   sprintf(idname_string+strlen(idname_string),
 409                                 "/%s", (char *) symbs[j]);
 410                             k++;
 411                         }
 412                     }
 413
 414                     individual_name_strings[svals[i]]
 415                         = compile_string(idname_string, FALSE, FALSE);
 416                 }
 417             }
 418             else
 419             {   sprintf(idname_string, "%s", (char *) symbs[i]);
 420
 421                 individual_name_strings[svals[i]]
 422                     = compile_string(idname_string, FALSE, FALSE);
 423             }
 424         }
 425         if (t == ATTRIBUTE_T)
 426         {   if (sflags[i] & ALIASED_SFLAG)
 427             {   if (attribute_name_strings[svals[i]] == null_value)
 428                 {   sprintf(idname_string, "%s", (char *) symbs[i]);
 429
 430                     for (j=i+1, k=0; (j<no_symbols && k<3); j++)
 431                     {   if ((stypes[j] == stypes[i])
 432                             && (svals[j] == svals[i]))
 433                         {   sprintf(idname_string+strlen(idname_string),
 434                                 "/%s", (char *) symbs[j]);
 435                             k++;
 436                         }
 437                     }
 438
 439                     attribute_name_strings[svals[i]]
 440                         = compile_string(idname_string, FALSE, FALSE);
 441                 }
 442             }
 443             else
 444             {   sprintf(idname_string, "%s", (char *) symbs[i]);
 445
 446                 attribute_name_strings[svals[i]]
 447                     = compile_string(idname_string, FALSE, FALSE);
 448             }
 449         }
 450         if (sflags[i] & ACTION_SFLAG)
 451         {   sprintf(idname_string, "%s", (char *) symbs[i]);
 452             idname_string[strlen(idname_string)-3] = 0;
 453
 454             if (debugfile_switch)
 455             {   debug_file_printf("<action>");
 456                 debug_file_printf
 457                     ("<identifier>##%s</identifier>", idname_string);
 458                 debug_file_printf("<value>%d</value>", svals[i]);
 459                 debug_file_printf("</action>");
 460             }
 461
 462             action_name_strings[svals[i]]
 463                 = compile_string(idname_string, FALSE, FALSE);
 464         }
 465     }
 466
 467     for (i=0; i<no_symbols; i++)
 468     {   if (stypes[i] == FAKE_ACTION_T)
 469         {   sprintf(idname_string, "%s", (char *) symbs[i]);
 470             idname_string[strlen(idname_string)-3] = 0;
 471
 472             action_name_strings[svals[i]
 473                     - ((grammar_version_number==1)?256:4096) + no_actions]
 474                 = compile_string(idname_string, FALSE, FALSE);
 475         }
 476     }
 477
 478     for (j=0; j<no_arrays; j++)
 479     {   i = array_symbols[j];
 480         sprintf(idname_string, "%s", (char *) symbs[i]);
 481
 482         array_name_strings[j]
 483             = compile_string(idname_string, FALSE, FALSE);
 484     }
 485   if (define_INFIX_switch)
 486   { for (i=0; i<no_symbols; i++)
 487     {   if (stypes[i] == GLOBAL_VARIABLE_T)
 488         {   sprintf(idname_string, "%s", (char *) symbs[i]);
 489             array_name_strings[no_arrays + svals[i] -16]
 490                 = compile_string(idname_string, FALSE, FALSE);
 491         }
 492     }
 493
 494     for (i=0; i<no_named_routines; i++)
 495     {   sprintf(idname_string, "%s", (char *) symbs[named_routine_symbols[i]]);
 496             array_name_strings[no_arrays + no_globals + i]
 497                 = compile_string(idname_string, FALSE, FALSE);
 498     }
 499
 500     for (i=0, no_named_constants=0; i<no_symbols; i++)
 501     {   if (((stypes[i] == OBJECT_T) || (stypes[i] == CLASS_T)
 502             || (stypes[i] == CONSTANT_T))
 503             && ((sflags[i] & (UNKNOWN_SFLAG+ACTION_SFLAG))==0))
 504         {   sprintf(idname_string, "%s", (char *) symbs[i]);
 505             array_name_strings[no_arrays + no_globals + no_named_routines
 506                 + no_named_constants++]
 507                 = compile_string(idname_string, FALSE, FALSE);
 508         }
 509     }
 510   }
 511
 512     veneer_mode = FALSE;
 513 }
 514 /* ------------------------------------------------------------------------- */
 515 /*   Creating symbols                                                        */
 516 /* ------------------------------------------------------------------------- */
 517
 518 static void assign_symbol_base(int index, int32 value, int type)
 519 {   svals[index]  = value;
 520     stypes[index] = type;
 521     if (sflags[index] & UNKNOWN_SFLAG)
 522     {   sflags[index] &= (~UNKNOWN_SFLAG);
 523         if (is_systemfile()) sflags[index] |= INSF_SFLAG;
 524         slines[index] = get_brief_location(&ErrorReport);
 525     }
 526 }
 527
 528 extern void assign_symbol(int index, int32 value, int type)
 529 {
 530     if (!glulx_mode) {
 531         assign_symbol_base(index, value, type);
 532     }
 533     else {
 534         smarks[index] = 0;
 535         assign_symbol_base(index, value, type);
 536     }
 537 }
 538
 539 extern void assign_marked_symbol(int index, int marker, int32 value, int type)
 540 {
 541     if (!glulx_mode) {
 542         assign_symbol_base(index, (int32)marker*0x10000 + (value % 0x10000),
 543             type);
 544     }
 545     else {
 546         smarks[index] = marker;
 547         assign_symbol_base(index, value, type);
 548     }
 549 }
 550
 551 static void emit_debug_information_for_predefined_symbol
 552     (char *name, int32 symbol, int32 value, int type)
 553 {   if (debugfile_switch)
 554     {   switch (type)
 555         {   case CONSTANT_T:
 556                 debug_file_printf("<constant>");
 557                 debug_file_printf("<identifier>%s</identifier>", name);
 558                 write_debug_symbol_optional_backpatch(symbol);
 559                 debug_file_printf("</constant>");
 560                 break;
 561             case GLOBAL_VARIABLE_T:
 562                 debug_file_printf("<global-variable>");
 563                 debug_file_printf("<identifier>%s</identifier>", name);
 564                 debug_file_printf("<address>");
 565                 write_debug_global_backpatch(value);
 566                 debug_file_printf("</address>");
 567                 debug_file_printf("</global-variable>");
 568                 break;
 569             case OBJECT_T:
 570                 if (value)
 571                 {   compiler_error("Non-nothing object predefined");
 572                 }
 573                 debug_file_printf("<object>");
 574                 debug_file_printf("<identifier>%s</identifier>", name);
 575                 debug_file_printf("<value>0</value>");
 576                 debug_file_printf("</object>");
 577                 break;
 578             case ATTRIBUTE_T:
 579                 debug_file_printf("<attribute>");
 580                 debug_file_printf("<identifier>%s</identifier>", name);
 581                 debug_file_printf("<value>%d</value>", value);
 582                 debug_file_printf("</attribute>");
 583                 break;
 584             case PROPERTY_T:
 585             case INDIVIDUAL_PROPERTY_T:
 586                 debug_file_printf("<property>");
 587                 debug_file_printf("<identifier>%s</identifier>", name);
 588                 debug_file_printf("<value>%d</value>", value);
 589                 debug_file_printf("</property>");
 590                 break;
 591             default:
 592                 compiler_error
 593                     ("Unable to emit debug information for predefined symbol");
 594             break;
 595         }
 596     }
 597 }
 598
 599 static void create_symbol(char *p, int32 value, int type)
 600 {   int i = symbol_index(p, -1);
 601     svals[i] = value; stypes[i] = type; slines[i] = blank_brief_location;
 602     sflags[i] = USED_SFLAG + SYSTEM_SFLAG;
 603     emit_debug_information_for_predefined_symbol(p, i, value, type);
 604 }
 605
 606 static void create_rsymbol(char *p, int value, int type)
 607 {   int i = symbol_index(p, -1);
 608     svals[i] = value; stypes[i] = type; slines[i] = blank_brief_location;
 609     sflags[i] = USED_SFLAG + SYSTEM_SFLAG + REDEFINABLE_SFLAG;
 610     emit_debug_information_for_predefined_symbol(p, i, value, type);
 611 }
 612
 613 static void stockup_symbols(void)
 614 {
 615     if (!glulx_mode)
 616         create_symbol("TARGET_ZCODE", 0, CONSTANT_T);
 617     else
 618         create_symbol("TARGET_GLULX", 0, CONSTANT_T);
 619
 620     create_symbol("nothing",        0, OBJECT_T);
 621     create_symbol("name",           1, PROPERTY_T);
 622
 623     create_symbol("true",           1, CONSTANT_T);
 624     create_symbol("false",          0, CONSTANT_T);
 625
 626     /* Glulx defaults to GV2; Z-code to GV1 */
 627     if (!glulx_mode)
 628         create_rsymbol("Grammar__Version", 1, CONSTANT_T);
 629     else
 630         create_rsymbol("Grammar__Version", 2, CONSTANT_T);
 631     grammar_version_symbol = symbol_index("Grammar__Version", -1);
 632
 633     if (module_switch)
 634         create_rsymbol("MODULE_MODE",0, CONSTANT_T);
 635
 636     if (runtime_error_checking_switch)
 637         create_rsymbol("STRICT_MODE",0, CONSTANT_T);
 638
 639     if (define_DEBUG_switch)
 640         create_rsymbol("DEBUG",      0, CONSTANT_T);
 641
 642     if (define_USE_MODULES_switch)
 643         create_rsymbol("USE_MODULES",0, CONSTANT_T);
 644
 645     if (define_INFIX_switch)
 646     {   create_rsymbol("INFIX",      0, CONSTANT_T);
 647         create_symbol("infix__watching", 0, ATTRIBUTE_T);
 648     }
 649
 650     create_symbol("WORDSIZE",        WORDSIZE, CONSTANT_T);
 651     create_symbol("DICT_ENTRY_BYTES", DICT_ENTRY_BYTE_LENGTH, CONSTANT_T);
 652     if (!glulx_mode) {
 653         create_symbol("DICT_WORD_SIZE", ((version_number==3)?4:6), CONSTANT_T);
 654         create_symbol("NUM_ATTR_BYTES", ((version_number==3)?4:6), CONSTANT_T);
 655     }
 656     else {
 657         create_symbol("DICT_WORD_SIZE",     DICT_WORD_SIZE, CONSTANT_T);
 658         create_symbol("DICT_CHAR_SIZE",     DICT_CHAR_SIZE, CONSTANT_T);
 659         if (DICT_CHAR_SIZE != 1)
 660             create_symbol("DICT_IS_UNICODE", 1, CONSTANT_T);
 661         create_symbol("NUM_ATTR_BYTES",     NUM_ATTR_BYTES, CONSTANT_T);
 662         create_symbol("GOBJFIELD_CHAIN",    GOBJFIELD_CHAIN(), CONSTANT_T);
 663         create_symbol("GOBJFIELD_NAME",     GOBJFIELD_NAME(), CONSTANT_T);
 664         create_symbol("GOBJFIELD_PROPTAB",  GOBJFIELD_PROPTAB(), CONSTANT_T);
 665         create_symbol("GOBJFIELD_PARENT",   GOBJFIELD_PARENT(), CONSTANT_T);
 666         create_symbol("GOBJFIELD_SIBLING",  GOBJFIELD_SIBLING(), CONSTANT_T);
 667         create_symbol("GOBJFIELD_CHILD",    GOBJFIELD_CHILD(), CONSTANT_T);
 668         create_symbol("GOBJ_EXT_START",     1+NUM_ATTR_BYTES+6*WORDSIZE, CONSTANT_T);
 669         create_symbol("GOBJ_TOTAL_LENGTH",  1+NUM_ATTR_BYTES+6*WORDSIZE+GLULX_OBJECT_EXT_BYTES, CONSTANT_T);
 670         create_symbol("INDIV_PROP_START",   INDIV_PROP_START, CONSTANT_T);
 671     }
 672
 673     if (!glulx_mode) {
 674         create_symbol("temp_global",  255, GLOBAL_VARIABLE_T);
 675         create_symbol("temp__global2", 254, GLOBAL_VARIABLE_T);
 676         create_symbol("temp__global3", 253, GLOBAL_VARIABLE_T);
 677         create_symbol("temp__global4", 252, GLOBAL_VARIABLE_T);
 678         create_symbol("self",         251, GLOBAL_VARIABLE_T);
 679         create_symbol("sender",       250, GLOBAL_VARIABLE_T);
 680         create_symbol("sw__var",      249, GLOBAL_VARIABLE_T);
 681
 682         create_symbol("sys__glob0",     16, GLOBAL_VARIABLE_T);
 683         create_symbol("sys__glob1",     17, GLOBAL_VARIABLE_T);
 684         create_symbol("sys__glob2",     18, GLOBAL_VARIABLE_T);
 685
 686         create_symbol("create",        64, INDIVIDUAL_PROPERTY_T);
 687         create_symbol("recreate",      65, INDIVIDUAL_PROPERTY_T);
 688         create_symbol("destroy",       66, INDIVIDUAL_PROPERTY_T);
 689         create_symbol("remaining",     67, INDIVIDUAL_PROPERTY_T);
 690         create_symbol("copy",          68, INDIVIDUAL_PROPERTY_T);
 691         create_symbol("call",          69, INDIVIDUAL_PROPERTY_T);
 692         create_symbol("print",         70, INDIVIDUAL_PROPERTY_T);
 693         create_symbol("print_to_array",71, INDIVIDUAL_PROPERTY_T);
 694     }
 695     else {
 696         /* In Glulx, these system globals are entered in order, not down
 697            from 255. */
 698         create_symbol("temp_global",  MAX_LOCAL_VARIABLES+0,
 699           GLOBAL_VARIABLE_T);
 700         create_symbol("temp__global2", MAX_LOCAL_VARIABLES+1,
 701           GLOBAL_VARIABLE_T);
 702         create_symbol("temp__global3", MAX_LOCAL_VARIABLES+2,
 703           GLOBAL_VARIABLE_T);
 704         create_symbol("temp__global4", MAX_LOCAL_VARIABLES+3,
 705           GLOBAL_VARIABLE_T);
 706         create_symbol("self",         MAX_LOCAL_VARIABLES+4,
 707           GLOBAL_VARIABLE_T);
 708         create_symbol("sender",       MAX_LOCAL_VARIABLES+5,
 709           GLOBAL_VARIABLE_T);
 710         create_symbol("sw__var",      MAX_LOCAL_VARIABLES+6,
 711           GLOBAL_VARIABLE_T);
 712
 713         /* These are almost certainly meaningless, and can be removed. */
 714         create_symbol("sys__glob0",     MAX_LOCAL_VARIABLES+7,
 715           GLOBAL_VARIABLE_T);
 716         create_symbol("sys__glob1",     MAX_LOCAL_VARIABLES+8,
 717           GLOBAL_VARIABLE_T);
 718         create_symbol("sys__glob2",     MAX_LOCAL_VARIABLES+9,
 719           GLOBAL_VARIABLE_T);
 720
 721         /* value of statusline_flag to be written later */
 722         create_symbol("sys_statusline_flag",  MAX_LOCAL_VARIABLES+10,
 723           GLOBAL_VARIABLE_T);
 724
 725         /* These are created in order, but not necessarily at a fixed
 726            value. */
 727         create_symbol("create",        INDIV_PROP_START+0,
 728           INDIVIDUAL_PROPERTY_T);
 729         create_symbol("recreate",      INDIV_PROP_START+1,
 730           INDIVIDUAL_PROPERTY_T);
 731         create_symbol("destroy",       INDIV_PROP_START+2,
 732           INDIVIDUAL_PROPERTY_T);
 733         create_symbol("remaining",     INDIV_PROP_START+3,
 734           INDIVIDUAL_PROPERTY_T);
 735         create_symbol("copy",          INDIV_PROP_START+4,
 736           INDIVIDUAL_PROPERTY_T);
 737         create_symbol("call",          INDIV_PROP_START+5,
 738           INDIVIDUAL_PROPERTY_T);
 739         create_symbol("print",         INDIV_PROP_START+6,
 740           INDIVIDUAL_PROPERTY_T);
 741         create_symbol("print_to_array",INDIV_PROP_START+7,
 742           INDIVIDUAL_PROPERTY_T);
 743
 744         /* Floating-point constants. Note that FLOAT_NINFINITY is not
 745            -FLOAT_INFINITY, because float negation doesn't work that
 746            way. Also note that FLOAT_NAN is just one of many possible
 747            "not-a-number" values. */
 748         create_symbol("FLOAT_INFINITY",  0x7F800000, CONSTANT_T);
 749         create_symbol("FLOAT_NINFINITY", 0xFF800000, CONSTANT_T);
 750         create_symbol("FLOAT_NAN",       0x7FC00000, CONSTANT_T);
 751     }
 752 }
 753
 754 /* ------------------------------------------------------------------------- */
 755 /*   The symbol replacement table. This is needed only for the               */
 756 /*   "Replace X Y" directive.                                                */
 757 /* ------------------------------------------------------------------------- */
 758
 759 extern void add_symbol_replacement_mapping(int original, int renamed)
 760 {
 761     int ix;
 762
 763     if (original == renamed) {
 764         error_named("A routine cannot be 'Replace'd to itself:", (char *)symbs[original]);
 765         return;
 766     }
 767
 768     if (symbol_replacements_count == symbol_replacements_size) {
 769         int oldsize = symbol_replacements_size;
 770         if (symbol_replacements_size == 0)
 771             symbol_replacements_size = 4;
 772         else
 773             symbol_replacements_size *= 2;
 774         my_recalloc(&symbol_replacements, sizeof(value_pair_t), oldsize,
 775             symbol_replacements_size, "symbol replacement table");
 776     }
 777
 778     /* If the original form is already in our table, report an error.
 779        Same goes if the replaced form is already in the table as an
 780        original. (Other collision cases have already been
 781        detected.) */
 782
 783     for (ix=0; ix<symbol_replacements_count; ix++) {
 784         if (original == symbol_replacements[ix].original_symbol) {
 785             error_named("A routine cannot be 'Replace'd to more than one new name:", (char *)symbs[original]);
 786         }
 787         if (renamed == symbol_replacements[ix].original_symbol) {
 788             error_named("A routine cannot be 'Replace'd to a 'Replace'd name:", (char *)symbs[original]);
 789         }
 790     }
 791
 792     symbol_replacements[symbol_replacements_count].original_symbol = original;
 793     symbol_replacements[symbol_replacements_count].renamed_symbol = renamed;
 794     symbol_replacements_count++;
 795 }
 796
 797 extern int find_symbol_replacement(int *value)
 798 {
 799     int changed = FALSE;
 800     int ix;
 801
 802     if (!symbol_replacements)
 803         return FALSE;
 804
 805     for (ix=0; ix<symbol_replacements_count; ix++) {
 806         if (*value == symbol_replacements[ix].original_symbol) {
 807             *value = symbol_replacements[ix].renamed_symbol;
 808             changed = TRUE;
 809         }
 810     }
 811
 812     return changed;
 813 }
 814
 815 /* ------------------------------------------------------------------------- */
 816 /*   The dead-function removal optimization.                                 */
 817 /* ------------------------------------------------------------------------- */
 818
 819 int track_unused_routines; /* set if either WARN_UNUSED_ROUTINES or
 820                               OMIT_UNUSED_ROUTINES is nonzero */
 821 int df_dont_note_global_symbols; /* temporarily set at times in parsing */
 822 static int df_tables_closed; /* set at end of compiler pass */
 823
 824 typedef struct df_function_struct df_function_t;
 825 typedef struct df_reference_struct df_reference_t;
 826
 827 struct df_function_struct {
 828     char *name; /* borrowed reference, generally to the symbs[] table */
 829     brief_location source_line; /* copied from routine_starts_line */
 830     int sysfile; /* does this occur in a system file? */
 831     uint32 address; /* function offset in zcode_area (not the final address) */
 832     uint32 newaddress; /* function offset after stripping */
 833     uint32 length;
 834     int usage;
 835     df_reference_t *refs; /* chain of references made *from* this function */
 836     int processed;
 837
 838     df_function_t *funcnext; /* in forward functions order */
 839     df_function_t *todonext; /* in the todo chain */
 840     df_function_t *next; /* in the hash table */
 841 };
 842
 843 struct df_reference_struct {
 844     uint32 address; /* function offset in zcode_area (not the final address) */
 845     int symbol; /* index in symbols array */
 846
 847     df_reference_t *refsnext; /* in the function's refs chain */
 848     df_reference_t *next; /* in the hash table */
 849 };
 850
 851 /* Bitmask flags for how functions are used: */
 852 #define DF_USAGE_GLOBAL   (1<<0) /* In a global variable, array, etc */
 853 #define DF_USAGE_EMBEDDED (1<<1) /* An anonymous function in a property */
 854 #define DF_USAGE_MAIN     (1<<2) /* Main() or Main__() */
 855 #define DF_USAGE_FUNCTION (1<<3) /* Used from another used function */
 856
 857 #define DF_FUNCTION_HASH_BUCKETS (1023)
 858
 859 /* Table of all compiled functions. (Only created if track_unused_routines
 860    is set.) This is a hash table. */
 861 static df_function_t **df_functions;
 862 /* List of all compiled functions, in address order. The first entry
 863    has address DF_NOT_IN_FUNCTION, and stands in for the global namespace. */
 864 static df_function_t *df_functions_head;
 865 static df_function_t *df_functions_tail;
 866 /* Used during output_file(), to track how far the code-area output has
 867    gotten. */
 868 static df_function_t *df_iterator;
 869
 870 /* Array of all compiled functions in address order. (Does not include
 871    the global namespace entry.) This is generated only if needed. */
 872 static df_function_t **df_functions_sorted;
 873 static int df_functions_sorted_count;
 874
 875 #define DF_NOT_IN_FUNCTION ((uint32)0xFFFFFFFF)
 876 #define DF_SYMBOL_HASH_BUCKETS (4095)
 877
 878 /* Map of what functions reference what other functions. (Only created if
 879    track_unused_routines is set.) */
 880 static df_reference_t **df_symbol_map;
 881
 882 /* Globals used while a function is being compiled. When a function
 883   *isn't* being compiled, df_current_function_addr will be DF_NOT_IN_FUNCTION
 884   and df_current_function will refer to the global namespace record. */
 885 static df_function_t *df_current_function;
 886 static char *df_current_function_name;
 887 static uint32 df_current_function_addr;
 888
 889 /* Size totals for compiled code. These are only meaningful if
 890    track_unused_routines is true. (If we're only doing WARN_UNUSED_ROUTINES,
 891    these values will be set, but the "after" value will not affect the
 892    final game file.) */
 893 uint32 df_total_size_before_stripping;
 894 uint32 df_total_size_after_stripping;
 895
 896 /* When we begin compiling a function, call this to note that fact.
 897    Any symbol referenced from now on will be associated with the function.
 898 */
 899 extern void df_note_function_start(char *name, uint32 address,
 900     int embedded_flag, brief_location source_line)
 901 {
 902     df_function_t *func;
 903     int bucket;
 904
 905     if (df_tables_closed)
 906         error("Internal error in stripping: Tried to start a new function after tables were closed.");
 907
 908     /* We retain the name only for debugging output. Note that embedded
 909        functions all show up as "<embedded>" -- their "obj.prop" name
 910        never gets stored in permanent memory. */
 911     df_current_function_name = name;
 912     df_current_function_addr = address;
 913
 914     func = my_malloc(sizeof(df_function_t), "df function entry");
 915     memset(func, 0, sizeof(df_function_t));
 916     func->name = name;
 917     func->address = address;
 918     func->source_line = source_line;
 919     func->sysfile = (address == DF_NOT_IN_FUNCTION || is_systemfile());
 920     /* An embedded function is stored in an object property, so we
 921        consider it to be used a priori. */
 922     if (embedded_flag)
 923         func->usage |= DF_USAGE_EMBEDDED;
 924
 925     if (!df_functions_head) {
 926         df_functions_head = func;
 927         df_functions_tail = func;
 928     }
 929     else {
 930         df_functions_tail->funcnext = func;
 931         df_functions_tail = func;
 932     }
 933
 934     bucket = address % DF_FUNCTION_HASH_BUCKETS;
 935     func->next = df_functions[bucket];
 936     df_functions[bucket] = func;
 937
 938     df_current_function = func;
 939 }
 940
 941 /* When we're done compiling a function, call this. Any symbol referenced
 942    from now on will be associated with the global namespace.
 943 */
 944 extern void df_note_function_end(uint32 endaddress)
 945 {
 946     df_current_function->length = endaddress - df_current_function->address;
 947
 948     df_current_function_name = NULL;
 949     df_current_function_addr = DF_NOT_IN_FUNCTION;
 950     df_current_function = df_functions_head; /* the global namespace */
 951 }
 952
 953 /* Find the function record for a given address. (Addresses are offsets
 954    in zcode_area.)
 955 */
 956 static df_function_t *df_function_for_address(uint32 address)
 957 {
 958     int bucket = address % DF_FUNCTION_HASH_BUCKETS;
 959     df_function_t *func;
 960     for (func = df_functions[bucket]; func; func = func->next) {
 961         if (func->address == address)
 962             return func;
 963     }
 964     return NULL;
 965 }
 966
 967 /* Whenever a function is referenced, we call this to note who called it.
 968 */
 969 extern void df_note_function_symbol(int symbol)
 970 {
 971     int bucket, symtype;
 972     df_reference_t *ent;
 973
 974     /* If the compiler pass is over, looking up symbols does not create
 975        a global reference. */
 976     if (df_tables_closed)
 977         return;
 978     /* In certain cases during parsing, looking up symbols does not
 979        create a global reference. (For example, when reading the name
 980        of a function being defined.) */
 981     if (df_dont_note_global_symbols)
 982         return;
 983
 984     /* We are only interested in functions, or forward-declared symbols
 985        that might turn out to be functions. */
 986     symtype = stypes[symbol];
 987     if (symtype != ROUTINE_T && symtype != CONSTANT_T)
 988         return;
 989     if (symtype == CONSTANT_T && !(sflags[symbol] & UNKNOWN_SFLAG))
 990         return;
 991
 992     bucket = (df_current_function_addr ^ (uint32)symbol) % DF_SYMBOL_HASH_BUCKETS;
 993     for (ent = df_symbol_map[bucket]; ent; ent = ent->next) {
 994         if (ent->address == df_current_function_addr && ent->symbol == symbol)
 995             return;
 996     }
 997
 998     /* Create a new reference entry in df_symbol_map. */
 999     ent = my_malloc(sizeof(df_reference_t), "df symbol map entry");
1000     ent->address = df_current_function_addr;
1001     ent->symbol = symbol;
1002     ent->next = df_symbol_map[bucket];
1003     df_symbol_map[bucket] = ent;
1004
1005     /* Add the reference to the function's entry as well. */
1006     /* The current function is the most recently added, so it will be
1007        at the top of its bucket. That makes this call fast. Unless
1008        we're in global scope, in which case it might be slower.
1009        (I suppose we could cache the df_function_t pointer of the
1010        current function, to speed things up.) */
1011     if (!df_current_function || df_current_function_addr != df_current_function->address)
1012         compiler_error("DF: df_current_function does not match current address.");
1013     ent->refsnext = df_current_function->refs;
1014     df_current_function->refs = ent;
1015 }
1016
1017 /* This does the hard work of figuring out what functions are truly dead.
1018    It's called near the end of run_pass() in inform.c.
1019 */
1020 extern void locate_dead_functions(void)
1021 {
1022     df_function_t *func, *tofunc;
1023     df_reference_t *ent;
1024     int ix;
1025
1026     if (!track_unused_routines)
1027         compiler_error("DF: locate_dead_functions called, but function references have not been mapped");
1028
1029     df_tables_closed = TRUE;
1030     df_current_function = NULL;
1031
1032     /* Note that Main__ was tagged as global implicitly during
1033        compile_initial_routine(). Main was tagged during
1034        issue_unused_warnings(). But for the sake of thoroughness,
1035        we'll mark them specially. */
1036
1037     ix = symbol_index("Main__", -1);
1038     if (stypes[ix] == ROUTINE_T) {
1039         uint32 addr = svals[ix] * (glulx_mode ? 1 : scale_factor);
1040         tofunc = df_function_for_address(addr);
1041         if (tofunc)
1042             tofunc->usage |= DF_USAGE_MAIN;
1043     }
1044     ix = symbol_index("Main", -1);
1045     if (stypes[ix] == ROUTINE_T) {
1046         uint32 addr = svals[ix] * (glulx_mode ? 1 : scale_factor);
1047         tofunc = df_function_for_address(addr);
1048         if (tofunc)
1049             tofunc->usage |= DF_USAGE_MAIN;
1050     }
1051
1052     /* Go through all the functions referenced at the global level;
1053        mark them as used. */
1054
1055     func = df_functions_head;
1056     if (!func || func->address != DF_NOT_IN_FUNCTION)
1057         compiler_error("DF: Global namespace entry is not at the head of the chain.");
1058
1059     for (ent = func->refs; ent; ent=ent->refsnext) {
1060         uint32 addr;
1061         int symbol = ent->symbol;
1062         if (stypes[symbol] != ROUTINE_T)
1063             continue;
1064         addr = svals[symbol] * (glulx_mode ? 1 : scale_factor);
1065         tofunc = df_function_for_address(addr);
1066         if (!tofunc) {
1067             error_named("Internal error in stripping: global ROUTINE_T symbol is not found in df_function map:", (char *)symbs[symbol]);
1068             continue;
1069         }
1070         /* A function may be marked here more than once. That's fine. */
1071         tofunc->usage |= DF_USAGE_GLOBAL;
1072     }
1073
1074     /* Perform a breadth-first search through functions, starting with
1075        the ones that are known to be used at the top level. */
1076     {
1077         df_function_t *todo, *todotail;
1078         df_function_t *func;
1079         todo = NULL;
1080         todotail = NULL;
1081
1082         for (func = df_functions_head; func; func = func->funcnext) {
1083             if (func->address == DF_NOT_IN_FUNCTION)
1084                 continue;
1085             if (func->usage == 0)
1086                 continue;
1087             if (!todo) {
1088                 todo = func;
1089                 todotail = func;
1090             }
1091             else {
1092                 todotail->todonext = func;
1093                 todotail = func;
1094             }
1095         }
1096
1097         /* todo is a linked list of functions which are known to be
1098            used. If a function's usage field is nonzero, it must be
1099            either be on the todo list or have come off already (in
1100            which case processed will be set). */
1101
1102         while (todo) {
1103             /* Pop the next function. */
1104             func = todo;
1105             todo = todo->todonext;
1106             if (!todo)
1107                 todotail = NULL;
1108
1109             if (func->processed)
1110                 error_named("Internal error in stripping: function has been processed twice:", func->name);
1111
1112             /* Go through the function's symbol references. Any
1113                reference to a routine, push it into the todo list (if
1114                it isn't there already). */
1115
1116             for (ent = func->refs; ent; ent=ent->refsnext) {
1117                 uint32 addr;
1118                 int symbol = ent->symbol;
1119                 if (stypes[symbol] != ROUTINE_T)
1120                     continue;
1121                 addr = svals[symbol] * (glulx_mode ? 1 : scale_factor);
1122                 tofunc = df_function_for_address(addr);
1123                 if (!tofunc) {
1124                     error_named("Internal error in stripping: function ROUTINE_T symbol is not found in df_function map:", (char *)symbs[symbol]);
1125                     continue;
1126                 }
1127                 if (tofunc->usage)
1128                     continue;
1129
1130                 /* Not yet known to be used. Add it to the todo list. */
1131                 tofunc->usage |= DF_USAGE_FUNCTION;
1132                 if (!todo) {
1133                     todo = tofunc;
1134                     todotail = tofunc;
1135                 }
1136                 else {
1137                     todotail->todonext = tofunc;
1138                     todotail = tofunc;
1139                 }
1140             }
1141
1142             func->processed = TRUE;
1143         }
1144     }
1145
1146     /* Go through all functions; figure out how much space is consumed,
1147        with and without useless functions. */
1148
1149     {
1150         df_function_t *func;
1151
1152         df_total_size_before_stripping = 0;
1153         df_total_size_after_stripping = 0;
1154
1155         for (func = df_functions_head; func; func = func->funcnext) {
1156             if (func->address == DF_NOT_IN_FUNCTION)
1157                 continue;
1158
1159             if (func->address != df_total_size_before_stripping)
1160                 compiler_error("DF: Address gap in function list");
1161
1162             df_total_size_before_stripping += func->length;
1163             if (func->usage) {
1164                 func->newaddress = df_total_size_after_stripping;
1165                 df_total_size_after_stripping += func->length;
1166             }
1167
1168             if (!glulx_mode && (df_total_size_after_stripping % scale_factor != 0))
1169                 compiler_error("DF: New function address is not aligned");
1170
1171             if (WARN_UNUSED_ROUTINES && !func->usage) {
1172                 if (!func->sysfile || WARN_UNUSED_ROUTINES >= 2)
1173                     uncalled_routine_warning("Routine", func->name, func->source_line);
1174             }
1175         }
1176     }
1177
1178     /* df_measure_hash_table_usage(); */
1179 }
1180
1181 /* Given an original function address, return where it winds up after
1182    unused-function stripping. The function must not itself be unused.
1183
1184    Both the input and output are offsets, and already scaled by
1185    scale_factor.
1186
1187    This is used by the backpatching system.
1188 */
1189 extern uint32 df_stripped_address_for_address(uint32 addr)
1190 {
1191     df_function_t *func;
1192
1193     if (!track_unused_routines)
1194         compiler_error("DF: df_stripped_address_for_address called, but function references have not been mapped");
1195
1196     if (!glulx_mode)
1197         func = df_function_for_address(addr*scale_factor);
1198     else
1199         func = df_function_for_address(addr);
1200
1201     if (!func) {
1202         compiler_error("DF: Unable to find function while backpatching");
1203         return 0;
1204     }
1205     if (!func->usage)
1206         compiler_error("DF: Tried to backpatch a function address which should be stripped");
1207
1208     if (!glulx_mode)
1209         return func->newaddress / scale_factor;
1210     else
1211         return func->newaddress;
1212 }
1213
1214 /* Given an address in the function area, return where it winds up after
1215    unused-function stripping. The address can be a function or anywhere
1216    within the function. If the address turns out to be in a stripped
1217    function, returns 0 (and sets *stripped).
1218
1219    The input and output are offsets, but *not* scaled.
1220
1221    This is only used by the debug-file system.
1222 */
1223 uint32 df_stripped_offset_for_code_offset(uint32 offset, int *stripped)
1224 {
1225     df_function_t *func;
1226     int count;
1227
1228     if (!track_unused_routines)
1229         compiler_error("DF: df_stripped_offset_for_code_offset called, but function references have not been mapped");
1230
1231     if (!df_functions_sorted) {
1232         /* To do this efficiently, we need a binary-searchable table. Fine,
1233            we'll make one. Include both used and unused functions. */
1234
1235         for (func = df_functions_head, count = 0; func; func = func->funcnext) {
1236             if (func->address == DF_NOT_IN_FUNCTION)
1237                 continue;
1238             count++;
1239         }
1240         df_functions_sorted_count = count;
1241
1242         df_functions_sorted = my_calloc(sizeof(df_function_t *), df_functions_sorted_count, "df function sorted table");
1243
1244         for (func = df_functions_head, count = 0; func; func = func->funcnext) {
1245             if (func->address == DF_NOT_IN_FUNCTION)
1246                 continue;
1247             df_functions_sorted[count] = func;
1248             count++;
1249         }
1250     }
1251
1252     /* Do a binary search. Maintain beg <= res < end, where res is the
1253        function containing the desired address. */
1254     int beg = 0;
1255     int end = df_functions_sorted_count;
1256
1257     /* Set stripped flag until we decide on a non-stripped function. */
1258     *stripped = TRUE;
1259
1260     while (1) {
1261         if (beg >= end) {
1262             error("DF: offset_for_code_offset: Could not locate address.");
1263             return 0;
1264         }
1265         if (beg+1 == end) {
1266             func = df_functions_sorted[beg];
1267             if (func->usage == 0)
1268                 return 0;
1269             *stripped = FALSE;
1270             return func->newaddress + (offset - func->address);
1271         }
1272         int new = (beg + end) / 2;
1273         if (new <= beg || new >= end)
1274             compiler_error("DF: binary search went off the rails");
1275
1276         func = df_functions_sorted[new];
1277         if (offset >= func->address) {
1278             if (offset < func->address+func->length) {
1279                 /* We don't need to loop further; decide here. */
1280                 if (func->usage == 0)
1281                     return 0;
1282                 *stripped = FALSE;
1283                 return func->newaddress + (offset - func->address);
1284             }
1285             beg = new;
1286         }
1287         else {
1288             end = new;
1289         }
1290     }
1291 }
1292
1293 /* The output_file() routines in files.c have to run down the list of
1294    functions, deciding who is in and who is out. But I don't want to
1295    export the df_function_t list structure. Instead, I provide this
1296    silly iterator pair. Set it up with df_prepare_function_iterate();
1297    then repeatedly call df_next_function_iterate().
1298 */
1299
1300 extern void df_prepare_function_iterate(void)
1301 {
1302     df_iterator = df_functions_head;
1303     if (!df_iterator || df_iterator->address != DF_NOT_IN_FUNCTION)
1304         compiler_error("DF: Global namespace entry is not at the head of the chain.");
1305     if (!df_iterator->funcnext || df_iterator->funcnext->address != 0)
1306         compiler_error("DF: First function entry is not second in the chain.");
1307 }
1308
1309 /* This returns the end of the next function, and whether the next function
1310    is used (live).
1311 */
1312 extern uint32 df_next_function_iterate(int *funcused)
1313 {
1314     if (df_iterator)
1315         df_iterator = df_iterator->funcnext;
1316     if (!df_iterator) {
1317         *funcused = TRUE;
1318         return df_total_size_before_stripping+1;
1319     }
1320     *funcused = (df_iterator->usage != 0);
1321     return df_iterator->address + df_iterator->length;
1322 }
1323
1324 /* ========================================================================= */
1325 /*   Data structure management routines                                      */
1326 /* ------------------------------------------------------------------------- */
1327
1328 extern void init_symbols_vars(void)
1329 {
1330     symbs = NULL;
1331     svals = NULL;
1332     smarks = NULL;
1333     stypes = NULL;
1334     sflags = NULL;
1335     next_entry = NULL;
1336     start_of_list = NULL;
1337
1338     symbol_name_space_chunks = NULL;
1339     no_symbol_name_space_chunks = 0;
1340     symbols_free_space=NULL;
1341     symbols_ceiling=symbols_free_space;
1342
1343     no_symbols = 0;
1344
1345     symbol_replacements = NULL;
1346     symbol_replacements_count = 0;
1347     symbol_replacements_size = 0;
1348
1349     make_case_conversion_grid();
1350
1351     track_unused_routines = (WARN_UNUSED_ROUTINES || OMIT_UNUSED_ROUTINES);
1352     df_tables_closed = FALSE;
1353     df_symbol_map = NULL;
1354     df_functions = NULL;
1355     df_functions_head = NULL;
1356     df_functions_tail = NULL;
1357     df_current_function = NULL;
1358     df_functions_sorted = NULL;
1359     df_functions_sorted_count = 0;
1360 }
1361
1362 extern void symbols_begin_pass(void)
1363 {
1364     df_total_size_before_stripping = 0;
1365     df_total_size_after_stripping = 0;
1366     df_dont_note_global_symbols = FALSE;
1367     df_iterator = NULL;
1368 }
1369
1370 extern void symbols_allocate_arrays(void)
1371 {
1372     symbs      = my_calloc(sizeof(char *),  MAX_SYMBOLS, "symbols");
1373     svals      = my_calloc(sizeof(int32),   MAX_SYMBOLS, "symbol values");
1374     if (glulx_mode)
1375         smarks = my_calloc(sizeof(int),     MAX_SYMBOLS, "symbol markers");
1376     slines     = my_calloc(sizeof(brief_location), MAX_SYMBOLS, "symbol lines");
1377     stypes     = my_calloc(sizeof(char),    MAX_SYMBOLS, "symbol types");
1378     sflags     = my_calloc(sizeof(int),     MAX_SYMBOLS, "symbol flags");
1379     if (debugfile_switch)
1380     {   symbol_debug_backpatch_positions =
1381             my_calloc(sizeof(maybe_file_position), MAX_SYMBOLS,
1382                       "symbol debug information backpatch positions");
1383         replacement_debug_backpatch_positions =
1384             my_calloc(sizeof(maybe_file_position), MAX_SYMBOLS,
1385                       "replacement debug information backpatch positions");
1386     }
1387     next_entry = my_calloc(sizeof(int),     MAX_SYMBOLS,
1388                      "symbol linked-list forward links");
1389     start_of_list = my_calloc(sizeof(int32), HASH_TAB_SIZE,
1390                      "hash code list beginnings");
1391
1392     symbol_name_space_chunks
1393         = my_calloc(sizeof(char *), MAX_SYMBOL_CHUNKS, "symbol names chunk addresses");
1394
1395     if (track_unused_routines) {
1396         df_tables_closed = FALSE;
1397
1398         df_symbol_map = my_calloc(sizeof(df_reference_t *), DF_SYMBOL_HASH_BUCKETS, "df symbol-map hash table");
1399         memset(df_symbol_map, 0, sizeof(df_reference_t *) * DF_SYMBOL_HASH_BUCKETS);
1400
1401         df_functions = my_calloc(sizeof(df_function_t *), DF_FUNCTION_HASH_BUCKETS, "df function hash table");
1402         memset(df_functions, 0, sizeof(df_function_t *) * DF_FUNCTION_HASH_BUCKETS);
1403         df_functions_head = NULL;
1404         df_functions_tail = NULL;
1405
1406         df_functions_sorted = NULL;
1407         df_functions_sorted_count = 0;
1408
1409         df_note_function_start("<global namespace>", DF_NOT_IN_FUNCTION, FALSE, blank_brief_location);
1410         df_note_function_end(DF_NOT_IN_FUNCTION);
1411         /* Now df_current_function is df_functions_head. */
1412     }
1413
1414     init_symbol_banks();
1415     stockup_symbols();
1416
1417     /*  Allocated as needed  */
1418     symbol_replacements = NULL;
1419
1420     /*  Allocated during story file construction, not now  */
1421     individual_name_strings = NULL;
1422     attribute_name_strings = NULL;
1423     action_name_strings = NULL;
1424     array_name_strings = NULL;
1425 }
1426
1427 extern void symbols_free_arrays(void)
1428 {   int i;
1429
1430     for (i=0; i<no_symbol_name_space_chunks; i++)
1431         my_free(&(symbol_name_space_chunks[i]),
1432             "symbol names chunk");
1433
1434     my_free(&symbol_name_space_chunks, "symbol names chunk addresses");
1435
1436     my_free(&symbs, "symbols");
1437     my_free(&svals, "symbol values");
1438     my_free(&smarks, "symbol markers");
1439     my_free(&slines, "symbol lines");
1440     my_free(&stypes, "symbol types");
1441     my_free(&sflags, "symbol flags");
1442     if (debugfile_switch)
1443     {   my_free
1444             (&symbol_debug_backpatch_positions,
1445              "symbol debug information backpatch positions");
1446         my_free
1447             (&replacement_debug_backpatch_positions,
1448              "replacement debug information backpatch positions");
1449     }
1450     my_free(&next_entry, "symbol linked-list forward links");
1451     my_free(&start_of_list, "hash code list beginnings");
1452
1453     if (symbol_replacements)
1454         my_free(&symbol_replacements, "symbol replacement table");
1455
1456     if (df_symbol_map) {
1457         for (i=0; i<DF_SYMBOL_HASH_BUCKETS; i++) {
1458             df_reference_t *ent = df_symbol_map[i];
1459             while (ent) {
1460                 df_reference_t *next = ent->next;
1461                 my_free(&ent, "df symbol map entry");
1462                 ent = next;
1463             }
1464         }
1465         my_free(&df_symbol_map, "df symbol-map hash table");
1466     }
1467     if (df_functions_sorted) {
1468         my_free(&df_functions, "df function sorted table");
1469     }
1470     if (df_functions) {
1471         for (i=0; i<DF_FUNCTION_HASH_BUCKETS; i++) {
1472             df_function_t *func = df_functions[i];
1473             while (func) {
1474                 df_function_t *next = func->next;
1475                 my_free(&func, "df function entry");
1476                 func = next;
1477             }
1478         }
1479         my_free(&df_functions, "df function hash table");
1480     }
1481     df_functions_head = NULL;
1482     df_functions_tail = NULL;
1483
1484     if (individual_name_strings != NULL)
1485         my_free(&individual_name_strings, "property name strings");
1486     if (action_name_strings != NULL)
1487         my_free(&action_name_strings,     "action name strings");
1488     if (attribute_name_strings != NULL)
1489         my_free(&attribute_name_strings,  "attribute name strings");
1490     if (array_name_strings != NULL)
1491         my_free(&array_name_strings,      "array name strings");
1492 }
1493
1494 /* ========================================================================= */