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