src/linker.c

   1 /* ------------------------------------------------------------------------- */
   2 /*   "linker" : For compiling and linking modules                            */
   3 /*                                                                           */
   4 /*   Part of Inform 6.35                                                     */
   5 /*   copyright (c) Graham Nelson 1993 - 2020                                 */
   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 memory_block link_data_area;
  25 uchar *link_data_holding_area, *link_data_top;
  26                                           /*  Start, current top, size of    */
  27 int32 link_data_size;                     /*  link data table being written  */
  28                                           /*  (holding import/export names)  */
  29 extern int32 *action_symbol;
  30
  31 /* ------------------------------------------------------------------------- */
  32 /*   Marker values                                                           */
  33 /* ------------------------------------------------------------------------- */
  34
  35 extern char *describe_mv(int mval)
  36 {   switch(mval)
  37     {   case NULL_MV:       return("null");
  38
  39         /*  Marker values used in ordinary story file backpatching  */
  40
  41         case DWORD_MV:      return("dictionary word");
  42         case STRING_MV:     return("string literal");
  43         case INCON_MV:      return("system constant");
  44         case IROUTINE_MV:   return("routine");
  45         case VROUTINE_MV:   return("veneer routine");
  46         case ARRAY_MV:      return("internal array");
  47         case NO_OBJS_MV:    return("the number of objects");
  48         case INHERIT_MV:    return("inherited common p value");
  49         case INDIVPT_MV:    return("indiv prop table address");
  50         case INHERIT_INDIV_MV: return("inherited indiv p value");
  51         case MAIN_MV:       return("ref to Main");
  52         case SYMBOL_MV:     return("ref to symbol value");
  53
  54         /*  Additional marker values used in module backpatching  */
  55
  56         case VARIABLE_MV:   return("global variable");
  57         case IDENT_MV:      return("prop identifier number");
  58         case ACTION_MV:     return("action");
  59         case OBJECT_MV:     return("internal object");
  60
  61         /*  Record types in the import/export table (not really marker
  62             values at all)  */
  63
  64         case EXPORT_MV:     return("Export   ");
  65         case EXPORTSF_MV:   return("Export sf");
  66         case EXPORTAC_MV:   return("Export ##");
  67         case IMPORT_MV:     return("Import   ");
  68     }
  69     return("** No such MV **");
  70 }
  71
  72 /* ------------------------------------------------------------------------- */
  73 /*   Import/export records                                                   */
  74 /* ------------------------------------------------------------------------- */
  75
  76 typedef struct importexport_s
  77 {   int module_value;
  78     int32 symbol_number;
  79     char symbol_type;
  80     int backpatch;
  81     int32 symbol_value;
  82     char *symbol_name;
  83 } ImportExport;
  84
  85 static void describe_importexport(ImportExport *I)
  86 {   printf("%8s %20s %04d %04x %s\n",
  87         describe_mv(I->module_value), I->symbol_name,
  88             I->symbol_number, I->symbol_value, typename(I->symbol_type));
  89 }
  90
  91 /* ========================================================================= */
  92 /*   Linking in external modules: this code is run when the external         */
  93 /*   program hits a Link directive.                                          */
  94 /* ------------------------------------------------------------------------- */
  95 /*   This map is between global variable numbers in the module and in the    */
  96 /*   external program: variables_map[n] will be the external global variable */
  97 /*   no for module global variable no n.  (The entries [0] to [15] are not   */
  98 /*   used.)                                                                  */
  99 /* ------------------------------------------------------------------------- */
 100
 101 static int variables_map[256], actions_map[256];
 102
 103 int32 module_map[16];
 104
 105 ImportExport IE;
 106
 107 /* ------------------------------------------------------------------------- */
 108 /*   These are offsets within the module:                                    */
 109 /* ------------------------------------------------------------------------- */
 110
 111 static int32 m_code_offset, m_strs_offset, m_static_offset, m_dict_offset,
 112              m_vars_offset, m_objs_offset, m_props_offset, m_class_numbers,
 113              m_individuals_offset,         m_individuals_length;
 114
 115 static int m_no_objects, m_no_globals, p_no_globals, lowest_imported_global_no;
 116
 117 int32 *xref_table; int xref_top;
 118 int32 *property_identifier_map;
 119 int *accession_numbers_map;
 120 int32 routine_replace[64],
 121       routine_replace_with[64]; int no_rr;
 122
 123 /* ------------------------------------------------------------------------- */
 124 /*   Reading and writing bytes/words in the module (as loaded in), indexing  */
 125 /*   via "marker addresses".                                                 */
 126 /* ------------------------------------------------------------------------- */
 127
 128 static int32 read_marker_address(uchar *p, int size,
 129     int zmachine_area, int32 offset)
 130 {
 131     /*  A routine to read the value referred to by the marker address
 132         (zmachine_area, offset): size is 1 for byte, 2 for word, and the
 133         module itself resides at p.                                          */
 134
 135     int32 addr = 0;
 136
 137     switch(zmachine_area)
 138     {
 139         case DYNAMIC_ARRAY_ZA:
 140             addr = m_vars_offset; break;
 141         case ZCODE_ZA:
 142             addr = m_code_offset; break;
 143         case STATIC_STRINGS_ZA:
 144             addr = m_strs_offset; break;
 145         case DICTIONARY_ZA:
 146             addr = m_dict_offset; break;
 147         case OBJECT_TREE_ZA:
 148             addr = m_objs_offset; break;
 149         case PROP_ZA:
 150             addr = m_props_offset; break;
 151         case INDIVIDUAL_PROP_ZA:
 152             addr = m_individuals_offset; break;
 153     }
 154     if (size == 1) return p[addr+offset];
 155     return 256*p[addr+offset] + p[addr+offset+1];
 156 }
 157
 158 static void write_marker_address(uchar *p, int size,
 159     int zmachine_area, int32 offset, int32 value)
 160 {
 161     /*  Similar, but to write to it.                                         */
 162
 163     int32 addr = 0;
 164
 165     switch(zmachine_area)
 166     {
 167         case DYNAMIC_ARRAY_ZA:
 168             addr = m_vars_offset; break;
 169         case ZCODE_ZA:
 170             addr = m_code_offset; break;
 171         case STATIC_STRINGS_ZA:
 172             addr = m_strs_offset; break;
 173         case DICTIONARY_ZA:
 174             addr = m_dict_offset; break;
 175         case OBJECT_TREE_ZA:
 176             addr = m_objs_offset; break;
 177         case PROP_ZA:
 178             addr = m_props_offset; break;
 179         case INDIVIDUAL_PROP_ZA:
 180             addr = m_individuals_offset; break;
 181     }
 182     if (size == 1) { p[addr+offset] = value%256; return; }
 183     p[addr+offset] = value/256;
 184     p[addr+offset+1] = value%256;
 185 }
 186
 187 int m_read_pos;
 188
 189 static int get_next_record(uchar *p)
 190 {   int i;
 191     int record_type = p[m_read_pos++];
 192     switch(record_type)
 193     {   case 0: break;
 194         case EXPORT_MV:
 195         case EXPORTSF_MV:
 196         case EXPORTAC_MV:
 197         case IMPORT_MV:
 198             IE.module_value = record_type;
 199             i=p[m_read_pos++]; IE.symbol_number = 256*i + p[m_read_pos++];
 200             IE.symbol_type = p[m_read_pos++];
 201             if (record_type != IMPORT_MV) IE.backpatch = p[m_read_pos++];
 202             i=p[m_read_pos++]; IE.symbol_value = 256*i + p[m_read_pos++];
 203             IE.symbol_name = (char *) (p+m_read_pos);
 204             m_read_pos += strlen((char *) (p+m_read_pos))+1;
 205             if (linker_trace_level >= 2) describe_importexport(&IE);
 206             break;
 207         default:
 208             printf("Marker value of %d\n", record_type);
 209             compiler_error("Link: illegal import/export marker value");
 210             return -1;
 211     }
 212     return record_type;
 213 }
 214
 215 static char link_errorm[128];
 216
 217 static void accept_export(void)
 218 {   int32 index, map_to = IE.symbol_value % 0x10000;
 219     index = symbol_index(IE.symbol_name, -1);
 220
 221     xref_table[IE.symbol_number] = index;
 222
 223     if (!(sflags[index] & UNKNOWN_SFLAG))
 224     {   if (IE.module_value == EXPORTAC_MV)
 225         {   if ((!(sflags[index] & ACTION_SFLAG))
 226                 && (stypes[index] != FAKE_ACTION_T))
 227                 link_error_named(
 228 "action name clash with", IE.symbol_name);
 229         }
 230         else
 231         if (stypes[index] == IE.symbol_type)
 232         {   switch(IE.symbol_type)
 233             {   case CONSTANT_T:
 234                     if ((!(svals[index] == IE.symbol_value))
 235                         || (IE.backpatch != 0))
 236                         link_error_named(
 237 "program and module give differing values of", IE.symbol_name);
 238                     break;
 239                 case INDIVIDUAL_PROPERTY_T:
 240                     property_identifier_map[IE.symbol_value] = svals[index];
 241                     break;
 242                 case ROUTINE_T:
 243                     if ((IE.module_value == EXPORTSF_MV)
 244                         && (sflags[index] & REPLACE_SFLAG))
 245                     break;
 246                 default:
 247                     sprintf(link_errorm,
 248                         "%s '%s' in both program and module",
 249                         typename(IE.symbol_type), IE.symbol_name);
 250                     link_error(link_errorm);
 251                     break;
 252             }
 253         }
 254         else
 255         {   sprintf(link_errorm,
 256                     "'%s' has type %s in program but type %s in module",
 257                     IE.symbol_name, typename(stypes[index]),
 258                     typename(IE.symbol_type));
 259             link_error(link_errorm);
 260         }
 261     }
 262     else
 263     {   if (IE.module_value == EXPORTAC_MV)
 264         {   IE.symbol_value = no_actions;
 265             action_symbol[no_actions++] = index;
 266             if (linker_trace_level >= 4)
 267                 printf("Creating action ##%s\n", (char *) symbs[index]);
 268         }
 269         else
 270         switch(IE.symbol_type)
 271         {   case ROUTINE_T:
 272                 if ((IE.module_value == EXPORTSF_MV)
 273                     && (sflags[index] & REPLACE_SFLAG))
 274                 {   routine_replace[no_rr] = IE.symbol_value;
 275                     routine_replace_with[no_rr++] = index;
 276                     return;
 277                 }
 278                 IE.symbol_value += (zmachine_pc/scale_factor);
 279                 break;
 280             case OBJECT_T:
 281             case CLASS_T:
 282                 IE.symbol_value += no_objects;
 283                 break;
 284             case ARRAY_T:
 285                 IE.symbol_value += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
 286                 break;
 287             case GLOBAL_VARIABLE_T:
 288                 if (no_globals==233)
 289                 {   link_error(
 290 "failed because too many extra global variables needed");
 291                     return;
 292                 }
 293                 variables_map[16 + m_no_globals++] = 16 + no_globals;
 294                 set_variable_value(no_globals, IE.symbol_value);
 295                 IE.symbol_value = 16 + no_globals++;
 296                 break;
 297             case INDIVIDUAL_PROPERTY_T:
 298                 property_identifier_map[IE.symbol_value]
 299                     = no_individual_properties;
 300                 IE.symbol_value = no_individual_properties++;
 301
 302                 if (debugfile_switch)
 303                 {   debug_file_printf("<property>");
 304                     debug_file_printf
 305                         ("<identifier>%s</identifier>", IE.symbol_name);
 306                     debug_file_printf
 307                         ("<value>%d</value>", IE.symbol_value);
 308                     debug_file_printf("</property>");
 309                 }
 310
 311                 break;
 312         }
 313         assign_symbol(index, IE.backpatch*0x10000 + IE.symbol_value,
 314             IE.symbol_type);
 315         if (IE.backpatch != 0) sflags[index] |= CHANGE_SFLAG;
 316         sflags[index] |= EXPORT_SFLAG;
 317         if (IE.module_value == EXPORTSF_MV)
 318             sflags[index] |= INSF_SFLAG;
 319         if (IE.module_value == EXPORTAC_MV)
 320             sflags[index] |= ACTION_SFLAG;
 321     }
 322
 323     if (IE.module_value == EXPORTAC_MV)
 324     {   if (linker_trace_level >= 4)
 325             printf("Map %d '%s' to %d\n",
 326                 IE.symbol_value, (char *) (symbs[index]), svals[index]);
 327         actions_map[map_to] = svals[index];
 328     }
 329 }
 330
 331 static void accept_import(void)
 332 {   int32 index;
 333
 334     index = symbol_index(IE.symbol_name, -1);
 335     sflags[index] |= USED_SFLAG;
 336     xref_table[IE.symbol_number] = index;
 337
 338     if (!(sflags[index] & UNKNOWN_SFLAG))
 339     {   switch (IE.symbol_type)
 340         {
 341             case GLOBAL_VARIABLE_T:
 342                 if (stypes[index] != GLOBAL_VARIABLE_T)
 343                     link_error_named(
 344 "module (wrongly) declared this a variable:", IE.symbol_name);
 345                 variables_map[IE.symbol_value] = svals[index];
 346                 if (IE.symbol_value < lowest_imported_global_no)
 347                     lowest_imported_global_no = IE.symbol_value;
 348                 break;
 349             default:
 350                 switch(stypes[index])
 351                 {   case ATTRIBUTE_T:
 352                         link_error_named(
 353 "this attribute is undeclared within module:", IE.symbol_name);; break;
 354                     case PROPERTY_T:
 355                         link_error_named(
 356 "this property is undeclared within module:", IE.symbol_name); break;
 357                     case INDIVIDUAL_PROPERTY_T:
 358                     case ARRAY_T:
 359                     case ROUTINE_T:
 360                     case CONSTANT_T:
 361                     case OBJECT_T:
 362                     case CLASS_T:
 363                     case FAKE_ACTION_T:
 364                         break;
 365                     default:
 366                         link_error_named(
 367 "this was referred to as a constant, but isn't:", IE.symbol_name);
 368                         break;
 369                 }
 370                 break;
 371         }
 372     }
 373     else
 374     {   switch (IE.symbol_type)
 375         {
 376             case GLOBAL_VARIABLE_T:
 377                 if (stypes[index] != GLOBAL_VARIABLE_T)
 378                     link_error_named(
 379                 "Module tried to import a Global variable not defined here:",
 380                         IE.symbol_name);
 381                 variables_map[IE.symbol_value] = 16;
 382                 if (IE.symbol_value < lowest_imported_global_no)
 383                     lowest_imported_global_no = IE.symbol_value;
 384                 break;
 385         }
 386     }
 387 }
 388
 389 static int32 backpatch_backpatch(int32 v)
 390 {   switch(backpatch_marker)
 391     {
 392         /*  Backpatches made now which are final  */
 393
 394         case OBJECT_MV:
 395             v += no_objects;
 396             backpatch_marker = NULL_MV;
 397             break;
 398
 399         case ACTION_MV:
 400             if ((v<0) || (v>=256) || (actions_map[v] == -1))
 401             {   link_error("unmapped action number");
 402                 printf("*** Link: unmapped action number %d ***", v);
 403                 v = 0;
 404                 break;
 405             }
 406             v = actions_map[v];
 407             backpatch_marker = NULL_MV;
 408             break;
 409
 410         case IDENT_MV:
 411             {   int f = v & 0x8000;
 412                 v = f + property_identifier_map[v-f];
 413                 backpatch_marker = NULL_MV;
 414                 break;
 415             }
 416
 417         case VARIABLE_MV:
 418             backpatch_marker = NULL_MV;
 419             if (v < lowest_imported_global_no)
 420             {   v = v + p_no_globals; break;
 421             }
 422             if (variables_map[v] == -1)
 423             {   printf("** Unmapped variable %d! **\n", v);
 424                 variables_map[v] = 16;
 425                 link_error("unmapped variable error"); break;
 426             }
 427             v = variables_map[v];
 428             break;
 429
 430         /*  Backpatch values which are themselves being backpatched  */
 431
 432         case INDIVPT_MV:
 433             v += individuals_length;
 434             break;
 435
 436         case SYMBOL_MV:
 437             v = xref_table[v];
 438             if ((v<0) || (v>=no_symbols))
 439             {   printf("** Symbol number %d cannot be crossreferenced **\n", v);
 440                 link_error("symbol crossreference error"); v=0;
 441                 break;
 442             }
 443             break;
 444
 445         case STRING_MV:
 446             v += static_strings_extent/scale_factor;
 447             break;
 448
 449         case IROUTINE_MV:
 450             {   int i;
 451                 for (i=0;i<no_rr;i++)
 452                     if (v == routine_replace[i])
 453                     {   v = routine_replace_with[i];
 454                         backpatch_marker = SYMBOL_MV;
 455                         goto IR_Done;
 456                     }
 457                 v += zmachine_pc/scale_factor;
 458             }
 459             IR_Done: break;
 460
 461         case VROUTINE_MV:
 462             veneer_routine(v);
 463             break;
 464
 465         case ARRAY_MV:
 466             if (v < (MAX_GLOBAL_VARIABLES*2))
 467             {   v = 2*(variables_map[v/2 + 16] - 16);
 468             }
 469             else
 470             {   v += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
 471             }
 472             break;
 473
 474         case DWORD_MV:
 475             v = accession_numbers_map[v];
 476             break;
 477
 478         case INHERIT_MV:
 479             v += properties_table_size;
 480             break;
 481
 482         case INHERIT_INDIV_MV:
 483             v += individuals_length;
 484             break;
 485     }
 486     return v;
 487 }
 488
 489 static void backpatch_module_image(uchar *p,
 490     int marker_value, int zmachine_area, int32 offset)
 491 {   int size = (marker_value>=0x80)?1:2; int32 v;
 492     marker_value &= 0x7f;
 493
 494     backpatch_marker = marker_value;
 495
 496     if (zmachine_area == PROP_DEFAULTS_ZA) return;
 497
 498     if (linker_trace_level >= 3)
 499         printf("Backpatch %s area %d offset %04x size %d: ",
 500             describe_mv(marker_value), zmachine_area, offset, size);
 501
 502     v = read_marker_address(p, size, zmachine_area, offset);
 503     if (linker_trace_level >= 3) printf("%04x ", v);
 504
 505     v = backpatch_backpatch(v);
 506
 507     write_marker_address(p, size, zmachine_area, offset, v);
 508     if (linker_trace_level >= 3) printf("%04x\n", v);
 509 }
 510
 511 /* ------------------------------------------------------------------------- */
 512 /*   The main routine: linking in a module with the given filename.          */
 513 /* ------------------------------------------------------------------------- */
 514
 515 char current_module_filename[128];
 516
 517 void link_module(char *given_filename)
 518 {   FILE *fin;
 519     int record_type;
 520     char filename[128];
 521     uchar *p, p0[64];
 522     int32 last, i, j, k, l, m, vn, len, size, link_offset, module_size, map,
 523           max_property_identifier, symbols_base = no_symbols;
 524
 525     strcpy(current_module_filename, given_filename);
 526
 527     /* (1) Load in the module to link */
 528
 529     i = 0;
 530     do
 531     {   i = translate_link_filename(i, filename, given_filename);
 532         fin=fopen(filename,"rb");
 533     } while ((fin == NULL) && (i != 0));
 534
 535     if (fin==NULL)
 536     {   error_named("Couldn't open module file", filename); return;
 537     }
 538
 539     for (i=0;i<64;i++) p0[i]=fgetc(fin);
 540
 541     vn = p0[0];
 542     if ((vn<65) || (vn>75))
 543     {   error_named("File isn't a module:", filename);
 544         fclose(fin); return;
 545     }
 546
 547     if (vn != 64 + version_number)
 548     {   char ebuff[100];
 549         sprintf(ebuff,
 550            "module compiled as Version %d (so it can't link\
 551  into this V%d game):", vn-64, version_number);
 552         error_named(ebuff, filename);
 553         fclose(fin); return;
 554     }
 555
 556     module_size     = (256*p0[26] + p0[27])*scale_factor;
 557     p = my_malloc(module_size + 16, "link module storage");
 558         /*  The + 16 allows for rounding errors  */
 559
 560     for (k=0;k<64;k++) p[k] = p0[k];
 561     for (k=64;k<module_size;k++) p[k] = fgetc(fin);
 562     fclose(fin);
 563
 564     if ((p0[52] != 0) || (p0[53] != 0))
 565     {   /*  Then the module contains a character set table  */
 566         if (alphabet_modified)
 567         {   k = FALSE; m = 256*p0[52] + p0[53];
 568             for (i=0;i<3;i++) for (j=0;j<26;j++)
 569             {   l = alphabet[i][j]; if (l == '~') l = '\"';
 570                 if (l != p[m]) k = TRUE;
 571             }
 572             if (k)
 573         link_error("module and game both define non-standard character sets, \
 574 but they disagree");
 575             k = FALSE;
 576         }
 577         else k = TRUE;
 578     }
 579     else
 580     {   if (alphabet_modified) k = TRUE;
 581         else k = FALSE;
 582     }
 583     if (k)
 584         link_error("module and game use different character sets");
 585
 586     i = p[1];
 587     if (i > MODULE_VERSION_NUMBER)
 588         warning_named("module has a more advanced format than this release \
 589 of the Inform 6 compiler knows about: it may not link in correctly", filename);
 590
 591     /* (2) Calculate offsets: see the header-writing code in "tables.c"  */
 592
 593     map             = (256*p[6] + p[7]);
 594     for (i=0; i<16; i++) module_map[i] = 256*p[map + i*2] + p[map + i*2 + 1];
 595
 596     m_vars_offset   = (256*p[12] + p[13]);
 597     m_static_offset = (256*p[14] + p[15]);
 598     m_dict_offset   = (256*p[8] + p[9]);
 599     m_code_offset   = (256*p[4] + p[5]);
 600
 601     /* (3) Read the "module map" table   */
 602
 603     if (linker_trace_level>=4)
 604     {   printf("[Reading module map:\n");
 605         for (i=0; i<16; i++) printf("%04x ", module_map[i]);
 606         printf("]\n");
 607     }
 608
 609     m_objs_offset        = module_map[0];
 610     m_props_offset       = module_map[1];
 611     m_strs_offset        = scale_factor*module_map[2];
 612     m_class_numbers      = module_map[3];
 613     m_individuals_offset = module_map[4];
 614     m_individuals_length = module_map[5];
 615
 616     for (i=16;i<256;i++) variables_map[i] = -1;
 617     for (i=0;i<16;i++)  variables_map[i] = i;
 618     for (i=LOWEST_SYSTEM_VAR_NUMBER;i<256;i++) variables_map[i] = i;
 619
 620     for (i=0;i<256;i++) actions_map[i] = -1;
 621
 622     xref_table = my_calloc(sizeof(int32), module_map[6],
 623         "linker cross-references table");
 624     for (i=0;i<module_map[6];i++) xref_table[i] = -1;
 625
 626     max_property_identifier = module_map[7];
 627     property_identifier_map = my_calloc(sizeof(int32), max_property_identifier,
 628         "property identifier map");
 629     for (i=0; i<max_property_identifier; i++)
 630         property_identifier_map[i] = i;
 631
 632     m_no_objects         = module_map[8];
 633     link_offset          = module_map[9];
 634
 635     m_no_globals = 0; p_no_globals = no_globals;
 636     lowest_imported_global_no=236;
 637
 638     no_rr = 0;
 639
 640     if ((linker_trace_level>=1) || transcript_switch)
 641     {   char link_banner[128];
 642         sprintf(link_banner,
 643             "[Linking release %d.%c%c%c%c%c%c of module '%s' (size %dK)]",
 644             p[2]*256 + p[3], p[18], p[19], p[20], p[21], p[22], p[23],
 645             filename, module_size/1024);
 646         if (linker_trace_level >= 1) printf("%s\n", link_banner);
 647         if (transcript_switch)
 648             write_to_transcript_file(link_banner);
 649     }
 650
 651     /* (4) Merge in the dictionary */
 652
 653     if (linker_trace_level >= 2)
 654         printf("Merging module's dictionary at %04x\n", m_dict_offset);
 655     k=m_dict_offset; k+=p[k]+1;
 656     len=p[k++];
 657     size = p[k]*256 + p[k+1]; k+=2;
 658
 659     accession_numbers_map = my_calloc(sizeof(int), size,
 660         "dictionary accession numbers map");
 661
 662     for (i=0;i<size;i++, k+=len)
 663     {   char word[10];
 664         word_to_ascii(p+k,word);
 665         if (linker_trace_level >= 3)
 666             printf("%03d %04x  '%s' %02x %02x %02x\n",i,k,
 667             word, p[k+len-3], p[k+len-2], p[k+len-1]);
 668
 669         accession_numbers_map[i]
 670             = dictionary_add(word, p[k+len-3], p[k+len-2], p[k+len-1]);
 671     }
 672
 673     /* (5) Run through import/export table  */
 674
 675     m_read_pos = module_map[9];
 676     if (linker_trace_level>=2)
 677         printf("Import/export table is at byte offset %04x\n", m_read_pos);
 678
 679     do
 680     {   record_type = get_next_record(p);
 681         if (((record_type == EXPORT_MV) || (record_type == EXPORTSF_MV))
 682             && (IE.symbol_type == INDIVIDUAL_PROPERTY_T))
 683         {   int32 si = symbol_index(IE.symbol_name, -1);
 684             property_identifier_map[IE.symbol_value] = svals[si];
 685         }
 686         switch(record_type)
 687         {   case EXPORT_MV:
 688             case EXPORTSF_MV:
 689             case EXPORTAC_MV:
 690                 accept_export(); break;
 691             case IMPORT_MV:
 692                 accept_import(); break;
 693         }
 694     } while (record_type != 0);
 695
 696     if ((linker_trace_level >= 4) && (no_rr != 0))
 697     {   printf("Replaced routine addresses:\n");
 698         for (i=0; i<no_rr; i++)
 699         {   printf("Replace code offset %04x with %04x\n",
 700                 routine_replace[i], routine_replace_with[i]);
 701         }
 702     }
 703
 704     if (linker_trace_level >= 4)
 705     {   printf("Symbol cross-references table:\n");
 706         for (i=0; i<module_map[6]; i++)
 707         {   if (xref_table[i] != -1)
 708                 printf("module %4d -> story file '%s'\n", i,
 709                     (char *) symbs[xref_table[i]]);
 710         }
 711     }
 712
 713     if (linker_trace_level >= 4)
 714     {   printf("Action numbers map:\n");
 715         for (i=0; i<256; i++)
 716             if (actions_map[i] != -1)
 717                 printf("%3d -> %3d\n", i, actions_map[i]);
 718     }
 719
 720     if ((linker_trace_level >= 4) && (max_property_identifier > 72))
 721     {   printf("Property identifier number map:\n");
 722         for (i=72; i<max_property_identifier; i++)
 723         {   printf("module %04x -> program %04x\n",
 724                 i, property_identifier_map[i]);
 725         }
 726     }
 727
 728     /* (6) Backpatch the backpatch markers attached to exported symbols  */
 729
 730     for (i=symbols_base; i<no_symbols; i++)
 731     {   if ((sflags[i] & CHANGE_SFLAG) && (sflags[i] & EXPORT_SFLAG))
 732         {   backpatch_marker = svals[i]/0x10000;
 733             j = svals[i] % 0x10000;
 734
 735             j = backpatch_backpatch(j);
 736
 737             svals[i] = backpatch_marker*0x10000 + j;
 738             if (backpatch_marker == 0) sflags[i] &= (~(CHANGE_SFLAG));
 739         }
 740     }
 741
 742     /* (7) Run through the Z-code backpatch table  */
 743
 744     for (i=module_map[11]; i<module_map[11]+module_map[12]; i += 3)
 745     {   int marker_value = p[i];
 746         int32 offset = 256*p[i+1] + p[i+2];
 747
 748         switch(marker_value & 0x7f)
 749         {   case OBJECT_MV:
 750             case ACTION_MV:
 751             case IDENT_MV:
 752             case VARIABLE_MV:
 753                 backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
 754                 break;
 755             default:
 756                 backpatch_module_image(p, marker_value, ZCODE_ZA, offset);
 757                 write_byte_to_memory_block(&zcode_backpatch_table,
 758                     zcode_backpatch_size++, backpatch_marker);
 759                 write_byte_to_memory_block(&zcode_backpatch_table,
 760                     zcode_backpatch_size++, (offset + zmachine_pc)/256);
 761                 write_byte_to_memory_block(&zcode_backpatch_table,
 762                     zcode_backpatch_size++, (offset + zmachine_pc)%256);
 763                 break;
 764         }
 765     }
 766
 767     /* (8) Run through the Z-machine backpatch table  */
 768
 769     for (i=module_map[13]; i<module_map[13]+module_map[14]; i += 4)
 770     {   int marker_value = p[i], zmachine_area = p[i+1];
 771         int32 offset = 256*p[i+2] + p[i+3];
 772
 773         switch(marker_value)
 774         {   case OBJECT_MV:
 775             case ACTION_MV:
 776             case IDENT_MV:
 777                 backpatch_module_image(p, marker_value, zmachine_area, offset);
 778                 break;
 779             default:
 780                 backpatch_module_image(p, marker_value, zmachine_area, offset);
 781                 switch(zmachine_area)
 782                 {   case PROP_DEFAULTS_ZA:
 783                         break;
 784                     case PROP_ZA:
 785                         offset += properties_table_size; break;
 786                     case INDIVIDUAL_PROP_ZA:
 787                         offset += individuals_length; break;
 788                     case DYNAMIC_ARRAY_ZA:
 789                         if (offset < (MAX_GLOBAL_VARIABLES*2))
 790                         {   offset = 2*(variables_map[offset/2 + 16] - 16);
 791                         }
 792                         else
 793                         {   offset += dynamic_array_area_size - (MAX_GLOBAL_VARIABLES*2);
 794                         }
 795                         break;
 796                 }
 797                 backpatch_zmachine(backpatch_marker, zmachine_area, offset);
 798                 break;
 799         }
 800     }
 801
 802     /* (9) Adjust initial values of variables */
 803
 804     if (linker_trace_level >= 3)
 805         printf("\nFinal variables map, Module -> Main:\n");
 806
 807     for (i=16;i<255;i++)
 808         if (variables_map[i]!=-1)
 809         {   if (linker_trace_level>=2)
 810                 printf("%d->%d  ",i,variables_map[i]);
 811             if (i<lowest_imported_global_no)
 812             {   int32 j = read_marker_address(p, 2,
 813                     DYNAMIC_ARRAY_ZA, 2*(i-16));
 814                 set_variable_value(variables_map[i]-16, j);
 815                 if (linker_trace_level>=2)
 816                     printf("(set var %d to %d) ",
 817                         variables_map[i], j);
 818             }
 819         }
 820     if (linker_trace_level>=2) printf("\n");
 821
 822     /* (10) Glue in the dynamic array data */
 823
 824     i = m_static_offset - m_vars_offset - MAX_GLOBAL_VARIABLES*2;
 825     if (dynamic_array_area_size + i >= MAX_STATIC_DATA)
 826         memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
 827
 828     if (linker_trace_level >= 2)
 829         printf("Inserting dynamic array area, %04x to %04x, at %04x\n",
 830             m_vars_offset + MAX_GLOBAL_VARIABLES*2, m_static_offset,
 831             variables_offset + dynamic_array_area_size);
 832     for (k=0;k<i;k++)
 833     {   dynamic_array_area[dynamic_array_area_size+k]
 834             = p[m_vars_offset+MAX_GLOBAL_VARIABLES*2+k];
 835     }
 836     dynamic_array_area_size+=i;
 837
 838     /* (11) Glue in the code area */
 839
 840     if (linker_trace_level >= 2)
 841       printf("Inserting code area, %04x to %04x, at code offset %04x (+%04x)\n",
 842         m_code_offset, m_strs_offset, code_offset, zmachine_pc);
 843
 844     for (k=m_code_offset;k<m_strs_offset;k++)
 845     {   if (temporary_files_switch)
 846         {   fputc(p[k],Temp2_fp);
 847             zmachine_pc++;
 848         }
 849         else
 850             write_byte_to_memory_block(&zcode_area, zmachine_pc++, p[k]);
 851     }
 852
 853     /* (12) Glue in the static strings area */
 854
 855     if (linker_trace_level >= 2)
 856         printf("Inserting strings area, %04x to %04x, \
 857 at strings offset %04x (+%04x)\n",
 858         m_strs_offset, link_offset, strings_offset,
 859         static_strings_extent);
 860     for (k=m_strs_offset;k<link_offset;k++)
 861     {   if (temporary_files_switch)
 862         {   fputc(p[k], Temp1_fp);
 863             static_strings_extent++;
 864         }
 865         else
 866             write_byte_to_memory_block(&static_strings_area,
 867                     static_strings_extent++, p[k]);
 868     }
 869
 870     /* (13) Append the class object-numbers table: note that modules
 871             provide extra information in this table */
 872
 873     i = m_class_numbers;
 874     do
 875     {   j = p[i]*256 + p[i+1]; i+=2;
 876         if (j == 0) break;
 877
 878         class_object_numbers[no_classes] = j + no_objects;
 879         j = p[i]*256 + p[i+1]; i+=2;
 880         class_begins_at[no_classes++] = j + properties_table_size;
 881
 882     } while (TRUE);
 883
 884     /* (14) Glue on the object tree */
 885
 886     if ((linker_trace_level>=2) && (m_no_objects>0))
 887         printf("Joining on object tree of size %d\n", m_no_objects);
 888
 889     for (i=0, k=no_objects, last=m_props_offset;i<m_no_objects;i++)
 890     {   objectsz[no_objects].atts[0]=p[m_objs_offset+14*i];
 891         objectsz[no_objects].atts[1]=p[m_objs_offset+14*i+1];
 892         objectsz[no_objects].atts[2]=p[m_objs_offset+14*i+2];
 893         objectsz[no_objects].atts[3]=p[m_objs_offset+14*i+3];
 894         objectsz[no_objects].atts[4]=p[m_objs_offset+14*i+4];
 895         objectsz[no_objects].atts[5]=p[m_objs_offset+14*i+5];
 896         objectsz[no_objects].parent =
 897             (p[m_objs_offset+14*i+6])*256+p[m_objs_offset+14*i+7];
 898         objectsz[no_objects].next =
 899             (p[m_objs_offset+14*i+8])*256+p[m_objs_offset+14*i+9];
 900         objectsz[no_objects].child =
 901             (p[m_objs_offset+14*i+10])*256+p[m_objs_offset+14*i+11];
 902         if (linker_trace_level>=4)
 903             printf("Module objects[%d] has %d,%d,%d\n",
 904                 i,objectsz[no_objects].parent,
 905                 objectsz[no_objects].next,objectsz[no_objects].child);
 906         if (objectsz[no_objects].parent == 0x7fff)
 907         {   objectsz[no_objects].parent = 1;
 908             if (objectsz[1].child == 0)
 909             {   objectsz[1].child = no_objects+1;
 910             }
 911             else
 912             {   int j1 = 0, j2 = objectsz[1].child;
 913                 while (j2 != 0)
 914                 {   j1 = j2;
 915                     j2 = objectsz[j2].next;
 916                 }
 917                 objectsz[j1].next = no_objects+1;
 918             }
 919             objectsz[no_objects].next = 0;
 920         }
 921         else
 922         if (objectsz[no_objects].parent>0) objectsz[no_objects].parent += k;
 923         if (objectsz[no_objects].next>0)   objectsz[no_objects].next   += k;
 924         if (objectsz[no_objects].child>0)  objectsz[no_objects].child  += k;
 925         objectsz[no_objects].propsize =
 926             (p[m_objs_offset+14*i+12])*256+p[m_objs_offset+14*i+13];
 927         last += objectsz[no_objects].propsize;
 928         if (linker_trace_level>=4)
 929             printf("Objects[%d] has %d,%d,%d\n",
 930                 no_objects,objectsz[no_objects].parent,
 931                 objectsz[no_objects].next,objectsz[no_objects].child);
 932         no_objects++;
 933     }
 934
 935     /* (15) Glue on the properties */
 936
 937     if (last>m_props_offset)
 938     {   i = m_static_offset - m_vars_offset - MAX_GLOBAL_VARIABLES*2;
 939         if (dynamic_array_area_size + i >= MAX_STATIC_DATA)
 940             memoryerror("MAX_STATIC_DATA", MAX_STATIC_DATA);
 941
 942         if (linker_trace_level >= 2)
 943             printf("Inserting object properties area, %04x to %04x, at +%04x\n",
 944                 m_props_offset, last, properties_table_size);
 945         for (k=0;k<last-m_props_offset;k++)
 946             properties_table[properties_table_size++] = p[m_props_offset+k];
 947     }
 948
 949     /* (16) Bitwise OR Flags 2 (Z-machine requirements flags) */
 950
 951     j = p[16]*256 + p[17];
 952     for (i=0, k=1;i<16;i++, k=k*2) flags2_requirements[i] |= ((j/k)%2);
 953
 954     /* (17) Append the individual property values table */
 955
 956     i = m_individuals_length;
 957     if (individuals_length + i >= MAX_INDIV_PROP_TABLE_SIZE)
 958         memoryerror("MAX_INDIV_PROP_TABLE_SIZE",
 959             MAX_INDIV_PROP_TABLE_SIZE);
 960
 961     if (linker_trace_level >= 2)
 962       printf("Inserting individual prop tables area, %04x to %04x, at +%04x\n",
 963             m_individuals_offset, m_individuals_offset + i,
 964             individuals_length);
 965     for (k=0;k<i;k++)
 966     {   individuals_table[individuals_length + k]
 967             = p[m_individuals_offset + k];
 968     }
 969     individuals_length += i;
 970
 971     /* (18) All done */
 972
 973     if (linker_trace_level >= 2)
 974          printf("Link complete\n");
 975
 976   my_free(&p, "link module storage");
 977   my_free(&xref_table, "linker cross-references table");
 978   my_free(&property_identifier_map, "property identifier map");
 979   my_free(&accession_numbers_map, "accession numbers map");
 980 }
 981
 982 /* ========================================================================= */
 983 /*   Writing imports, exports and markers to the link data table during      */
 984 /*   module compilation                                                      */
 985 /* ------------------------------------------------------------------------- */
 986 /*   Writing to the link data table                                          */
 987 /* ------------------------------------------------------------------------- */
 988
 989 static void write_link_byte(int x)
 990 {   *link_data_top=(unsigned char) x; link_data_top++; link_data_size++;
 991     if (subtract_pointers(link_data_top,link_data_holding_area)
 992         >= MAX_LINK_DATA_SIZE)
 993     {   memoryerror("MAX_LINK_DATA_SIZE",MAX_LINK_DATA_SIZE);
 994     }
 995 }
 996
 997 extern void flush_link_data(void)
 998 {   int32 i, j;
 999     j = subtract_pointers(link_data_top, link_data_holding_area);
1000     if (temporary_files_switch)
1001         for (i=0;i<j;i++) fputc(link_data_holding_area[i], Temp3_fp);
1002     else
1003         for (i=0;i<j;i++)
1004             write_byte_to_memory_block(&link_data_area, link_data_size-j+i,
1005             link_data_holding_area[i]);
1006     link_data_top=link_data_holding_area;
1007 }
1008
1009 static void write_link_word(int32 x)
1010 {   write_link_byte(x/256); write_link_byte(x%256);
1011 }
1012
1013 static void write_link_string(char *s)
1014 {   int i;
1015     for (i=0; s[i]!=0; i++) write_link_byte(s[i]);
1016     write_link_byte(0);
1017 }
1018
1019 /* ------------------------------------------------------------------------- */
1020 /*   Exports and imports                                                     */
1021 /* ------------------------------------------------------------------------- */
1022
1023 static void export_symbols(void)
1024 {   int symbol_number;
1025
1026     for (symbol_number = 0; symbol_number < no_symbols; symbol_number++)
1027     {   int export_flag = FALSE, import_flag = FALSE;
1028
1029         if (stypes[symbol_number]==GLOBAL_VARIABLE_T)
1030         {   if (svals[symbol_number] < LOWEST_SYSTEM_VAR_NUMBER)
1031             {   if (sflags[symbol_number] & IMPORT_SFLAG)
1032                     import_flag = TRUE;
1033                 else
1034                     if (!(sflags[symbol_number] & SYSTEM_SFLAG))
1035                         export_flag = TRUE;
1036             }
1037         }
1038         else
1039         {   if (!(sflags[symbol_number] & SYSTEM_SFLAG))
1040             {   if (sflags[symbol_number] & UNKNOWN_SFLAG)
1041                 {   if (sflags[symbol_number] & IMPORT_SFLAG)
1042                         import_flag = TRUE;
1043                 }
1044                 else
1045                 switch(stypes[symbol_number])
1046                 {   case LABEL_T:
1047                     case ATTRIBUTE_T:
1048                     case PROPERTY_T:
1049                          /*  Ephemera  */
1050                          break;
1051
1052                     default: export_flag = TRUE;
1053                 }
1054             }
1055         }
1056
1057         if (export_flag)
1058         {   if (linker_trace_level >= 1)
1059             {   IE.module_value = EXPORT_MV;
1060                 IE.symbol_number = symbol_number;
1061                 IE.symbol_type = stypes[symbol_number];
1062                 IE.symbol_value = svals[symbol_number];
1063                 IE.symbol_name = (char *) (symbs[symbol_number]);
1064                 describe_importexport(&IE);
1065             }
1066
1067             if (sflags[symbol_number] & ACTION_SFLAG)
1068                 write_link_byte(EXPORTAC_MV);
1069             else
1070             if (sflags[symbol_number] & INSF_SFLAG)
1071                 write_link_byte(EXPORTSF_MV);
1072             else
1073                 write_link_byte(EXPORT_MV);
1074
1075             write_link_word(symbol_number);
1076             write_link_byte(stypes[symbol_number]);
1077             if (sflags[symbol_number] & CHANGE_SFLAG)
1078                  write_link_byte(svals[symbol_number] / 0x10000);
1079             else write_link_byte(0);
1080             write_link_word(svals[symbol_number] % 0x10000);
1081             write_link_string((char *) (symbs[symbol_number]));
1082             flush_link_data();
1083         }
1084
1085         if (import_flag)
1086         {   if (linker_trace_level >= 1)
1087             {   IE.module_value = IMPORT_MV;
1088                 IE.symbol_number = symbol_number;
1089                 IE.symbol_type = stypes[symbol_number];
1090                 IE.symbol_value = svals[symbol_number];
1091                 IE.symbol_name = (char *) (symbs[symbol_number]);
1092                 describe_importexport(&IE);
1093             }
1094
1095             write_link_byte(IMPORT_MV);
1096             write_link_word(symbol_number);
1097             write_link_byte(stypes[symbol_number]);
1098             write_link_word(svals[symbol_number]);
1099             write_link_string((char *) (symbs[symbol_number]));
1100             flush_link_data();
1101         }
1102     }
1103 }
1104
1105 /* ------------------------------------------------------------------------- */
1106 /*   Marking for later importation                                           */
1107 /* ------------------------------------------------------------------------- */
1108
1109 int mv_vref=LOWEST_SYSTEM_VAR_NUMBER-1;
1110
1111 void import_symbol(int32 symbol_number)
1112 {   sflags[symbol_number] |= IMPORT_SFLAG;
1113     switch(stypes[symbol_number])
1114     {   case GLOBAL_VARIABLE_T:
1115             assign_symbol(symbol_number, mv_vref--, stypes[symbol_number]);
1116             break;
1117     }
1118 }
1119
1120 /* ========================================================================= */
1121 /*   Data structure management routines                                      */
1122 /* ------------------------------------------------------------------------- */
1123
1124 extern void init_linker_vars(void)
1125 {   link_data_size = 0;
1126     initialise_memory_block(&link_data_area);
1127 }
1128
1129 extern void linker_begin_pass(void)
1130 {   link_data_top = link_data_holding_area;
1131 }
1132
1133 extern void linker_endpass(void)
1134 {   export_symbols();
1135     write_link_byte(0);
1136     flush_link_data();
1137 }
1138
1139 extern void linker_allocate_arrays(void)
1140 {   if (!module_switch)
1141         link_data_holding_area
1142             = my_malloc(64, "link data holding area");
1143     else
1144         link_data_holding_area
1145             = my_malloc(MAX_LINK_DATA_SIZE, "link data holding area");
1146 }
1147
1148 extern void linker_free_arrays(void)
1149 {   my_free(&link_data_holding_area, "link data holding area");
1150     deallocate_memory_block(&link_data_area);
1151 }
1152
1153 /* ========================================================================= */