src/symbols.c

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