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