src/linker.c

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