src/symbols.c

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