|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 157184 (0x26600)
Types: TextFile
Names: »LNK.PRN«
└─⟦3d1e6965e⟧ Bits:30009789/_.ft.Ibm2.50007347.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNK.PRN«
└─⟦91467e717⟧ Bits:30009789/_.ft.Ibm2.50007348.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNK.PRN«
Pro Pascal Compiler - Version zz 2.1
Compilation of: B:LNK.PAS
Options: LNIAG
1 0000 (******************************************************************************)
2 0000 (* *)
3 0000 (* Copyright (1985) by Metanic Aps., Denmark *)
4 0000 (* *)
5 0000 (* Author: Lars Gregers Jakobsen. *)
6 0000 (* *)
7 0000 (******************************************************************************)
8 0000
9 0000 PROGRAM Link;
10 0000
11 0000 (*$I B:lnkDC0.pas Declarations of global constants, types, and commons *)
12 0000 (******************************************************************************)
13 0000 (* *)
14 0000 (* Copyright (1985) by Metanic Aps., Denmark *)
15 0000 (* *)
16 0000 (* Author: Lars Gregers Jakobsen. *)
17 0000 (* *)
18 0000 (******************************************************************************)
19 0000
20 0000 (*$I B:LNKDC0-0.pas Configuration Constants *)
21 0000 (* $I B:LNKDC0-0.pas Configuration Constants *)
22 0000
23 0000 CONST (*LINK*)
24 0000 CommandLineLength = 127;
25 0000 FileNameLength = 14;
26 0000 MaxSymbolNameIndex = 32; (*?*)
27 0000 MaxNooInputFiles = 5; (*?*)
28 0000 MaxNooModules = 10; (*?*)
29 0000 MaxNooSections = 40; (*?*)
30 0000 MaxNooSegments = 5; (*?*)
31 0000 MaxNooSymbols = 50; (*?*)
32 0000 MaxNooExternalImportSymbols = 50; (*?*)
33 0000 MaxNooInternalImportSymbols = 50; (*?*)
34 0000 MaxObjectRecordIndex = 31; (*?*)
35 0000 MaxSectorIndex = 1023;
36 0000 MaxNameTableIndex = 250; (*?*)
37 0000 MaxHeapIndex = 11; (* >= MaxNooModules + 1 *)
38 0000 OM_Format1 = 1;
39 0000 OF_Format1 = 1;
40 0000 LogFilePageSize = 65; (*First line is #1. Last line is #65*)
41 0000
42 0000
43 0000 (*$I A:PrTstCon.pas Declarations of constants for PrTst package *)
44 0000 (* $I A:PrTstCon.pas Declarations of constants for PrTst package *)
45 0000
46 0000 (* This file is part of the ProPascal test option package. Se file
47 0000 PrTst.pas for further explanations of usage
48 0000 *)
49 0000
50 0000 max_test_option_number = 31;
51 0000
52 0000
53 0000
54 0000
55 0000 TYPE (*LINK*)
56 0000
57 0000 (* General Types *)
58 0000
59 0000 i8 = 0..255;
60 0000 byte = i8;
61 0000 i16 = 0..65535;
62 0000 i32 = integer;
63 0000 i32IndexType = (bs0, bs1, bs2, bs3);
64 0000 i32ArrayType = ARRAY (.i32IndexType.) OF i8;
65 0000 CharSetType = SET OF char;
66 0000
67 0000 (* Basic Types *)
68 0000
69 0000 StatusBaseType =
70 0000 (success
71 0000 ,badfileformat
72 0000 ,badmoduleformat
73 0000 ,unexpectedeof
74 0000 ,NotFound
75 0000 ,DuplicateModuleName
76 0000 ,NameTableOverFlow
77 0000 ,ModuleTableOverFlow
78 0000 ,SectionTableOverFlow
79 0000 ,FileNameTableOverFlow
80 0000 ,SymbolTableOverFlow
81 0000 ,ExternalImportTableOverFlow
82 0000 ,InternalImportTableOverFlow
83 0000 ,ValueTableOverFlow
84 0000 ,NoSuchFile
85 0000 ,NotFinished
86 0000 ,BadLogFileName
87 0000 ,BadTargetFileName
88 0000 ,BadSymbolName
89 0000 ,NoInputFiles
90 0000 ,BadOption
91 0000 ,BadFileName
92 0000 ,DuplicateExportSymbol
93 0000 ,HeapEmpty
94 0000 ,NoInput
95 0000 ,error
96 0000 );
97 0000
98 0000 StatusType = SET OF StatusBaseType;
99 0000
100 0000 OF_FormatType = i32;
101 0000 OM_FormatType = i32;
102 0000 FileKindBaseType = (explicit, implicit, none);
103 0000 LogFileKindType = explicit..none;
104 0000 TargetFileKindType = explicit..implicit;
105 0000
106 0000 SegmentNoType = 0..MaxNooSegments;
107 0000 RelocationIndicatorType = SegmentNoType;
108 0000 FileAddressType = 0..MaxInt;
109 0000 SizeType = FileAddressType;
110 0000 ModuleSectionReferenceType = - MaxNooModules..MaxNooSections;
111 0000
112 0000 CommandLineIndexType = 0..CommandLineLength;
113 0000 CommandLineType = String(.CommandLineLength.);
114 0000
115 0000
116 0000
117 0000 SymbolNameIndexType = 0..MaxSymbolNameIndex;
118 0000 SymbolNameSubIndexType = 1..MaxSymbolNameIndex;
119 0000 SymbolNameType = RECORD
120 0000 Length: SymbolNameIndexType;
121 0000 Name: ARRAY (.SymbolNameSubIndexType.) OF i8;
122 0000 END;
123 0000 ModuleNameType = SymbolNameType;
124 0000 FileNameType = STRING(.FileNameLength.);
125 0000
126 0000 FileType = RECORD
127 0000 F: FILE OF i8; (* File systeme file *)
128 0000 P: FileAddressType (* Current file address.
129 0000 NOT defined when eof(F) = true *)
130 0000 END;
131 0000
132 0000 PageNoType = i32;
133 0000 LineNoType = 0..255;
134 0000 LogFileType = RECORD
135 0000 F: text; (* File system file *)
136 0000 P: PageNoType; (* No of page started upon *)
137 0000 L: LineNoType; (* No of line just printed within current page *)
138 0000 END;
139 0000
140 0000 (* Table Index Types *)
141 0000
142 0000 ExternalImportTableIndexType = 0..MaxNooExternalImportSymbols;
143 0000 FileNameTableIndexType = -1..MaxNooInputFiles;
144 0000 InternalImportTableIndexType = 0..MaxNooInternalImportSymbols;
145 0000 ModuleTableIndexType = 0..MaxNooModules;
146 0000 NameTableIndexType = 0..MaxNameTableIndex;
147 0000 SectionTableIndexType = 0..MaxNooSections;
148 0000 SymbolTableIndexType = 0..MaxNooSymbols;
149 0000 HeapIndexType = 0..MaxHeapIndex;
150 0000
151 0000 (* Table Sub Index Types *)
152 0000
153 0000 ExternalImportTableSubIndexType = 1..MaxNooExternalImportSymbols;
154 0000 InternalImportTableSubIndexType = 1..MaxNooInternalImportSymbols;
155 0000 ModuleTableSubIndexType = 1..MaxNooModules;
156 0000 NameTableSubIndexType = 1..MaxNameTableIndex;
157 0000 SectionTableSubIndexType = 1..MaxNooSections;
158 0000 SymbolTableSubIndexType = 1..MaxNooSymbols;
159 0000
160 0000
161 0000
162 0000 (* Table Record Types *)
163 0000
164 0000 ExternalImportTableRecordType = RECORD
165 0000 SymbolNo: SymbolTableIndexType
166 0000 END;
167 0000
168 0000 FileNameTableRecordType = FileNameType;
169 0000
170 0000 InternalImportTableRecordType = RECORD
171 0000 ModificationAddress: FileAddressType;
172 0000 SymbolIndex: ExternalImportTableIndexType
173 0000 END;
174 0000
175 0000 ModuleTableRecordType = RECORD
176 0000 ModuleNameReference: SymbolTableIndexType; (* Reference to symbol
177 0000 table entry holding
178 0000 module name*)
179 0000 FileNameReference: FileNameTableIndexType; (* *)
180 0000 CurrentFileAddress: FileAddressType; (* Offset relative to
181 0000 start of file *)
182 0000 Referenced: Boolean; (* True if module referenced *)
183 0000 NooSegments: SegmentNoType; (* Noo Segments in module *)
184 0000 NooExternalImportSymbols: ExternalImportTableIndexType;
185 0000 EITOffset: ExternalImportTableIndexType;
186 0000 SBTLinkHead: SymbolTableIndexType
187 0000 END;
188 0000
189 0000 SectionTableRecordType = RECORD
190 0000 ModuleNo: ModuleTableIndexType;
191 0000 SegmentNo: SegmentNoType;
192 0000 ImageSize,
193 0000 RldSize: FileAddressType;
194 0000 NooInternalImportSymbols: InternalImportTableIndexType;
195 0000 RelocationConstant: SizeType;
196 0000 END;
197 0000
198 0000 SymbolTableRecordType = RECORD
199 0000 Section: ModuleSectionReferenceType;
200 0000 NameReference: NameTableIndexType;
201 0000 SortLink: SymbolTableIndexType
202 0000 END;
203 0000
204 0000 ValueTableRecordType = RECORD
205 0000 Resolved: Boolean;
206 0000 Value: i32
207 0000 END;
208 0000
209 0000 (* Table Types *)
210 0000
211 0000
212 0000 ExternalImportTableType = ARRAY (.ExternalImportTableSubIndexType.) OF
213 0000 ExternalImportTableRecordType;
214 0000
215 0000 FileNameTableType = ARRAY (.FileNameTableIndexType.) OF
216 0000 FileNameTableRecordType;
217 0000
218 0000 InternalImportTableType = ARRAY (.InternalImportTableSubIndexType.) OF
219 0000 InternalImportTableRecordType;
220 0000
221 0000 ModuleTableType = ARRAY (.ModuleTableSubIndexType.) OF
222 0000 ModuleTableRecordType;
223 0000
224 0000 OptionTableType = RECORD
225 0000 LogFileKind: LogFileKindType;
226 0000 TargetFileKind: TargetFileKindType
227 0000 END;
228 0000
229 0000 NameTableType = ARRAY (.NameTableSubIndexType.) OF i8;
230 0000
231 0000 SectionTableType = ARRAY (.SectionTableSubIndexType.) OF
232 0000 SectionTableRecordType;
233 0000
234 0000 SymbolTableType = ARRAY (.SymbolTableSubIndexType.) OF
235 0000 SymbolTableRecordType;
236 0000
237 0000 ValueTableType = ARRAY (.SymbolTableSubIndexType.) OF
238 0000 ValueTableRecordType;
239 0000
240 0000
241 0000 (* Other major data structures *)
242 0000
243 0000 HeapType = ARRAY (.ModuleTableIndexType.) OF SymbolTableIndexType;
244 0000
245 0000
246 0000
247 0000 ObjectRecordKindType = (OFF_Kind,
248 0000 OMF_Kind,
249 0000 OMH_Kind,
250 0000 SGD_Kind,
251 0000 EXP_Kind,
252 0000 EXI_Kind,
253 0000 IMG_Kind,
254 0000 RLD_Kind,
255 0000 INI_Kind,
256 0000 SYM_Kind,
257 0000 IndexableKind
258 0000 );
259 0000
260 0000 ObjectRecordIndexType = 0..MaxObjectRecordIndex;
261 0000
262 0000 ObjectRecordType = RECORD
263 0000 CASE ObjectRecordKind: ObjectRecordKindType OF
264 0000 OFF_Kind:
265 0000 (OF_Format: OF_FormatType);
266 0000 OMF_Kind:
267 0000 (OM_Format: OM_FormatType);
268 0000 OMH_Kind:
269 0000 (OMH_Module
270 0000 ,OMH_NooSegments
271 0000 ,OMH_NooExportSymbols
272 0000 ,OMH_NooExtImportSymbols
273 0000 : i32
274 0000 ;OMH_ModuleName
275 0000 : ModuleNameType
276 0000 );
277 0000 SGD_Kind:
278 0000 (SGD_Image
279 0000 ,SGD_Rld
280 0000 ,SGD_IntImport
281 0000 ,SGD_NooIntImportSymbols: i32
282 0000 );
283 0000 EXP_Kind:
284 0000 (EXP_RelocationIndicator: RelocationIndicatorType
285 0000 ;EXP_Item: i32
286 0000 ;EXP_SymbolName: SymbolNameType
287 0000 );
288 0000 EXI_Kind:
289 0000 (EXI_SymbolName: SymbolNameType
290 0000 );
291 0000 IMG_Kind:
292 0000 (IMG_SectionImageUnit: i8
293 0000 );
294 0000 RLD_Kind:
295 0000 (RLD_RelocationIndicator: RelocationIndicatorType
296 0000 );
297 0000 INI_Kind:
298 0000 (INI_ModificationAddress: FileAddressType
299 0000 ;INI_SymbolIndex: ExternalImportTableIndexType
300 0000 );
301 0000 SYM_Kind:
302 0000 (SYM_SymbolName: SymbolNameType
303 0000 );
304 0000 IndexableKind:
305 0000 (N: ARRAY (.ObjectRecordIndexType.) OF i8)
306 0000 END; (*RECORD CASE*)
307 0000
308 0000 (*$I A:PrTstTyp.pas Declarations of types for PrTst package *)
309 0000 (* $I A:PrTstTyp.pas Declarations of types for PrTst package *)
310 0000
311 0000 (* This file is part of the ProPascal test option package. Se file
312 0000 PrTst.pas for further explanations of usage
313 0000 *)
314 0000
315 0000 test_option_type = 0..max_test_option_number;
316 0000 test_option_set_type = SET OF test_option_type;
317 0000
318 0000
319 0000
320 0000
321 0000 COMMON (*LINK*)
322 0000
323 0000 (* Permanent Tables *)
324 0000
325 0000 OptionTable: OptionTableType;
326 0000
327 0000 FileNameTable: FilenameTableType;
328 0000 CurFileNo: FileNameTableIndexType;
329 0000
330 0000 ModuleTable: ModuleTableType;
331 0000 CurModuleNo: ModuleTableIndexType;
332 0000 TargetModuleNo: ModuleTableIndexType;
333 0000
334 0000 SectionTable: SectionTableType;
335 0000 SCTOffset: SectionTableIndexType;
336 0000 TargetSectionOffset: SectionTableIndexType;
337 0000 CurSegmentCount: SegmentNoType;
338 0000
339 0000
340 0000 ValueTable: ValueTableType;
341 0000 CurValueNo: SymbolTableIndexType; (*?*)
342 0000
343 0000 ExternalImportTable: ExternalImportTableType;
344 0000 CurExternalImportSymbolNo: ExternalImportTableIndexType;
345 0000
346 0000 (*$I A:PrTstCom.pas Declarations of global variables for PrTst package *)
347 0000 (* $I A:PrTstCom.pas Declarations of global variables for PrTst package *)
348 0000
349 0000 (* This file is part of the ProPascal test option package. Se file
350 0000 PrTst.pas for further explanations of usage
351 0000 *)
352 0000
353 0000 test_options: test_option_set_type;
354 0000 test_out: text;
355 0000 test_global: boolean;
356 0000
357 0000
358 0000
359 0000
360 0000 VAR (*LINK*)
361 0000
362 0000 (* Misc. Variables *)
363 0000
364 0000 Status: StatusType;
365 0000 StatusInx: StatusBaseType;
366 0000 TargetFile: FileType;
367 0000 LogFile: LogFileType;
368 0000
369 0000 (*$I A:PrTstExt.pas External Decl. of standard test procedures *)
370 0000 (* $I A:ProTstExt.pas Declarations of external procedures for ProTst package *)
371 0000
372 0000 (* This file is part of the ProPascal test option package. Se file
373 0000 ProTst.pas for further explanations of usage
374 0000 *)
375 0000
376 0000 FUNCTION test(list: test_option_set_type
377 0000 ): boolean; EXTERNAL;
378 0000
379 0000 PROCEDURE test_init(VAR in_file,
380 0000 out_file: text
381 0000 ); EXTERNAL;
382 0000
383 0000
384 0000 (* $I B:LnkDC1.pas External Decl. of global test output primitives *)
385 0000 (*$I B:LnkDF1.pas Globall test output primitives *)
386 0000 (*
387 0000 SEGMENT LnkDF1X;
388 0000 *)
389 0000 (* Segment LnkDF1X defines the test output primitives used for debugging
390 0000 program link and its associated subroutines and functions. The
391 0000 corresponding external declarations should be found in file
392 0000 'LnkDC1.pas'.
393 0000 *)
394 0000
395 0000 (* $I B:lnkDC0.pas Declarations of global constants, types, and commons *)
396 0000
397 0000 FUNCTION memavail: integer; EXTERNAL;
398 0000
399 0000 PROCEDURE TSTasc(N: i8
400 0000 );
401 0000
402 0000 BEGIN (*TSTASC*)
403 0000 IF (31 < N) and (N < 127) THEN
404 0024 write(TestOut, chr(N) )
405 003D ELSE
406 0042 write(TestOut, '+')
407 005A END; (*TSTASC*)
408 0063
409 0063 PROCEDURE TSThex(N: i8
410 0063 );
411 0063
412 0063 VAR
413 0063 Nibble: i8;
414 0063
415 0063 BEGIN (*TSTHEX*)
416 0063 Nibble := N div 16;
417 0082 IF Nibble < 10 THEN
418 008B write(TestOut, chr( ord('0') + Nibble ) )
419 00AB ELSE
420 00B0 write(TestOut, chr( ord('A') - 10 + Nibble ) );
421 00D3 Nibble := N mod 16;
422 00E4 IF Nibble < 10 THEN
423 00ED write(TestOut, chr( ord('0') + Nibble ) )
424 010D ELSE
425 0112 write(TestOut, chr( ord('A') - 10 + Nibble ) )
426 0132 END; (*TSTHEX*)
427 013B
428 013B PROCEDURE TSTbool(A: boolean
429 013B );
430 013B
431 013B BEGIN (*TSTBOOL*)
432 013B IF A THEN
433 014E write(TestOut, 'T')
434 0166 ELSE
435 016B write(TestOut, 'F')
436 0183 END; (*TSTBOOL*)
437 018C
438 018C PROCEDURE TSTindt;
439 018C
440 018C BEGIN (*TSTindt*)
441 018C write(TestOut, ' ':3)
442 01AC END; (*TSTindt*)
443 01B5
444 01B5 PROCEDURE TSTln;
445 01B5
446 01B5 BEGIN (*TSTln*)
447 01B5 writeln(TestOut)
448 01CC END; (*TSTln*)
449 01D5
450 01D5 PROCEDURE TSTsymbol(S: SymbolNameType
451 01D5 );
452 01D5
453 01D5 VAR
454 01D5 I: SymbolNameIndexType;
455 01D5
456 01D5 BEGIN (*TSTSYMBOL*)
457 01D5 WITH S DO
458 01F7 BEGIN
459 01FC write(TestOut, 'SYMBOLÆ', Length:1, 'Å=');
460 0242 FOR I := 1 TO Length DO
461 025B TSTasc(Name(.I.));
462 0281 TSTln;
463 0289 END
464 0289 END; (*TSTSYMBOL*)
465 028F
466 028F PROCEDURE TSTstat(Status: StatusType
467 028F );
468 028F
469 028F VAR
470 028F Inx: StatusBaseType;
471 028F
472 028F BEGIN (*TSTstat*)
473 028F write(TestOut, 'STAT=(');
474 02BC IF Status = (..) THEN
475 02D5 write(TestOut, 'SUCCESS)' )
476 02F9 ELSE
477 02FF BEGIN
478 0304 FOR Inx := succ(Success) TO Error DO
479 0315 IF Inx IN Status THEN
480 032C write(TestOut, ' ', ord(Inx):1);
481 0360 write(TestOut, ' )');
482 0381 END
483 0381 END; (*TSTstat*)
484 0387
485 0387 PROCEDURE TSTmem;
486 0387
487 0387 BEGIN (*TSTmem*)
488 0387 write(TestOut, 'MEMAVAIL=', memavail:1)
489 03BF END; (*TSTmem*)
490 03C8
491 03C8 PROCEDURE TSTfpos(VAR Fl: FileType
492 03C8 );
493 03C8
494 03C8 BEGIN (*TSTfpos*)
495 03C8 write(TestOut, 'FPOS=',
496 03F1 (*Fl.S:1, '/',*)
497 03F1 Fl.P:1)
498 0404 END; (*TSTfpos*)
499 040D
500 040D PROCEDURE TSTeit(Inx: ExternalImportTableIndexType
501 040D );
502 040D
503 040D BEGIN (*TSTeit*)
504 040D WITH ExternalImportTable(.Inx.) DO
505 042E writeln(TestOut, 'EITÆ', Inx:1, '/', CurExternalImportSymbolNo:1,
506 0479 'Å=(SblNo=', SymbolNo:1, ')' )
507 04AD END; (*TSTeit*)
508 04B6
509 04B6 PROCEDURE TSTfnt(Inx: FileNameTableIndexType
510 04B6 );
511 04B6
512 04B6 BEGIN (*TSTfnt*)
513 04B6 writeln(TestOut, 'FNTÆ', Inx:1, '/', CurFileNo:1,
514 0509 'Å=(FlNm=', FileNameTable(.inx.), ')' )
515 0544 END; (*TSTfnt*)
516 054D
517 054D PROCEDURE TSTheap(Heap: HeapType
518 054D ;HeapMax: ModuleTableIndexType
519 054D );
520 054D
521 054D VAR
522 054D I: ModuleTableIndexType;
523 054D
524 054D BEGIN (*TSTHEAP*)
525 054D TSTindt; TSTindt; TSTindt;
526 0578 write(TestOut, 'HeapÆ',HeapMax:2,'Å=(' );
527 05BD FOR I := 1 TO HeapMax + 1 DO
528 05E3 write(TestOut, Heap(.I.):2, ' ':1);
529 0629 writeln(TestOut, ')');
530 0644 END; (*TSTHEAP*)
531 064A
532 064A PROCEDURE TSTiit(Inx: InternalImportTableIndexType
533 064A );
534 064A
535 064A BEGIN (*TSTiit*)
536 064A END; (*TSTiit*)
537 0658
538 0658 PROCEDURE TSTmdt(Inx: ModuleTableIndexType
539 0658 );
540 0658
541 0658 BEGIN (*TST*)
542 0658 WITH moduleTable(.Inx.) DO
543 067F BEGIN
544 0684 write(TestOut, 'MDTÆ', Inx:1, '/', CurModuleNo:1,
545 06CF 'Å=(MdNm#=', ModuleNameReference:1, ' ':2
546 06FD ,'Fn#=', FileNameReference:1, ' ':2
547 072D ,'CurFlAddr=', CurrentFileAddress:1, ' ':2
548 0760 ,'Refd='
549 076E );
550 077B TSTbool(Referenced);
551 0792 TSTln;
552 079A TSTindt; TSTindt; TSTindt;
553 07A8 writeln(TestOut ,'#Sgm=', NooSegments:1, ' ':2
554 07E5 ,'#EIsbl=', NooExternalImportSymbols:1, ' ':2
555 081B ,'EIT#=', EITOffset:1, ' ':2
556 084F ,'SBTLH=', SBTlinkHead:1
557 087B ,')'
558 0881 );
559 088D END
560 088D END; (*TST*)
561 0893
562 0893 PROCEDURE TSTopt;
563 0893
564 0893 BEGIN (*TSTopt*)
565 0893 writeln(TestOut, 'OPT=(LogKind=', ord(OptionTable.LogFileKind):1, ' ':2
566 08D6 ,'TargetKind=', ord(OptionTable.TargetFileKind):1
567 08FD ,')' )
568 090C END; (*TSTopt*)
569 0915
570 0915 PROCEDURE TSTsct(Inx: SectionTableIndexType
571 0915 );
572 0915
573 0915 BEGIN (*TSTsct*)
574 0915 WITH SectionTable(.Inx.) DO
575 093C BEGIN
576 0941 writeln(TestOut, 'SCT=Æ', Inx:1, '/', SCTOffset:1, '/', CurSegmentCount:1
577 09A1 ,'Å=(Mdl#=', ModuleNo:1, ' ':2
578 09D4 ,'Sgm#=', SegmentNo:1
579 09FC ,'#IISbl=', NooInternalImportSymbols:1
580 0A29 );
581 0A32 writeln(TestOut, ' ImSz=', ImageSize, ' ':2
582 0A72 ,'RlSz=', RldSize, ' ':2
583 0AA2 ,'RlConst=', RelocationConstant
584 0ABD ,')'
585 0AD2 );
586 0ADE END
587 0ADE END; (*TSTsct*)
588 0AE4
589 0AE4 PROCEDURE TSTvlt(Inx: SymbolTableIndexType
590 0AE4 );
591 0AE4
592 0AE4 BEGIN (*TSTvlt*)
593 0AE4 WITH ValueTable(.Inx.) DO
594 0B0B BEGIN
595 0B10 write(TestOut, 'VLTÆ',Inx:1,'Å=(Resolved='); TSTbool(Resolved);
596 0B6B write(TestOut, ' Value=', Value:1)
597 0BA1 END
598 0BA4 END; (*TSTvlt*)
599 0BAA
600 0BAA
601 0BAA
602 0BAA (* BEGIN (*LNKTST*)
603 0BAA (* END. (*LNKTST*)
604 0BAA
605 0BAA
606 0BAA (* $I B:LnkDC2.pas External Decl. of global access primitives *)
607 0BAA (*$I B:LnkDF2.pas Global access primitives *)
608 0BAA (******************************************************************************)
609 0BAA (* *)
610 0BAA (* Copyright (1985) by Metanic Aps., Denmark *)
611 0BAA (* *)
612 0BAA (* Author: Lars Gregers Jakobsen. *)
613 0BAA (* *)
614 0BAA (******************************************************************************)
615 0BAA (*
616 0BAA SEGMENT LnkDF2X;
617 0BAA *)
618 0BAA (* Segment LnkDF2X holds the access primitives used by the
619 0BAA linker to access input and output files. *)
620 0BAA
621 0BAA (* On resetting (FILRST) the File sector number 0 (zero) is brought
622 0BAA into F^ and sector number (S) is initialized to 0 (zero). The file
623 0BAA pointer (P) is initialized to 0 too and it always points to the next
624 0BAA byte to be read. If a read operation causes the file pointer to
625 0BAA exceed maxsectorindex and no end of file condition exists a new
626 0BAA sector will be fetched (renew) and P will be updated accordingly.
627 0BAA If an end of file condition exists it will persist throughout
628 0BAA (thus identifiable) and P will be set to 0 (zero). *)
629 0BAA
630 0BAA
631 0BAA
632 0BAA (* $I B:lnkDC0.pas Declarations of global constants, types, and commons *)
633 0BAA (* $I A:PrTstExt.pas External Decl. of standard test procedures *)
634 0BAA (* $I B:LnkDC1.pas External Decl. of global test output primitives *)
635 0BAA
636 0BAA (*$I B:LNKDF8.PAS Object file access primitives *)
637 0BAA PROCEDURE FilAsg(VAR Fl: FileType
638 0BAA ;Fn: FileNameType
639 0BAA );
640 0BAA
641 0BAA BEGIN (*FILASG*)
642 0BAA IF test((.0,1.)) THEN
643 0BC8 writeln(TestOut, 'FILasg FlNm=', Fn);
644 0C05 assign(Fl.F, Fn)
645 0C22 END; (*FILASG*)
646 0C28
647 0C28 PROCEDURE FilRst(VAR Status: StatusType
648 0C28 ;VAR Fl: FileType
649 0C28 );
650 0C28
651 0C28 BEGIN (*FILRST*)
652 0C28 WITH Fl DO
653 0C41 BEGIN
654 0C46 P := 0;
655 0C57 reset(F);
656 0C6A IF eof(F) THEN
657 0C80 Status := Status + (.UnExpectedEof.);
658 0CA4 IF test((.0,1.)) THEN
659 0CBA BEGIN
660 0CBF write(TestOut, 'FILrst'); TSTstat(Status); TSTln;
661 0CFB END;
662 0CFB END
663 0CFB END; (*FILRST*)
664 0D01
665 0D01 PROCEDURE FilRwt(VAR Fl: FileType
666 0D01 );
667 0D01
668 0D01 BEGIN (*FILRWT*)
669 0D01 IF test((.0,1.)) THEN
670 0D1F writeln(TestOut, 'FILrwt');
671 0D44 WITH Fl DO
672 0D55 BEGIN
673 0D5A rewrite(F);
674 0D67 P := 0;
675 0D7E END
676 0D7E END; (*FILRWT*)
677 0D84
678 0D84 PROCEDURE FilCls(VAR Fl: FileType
679 0D84 );
680 0D84
681 0D84 BEGIN (*FILCLS*)
682 0D84 close(Fl.F);
683 0D9F END; (*FILCLS*)
684 0DA5
685 0DA5 PROCEDURE FilSeek(VAR Status: StatusType
686 0DA5 ;VAR Fl: FileType
687 0DA5 ; Position: FileAddressType
688 0DA5 );
689 0DA5
690 0DA5 BEGIN (*FILSEEK*)
691 0DA5 WITH Fl DO
692 0DBE BEGIN
693 0DC3 P := Position;
694 0DD5 seek(F, Position);
695 0DEE IF eof(F) THEN
696 0E04 Status := Status + (.UnExpectedEof.);
697 0E28 IF test((.0,1,2.)) THEN
698 0E3F BEGIN
699 0E44 write(TestOut, 'FILSEEK '); TSTstat(Status); TSTindt;
700 0E83 write(TestOut, 'P=', P:1
701 0EAE , ' EOF='); TSTbool(eof(F));
702 0EE4 TSTln;
703 0EEC END;
704 0EEC END
705 0EEC END; (*FILSEEK*)
706 0EF2
707 0EF2 PROCEDURE FGi8(VAR Status: StatusType
708 0EF2 ;VAR Fl: FileType
709 0EF2 ;VAR V: i8
710 0EF2 );
711 0EF2
712 0EF2 BEGIN (*FGI8*)
713 0EF2 WITH Fl DO
714 0F0B BEGIN
715 0F10 IF not eof(F) THEN
716 0F22 BEGIN
717 0F27 read(F,V);
718 0F50 P := P + 1;
719 0F72 END
720 0F72 ELSE
721 0F74 Status := Status + (.UnexpectedEof.);
722 0F98 IF test((.0,2.)) THEN
723 0FAF BEGIN
724 0FB4 write(TestOut, 'FGI8 '); TSTstat(Status); TSTindt;
725 0FF3 write(TestOut, 'P=', P:1,' V=', V:1, ' EOF='); TSTbool(eof(F));
726 1071 TSTln;
727 1079 END;
728 1079 END;
729 1079 END; (*FGI8*)
730 107F
731 107F PROCEDURE FGi32(VAR Status: StatusType
732 107F ;VAR Fl: FileType
733 107F ;VAR V: i32
734 107F );
735 107F
736 107F VAR
737 107F I: I32IndexType;
738 107F N: I32ArrayType;
739 107F
740 107F BEGIN (*FGI32*)
741 107F WITH Fl DO
742 1098 BEGIN
743 109D P := P + 4;
744 10C1 FOR I := bs0 TO bs3 DO
745 10D2 IF not eof(f) THEN
746 10EB read(F, N(.I.) )
747 111C ELSE
748 1122 Status := Status + (.UnexpectedEof.);
749 1150 move(N, V, 4);
750 1169 IF test((.0,2.)) THEN
751 1180 BEGIN
752 1185 write(TestOut, 'FGI32 '); TSTstat(Status); TSTindt;
753 11C4 write(TestOut, 'P=', P:1,' V=', V:1,
754 1216 ' N=(',N(.bs3.):3,'/',N(.bs2.):3
755 1248 ,'/',N(.bs1.):3,'/',N(.bs0.):3,') EOF=');
756 1294 TSTbool(eof(F)); TSTln;
757 12B1 END;
758 12B1 END;
759 12B1 END; (*FGI32*)
760 12B7
761 12B7 PROCEDURE FGSym(VAR Status: StatusType
762 12B7 ;VAR Fl: FileType
763 12B7 ;VAR SymbolName: SymbolNameType
764 12B7 );
765 12B7
766 12B7 VAR
767 12B7 I: i8;
768 12B7 N: i8;
769 12B7
770 12B7 BEGIN (*FGSYM*)
771 12B7 WITH Fl, SymbolName DO
772 12DC BEGIN
773 12E1 IF test((.0,2.)) THEN
774 12F8 BEGIN
775 12FD write(TestOut, 'FGSYM-1 '); TSTstat(Status); TSTindt;
776 133C write(TestOut, 'P=', P:1, ' F^=',F^:3, ' EOF=');
777 13B0 TSTbool(eof(F)); TSTln
778 13CA END;
779 13CD IF not eof(F) THEN
780 13E6 BEGIN
781 13EB read(F, N);
782 140E P := P + 1 + N;
783 143D IF (0 < N) and (N <= MaxSymbolNameIndex) THEN
784 145B BEGIN
785 1460 Length := N;
786 1478 FOR I := 1 TO N DO
787 148F IF not eof(F) THEN
788 14A8 read(F, Name(.I.) )
789 14E1 ELSE
790 14E7 Status := Status + (.UnexpectedEof.)
791 14FD END
792 1515 ELSE
793 1518 BEGIN
794 151D Status := Status + (.BadSymbolName.);
795 1544 FOR I := 1 TO N DO
796 155A IF not eof(F) THEN
797 1573 read(F, Name(.1.) )
798 159A ELSE
799 15A0 Status := Status + (.UnexpectedEof.)
800 15B6 END
801 15CE END
802 15CE ELSE
803 15D0 Status := Status + (.UnexpectedEof.);
804 15F4 IF test((.0,2.)) THEN
805 160A BEGIN
806 160F write(TestOut, 'FGSYM-2 '); TSTstat(Status); TSTindt;
807 164E TSTsymbol(SymbolName);
808 165D END;
809 165D END
810 165D END; (*FGSYM*)
811 1663
812 1663 PROCEDURE FPi8(VAR Fl: FileType
813 1663 ; V: i8
814 1663 );
815 1663
816 1663 BEGIN (*FPI8*)
817 1663 WITH Fl DO
818 167C BEGIN
819 1681 IF test((.0,3.)) THEN
820 1697 BEGIN
821 169C writeln(TestOut, 'FPI8 ', 'P=', P:1,' V=', V:1);
822 1705 END;
823 1705 write(F,V);
824 172A P := P + 1
825 1743 END
826 174C END; (*FPI8*)
827 1752
828 1752 PROCEDURE FPi32(VAR Fl: FileType
829 1752 ; V: i32
830 1752 );
831 1752
832 1752 VAR
833 1752 I: I32IndexType;
834 1752 N: I32ArrayType;
835 1752
836 1752 BEGIN (*FPI32*)
837 1752 move(V, N, 4);
838 1774 WITH Fl DO
839 1785 BEGIN
840 178A IF test((.0,3.)) THEN
841 17A1 BEGIN
842 17A6 writeln(TestOut, 'FPI32 ', 'P=', P:1,' V=', V:1,
843 1809 ' N=(',N(.bs3.):3,'/',N(.bs2.):3
844 183B ,'/',N(.bs1.):3,'/',N(.bs0.):3,')');
845 187D END;
846 187D P := P + 4;
847 18A7 FOR I := bs0 TO bs3 DO
848 18B8 write(F, N(.I.) )
849 18E9 END
850 18F6 END; (*FPI32*)
851 18FC
852 18FC PROCEDURE FPSym(VAR Fl: FileType
853 18FC ; SymbolName: SymbolNameType
854 18FC );
855 18FC
856 18FC VAR
857 18FC I: SymbolNameIndexType;
858 18FC
859 18FC BEGIN (*FPSYM*)
860 18FC WITH Fl, SymbolName DO
861 192A BEGIN
862 192F IF test((.0,3.)) THEN
863 1946 BEGIN
864 194B write(TestOut, 'FPSYM-2 '); TSTstat(Status); TSTindt;
865 1988 write(TestOut, 'P=', P:1); TSTindt; TSTsymbol(SymbolName);
866 19CA END;
867 19CA P := P + 1 + Length;
868 19FA write(F, Length);
869 1A23 FOR I := 1 TO Length DO
870 1A3C write(F, Name(.I.) )
871 1A6E END
872 1A7B END; (*FPSYM*)
873 1A81
874 1A81 (*$I B:LNKDF7.PAS Log file access primitives *)
875 1A81 (******************************************************************************)
876 1A81 (* *)
877 1A81 (* Copyright (1985) by Metanic Aps., Denmark *)
878 1A81 (* *)
879 1A81 (* Author: Lars Gregers Jakobsen. *)
880 1A81 (* *)
881 1A81 (******************************************************************************)
882 1A81
883 1A81 (* This file holds the access primitives for writing the log file*)
884 1A81
885 1A81 PROCEDURE WriteSymbolName(VAR F: text
886 1A81 ; SymbolName: SymbolNameType
887 1A81 ; FieldSize: i8
888 1A81 );
889 1A81
890 1A81 VAR
891 1A81 I: SymbolNameIndexType;
892 1A81 N: i8;
893 1A81
894 1A81 BEGIN (*WRITESYMBOLNAME*)
895 1A81 WITH SymbolName DO
896 1AA3 BEGIN
897 1AA8 IF Length < FieldSize THEN
898 1AC0 N := Length
899 1AC5 ELSE
900 1AD1 N := FieldSize;
901 1ADC FOR I := 1 TO N DO
902 1AFE IF Name(.I.) in (.32..127.) THEN
903 1B31 write(F, chr(Name(.I.)) );
904 1B6E FOR I := N+1 TO FieldSize DO
905 1B93 write(F, ' ');
906 1BBF END
907 1BBF END; (*WRITESYMBOLNAME*)
908 1BC5
909 1BC5 PROCEDURE LogInit(VAR LogFile: LogFileType
910 1BC5 ; FileName: FileNameType
911 1BC5 );
912 1BC5
913 1BC5 BEGIN (*LOGINIT*)
914 1BC5 WITH LogFile DO
915 1BDE BEGIN
916 1BE3 assign(F, FileName);
917 1BFA rewrite(F);
918 1C0D P := 0;
919 1C24 L := LogFilePageSize;
920 1C35 END
921 1C35 END; (*LOGINIT*)
922 1C3B
923 1C3B PROCEDURE LogTerm(VAR LogFile: LogFileType
924 1C3B );
925 1C3B
926 1C3B BEGIN (*LOGTERM*)
927 1C3B WITH LogFile DO
928 1C54 BEGIN
929 1C59 close(F);
930 1C66 END
931 1C66 END; (*LOGTERM*)
932 1C6C
933 1C6C FUNCTION LogFF(VAR LogFile: LogFileType
934 1C6C ; Delta: LineNoType
935 1C6C ): boolean;
936 1C6C
937 1C6C CONST
938 1C6C LogFFDelta = 5;
939 1C6C
940 1C6C BEGIN (*LOGFF*)
941 1C6C WITH LogFile DO
942 1C85 IF L > LogFilePageSize - Delta THEN
943 1CAE BEGIN
944 1CB3 LogFF := true;
945 1CBC P := P + 1;
946 1CDB L := LogFFDelta;
947 1CEC page(F);
948 1CFF writeln(F);
949 1D18 writeln(F);
950 1D31 writeln(F, ' ':10, 'LINKER for unnamed project. '
951 1D6F , 'Butler has neither clock nor calender. '
952 1DA3 , 'PAGE # ', P:2);
953 1DD7 writeln(F);
954 1DF0 writeln(F);
955 1E09 END
956 1E09 ELSE
957 1E0B LogFF := false;
958 1E14 END; (*LOGFF*)
959 1E1D
960 1E1D PROCEDURE LogCmd(VAR LogFile: LogFileType
961 1E1D ; CommandLine: CommandLineType
962 1E1D );
963 1E1D
964 1E1D CONST Delta = 3;
965 1E1D
966 1E1D BEGIN (*LOGCMD*)
967 1E1D IF OptionTable.LogFileKind <> none THEN
968 1E32 BEGIN
969 1E37 IF LogFF(LogFile, Delta) THEN BEGIN END;
970 1E4C WITH LogFile DO
971 1E5D BEGIN
972 1E62 writeln(F, ' ':10, 'AKTIVERINGSKOMMANDO: ');
973 1EA6 writeln(F, ' ':10, CommandLine);
974 1ED8 writeln(F)
975 1EEE END
976 1EF1 END
977 1EF1 END; (*LOGCMD*)
978 1EF7
979 1EF7 PROCEDURE LogHSsgd(VAR LogFile: LogFileType
980 1EF7 );
981 1EF7
982 1EF7 BEGIN (*LOGHSSGD*)
983 1EF7 IF OptionTable.LogFileKind <> none THEN
984 1F0C WITH LogFile DO
985 1F1D BEGIN
986 1F22 L := L + 2;
987 1F43 writeln(F, ' ':10, 'SEGM STARTADR. STØRRELSE MODUL'
988 1F86 (* , ' ':25, 'FIL' *)
989 1F86 );
990 1F93 writeln(F);
991 1FAC END
992 1FAC END; (*LOGHSSGD*)
993 1FB2
994 1FB2 PROCEDURE LogHsgd(VAR LogFile: LogFileType
995 1FB2 );
996 1FB2
997 1FB2 BEGIN (*LOGHSGD*)
998 1FB2 IF OptionTable.LogFileKind <> none THEN
999 1FC7 BEGIN
1000 1FCC IF LogFF(LogFile, 6) THEN BEGIN END;
1001 1FE1 WITH LogFile DO
1002 1FF2 BEGIN
1003 1FF7 L := L + 3;
1004 2018 writeln(F);
1005 2031 writeln(F, ' ':10, 'LOKALISERINGSPLAN:');
1006 2072 writeln(F);
1007 208B END;
1008 208B LogHSsgd(LogFile);
1009 209A END;
1010 209A END; (*LOGHSGD*)
1011 20A0
1012 20A0 PROCEDURE LogSGD(VAR LogFile: LogFileType
1013 20A0 ; SegmentNo: RelocationIndicatorType
1014 20A0 ; StartAddress: SizeType
1015 20A0 ; Size: SizeType
1016 20A0 ; ModuleName: SymbolNameType
1017 20A0 );
1018 20A0
1019 20A0 BEGIN (*LOGSGD*)
1020 20A0 IF OptionTable.LogFileKind <> none THEN
1021 20CA BEGIN
1022 20CF IF LogFF(LogFile, 1) THEN
1023 20E4 LogHSsgd(LogFile);
1024 20F3 WITH LogFile DO
1025 2104 BEGIN
1026 2109 L := L + 1;
1027 2127 write(F, ' ':10, SegmentNo:3
1028 2151 , ' ':2, StartAddress:9
1029 2166 , ' ':2, Size:9
1030 217B , ' ':3
1031 2184 );
1032 218D WriteSymbolName(F, ModuleName, 24);
1033 21A7 writeln(F);
1034 21C0 END;
1035 21C0 END
1036 21C0 END; (*LOGSGD*)
1037 21C6
1038 21C6 PROCEDURE LogHSxp(VAR LogFile: LogFileType
1039 21C6 );
1040 21C6
1041 21C6 BEGIN (*LOGHSXP*)
1042 21C6 IF OptionTable.LogFileKind <> none THEN
1043 21DB WITH LogFile DO
1044 21EC BEGIN
1045 21F1 L := L + 2;
1046 2212 writeln(F, ' ':10, 'SEGM VÆRDI MODUL SYMBOL');
1047 225E writeln(F);
1048 2277 END
1049 2277 END; (*LOGHSXP*)
1050 227D
1051 227D PROCEDURE LogHxpN(VAR LogFile: LogFileType
1052 227D );
1053 227D
1054 227D BEGIN (*LOGHXPN*)
1055 227D IF OptionTable.LogFileKind <> none THEN
1056 2292 BEGIN
1057 2297 IF LogFF(LogFile, 6) THEN BEGIN END;
1058 22AC WITH LogFile DO
1059 22BD BEGIN
1060 22C2 L := L + 3;
1061 22E3 writeln(F);
1062 22FC writeln(F, ' ':10, 'EXPORTEREDE SYMBOLER (NAVNEORDEN):');
1063 234D writeln(F);
1064 2366 END;
1065 2366 LogHSxp(LogFile);
1066 2375 END
1067 2375 END; (*LOGHXPN*)
1068 237B
1069 237B PROCEDURE LogHxpV(VAR LogFile: LogFileType
1070 237B );
1071 237B
1072 237B BEGIN (*LOGHXPV*)
1073 237B IF OptionTable.LogFileKind <> none THEN
1074 2390 BEGIN
1075 2395 IF LogFF(LogFile, 6) THEN BEGIN END;
1076 23AA WITH LogFile DO
1077 23BB BEGIN
1078 23C0 L := L + 3;
1079 23E1 writeln(F);
1080 23FA writeln(F, ' ':10, 'EXPORTEREDE SYMBOLER (VÆRDIORDEN):');
1081 244B writeln(F);
1082 2464 END;
1083 2464 LogHSxp(LogFile);
1084 2473 END
1085 2473 END; (*LOGHXPV*)
1086 2479
1087 2479 PROCEDURE LogXP(VAR LogFile: LogFileType
1088 2479 ; SegmentNo: RelocationIndicatorType
1089 2479 ; Value: i32
1090 2479 ; SymbolName: SymbolNameType
1091 2479 ; ModuleName: ModuleNameType
1092 2479 );
1093 2479
1094 2479 BEGIN (*LOGXP*)
1095 2479 IF OptionTable.LogFileKind <> none THEN
1096 24B8 BEGIN
1097 24BD IF LogFF(LogFile,1) THEN
1098 24D2 LogHSxp(LogFile);
1099 24E1 WITH LogFile DO
1100 24F2 BEGIN
1101 24F7 L := L + 1;
1102 2515 write(F, ' ':10, SegmentNo:3
1103 253F , ' ':2, Value:9
1104 2554 , ' ':2
1105 255D );
1106 2566 WriteSymbolName(F, ModuleName, 20);
1107 2580 write(F, ' ':2);
1108 25A2 WriteSymbolName(F, SymbolName, 20);
1109 25BC writeln(F);
1110 25D5 END
1111 25D5 END
1112 25D5 END; (*LOGXP*)
1113 25DB
1114 25DB PROCEDURE LogHSurs(VAR LogFile: LogFileType
1115 25DB );
1116 25DB
1117 25DB BEGIN (*LOGHSURS*)
1118 25DB IF OptionTable.LogFileKind <> none THEN
1119 25F0 BEGIN
1120 25F5 WITH LogFile DO
1121 2606 BEGIN
1122 260B L := L + 2;
1123 262C writeln(F, ' ':10, 'MODUL SYMBOL');
1124 2668 writeln(F);
1125 2681 END
1126 2681 END
1127 2681 END; (*LOGHSURS*)
1128 2687
1129 2687 PROCEDURE LogHurs(VAR LogFile: LogFileType
1130 2687 );
1131 2687
1132 2687 BEGIN (*LOGHURS*)
1133 2687 IF OptionTable.LogFileKind <> none THEN
1134 269C BEGIN
1135 26A1 IF LogFF(LogFile, 6)THEN BEGIN END;
1136 26B6 WITH LogFile DO
1137 26C7 BEGIN
1138 26CC L := L + 3;
1139 26ED writeln(F);
1140 2706 writeln(F, ' ':10, 'UTILFREDSSTILLEDE REFERENCER:');
1141 2752 writeln(F);
1142 276B END;
1143 276B LogHSurs(LogFile);
1144 277A END
1145 277A END; (*LOGHURS*)
1146 2780
1147 2780 PROCEDURE LogURS(VAR LogFile: LogFileType
1148 2780 ; ModuleName: ModuleNameType
1149 2780 ; SymbolName: SymbolNameType
1150 2780 );
1151 2780
1152 2780 BEGIN (*LOGURS*)
1153 2780 IF OptionTable.LogFileKind <> none THEN
1154 27BF BEGIN
1155 27C4 IF LogFF(LogFile, 1) THEN
1156 27D9 LogHSurs(LogFile);
1157 27E8 WITH LogFile DO
1158 27F9 BEGIN
1159 27FE L := L + 1;
1160 281C write(F, ' ':10);
1161 283E WriteSymbolName(F, ModuleName, 20);
1162 2858 write(F, ' ':2);
1163 287A WriteSymbolName(F, SymbolName, 20);
1164 2894 writeln(F);
1165 28AD END
1166 28AD END
1167 28AD END; (*LOGURS*)
1168 28B3
1169 28B3 PROCEDURE LogHSdds(VAR LogFile: LogFileType
1170 28B3 );
1171 28B3
1172 28B3 BEGIN (*LOGHSDDS*)
1173 28B3 IF OptionTable.LogFileKind <> none THEN
1174 28C8 WITH LogFile DO
1175 28D9 BEGIN
1176 28DE L := L + 2;
1177 28FF writeln(F, ' ':10, 'MODUL SEGM VÆRDI SYMBOL');
1178 294A writeln(F);
1179 2963 END;
1180 2963 END; (*LOGHSDDS*)
1181 2969
1182 2969 PROCEDURE LogHdds(VAR LogFfle: LogFileType
1183 2969 );
1184 2969
1185 2969 BEGIN (*LOGHDDS*)
1186 2969 IF OptionTable.LogFileKind <> none THEN
1187 297E BEGIN
1188 2983 IF LogFF(LogFile, 5) THEN BEGIN END;
1189 2995 WITH LogFile DO
1190 299A BEGIN
1191 299F L := L + 2;
1192 29B4 writeln(F);
1193 29C6 writeln(F, ' ':10, 'Dobbeltdefinerede symboler:');
1194 2A09 END;
1195 2A09 LogHSdds(LogFile);
1196 2A15 END
1197 2A15 END; (*LOGHDDS*)
1198 2A1B
1199 2A1B PROCEDURE LogDDS(VAR LogFile: LogFileType
1200 2A1B ; ModuleNo: ModuleTableIndexType
1201 2A1B ; RelocationIndicator: RelocationIndicatorType
1202 2A1B ; Value: i32
1203 2A1B ; SymbolName: SymbolNameType
1204 2A1B );
1205 2A1B
1206 2A1B BEGIN (*LOGDDS*)
1207 2A1B IF OptionTable.LogFileKind <> none THEN
1208 2A45 BEGIN
1209 2A4A IF LogFF(LogFile, 1) THEN
1210 2A5F LogHSdds(LogFile);
1211 2A6E WITH LogFile DO
1212 2A7F BEGIN
1213 2A84 L := L + 1;
1214 2AA2 write(F, ' ':10, ' ':1, ModuleNo:3
1215 2AD5 , ' ':4, ord(RelocationIndicator):2
1216 2AEF , ' ':3, Value:9
1217 2B04 , ' ':1
1218 2B0D );
1219 2B16 WriteSymbolName(F, SymbolName, 40);
1220 2B30 writeln(F);
1221 2B49 END;
1222 2B49 END
1223 2B49 END; (*LOGDDS*)
1224 2B4F
1225 2B4F PROCEDURE LogOFFerror(VAR LogFile: LogFileType
1226 2B4F ; FileNo: FileNameTableIndexType
1227 2B4F );
1228 2B4F
1229 2B4F BEGIN (*LOGOFFERROR*)
1230 2B4F IF OptionTable.LogFileKind <> none THEN
1231 2B64 BEGIN
1232 2B69 IF LogFF(LogFile, 2) THEN BEGIN END;
1233 2B7E WITH LogFile DO
1234 2B8F BEGIN
1235 2B94 L := L + 2;
1236 2BB5 writeln(F, ' ':10, '*** Filformatfejl *** Fil # ', FileNo:1
1237 2C08 , ' ***'
1238 2C15 );
1239 2C22 END;
1240 2C22 END
1241 2C22 END; (*LOGOFFERROR*)
1242 2C28
1243 2C28
1244 2C28 PROCEDURE LogOMFerror(VAR LogFile: LogFileType
1245 2C28 ; FileNo: FileNameTableIndexType
1246 2C28 ; Position: FileAddressType
1247 2C28 );
1248 2C28
1249 2C28 BEGIN (*LOGOMFERROR*)
1250 2C28 IF OptionTable.LogFileKind <> none THEN
1251 2C3D BEGIN
1252 2C42 IF LogFF(LogFile, 2) THEN BEGIN END;
1253 2C57 WITH LogFile DO
1254 2C68 BEGIN
1255 2C6D L := L + 2;
1256 2C8E writeln(F, ' ':10, '*** Modulformatfejl *** Fil # ', FileNo:1
1257 2CE3 , ' *** Position # ', Position:1
1258 2D0C , ' ***'
1259 2D19 );
1260 2D26 END;
1261 2D26 END
1262 2D26 END; (*LOGOMFERROR*)
1263 2D2C
1264 2D2C PROCEDURE LogEOFerror(VAR LogFile: LogFileType
1265 2D2C ; FileNo: FileNameTableIndexType
1266 2D2C ; Position: FileAddressType
1267 2D2C );
1268 2D2C
1269 2D2C BEGIN (*LOGEOFERROR*)
1270 2D2C IF OptionTable.LogFileKind <> none THEN
1271 2D41 BEGIN
1272 2D46 IF LogFF(LogFile, 2) THEN BEGIN END;
1273 2D5B WITH LogFile DO
1274 2D6C BEGIN
1275 2D71 L := L + 2;
1276 2D92 writeln(F, ' ':10, '*** FilLængdefejl *** Fil # ', FileNo:1
1277 2DE5 , ' *** Position # ', Position:1
1278 2E0E , ' ***'
1279 2E1B );
1280 2E28 END;
1281 2E28 END
1282 2E28 END; (*LOGEOFERROR*)
1283 2E2E
1284 2E2E
1285 2E2E
1286 2E2E
1287 2E2E FUNCTION OPTLFK: LogFileKindType;
1288 2E2E
1289 2E2E BEGIN (*OPTLFK*)
1290 2E2E optlfk := OptionTable.LogFileKind;
1291 2E44 END; (*OPTLFK*)
1292 2E4A
1293 2E4A PROCEDURE FNTP(VAR Status: StatusType
1294 2E4A ; FileName: FileNameType
1295 2E4A );
1296 2E4A
1297 2E4A BEGIN (*FNTP*)
1298 2E4A IF CurFileNo < MaxNooInputFiles THEN
1299 2E62 BEGIN
1300 2E67 CurFileNo := CurFileNo + 1;
1301 2E7D FileNameTable(.CurFileNo.) := FileName;
1302 2EA7 END
1303 2EA7 ELSE
1304 2EA9 Status := Status + (.FileNameTableOverFlow.);
1305 2ECF IF test((.0,6.)) THEN
1306 2EE5 BEGIN
1307 2EEA write(TestOut, 'FNTP '); TSTstat(Status); TSTindt;
1308 2F29 TSTfnt(CurFileNo); TSTln
1309 2F38 END
1310 2F3B END; (*FNTP*)
1311 2F41
1312 2F41 PROCEDURE FNTG(VAR Status: StatusType
1313 2F41 ; Inx: FileNameTableIndexType
1314 2F41 ;VAR FileName: FileNameType
1315 2F41 );
1316 2F41
1317 2F41 BEGIN (*FNTG*)
1318 2F41 IF test((.0,6.)) THEN
1319 2F5F BEGIN
1320 2F64 write(TestOut, 'FNTG '); TSTfnt(Inx); TSTln
1321 2F96 END;
1322 2F99 FileName := FileNameTable(.Inx.);
1323 2FC5 END; (*FNTG*)
1324 2FCB
1325 2FCB PROCEDURE EITP(VAR Status: StatusType
1326 2FCB ; SymbolTableEntryNo: SymbolTableIndexType
1327 2FCB );
1328 2FCB
1329 2FCB BEGIN (*EITP*)
1330 2FCB IF CurExternalImportSymbolNo < MaxNooExternalImportSymbols THEN
1331 2FE3 BEGIN
1332 2FE8 CurExternalImportSymbolNo := CurExternalImportSymbolNo + 1;
1333 2FFE ExternalImportTable(.CurExternalImportSymbolNo
1334 3003 .).SymbolNo := SymbolTableEntryNo
1335 300E END
1336 3017 ELSE
1337 3019 Status := Status + (.ExternalImportTableOverFlow.);
1338 303F IF test((.0,7.)) THEN
1339 3055 BEGIN
1340 305A write(TestOut, 'EITP '); TSTstat(Status); TSTln;
1341 3099 TSTeit(CurExternalImportSymbolNo)
1342 30A5 END
1343 30A8 END; (*EITP*)
1344 30AE
1345 30AE (* ModuleTable *)
1346 30AE
1347 30AE PROCEDURE MDTA(VAR Status: StatusType
1348 30AE ;VAR ModuleNo: ModuleTableIndexType
1349 30AE ; ModuleCount: ModuleTableIndexType
1350 30AE );
1351 30AE
1352 30AE BEGIN (*MDTA*)
1353 30AE IF CurModuleNo > MaxNooModules - ModuleCount THEN
1354 30DD Status := Status + (.ModuleTableOverFlow.)
1355 30F3 ELSE
1356 3103 BEGIN
1357 3108 ModuleNo := CurModuleNo + 1;
1358 3124 CurModuleNo := CurModuleNo + ModuleCount;
1359 3141 END;
1360 3141 END; (*MDTA*)
1361 3147
1362 3147 (* SectionTable *)
1363 3147
1364 3147 PROCEDURE SCTA(VAR Status: StatusType
1365 3147 ;VAR SectionNo: SectionTableIndexType
1366 3147 ; SectionCount: SectionTableIndexType
1367 3147 );
1368 3147
1369 3147 BEGIN (*SCTA*)
1370 3147 IF SCTOffset > MaxNooSections - SectionCount THEN
1371 3176 Status := Status + (.SectionTableOverFlow.)
1372 318C ELSE
1373 319E BEGIN
1374 31A3 SectionNo := SCTOffset + 1;
1375 31BF SCTOffset := SCTOffset + SectionCount;
1376 31DC END
1377 31DC END; (*SCTA*)
1378 31E2
1379 31E2 PROCEDURE SCTP(VAR Status: StatusType
1380 31E2 ; P_ModuleNo: ModuleTableIndexType
1381 31E2 ; P_SegmentNo: SegmentNoType
1382 31E2 ; SGD_Record: ObjectRecordType
1383 31E2 );
1384 31E2
1385 31E2 BEGIN (*SCTP*)
1386 31E2 IF SCTOffset >= MaxNooSections THEN
1387 320F Status := Status + (.Sectiontableoverflow.)
1388 3225 ELSE
1389 3238 BEGIN
1390 323D SCTOffset := SCTOffset + 1;
1391 3253 WITH SectionTable(.SCTOffset.), SGD_Record DO
1392 326F BEGIN
1393 3274 ModuleNo := P_ModuleNo;
1394 3282 SegmentNo := P_SegmentNo;
1395 3297 ImageSize := SGD_Image;
1396 32AF RldSize := SGD_Rld;
1397 32C9 NooInternalImportSymbols := SGD_NooIntImportSymbols;
1398 32E8 RelocationConstant := 0
1399 32F3 END;
1400 3301 END;
1401 3301 IF test((.0,6.)) THEN
1402 3317 BEGIN
1403 331C write(TestOut, 'SCTP '); TSTstat(Status); TSTindt;
1404 335B TSTsct(SCTOffset);
1405 336A END
1406 336A END; (*SCTP*)
1407 3370
1408 3370 PROCEDURE SCTG(VAR Status: StatusType
1409 3370 ; SectionNo: SectionTableIndexType
1410 3370 ;VAR Section: SectionTableRecordType
1411 3370 );
1412 3370
1413 3370 BEGIN (*SCTG*)
1414 3370 Section := SectionTable(.SectionNo.)
1415 3398 END; (*SCTG*)
1416 33A4
1417 33A4 PROCEDURE SCTWB(VAR Status: StatusType
1418 33A4 ; SectionNo: SectionTableIndexType
1419 33A4 ; Section: SectionTableRecordType
1420 33A4 );
1421 33A4
1422 33A4 BEGIN (*SCTWB*)
1423 33A4 SectionTable(.SectionNo.) := Section;
1424 33E8 IF test((.0,6.)) THEN
1425 33FE BEGIN
1426 3403 write(TestOut, 'SCTWB '); TSTstat(Status); TSTln;
1427 3441 TSTindt; TSTsct(SCTOffset);
1428 3453 END
1429 3453 END; (*SCTWB*)
1430 3459
1431 3459 FUNCTION SCTGSG( SectionNo: SectionTableIndexType
1432 3459 ): RelocationIndicatorType;
1433 3459
1434 3459 BEGIN (*SCTGSG*)
1435 3459 SCTGSG := SectionTable(.SectionNo.).SegmentNo
1436 347A END; (*SCTGSG*)
1437 3488
1438 3488 FUNCTION SCTGRC( SectionNo: SectionTableIndexType
1439 3488 ): SizeType;
1440 3488
1441 3488 BEGIN (*SCTGRC*)
1442 3488 SCTGRC := SectionTable(.SectionNo.).RelocationConstant
1443 34A9 END; (*SCTGRC*)
1444 34BD
1445 34BD
1446 34BD (* BEGIN (*LNKDF2X SEGMENT*)
1447 34BD (* END. (*LNKDF2X SEGMENT*)
1448 34BD
1449 34BD
1450 34BD
1451 34BD
1452 34BD
1453 34BD (*
1454 34BD PROCEDURE Init(VAR Status: StatusType
1455 34BD ); EXTERNAL;
1456 34BD PROCEDURE SetUp(VAR Status: StatusType
1457 34BD ;VAR TargetFile: FileType
1458 34BD ;VAR LogFile: LogFileType
1459 34BD ;VAR Output: text
1460 34BD ); EXTERNAL;
1461 34BD PROCEDURE Pass1(VAR Status: StatusType
1462 34BD ); EXTERNAL;
1463 34BD PROCEDURE Pass2(VAR Status: StatusType
1464 34BD ); EXTERNAL;
1465 34BD PROCEDURE Term(VAR Status: StatusType
1466 34BD ); EXTERNAL;
1467 34BD *)
1468 34BD (*$I B:lnkinit.pas Procedures init and term *)
1469 34BD (******************************************************************************)
1470 34BD (* *)
1471 34BD (* Copyright (1985) by Metanic Aps., Denmark *)
1472 34BD (* *)
1473 34BD (* Author: Lars Gregers Jakobsen. *)
1474 34BD (* *)
1475 34BD (******************************************************************************)
1476 34BD (*
1477 34BD SEGMENT InitTerm;
1478 34BD
1479 34BD This Prospero Pascal segment holds the declarations for the init
1480 34BD and term procedures for the Metanic Linker.
1481 34BD *)
1482 34BD
1483 34BD (* $I B:lnkDC0.pas Declarations of global constants, types, and commons *)
1484 34BD
1485 34BD PROCEDURE Init(VAR Status: StatusType
1486 34BD );
1487 34BD
1488 34BD BEGIN (*INIT*)
1489 34BD Optiontable.LogFileKind := None;
1490 34CF OptionTable.TargetFileKind := Implicit;
1491 34D9
1492 34D9 CurFileNo := 0;
1493 34E3 CurModuleNo := 0;
1494 34ED SCTOffset := 0;
1495 34F7 CurSegmentCount := 0;
1496 3501 CurValueNo := 0;
1497 350B CurExternalImportSymbolNo := 0;
1498 3515 Status := (..)
1499 3521 END; (*INIT*)
1500 3532
1501 3532
1502 3532 PROCEDURE Term(VAR Status: StatusType
1503 3532 );
1504 3532
1505 3532 BEGIN (*TERM*)
1506 3532 END; (*TERM*)
1507 3540
1508 3540 (* BEGIN (*INITTERM*)
1509 3540 (* END. (*INITTERM*)
1510 3540
1511 3540
1512 3540
1513 3540
1514 3540
1515 3540
1516 3540
1517 3540
1518 3540
1519 3540 (*$I B:lnkp0.pas Procedure setup *)
1520 3540 (******************************************************************************)
1521 3540 (* *)
1522 3540 (* Copyright (1985) by Metanic Aps., Denmark *)
1523 3540 (* *)
1524 3540 (* Author: Lars Gregers Jakobsen. *)
1525 3540 (* *)
1526 3540 (******************************************************************************)
1527 3540 (*
1528 3540 SEGMENT SetUp;
1529 3540 *)
1530 3540 (*
1531 3540 This prospero Pascal segment holds the declarations for the setup
1532 3540 procedure for Metanic linker.
1533 3540 *)
1534 3540
1535 3540 (* $I B:lnkDC0.pas Declarations of global constants, types, and commons *)
1536 3540 (* $I A:PrTstExt.pas External Decl. of standard test procedures *)
1537 3540 (* $I B:LnkDC1.pas External Decl. of global test output primitives *)
1538 3540 (* $I B:LnkDC2.pas External Decl. of global access primitives *)
1539 3540
1540 3540 PROCEDURE SetUp(VAR Status: StatusType
1541 3540 ;VAR TargetFile: FileType
1542 3540 ;VAR LogFile: LogFileType
1543 3540 ;VAR Out_file: text
1544 3540 );
1545 3540
1546 3540 CONST
1547 3540 InputFileNameSuffix = 'OBJ';
1548 3543 TargetFileNameSuffix = 'OUT';
1549 3546 LogFileNameSuffix = 'MAP';
1550 3549 NilSuffix = '';
1551 3549
1552 3549 VAR
1553 3549 CommandLine: CommandLineType;
1554 3549 Ch: Char;
1555 3549 Current: CommandLineIndexType;
1556 3549 FileName: FileNameType;
1557 3549
1558 3549 PROCEDURE SkipBlanks;
1559 3549
1560 3549 BEGIN (*SKIPBLANKS*)
1561 3549 WHILE (CommandLine(.Current.) = ' ') and
1562 3572 (Current < length(CommandLine)) DO
1563 3597 Current := Current + 1;
1564 35B7 END; (*SKIPBLANKS*)
1565 35BD
1566 35BD PROCEDURE DecodeFileName(VAR Status: StatusType
1567 35BD ;VAR FileName: FileNameType
1568 35BD ; Suffix: FileNameType
1569 35BD ; Terminators: CharSetType
1570 35BD );
1571 35BD
1572 35BD VAR
1573 35BD I: CommandLineIndexType;
1574 35BD
1575 35BD BEGIN (*DECODEFILENAME*)
1576 35BD I := 0;
1577 35CE WHILE (Current + I < length(CommandLine) ) and
1578 35F8 not ( CommandLine(.Current + I.) in Terminators ) DO
1579 3639 I := I + 1;
1580 3651 IF (0 < I) and (I <= FileNameLength) THEN
1581 3674 BEGIN
1582 3679 FileName := Copy(CommandLine, Current, I);
1583 36A7 Current := Current + I;
1584 36CC IF (pos('.', FileName) = 0) THEN
1585 36E7 IF (length(FileName) <= FileNameLength - 4) THEN
1586 36FA FileName := concat(FileName, '.', Suffix)
1587 3723 ELSE
1588 372E Status := Status + (.BadFileName.)
1589 3744 END
1590 3755 ELSE
1591 3757 Status := Status + (.BadFileName.);
1592 377E IF test((.0,16,18.)) THEN
1593 3798 BEGIN
1594 379D write(TestOut, 'DecodeFileName '); TSTstat(Status);
1595 37E1 TSTindt; write(TestOut, 'Curr=', Current:1);
1596 381D TSTindt; write(TestOut, 'I=', I:1);
1597 3852 TSTindt; writeln(TestOut, 'FileName=', FileName)
1598 3889 END
1599 388C END; (*DECODEFILENAME*)
1600 3892
1601 3892
1602 3892 BEGIN (*SETUP*)
1603 3892 Getcomm(CommandLine);
1604 38AD CommandLine := concat(CommandLine, ' ');
1605 38CF Current := 1;
1606 38D8 Status := (..);
1607 38EF SkipBlanks; (*Leaving current pointing at next non blank*)
1608 38FB (*Interpret option list*)
1609 38FB IF test((.0,16,18.)) THEN
1610 3915 BEGIN
1611 391A write(TestOut, 'Setup-1 '); write(TestOut, 'Curr=', Current:1);
1612 3973 TSTindt; write(TestOut, 'Lng(ComLin)=', Length(CommandLine):1);
1613 39B0 TSTindt; TSTmem; TSTln;
1614 39BE TSTindt; writeln(TestOut, 'ComLin=', CommandLine)
1615 39F4 END;
1616 39F7 WHILE (Current < length(CommandLine)) and
1617 3A0C (CommandLine(.Current.) = '/') and
1618 3A2E (Status = (..)) DO
1619 3A4A BEGIN
1620 3A4F Current := Current + 1;
1621 3A65 CASE CommandLine(.Current.) OF
1622 3A80 'M','m':
1623 3A80 BEGIN
1624 3A85 Current := Current + 1;
1625 3A9B IF CommandLine(.Current.) = '=' THEN
1626 3AB7 BEGIN
1627 3ABC Current := Current + 1;
1628 3AD2 DecodeFileName(Status, FileNametable(.-1.)
1629 3ADE , LogFileNameSuffix, (.' ', '/', ','.) );
1630 3B06 IF Status = (..) THEN
1631 3B1E OptionTable.LogFileKind := Explicit
1632 3B23 END
1633 3B28 ELSE
1634 3B2A OptionTable.LogFileKind := Implicit
1635 3B2F END;
1636 3B37 'O','o':
1637 3B37 BEGIN
1638 3B3C Current := Current + 1;
1639 3B52 IF CommandLine(.Current.) = '=' THEN
1640 3B6E BEGIN
1641 3B73 Current := Current + 1;
1642 3B89 DecodeFileName(Status, FileNameTable(.0.)
1643 3B95 , TargetFileNameSuffix, (.' ', '/', ','.) );
1644 3BBD IF Status = (..) THEN
1645 3BD5 OptionTable.TargetFileKind := Explicit
1646 3BDA END
1647 3BDF ELSE
1648 3BE1 OptionTable.TargetFileKind := Implicit
1649 3BE6 END;
1650 3BED OTHERWISE
1651 3BED Status := Status + (.BadOption.)
1652 3C03 END; (*CASE*)
1653 3C29 IF test((.0,16,18.)) THEN
1654 3C43 BEGIN
1655 3C48 write(TestOut, 'Setup-2 '); TSTstat(Status);
1656 3C85 TSTindt; writeln(TestOut, 'Curr=', Current:1);
1657 3CBD TSTindt; TSTopt;
1658 3CC8 TSTindt; TSTfnt(-1);
1659 3CD6 TSTindt; TSTfnt(0)
1660 3CE1 END;
1661 3CE4 END; (*WHILE*)
1662 3CE7 IF Status = (..) THEN (*Interpret file list*)
1663 3D00 BEGIN
1664 3D05 SkipBlanks;
1665 3D11 IF Current < length(CommandLine) THEN
1666 3D29 Status := Status + (.NotFinished.);
1667 3D4F WHILE (Current < length(CommandLine)) and
1668 3D64 (NotFinished IN Status) DO
1669 3D85 BEGIN
1670 3D8A DecodeFileName(Status, FileName
1671 3D96 , InputFileNameSuffix, (.' ', ','.) );
1672 3DC2 IF not (BadFileName IN Status) THEN
1673 3DDD BEGIN
1674 3DE2 IF test((.0,16,18.)) THEN
1675 3DFC BEGIN
1676 3E01 write(TestOut, 'Setup-3 '); TSTstat(Status); TSTindt;
1677 3E41 write(TestOut, 'fstat(FileName)=');
1678 3E70 TSTbool(fstat(FileName)); TSTln;
1679 3E8C END;
1680 3E8C IF fstat(FileName) THEN
1681 3EA1 FNTP(Status, FileName)
1682 3EBC ELSE
1683 3EC1 Status := Status + (.NoSuchFile.);
1684 3EE7 END;
1685 3EE7 IF NotFinished IN Status THEN
1686 3F01 CASE CommandLine(.Current.) OF
1687 3F1F ' ':
1688 3F1F Status := Status - (.NotFinished.);
1689 3F47 ',':
1690 3F47 BEGIN
1691 3F4C Current := Current + 1 (*Skip the comma*)
1692 3F51 END
1693 3F62 END (*CASE CommandLine(.Current.) OF*)
1694 3F71 END (* WHILE *** DO *)
1695 3F71 END; (* IF Status = (..) -- End interpret file list *)
1696 3F74 IF CurFileNo <= 0 THEN
1697 3F85 Status := Status + (.NoInputFiles.);
1698 3FAC IF Status = (..) THEN
1699 3FC5 BEGIN
1700 3FCA FileName := copy(FileNameTable(.1.), 1, pos('.',FileNameTable(.1.)) );
1701 3FF6 IF OptionTable.LogFileKind = Implicit THEN
1702 4002 FileNameTable(.-1.) := concat(FileName, LogFileNameSuffix);
1703 4023 IF OptionTable.TargetFileKind = Implicit THEN
1704 402F FileNameTable(. 0.) := concat(FileName, TargetFileNameSuffix);
1705 4050
1706 4050 IF (OptionTable.LogFileKind <> none) and
1707 405A ( (not checkfn(FileNameTable(.-1.) ) ) or
1708 4069 (fstat(FileNameTable(.-1.) ) )
1709 4073 ) THEN
1710 407C Status := Status + (.badlogfilename.);
1711 40A3 IF (not checkfn(FileNameTable(.0.) ) ) or
1712 40B3 (fstat(FileNameTable(.0.) ) ) THEN
1713 40C3 Status := Status + (.badtargetfilename.);
1714 40EA
1715 40EA IF test((.0,16,18.)) THEN
1716 4103 BEGIN
1717 4108 write(TestOut, 'Setup-4 '); TSTstat(Status); TSTln;
1718 4148 TSTindt; TSTopt;
1719 4153 TSTindt; TSTfnt(-1);
1720 4161 TSTindt; TSTfnt(0);
1721 416F TSTindt; TSTfnt(1)
1722 417A END;
1723 417D
1724 417D IF Status = (..) THEN
1725 4195 BEGIN
1726 419A IF OptionTable.LogFileKind <> None THEN
1727 41A6 BEGIN
1728 41AB LogInit(LogFile, FileNameTable(.-1.) );
1729 41C5 LogCmd(LogFile, CommandLine);
1730 41E3 END;
1731 41E3 FilAsg(TargetFile, FileNameTable(.0.) );
1732 41FD FilRwt(TargetFile);
1733 420C END
1734 420C END
1735 420C ELSE
1736 420E BEGIN
1737 4213 writeln(out_file, CommandLine);
1738 423C writeln(out_file, '^':Current);
1739 425F END
1740 425F END; (*SETUP*)
1741 4265
1742 4265 (* BEGIN (*SETUP SEGMENT*)
1743 4265 (* END. (*SETUP SEGMENT*)
1744 4265
1745 4265 (*$I B:lnkp1.pas Procedure pass1 *)
1746 4265 (******************************************************************************)
1747 4265 (* *)
1748 4265 (* Copyright (1985) by Metanic Aps., Denmark *)
1749 4265 (* *)
1750 4265 (* Author: Lars Gregers Jakobsen. *)
1751 4265 (* *)
1752 4265 (******************************************************************************)
1753 4265 (*
1754 4265 SEGMENT pass1;
1755 4265
1756 4265 This prospero pascal segment holds the declarations for the pass1
1757 4265 procedure of the Metanic linker.
1758 4265 *)
1759 4265
1760 4265 (* $I B:lnkDC0.pas Declarations of global constants, types, and commons *)
1761 4265 (* $I A:PrTstExt.pas External Decl. of standard test procedures *)
1762 4265 (* $I B:LnkDC1.pas External Decl. of global test output primitives *)
1763 4265 (* $I B:LnkDC2.pas External Decl. of global access primitives *)
1764 4265
1765 4265 PROCEDURE Pass1(VAR Status: StatusType
1766 4265 ;VAR TargetFile: FileType
1767 4265 ;VAR LogFile: LogFileType
1768 4265 );
1769 4265
1770 4265 (* Pass1 of the linker performs the gathering of export and
1771 4265 import information from the input files as well as calculation
1772 4265 of final memory map and all operations on the symbol table
1773 4265 including reporting to the log file.
1774 4265 The following statusvalues may be returned:
1775 4265 Success: ok. All other parameters meaningful.
1776 4265
1777 4265 *)
1778 4265
1779 4265
1780 4265 VAR
1781 4265 SymbolTable: SymbolTableType;
1782 4265 LatestInsert: SymbolTableIndexType;
1783 4265 CurrentSymbolCount: SymbolTableIndexType;
1784 4265 CurrentUrsCount: integer; (* Count of unresolved symbols*)
1785 4265
1786 4265 NameTable: NameTableType;
1787 4265 CurrentNameTableIndex: NameTableIndexType; (*Max Index used -
1788 4265 NOT count of strings*)
1789 4265
1790 4265
1791 4265 (* MISC. VARIABLES *)
1792 4265
1793 4265 SBTSubInx: SymbolTableSubIndexType;
1794 4265
1795 4265 (*$I B:LnkDF3.pas Definitions of pass1 local test output primitives *)
1796 4265
1797 4265 PROCEDURE TSTnmt(Inx: NameTableIndexType
1798 4265 );
1799 4265
1800 4265 VAR
1801 4265 i : 0..9;
1802 4265
1803 4265 BEGIN (*TSTnmt*)
1804 4265 write(TestOut, 'NMTÆ', inx:1
1805 4296 , ';../', CurrentNameTableIndex:1,'Å=(' );
1806 42D3 FOR i := 0 TO 7 DO
1807 42E4 TSTasc( NameTable(. Inx+i .) );
1808 4316 write(TestOut, '/');
1809 4331 TSThex( NameTable(. Inx .) );
1810 434C FOR i := 1 TO 7 DO
1811 435D BEGIN
1812 4362 write(TestOut, '-');
1813 437D TSThex( NameTable(. Inx+i .) )
1814 43A2 END;
1815 43AF writeln(TestOut, ')' )
1816 43C7 END; (*TSTnmt*)
1817 43D0
1818 43D0 PROCEDURE TSTsbt(Inx: SymbolTableIndexType
1819 43D0 );
1820 43D0
1821 43D0 BEGIN (*TSTsbt*)
1822 43D0 WITH SymbolTable(.Inx.) DO
1823 43FB BEGIN
1824 4400 write(TestOut, 'SBTÆ', Inx:1
1825 442B , '/', LatestInsert:1
1826 444E , '/', CurrentSymbolCount:1
1827 4471 , '/', CurrentUrsCount:1
1828 448F , 'Å=(SectionNo=', Section:1, ' '
1829 44C4 , 'NameRef=', NameReference:1, ' '
1830 44F6 , 'SortLink=', SortLink:1, ')'
1831 452C );
1832 4538 END
1833 4538 END; (*TSTsbt*)
1834 453E
1835 453E (*$I B:LnkDF4.pas Definitions of pass1 local access primitives *)
1836 453E (******************************************************************************)
1837 453E (* *)
1838 453E (* Copyright (1985) by Metanic Aps., Denmark *)
1839 453E (* *)
1840 453E (* Author: Lars Gregers Jakobsen. *)
1841 453E (* *)
1842 453E (******************************************************************************)
1843 453E
1844 453E
1845 453E (* This include file contains the declarations for access
1846 453E procedures used by pass one.
1847 453E *)
1848 453E
1849 453E
1850 453E PROCEDURE NMTP(VAR Status: StatusType
1851 453E ;VAR NameReference: NameTableIndexType
1852 453E ; SymbolName: SymbolNameType
1853 453E );
1854 453E
1855 453E VAR
1856 453E I: SymbolNameIndexType;
1857 453E
1858 453E BEGIN (*NMTP*)
1859 453E WITH SymbolName DO
1860 4560 BEGIN
1861 4565 IF CurrentNameTableIndex + Length > MaxNameTableIndex THEN
1862 458A Status := Status + (.NameTableOverFlow.)
1863 45A0 ELSE
1864 45B1 BEGIN
1865 45B6 Namereference := CurrentNameTableIndex;
1866 45CE NameTable(.CurrentNameTableIndex.) := Length;
1867 45F2 FOR I := 1 TO Length DO
1868 460B NameTable(.CurrentNameTableIndex + I.) := Name(.I.);
1869 4652 CurrentNameTableIndex := CurrentNameTableIndex + Length + 1;
1870 4682 END;
1871 4682 IF test((.0,9.)) THEN
1872 469B BEGIN
1873 46A0 write(TestOut, 'NMTP '); TSTstat(Status); TSTindt;
1874 46DF writeln(TestOut, 'Length=', Length:1);
1875 4716 TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1876 4736 END;
1877 4736 END
1878 4736 END; (*NMTP*)
1879 473C
1880 473C FUNCTION NMTfail( NameReference: NameTableIndexType
1881 473C ; SymbolName: SymbolNameType
1882 473C ): boolean;
1883 473C
1884 473C (* NMTfail returns one of the following values:
1885 473C FALSE: If the exact same symbolname was found in NMT - i.e.
1886 473C
1887 473C NameReference <> 0 AND
1888 473C NMT(.NameReference.) = SymbolName.Length AND
1889 473C FOR i = 1 TO length:
1890 473C NMT(.NameReference+i.) = SymbolName.Name(.i.)
1891 473C
1892 473C OR If an empty entry was found in NMT - i.e.
1893 473C
1894 473C NameReference = 0.
1895 473C
1896 473C
1897 473C TRUE: In all other cases.
1898 473C *)
1899 473C
1900 473C VAR
1901 473C I: SymbolNameIndexType;
1902 473C
1903 473C BEGIN (*NMTS*)
1904 473C WITH SymbolName DO
1905 475E BEGIN
1906 4763 IF NameReference = 0 THEN
1907 476E NMTfail := false
1908 4773 ELSE
1909 477A IF length <> NameTable(.NameReference.) THEN
1910 4796 NMTfail := true
1911 479B ELSE
1912 47A2 BEGIN
1913 47A7 I := 1;
1914 47B0 WHILE (I <= length) and
1915 47BE ( Name(.I.) = NameTable(.NameReference + I.) ) DO
1916 4800 I := I + 1;
1917 4818 NMTfail := I <= Length
1918 481D END;
1919 482F IF test((.0,9.)) THEN
1920 4848 BEGIN
1921 484D writeln(TestOut, 'NMTfail ', 'NameRef=', NameReference:1);
1922 4899 TSTindt; TSTindt; TSTindt; TSTsymbol(SymbolName);
1923 48B2 TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1924 48CE TSTindt; TSTindt; TSTindt; write(TestOut, '(I <= Length)=');
1925 4904 TSTbool(I<=Length); TSTln;
1926 491F END;
1927 491F END
1928 491F END; (*NMTS*)
1929 4928
1930 4928 PROCEDURE NMTG( NameReference: NameTableIndexType
1931 4928 ;VAR SymbolName: SymbolNameType
1932 4928 );
1933 4928
1934 4928 VAR
1935 4928 I: SymbolNameIndexType;
1936 4928
1937 4928 BEGIN (*NMTG*)
1938 4928 WITH SymbolName DO
1939 4941 BEGIN
1940 4946 Length := NameTable(.NameReference.);
1941 4967 FOR I := 1 TO Length DO
1942 4984 Name(.I.) := NameTable(. NameReference + I .);
1943 49CA IF test((.0,9,13.)) THEN
1944 49E2 BEGIN
1945 49E7 write(TestOut, 'NMTG '); TSTindt;
1946 4A12 write(TestOut, 'NameRef=', NameReference:1); TSTindt;
1947 4A4B TSTsymbol(SymbolName);
1948 4A5A END;
1949 4A5A END
1950 4A5A END; (*NMTG*)
1951 4A60
1952 4A60 PROCEDURE Hash(VAR SymbolName: SymbolNameType
1953 4A60 ;VAR SBTInx: SymbolTableIndexType
1954 4A60 );
1955 4A60
1956 4A60 BEGIN (*HASH*)
1957 4A60 SBTInx := 1
1958 4A73 END; (*HASH*)
1959 4A7B
1960 4A7B PROCEDURE SBTS(VAR Status: StatusType
1961 4A7B ;VAR SBTInx: SymbolTableIndexType
1962 4A7B ; SymbolName: SymbolNameType
1963 4A7B );
1964 4A7B
1965 4A7B (* SBTS returns one of the following Status codes:
1966 4A7B Success: SymbolName found in SBT. SBTInx reflects
1967 4A7B SymbolName.
1968 4A7B NotFound: SymbolName NOT found in SBT. SBTInx
1969 4A7B indicates the entry into which Symbol should be
1970 4A7B registered.
1971 4A7B SymbolTableOverFlow: SymbolName NOT found in SBT.
1972 4A7B SBTInx is not valid. There
1973 4A7B is no room in SBT for further updates.
1974 4A7B
1975 4A7B Search SBT to find the Entry for SYMBOLNAME retaining the index
1976 4A7B of the first vacant record as SYMBOLTABLEENTRYNO if the search
1977 4A7B fails. Otherwise return found index. Set Status to Success or
1978 4A7B NotFound according to outcome. Set Status to SBTOverFlow if
1979 4A7B no vacant is available and symbol is not found.
1980 4A7B
1981 4A7B A SBT record is vacant if Namereference = 0.
1982 4A7B A SBT record referring to section 0 holds an absolute symbol if
1983 4A7B namreference is non zero.
1984 4A7B *)
1985 4A7B
1986 4A7B
1987 4A7B BEGIN (*SBTS*)
1988 4A7B (* Assume existence of entry in SBT with NameReference = 0 *)
1989 4A7B Hash(SymbolName, SBTInx);
1990 4AAF IF test((.0,9.)) THEN
1991 4AC7 BEGIN
1992 4ACC write(TestOut, 'SBTS-1 '); TSTstat(Status); TSTln;
1993 4B0B TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1994 4B2E END;
1995 4B2E WHILE NMTfail(Symboltable(.SBTInx.).NameReference, SymbolName) DO
1996 4B68 BEGIN
1997 4B6D (* HASH NEXT TRY *)
1998 4B6D IF MaxNooSymbols <= SBTInx THEN
1999 4B84 SBTInx := 0;
2000 4B91 SBTInx := SBTInx + 1;
2001 4BB1
2002 4BB1 IF test((.0,9.)) THEN
2003 4BC9 BEGIN
2004 4BCE write(TestOut, 'SBTS-2 '); TSTstat(Status); TSTln;
2005 4C0D TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
2006 4C30 END;
2007 4C30
2008 4C30 END;
2009 4C33 IF SymbolTable(.SBTInx.).NameReference = 0 THEN
2010 4C59 IF CurrentSymbolCount >= MaxNooSymbols - 1 THEN
2011 4C72 Status := Status + (.SymbolTableOverFlow.)
2012 4C88 ELSE
2013 4C9A Status := Status + (.NotFound.);
2014 4CBE IF test((.0,10.)) THEN
2015 4CD6 BEGIN
2016 4CDB write(TestOut, 'SBTS-3 '); TSTstat(Status); TSTln;
2017 4D1A TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
2018 4D3D END;
2019 4D3D END; (*SBTS*)
2020 4D43
2021 4D43 PROCEDURE SBTEX(VAR Status: StatusType
2022 4D43 ;VAR SymbolTableEntryNo: SymbolTableIndexType
2023 4D43 ; SymbolName: SymbolNameType
2024 4D43 ; ModuleNo: ModuleTableIndexType
2025 4D43 ; SectionNo: SectionTableIndexType
2026 4D43 ; Item: i32
2027 4D43 );
2028 4D43
2029 4D43 VAR
2030 4D43 LocalNameReference: NameTableIndexType;
2031 4D43 LocalSectionNo: ModuleSectionReferenceType;
2032 4D43
2033 4D43 BEGIN (*SBTEX*)
2034 4D43 IF SectionNo = 0 THEN
2035 4D6B LocalSectionNo := - ModuleNo
2036 4D70 ELSE
2037 4D84 LocalSectionNo := SectionNo + SCTOffset;
2038 4DA1 SBTS(Status, SymbolTableEntryNo, SymbolName);
2039 4DC3 IF SymbolTableOverFlow IN Status THEN
2040 4DDD BEGIN END
2041 4DE2 ELSE IF NotFound IN Status THEN
2042 4E00 BEGIN (*Symbol is NOT in SBT and thus not resolved*)
2043 4E05 Status := Status - (.NotFound.);
2044 4E29 NMTP(Status, LocalNameReference, SymbolName);
2045 4E4C IF not (NameTableOverFlow IN Status) THEN
2046 4E67 BEGIN
2047 4E6C CurrentSymbolCount := CurrentSymbolCount + 1;
2048 4E94 WITH SymbolTable(.SymbolTableEntryNo.)
2049 4EB5 ,ValueTable(.SymbolTableEntryNo.) DO
2050 4ED9 BEGIN
2051 4EDE Section := LocalSectionNo;
2052 4EF2 NameReference := LocalNameReference;
2053 4F07 IF LatestInsert <> 0 THEN
2054 4F1B SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
2055 4F50 LatestInsert := SymbolTableEntryNo;
2056 4F6B SortLink := SymbolTableEntryNo;
2057 4F85 Resolved := true;
2058 4F92 CurrentUrsCount := CurrentUrsCount - 1;
2059 4FB4 Value := Item
2060 4FBF END (*WITH ... DO*)
2061 4FC8 END
2062 4FC8 END
2063 4FC8 ELSE (* SUCCESS: Symbol is in SBT*)
2064 4FCB WITH SymbolTable(.SymbolTableEntryNo.)
2065 4FEC ,ValueTable(.SymbolTableEntryNo.) DO
2066 5010 BEGIN
2067 5015 IF Resolved THEN
2068 501E Status := Status + (.DuplicateExportSymbol.)
2069 5034 ELSE (*Symbol NOT previously resolved i.e. imported only*)
2070 5048 BEGIN
2071 504D Section := LocalSectionNo;
2072 5061 IF LatestInsert <> 0 THEN
2073 5075 SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
2074 50AA LatestInsert := SymbolTableEntryNo;
2075 50C5 SortLink := SymbolTableEntryNo;
2076 50DF Resolved := true;
2077 50EC CurrentUrsCount := CurrentUrsCount - 1;
2078 510E Value := Item
2079 5119 END
2080 5122 END; (*WITH ... DO*)
2081 5122 IF test((.0,10.)) THEN
2082 513B BEGIN
2083 5140 write(TestOut, 'SBTEX '); TSTstat(Status);
2084 517C TSTindt; TSTsymbol(SymbolName);
2085 518F TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
2086 51B2 TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
2087 51D1 END;
2088 51D1 END; (*SBTEX*)
2089 51D7
2090 51D7
2091 51D7 PROCEDURE SBTIM(VAR Status: StatusType
2092 51D7 ;VAR SymbolTableEntryNo: SymbolTableIndexType
2093 51D7 ;VAR SymbolName: SymbolNameType
2094 51D7 ; ModuleNo: ModuleTableIndexType
2095 51D7 );
2096 51D7
2097 51D7 VAR
2098 51D7 LocalNameReference: NameTableIndexType;
2099 51D7
2100 51D7 BEGIN (*SBTIM*)
2101 51D7 SBTS(Status, SymbolTableEntryNo, SymbolName);
2102 5200 IF SymbolTableOverFlow IN Status THEN
2103 521A BEGIN END
2104 521F ELSE
2105 5222 BEGIN
2106 5227 IF NotFound IN Status THEN
2107 5242 BEGIN
2108 5247 Status := Status - (.NotFound.);
2109 526B NMTP(Status, LocalNameReference, SymbolName);
2110 528D IF not (NameTableOverFlow IN Status) THEN
2111 52A8 BEGIN
2112 52AD CurrentSymbolCount := CurrentSymbolCount + 1;
2113 52D5 WITH SymbolTable(.SymbolTableEntryNo.)
2114 52F6 ,ValueTable(.SymbolTableEntryNo.) DO
2115 531A BEGIN
2116 531F Section := - ModuleNo;
2117 533C NameReference := LocalNameReference;
2118 5351 SortLink := 0;
2119 5360 Resolved := false;
2120 536D CurrentUrsCount := CurrentUrsCount + 1;
2121 538F Value := 0;
2122 53A5 END
2123 53A5 END
2124 53A5 END;
2125 53A5 EITP(Status,SymbolTableEntryNo)
2126 53BC END;
2127 53BF IF test((.0,10.)) THEN
2128 53D8 BEGIN
2129 53DD write(TestOut, 'SBTIM '); TSTstat(Status); TSTln;
2130 541C TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
2131 543F TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
2132 545E END;
2133 545E END; (*SBTIM*)
2134 5464
2135 5464
2136 5464
2137 5464 (*$I B:lnkp1-1.pas getinputfiles *)
2138 5464
2139 5464 PROCEDURE GetInputFiles(VAR GStatus: StatusType
2140 5464 ;VAR LogFile: LogFileType
2141 5464 );
2142 5464
2143 5464 VAR
2144 5464 InputFile: FileType;
2145 5464 FileNo: FileNameTableIndexType;
2146 5464 Status: StatusType;
2147 5464
2148 5464 PROCEDURE ValidateFileFormat(VAR Status: StatusType
2149 5464 ;VAR F: FileType
2150 5464 ; Format: OF_FormatType
2151 5464 );
2152 5464
2153 5464 VAR
2154 5464 OFF_Format: OF_FormatType;
2155 5464
2156 5464 BEGIN (*VALIDATEFILEFORMAT*)
2157 5464 FGi32(Status, F, OFF_Format);
2158 548A IF OFF_Format <> Format THEN
2159 549E Status := Status + (.BadFileFormat.);
2160 54C2 IF test((.0,16,19.)) THEN
2161 54DC BEGIN
2162 54E1 write(TestOut, 'GetFFvalid '); TSTstat(Status); TSTindt;
2163 5524 writeln(TestOut, 'OFF_Format=', OFF_Format);
2164 555A END;
2165 555A END; (*VALIDATEFILEFORMAT*)
2166 5560
2167 5560 PROCEDURE GetModules(VAR GStatus: StatusType
2168 5560 ;VAR LogFile: LogFileType
2169 5560 ; FileNumber: FileNameTableIndexType
2170 5560 ;VAR Fl: FileType
2171 5560 ; StartAddressOfNextModule: FileAddressType
2172 5560 );
2173 5560
2174 5560 VAR
2175 5560 Status: StatusType;
2176 5560
2177 5560 PROCEDURE ValidateModuleFormat(VAR Status: StatusType
2178 5560 ;VAR F: FileType
2179 5560 ; Format: OM_FormatType
2180 5560 );
2181 5560
2182 5560 VAR
2183 5560 OMF_Format: OM_FormatType;
2184 5560
2185 5560 BEGIN (*VALIDATEMODULEFORMAT*)
2186 5560 FGi32(Status, F, OMF_Format);
2187 5586 IF OMF_Format <> Format THEN
2188 559A Status := Status + (.BadModuleFormat.);
2189 55BE IF test((.0,16,19.)) THEN
2190 55D8 BEGIN
2191 55DD write(TestOut, 'GetMFvalid '); TSTstat(Status); TSTindt;
2192 5620 writeln(TestOut, 'OMF_Format=',OMF_Format);
2193 5656 END;
2194 5656 END; (*VALIDATEMODULEFORMAT*)
2195 565C
2196 565C
2197 565C PROCEDURE GetModuleHeader(VAR GStatus: StatusType
2198 565C ;VAR LogFile: LogFileType
2199 565C ; FileNo:
2200 565C FileNameTableIndexType
2201 565C ;VAR Fl: FileType
2202 565C ;VAR StartAddressOfNextModule:
2203 565C FileAddressType
2204 565C );
2205 565C
2206 565C VAR
2207 565C Status: StatusType;
2208 565C SegmentNo: SegmentNoType;
2209 565C SymbolNo: SymbolTableIndexType;
2210 565C ModuleNo: ModuleTableIndexType;
2211 565C MdtRec: ModuleTableRecordType;
2212 565C NooExportSymbols: i32;
2213 565C
2214 565C PROCEDURE GetINX(VAR Status: StatusType
2215 565C ;VAR MdtRec: ModuleTableRecordType
2216 565C ;VAR Fl: FileType
2217 565C ;VAR StartAddressOfNextModule:
2218 565C FileAddressType
2219 565C ;VAR NooExportSymbols: i32
2220 565C );
2221 565C
2222 565C VAR
2223 565C OMH_ModuleSize: i32;
2224 565C OMH_ModuleName: ModuleNameType;
2225 565C Dummy32: i32;
2226 565C
2227 565C BEGIN (*GETINX*)
2228 565C WITH MdtRec DO
2229 5675 BEGIN
2230 567A FGi32(Status, Fl, OMH_ModuleSize);
2231 5698 StartAddressOfNextModule :=
2232 56A3 StartAddressOfNextModule + OMH_moduleSize;
2233 56BC CurrentFileAddress := StartAddressOfNextModule;
2234 56D9 Referenced := false;
2235 56EA FGi32(Status, Fl, Dummy32);
2236 5708 NooSegments := Dummy32;
2237 5727 IF NooSegments > CurSegmentCount THEN
2238 5743 CurSegmentCount := NooSegments;
2239 5759 FGi32(Status, Fl, NooExportSymbols);
2240 5776 FGi32(Status, Fl, Dummy32);
2241 5794 NooExternalImportSymbols := Dummy32;
2242 57B3 FGsym(Status, Fl, OMH_ModuleName);
2243 57D1 IF Status = (..) THEN
2244 57EA BEGIN
2245 57EF LatestInsert := 0;
2246 5801 SBTEX(Status, ModuleNameReference, OMH_ModuleName,0,0,0);
2247 5831 IF not (SymbolTableOverFlow IN Status) THEN
2248 584B BEGIN
2249 5850 ValueTable(.ModuleNameReference.).Resolved := false;
2250 586F CurrentUrsCount := CurrentUrsCount + 2;
2251 5899 END;
2252 5899 IF DuplicateExportSymbol IN Status THEN
2253 58B3 Status := Status - (.DuplicateExportSymbol.) +
2254 58D3 (.DuplicateModuleName.);
2255 58E1 END
2256 58E1 END
2257 58E1 END; (*GETINX*)
2258 58E7
2259 58E7
2260 58E7 PROCEDURE GetSGDs(VAR Status: StatusType
2261 58E7 ; NooSegments: SegmentNoType
2262 58E7 ; ModuleNo: ModuleTableIndexType
2263 58E7 ;VAR Fl: FileType
2264 58E7 );
2265 58E7
2266 58E7 VAR
2267 58E7 SegmentNo: SegmentNoType;
2268 58E7 SGD_Record: ObjectRecordType;
2269 58E7
2270 58E7 BEGIN (*GETSEGMENTDESCRIPTORS*)
2271 58E7 SegmentNo := 0;
2272 58F8 WITH SGD_Record DO
2273 58FD WHILE (SegmentNo < NooSegments) and (Status = (..)) DO
2274 592A BEGIN
2275 592F SegmentNo := SegmentNo + 1;
2276 5945 FGi32(Status, Fl, SGD_Image);
2277 5963 FGi32(Status, Fl, SGD_Rld);
2278 5981 FGi32(Status, Fl, SGD_IntImport);
2279 599F FGi32(Status, Fl, SGD_NooIntImportSymbols);
2280 59BD IF Status = (..) THEN
2281 59D5 SCTP(Status, ModuleNo, SegmentNo, SGD_Record);
2282 59FA IF test((.0,16,19.)) THEN
2283 5A13 BEGIN
2284 5A18 write(TestOut, 'GetSGDs '); TSTstat(Status); TSTln
2285 5A54 END;
2286 5A57 END
2287 5A57 END; (*GETSEGMENTDESCRIPTORS*)
2288 5A60
2289 5A60 PROCEDURE GetEXP(VAR GStatus: StatusType
2290 5A60 ;VAR LogFile: LogFileType
2291 5A60 ;VAR Fl: FileType
2292 5A60 ;VAR LinkHead: SymbolTableIndexType
2293 5A60 ; ModuleNo: ModuleTableIndexType
2294 5A60 ; NooExportSymbols: i32
2295 5A60 );
2296 5A60
2297 5A60 VAR
2298 5A60 Status: StatusType;
2299 5A60 SymbolCount: i32;
2300 5A60 DuplicateCount: i32;
2301 5A60 EXP_Record: ObjectRecordType;
2302 5A60 SymbolTableEntryNo: SymbolTableIndexType; (*DUMMY*)
2303 5A60 Dummy8: i8;
2304 5A60 Dummy32: i32;
2305 5A60
2306 5A60 BEGIN (*GETEXPORTLIST*)
2307 5A60 Status := (..);
2308 5A80 LinkHead := 0;
2309 5A8D LatestInsert := 0;
2310 5A9F SymbolCount := 0;
2311 5AAE DuplicateCount := 0;
2312 5ABD IF SymbolCount < NooExportSymbols THEN
2313 5AD2 WITH EXP_Record DO
2314 5AD7 BEGIN
2315 5ADC SymbolCount := SymbolCount + 1;
2316 5AEC FGi8( Status, Fl, Dummy8);
2317 5B0B EXP_Record.EXP_RelocationIndicator := Dummy8;
2318 5B1D FGi32(Status, Fl, EXP_Record.EXP_Item);
2319 5B3C FGsym(Status, Fl, EXP_Record.EXP_SymbolName);
2320 5B5B IF Status = (..) THEN
2321 5B75 BEGIN
2322 5B7A SBTEX(Status
2323 5B7F ,LinkHead
2324 5B87 ,EXP_SymbolName
2325 5B8E ,ModuleNo
2326 5B96 ,EXP_RelocationIndicator
2327 5B9D ,EXP_Item
2328 5BA4 );
2329 5BB1 IF DuplicateExportSymbol IN Status THEN
2330 5BC9 BEGIN
2331 5BCE DuplicateCount := DuplicateCount + 1;
2332 5BDE IF DuplicateCount <= 1 THEN
2333 5BF1 LogHdds(LogFile);
2334 5C00 LogDDS(LogFile
2335 5C05 ,ModuleNo
2336 5C0C ,EXP_RelocationIndicator
2337 5C13 ,EXP_Item
2338 5C1A ,EXP_SymbolName
2339 5C20 );
2340 5C2B END
2341 5C2B END;
2342 5C2B GStatus := GStatus + Status;
2343 5C56 END;
2344 5C56 WHILE (GStatus <= (.DuplicateExportSymbol.)) and
2345 5C6F (SymbolCount < NooExportSymbols) DO
2346 5C8A BEGIN
2347 5C8F SymbolCount := SymbolCount + 1;
2348 5C9F Status := (..);
2349 5CB7 FGi8( Status, Fl, Dummy8);
2350 5CD6 EXP_Record.EXP_RelocationIndicator := Dummy8;
2351 5CE8 FGi32(Status, Fl, EXP_Record.EXP_Item);
2352 5D07 FGsym(Status, Fl, EXP_Record.EXP_SymbolName);
2353 5D26 IF Status = (..) THEN
2354 5D40 WITH EXP_Record DO
2355 5D45 BEGIN
2356 5D4A SBTEX(Status
2357 5D4F ,SymbolTableEntryNo
2358 5D57 ,EXP_SymbolName
2359 5D5F ,ModuleNo
2360 5D67 ,EXP_RelocationIndicator
2361 5D6E ,EXP_Item
2362 5D75 );
2363 5D82 IF DuplicateExportSymbol IN Status THEN
2364 5D9A BEGIN
2365 5D9F DuplicateCount := DuplicateCount + 1;
2366 5DAF IF DuplicateCount <= 1 THEN
2367 5DC2 LogHdds(LogFile);
2368 5DD1 LogDDS(LogFile
2369 5DD6 ,ModuleNo
2370 5DDD ,EXP_RelocationIndicator
2371 5DE4 ,EXP_Item
2372 5DEB ,EXP_SymbolName
2373 5DF1 );
2374 5DFC END
2375 5DFC END;
2376 5DFC GStatus := GStatus + Status
2377 5E12 END; (*WHILE ... DO*)
2378 5E2A END; (*GETEXPORTLIST*)
2379 5E30
2380 5E30 PROCEDURE GetEXI(VAR Status: StatusType
2381 5E30 ;VAR Fl: FileType
2382 5E30 ; ModuleNo: ModuleTableIndexType
2383 5E30 ; NooExternalImportSymbols:
2384 5E30 ExternalImportTableIndexType
2385 5E30 );
2386 5E30
2387 5E30 VAR
2388 5E30 SymbolTableEntryNo: SymbolTableIndexType;
2389 5E30 SymbolCount: i32;
2390 5E30 EXI_SymbolName: SymbolNameType;
2391 5E30
2392 5E30 BEGIN (*GETEXTERNALIMPORTLIST*)
2393 5E30 SymbolCount := 0;
2394 5E47 WHILE (Status = (..)) and
2395 5E5D (SymbolCount < NooExternalImportSymbols) DO
2396 5E7C BEGIN
2397 5E81 SymbolCount := SymbolCount + 1;
2398 5E91 FGsym(Status, Fl, EXI_SymbolName);
2399 5EAF IF Status = (..) THEN
2400 5EC7 SBTIM(Status
2401 5ECC ,SymbolTableEntryNo
2402 5ED3 ,EXI_SymbolName
2403 5EDB ,ModuleNo
2404 5EE3 );
2405 5EF1 END; (*WHILE ... DO*)
2406 5EF4 END; (*GETEXTERNALIMPORTLIST*)
2407 5EFA
2408 5EFA
2409 5EFA
2410 5EFA BEGIN (*GETMODULEHEADER*)
2411 5EFA Status := (..);
2412 5F1A MDTA(Status, ModuleNo, 1);
2413 5F35 IF Status = (..) THEN
2414 5F4F BEGIN
2415 5F54 GetINX(Status, ModuleTable(.ModuleNo.), Fl
2416 5F76 , StartAddressOfNextModule
2417 5F7D , NooExportSymbols);
2418 5F93 IF Status = (..) THEN
2419 5FAD WITH ModuleTable(.ModuleNo.) DO
2420 5FCC BEGIN
2421 5FD1 FileNameReference := FileNo;
2422 5FE0 GetSGDs(Status
2423 5FE5 ,NooSegments
2424 5FED ,ModuleNo
2425 5FFC ,Fl
2426 6003 );
2427 600D IF Status = (..) THEN
2428 6027 BEGIN
2429 602C SymbolTable(.ModuleNameReference
2430 6031 .).Section := - ModuleNo;
2431 605F GetEXP(Status
2432 6064 ,LogFile
2433 606C ,Fl
2434 6073 ,SBTLinkHead
2435 607A ,ModuleNo
2436 6085 ,NooExportSymbols
2437 608C );
2438 6099 IF Status <= (.DuplicateExportSymbol.) THEN
2439 60B6 BEGIN
2440 60BB EITOffset := CurExternalImportSymbolNo;
2441 60D3 GetEXI(Status
2442 60D8 ,Fl
2443 60E0 ,ModuleNo
2444 60E7 ,NooExternalImportSymbols
2445 60EE );
2446 6104 END
2447 6104 END
2448 6104 END;
2449 6104 END;
2450 6104 GStatus := GStatus + Status;
2451 612F IF test((.0,6,16,19.)) THEN
2452 6148 BEGIN
2453 614D write(TestOut, 'GetOMH '); TSTstat(Status); TSTln;
2454 618D TSTindt; TSTindt; TSTindt; TSTmdt(ModuleNo);
2455 61A5 END;
2456 61A5 END; (*GETMODULEHEADER*)
2457 61AB
2458 61AB BEGIN (*GETMODULES*)
2459 61AB REPEAT
2460 61B8 Status := (..);
2461 61D0 FilSeek(Status, InputFile, StartAddressOfNextModule);
2462 61F1 IF not (UnexpectedEof IN Status) THEN
2463 620A BEGIN
2464 620F ValidateModuleFormat(Status, InputFile, OM_Format1);
2465 622F IF UnexpectedEof IN Status THEN
2466 6247 BEGIN
2467 624C LogEOFerror(LogFile, FileNumber, InputFile.P)
2468 626C END
2469 626F ELSE IF (BadModuleFormat IN Status) THEN
2470 6289 BEGIN
2471 628E LogOMFerror(LogFile, FileNumber, InputFile.P)
2472 62AE END
2473 62B1 ELSE (* Status = (..) *)
2474 62B3 GetModuleHeader(Status
2475 62B8 ,LogFile
2476 62C0 ,FileNumber
2477 62C7 ,InputFile
2478 62CE ,StartAddressOfNextModule
2479 62D6 );
2480 62E5 GStatus := GStatus + Status;
2481 6310 END
2482 6310 UNTIL Status - (.DuplicateExportSymbol, BadSymbolName.) <> (..);
2483 632F END; (*GETMODULES*)
2484 6335
2485 6335 BEGIN (*GETINPUTFILES*)
2486 6335 FOR FileNo := 1 TO CurFileNo DO
2487 6357 BEGIN
2488 635C Status := (..);
2489 6374 FilAsg(InputFile, FileNameTable(.FileNo.));
2490 63A0 FilRst(Status, InputFile);
2491 63B8 IF Status = (..) THEN
2492 63D2 BEGIN
2493 63D7 ValidateFileFormat (Status, InputFile, OF_Format1);
2494 63F7 IF Status = (..) THEN
2495 6411 GetModules(Status, LogFile, FileNo, InputFile, 4)
2496 643C ELSE IF BadFileFormat IN Status THEN
2497 645F LogOFFerror(LogFile, FileNo);
2498 6475 END;
2499 6475 IF UnexpectedEof IN Status THEN
2500 648E LogEOFerror(LogFile, FileNo, InputFile.P);
2501 64AD FilCls(InputFile);
2502 64BD GStatus := GStatus + Status;
2503 64E8 END;
2504 64F2 IF CurModuleNo <= 0 THEN
2505 6503 GStatus := GStatus + (.NoInput.);
2506 652B END; (*GETINPUTFILES*)
2507 6534
2508 6534 (*$I B:lnkp1-2.pas putmodule *)
2509 6534 PROCEDURE PutTargetFile(VAR Status: StatusType
2510 6534 ;VAR TargetFile: FileType
2511 6534 ;VAR LogFile: LogFileType
2512 6534 );
2513 6534
2514 6534 PROCEDURE PutFF(VAR Fl: FileType
2515 6534 );
2516 6534
2517 6534 BEGIN (*PUTFF*)
2518 6534 FPi32(Fl, OF_Format1);
2519 6553 END; (*OUTFF*)
2520 6559
2521 6559 PROCEDURE PutModule(VAR Status: StatusType
2522 6559 ;VAR TargetFile: FileType
2523 6559 ;VAR LogFile: LogFileType
2524 6559 );
2525 6559
2526 6559 PROCEDURE PutMF(VAR Fl: FileType
2527 6559 );
2528 6559
2529 6559 BEGIN (*PUTMF*)
2530 6559 FPi32(Fl, OM_Format1);
2531 6578 END; (*OUTMF*)
2532 657E
2533 657E PROCEDURE PutINX(VAR Status: StatusType
2534 657E ;VAR Fl: FileType
2535 657E ;VAR LogFile: LogFileType
2536 657E );
2537 657E
2538 657E VAR
2539 657E OMH_ModuleName: ModuleNameType;
2540 657E
2541 657E BEGIN (*PUTINX*)
2542 657E FPi32(Fl,0); (* OMH_Module *)
2543 659D FPi32(Fl,0); (* OMH_NooSegments *)
2544 65B4 FPi32(Fl,0); (* OMH_NooExportSymbols *)
2545 65CB FPi32(Fl,0); (* OMH_NooExtImprtSymbols *)
2546 65E2 NMTG(SymbolTable(.ModuleTable(.1.).ModuleNameReference
2547 65E7 .).NameReference
2548 65FF , OMH_ModuleName
2549 6605 );
2550 6614 FPsym(Fl, OMH_ModuleName);
2551 662B END; (*PUTINX*)
2552 6631
2553 6631 PROCEDURE PutSGDs(VAR Status: StatusType
2554 6631 ;VAR Fl: Filetype
2555 6631 ;VAR Log: LogFileType
2556 6631 );
2557 6631
2558 6631 VAR
2559 6631 SegmentNoIndex: SegmentNoType;
2560 6631 SRCinx: SectionTableIndexType;
2561 6631 DSTinx: SectionTableIndexType;
2562 6631 ModuleName: ModuleNameType;
2563 6631
2564 6631 PROCEDURE PutSGD(VAR TargetFile: FileType
2565 6631 ; Section: SectionTableRecordType
2566 6631 );
2567 6631
2568 6631 BEGIN (*PUTSGD*)
2569 6631 WITH Section DO
2570 6653 BEGIN
2571 6658 FPi32(TargetFile, ImageSize);
2572 666D FPi32(TargetFile, RldSize);
2573 6682 FPi32(TargetFile, RldSize); (***** IntImportSize !!!!!!*)
2574 6697 FPi32(TargetFile, NooInternalImportSymbols);
2575 66B1 END
2576 66B1 END; (*PUTSGD*)
2577 66B7
2578 66B7 BEGIN (*PUTSGDS*)
2579 66B7 Status := (..);
2580 66D6 SCTA(Status, TargetSectionOffset, CurSegmentCount);
2581 66F0 IF not (SectionTableOverFlow IN Status) THEN
2582 670B BEGIN
2583 6710 IF CurSegmentCount > 0 THEN
2584 6721 LogHSgd(LogFile);
2585 6734 FOR DSTinx := 1 TO CurSegmentCount DO
2586 674E WITH SectionTable(.TargetSectionOffset + DSTinx - 1.) DO
2587 6788 BEGIN
2588 678D ModuleNo := TargetModuleNo;
2589 679B SegmentNo := DSTinx;
2590 67B0 ImageSize := 0; (*TO BE UPDATED*)
2591 67C7 RldSize := 0; (*TO BE UPDATED*)
2592 67E0 NooInternalImportSymbols := 0; (*TO BE UPDATED AFTER PASS 2*)
2593 67F1 RelocationConstant := 0;
2594 680A FOR SRCinx := 1 TO TargetSectionOffset - 1 DO
2595 6831 IF SectionTable(.SRCinx.).SegmentNo = DSTinx THEN
2596 684F BEGIN
2597 6854 SectionTable(.SRCinx.).RelocationConstant := ImageSize;
2598 6883 ImageSize := ImageSize + SectionTable(.SRCinx.).ImageSize;
2599 68C0 RldSize := RldSize + SectionTable(.SRCinx.).RldSize;
2600 6903 WITH SectionTable(.SRCinx.) DO (*Log memory map element*)
2601 6922 IF ImageSize > 0 THEN
2602 693A BEGIN
2603 693F NMTG(SymbolTable(.ModuleTable(.
2604 6944 ModuleNo.).ModuleNameReference
2605 695C .).Namereference
2606 6972 ,ModuleName
2607 6978 );
2608 6987 LogSGD(LogFile
2609 698C ,DSTinx
2610 6997 ,RelocationConstant
2611 699E ,ImageSize
2612 69B0 ,ModuleName
2613 69C0 );
2614 69CB END;
2615 69CB IF test((.0,6,16,19.)) THEN
2616 69E5 BEGIN
2617 69EA write(TestOut, 'PutSGDs-1');
2618 6A12 TSTsct(SRCinx);
2619 6A21 END;
2620 6A21 END; (* FOR SRCinx := ... *)
2621 6A2B PutSGD(Fl, SectionTable(.TargetSectionOffset +
2622 6A37 DSTinx - 1.) );
2623 6A6A IF test((.0,6,16,19.)) THEN
2624 6A84 BEGIN
2625 6A89 write(TestOut, 'PutSGDs-2');
2626 6AB1 TSTsct(TargetSectionOffset + DSTinx - 1 );
2627 6ADB END;
2628 6ADB END; (* FOR DSTinx := ... *)
2629 6AE5 END; (* allocation ok *)
2630 6AE5 END; (*PUTSGDS*)
2631 6AEB
2632 6AEB PROCEDURE PutEXP(VAR Status: StatusType
2633 6AEB ;VAR Target: FileType
2634 6AEB ;VAR LogFile: LogFileType
2635 6AEB );
2636 6AEB
2637 6AEB VAR
2638 6AEB MDTInx: ModuleTableIndexType;
2639 6AEB ModuleName: ModuleNameType;
2640 6AEB Heap: HeapType;
2641 6AEB HeapMax: HeapIndexType;
2642 6AEB Winner: SymboltableIndexType;
2643 6AEB SymbolNo: SymbolTableIndexType;
2644 6AEB EXP_Record: ObjectRecordType;
2645 6AEB SbtInx: SymbolTableIndexType;
2646 6AEB
2647 6AEB FUNCTION NameSwop(VAR A
2648 6AEB , B: SymbolNameType
2649 6AEB ): boolean;
2650 6AEB
2651 6AEB VAR
2652 6AEB I: integer;
2653 6AEB
2654 6AEB BEGIN (*NAMESWOP*)
2655 6AEB I := 1;
2656 6B02 IF B.Length < A.Length THEN
2657 6B1E BEGIN
2658 6B23 WHILE (I <= B.Length) and (A.Name(.I.) >= B.Name(.I.)) DO
2659 6B8A I := I + 1;
2660 6B9D NameSwop := (I > B.Length);
2661 6BC1 END
2662 6BC1 ELSE
2663 6BC4 BEGIN
2664 6BC9 WHILE (I <= A.Length) and (A.Name(.I.) <= B.Name(.I.)) DO
2665 6C33 I := I + 1;
2666 6C46 NameSwop := not (I > A.Length);
2667 6C6A END;
2668 6C6A IF test((.0,13.)) THEN
2669 6C83 BEGIN
2670 6C88 writeln(TestOut, 'NameSwop ', 'I=', I:1);
2671 6CCB TSTindt; TSTindt; TSTindt;
2672 6CD9 write(TestOut, 'A='); TSTsymbol(A);
2673 6D04 TSTindt; TSTindt; TSTindt;
2674 6D12 write(TestOut, 'B='); TSTsymbol(B);
2675 6D3D END
2676 6D3D END; (*NAMESWOP*)
2677 6D46
2678 6D46 PROCEDURE InHeap( New: SymbolTableIndexType
2679 6D46 );
2680 6D46
2681 6D46 VAR
2682 6D46 I,J: integer;
2683 6D46 Z,V: SymbolNameType;
2684 6D46 Swop: boolean;
2685 6D46
2686 6D46 BEGIN (*INHEAP*)
2687 6D46 HeapMax := HeapMax + 1;
2688 6D6C I := HeapMax;
2689 6D7B NMTG(SymbolTable(.New.).NameReference, Z);
2690 6DAD IF I > 1 THEN
2691 6DC4 REPEAT
2692 6DC9 J := I div 2;
2693 6DE1 NMTG(SymbolTable(. Heap(.J.) .).NameReference, V);
2694 6E26 Swop := NameSwop(V,Z);
2695 6E44 IF Swop THEN
2696 6E4D BEGIN
2697 6E52 Heap(.I.) := Heap(.J.);
2698 6E90 I := J
2699 6E95 END
2700 6E9D UNTIL (I <= 1) or ( not Swop );
2701 6EBC Heap(.I.) := New;
2702 6EE3 IF test((.0,13.)) THEN
2703 6EFC BEGIN
2704 6F01 writeln(TestOut, 'InHeap New=', New:1);
2705 6F3E TSTheap(Heap, HeapMax);
2706 6F59 END;
2707 6F59 END; (*INHEAP*)
2708 6F5F
2709 6F5F PROCEDURE SelectWinner(VAR Status: StatusType
2710 6F5F );
2711 6F5F
2712 6F5F VAR
2713 6F5F I,J: integer;
2714 6F5F Swop: boolean;
2715 6F5F V,W,Z: SymbolNameType;
2716 6F5F New: SymbolTableIndexType;
2717 6F5F
2718 6F5F BEGIN (*SELECTWINNER*)
2719 6F5F IF (0 < HeapMax) THEN
2720 6F7B BEGIN
2721 6F80 Winner := Heap(.1.);
2722 6F96 WITH Symboltable(.Winner.) DO
2723 6FB6 IF SortLink <> Winner THEN
2724 6FC8 New := SortLink
2725 6FCD ELSE
2726 6FDF BEGIN (* Chain exhausted - descrease size of heap *)
2727 6FE4 New := Heap(.HeapMax.);
2728 7006 HeapMax := HeapMax - 1;
2729 7024 END;
2730 7024 I := 1;
2731 7033 IF HeapMax >= 2 THEN
2732 7047 BEGIN
2733 704C J := 2;
2734 705B Heap(.HeapMax + 1.) := New;
2735 7087 NMTG(SymbolTable(.New.).NameReference, Z);
2736 70B9 REPEAT
2737 70BE (* J <= HeapMax *)
2738 70BE
2739 70BE NMTG(SymbolTable(.Heap(. J .).).NameReference, V);
2740 7107 NMTG(SymbolTable(.Heap(.J+1.).).NameReference, W);
2741 7153 IF NameSwop(V,W) THEN
2742 716F BEGIN
2743 7174 V := W;
2744 718E J := J + 1
2745 7197 END;
2746 719E
2747 719E Swop := NameSwop(Z,V);
2748 71BC IF Swop THEN
2749 71C5 BEGIN
2750 71CA Heap(.I.) := Heap(.J.);
2751 7208 I := J;
2752 7215 J := I + I;
2753 7227 END;
2754 7227
2755 7227 IF test((.0,13.)) THEN
2756 7240 BEGIN
2757 7245 write(TestOut, 'SLCT-W-1 ', 'I=' , I:1
2758 727F , ' ':2 , 'J=' , J:1
2759 72A3 , ' ':2 , 'New=', New:1
2760 72CE , ' ':2 , 'Swop='
2761 72E5 ); TSTbool(Swop); TSTln;
2762 7304 TSTheap(Heap, HeapMax);
2763 731F END
2764 731F
2765 731F UNTIL (not Swop) or (J > HeapMax);
2766 7345 END;
2767 7345 Heap(.I.) := New;
2768 736C END
2769 736C ELSE
2770 736F Status := Status + (.HeapEmpty.);
2771 7396 IF test((.0,13,16,19.)) THEN
2772 73B0 BEGIN
2773 73B5 write(TestOut, 'SLCT-W-2 '); TSTstat(Status); TSTindt;
2774 73F4 writeln(TestOut, 'HeapMax=', HeapMax:1
2775 7427 , ' ':2, 'Winner=', Winner:1
2776 7459 );
2777 7462 END;
2778 7462 END; (*SELECTWINNER*)
2779 7468
2780 7468
2781 7468 BEGIN (*PUTEXP*)
2782 7468 IF CurrentSymbolCount > 0 THEN
2783 7489 LogHxpN(LogFile);
2784 7498
2785 7498 IF test((.0,13.)) THEN
2786 74B1 BEGIN
2787 74B6 writeln(TestOut, 'PUTEXP ');
2788 74DE FOR SbtInx := 1 TO MaxNooSymbols DO
2789 74EF WITH SymbolTable(.SbtInx.), ValueTable(.SbtInx.) DO
2790 7529 IF NameReference <> 0 THEN
2791 753A BEGIN
2792 753F TSTindt; TSTindt; TSTindt; TSTsbt(SbtInx);
2793 755B TSTindt; TSTvlt(SbtInx); TSTln;
2794 7570 END;
2795 757A END;
2796 757A
2797 757A (*Initialize selection*)
2798 757A HeapMax := 0;
2799 7583 FOR MDTInx := 1 TO TargetModuleNo - 1 DO
2800 75AA IF ModuleTable(.MDTInx
2801 75AF .).SBTLinkHead IN (.1..MaxNooSymbols.) THEN
2802 75D7 InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
2803 760A
2804 760A WHILE (Status = (..)) DO
2805 7623 BEGIN
2806 7628 SelectWinner(Status);
2807 763B IF Status = (..) THEN
2808 7654 WITH SymbolTable(.Winner.), ValueTable(.Winner.),
2809 7691 EXP_Record DO
2810 7691 IF resolved THEN
2811 769B BEGIN
2812 76A0 IF (Section > 0) THEN (*relocatable*)
2813 76B7 BEGIN
2814 76BC Value := Value + SCTGRC(Section);
2815 76E9 EXP_RelocationIndicator := SCTGSG(Section);
2816 7702 END
2817 7702 ELSE (*absolute*)
2818 7705 EXP_RelocationIndicator := 0;
2819 770E EXP_Item := Value;
2820 7721 NMTG(NameReference, EXP_SymbolName);
2821 7741 FPi8(Target, EXP_RelocationIndicator);
2822 7758 FPi32(Target, EXP_Item);
2823 776D FPsym(Target, EXP_SymbolName);
2824 7784 IF (Status = (..)) and (OPTlfk <> none) THEN
2825 77AD BEGIN
2826 77B2 IF Section > 0 THEN
2827 77C9 NMTG(SymbolTable(.
2828 77CE ModuleTable(.
2829 77CE SectionTable(.Section
2830 77CE .).ModuleNo
2831 77E6 .).ModuleNameReference
2832 77F8 .).NameReference
2833 780E ,ModuleName
2834 7814 )
2835 781C ELSE
2836 7826 NMTG(SymbolTable(.
2837 782B ModuleTable(.-(Section)
2838 7831 .).ModuleNameReference
2839 784C .).NameReference
2840 7862 ,ModuleName
2841 7868 );
2842 7877 LogXP(LogFile
2843 787C ,EXP_RelocationIndicator
2844 7883 ,EXP_Item
2845 788A ,EXP_SymbolName
2846 7890 ,ModuleName
2847 7898 )
2848 78A0 END;
2849 78A3 END;
2850 78A3 END;
2851 78A6 Status := Status - (.HeapEmpty.);
2852 78CD IF (HeapEmpty IN Status) and (OPTlfk <> none) THEN
2853 78F8 BEGIN (*sort sbt/vlt by value and log*)
2854 78FD Status := (..);
2855 7914 IF CurrentSymbolCount > 0 THEN
2856 792D LogHxpV(LogFile);
2857 793C (*sort*)
2858 793C WHILE Status = (..) DO
2859 7955 BEGIN
2860 795A (*GET NEXT IN LINKED LIST*)
2861 795A IF Status = (..) THEN
2862 7973 (***********Something is wrong here!!! V V *)
2863 7973 WITH SymbolTable(.winner.), ValueTable(.winner.), EXP_Record DO
2864 79B0 LogXP(LogFile
2865 79B5 ,EXP_RelocationIndicator
2866 79BC ,EXP_Item
2867 79C3 ,EXP_SymbolName
2868 79C9 ,ModuleName
2869 79D1 )
2870 79D9 END
2871 79DC END
2872 79DF END; (*PUTEXP*)
2873 79E5
2874 79E5
2875 79E5 PROCEDURE PutEXI(VAR Status: StatusType
2876 79E5 ;VAR Target: FileType
2877 79E5 ;VAR LogFile: LogFileType
2878 79E5 );
2879 79E5
2880 79E5 VAR
2881 79E5 ModuleName: ModuleNameType;
2882 79E5 SymbolName: SymbolNameType;
2883 79E5 ExiInx: ExternalImportTableIndexType;
2884 79E5
2885 79E5 (* TargetModuleNo is a global variable *)
2886 79E5 (* CurrentUrsCount and NooExternalImportSymbols of
2887 79E5 taget module represents the same information. *)
2888 79E5
2889 79E5 BEGIN (*PUTEXI*)
2890 79E5 IF CurrentUrsCount > 0 THEN
2891 7A0D LogHurs(LogFile);
2892 7A1C WITH ModuleTable(.TargetModuleNo.) DO
2893 7A3B BEGIN
2894 7A40 NooExternalImportSymbols := 0;
2895 7A4B FOR ExiInx := 1 TO CurExternalImportSymbolNo DO
2896 7A65 WITH ExternalImportTable(.ExiInx.) DO
2897 7A7B WITH ValueTable(.SymbolNo.),
2898 7A98 SymbolTable(.SymbolNo.) DO
2899 7ABA IF not resolved THEN
2900 7ACC BEGIN
2901 7AD1 NooExternalImportSymbols :=
2902 7ADC NooExternalImportSymbols + 1;
2903 7AF9 Value := NooExternalImportSymbols;
2904 7B1A NMTG(NameReference, SymbolName);
2905 7B3A FPsym(Target, SymbolName);
2906 7B51 IF Section > 0 THEN
2907 7B68 WITH SymbolTable(.
2908 7B6D ModuleTable(.
2909 7B6D SectionTable(.Section
2910 7B6D .).ModuleNo
2911 7B85 .).ModuleNameReference
2912 7B97 .) DO
2913 7BB3 NMTG(NameReference, ModuleName)
2914 7BC6 ELSE
2915 7BD0 WITH SymbolTable(.
2916 7BD5 ModuleTable(.-(Section)
2917 7BDB .).ModuleNameReference
2918 7BF6 .) DO
2919 7C12 NMTG(NameReference, ModuleName);
2920 7C2C LogURS(LogFile, ModuleName, SymbolName);
2921 7C4B IF test((.0,16,19.)) THEN
2922 7C65 BEGIN
2923 7C6A writeln(TestOut, 'PutEXI '
2924 7C85 , 'SymbolNo=', SymbolNo:1
2925 7CB4 , ' ':2, 'Value=', Value:1);
2926 7CEB END;
2927 7CEB END
2928 7CEB
2929 7CEB
2930 7CEB END
2931 7CF5 END; (*PUTEXI*)
2932 7CFB
2933 7CFB (* TargetModuleNo is a global variable *)
2934 7CFB
2935 7CFB BEGIN (*PUTMODULE*)
2936 7CFB MDTA(Status, TargetModuleNo, 1);
2937 7D19 IF not (ModuleTableOverFlow IN Status) THEN
2938 7D34 BEGIN
2939 7D39 PutMF(TargetFile);
2940 7D48 PutINX(Status, TargetFile, LogFile);
2941 7D69 IF Status = (..) THEN
2942 7D82 BEGIN (*Calculate memory map, write sgd, and log*)
2943 7D87 PutSGDs(Status, TargetFile, LogFile);
2944 7DA8
2945 7DA8 IF not (SectionTableOverFlow IN Status) THEN
2946 7DC3 BEGIN (*Relocate symbol table, write export list, and log*)
2947 7DC8 PutEXP(Status, TargetFile, LogFile);
2948 7DE9 IF Status = (..) THEN
2949 7E02 BEGIN (*Write EXI while logging unresolved references*)
2950 7E07 PutEXI(Status, TargetFile, LogFile);
2951 7E28 END;
2952 7E28 END;
2953 7E28 END;
2954 7E28 END;
2955 7E28 END; (*PUTMODULE*)
2956 7E2E
2957 7E2E BEGIN (*PUTTARGETFILE*)
2958 7E2E PutFF(TargetFile);
2959 7E45 PutModule(Status, TargetFile, LogFile);
2960 7E66 END; (*PUTTARGETFILE*)
2961 7E6C
2962 7E6C
2963 7E6C
2964 7E6C BEGIN (*PASS1*)
2965 7E6C
2966 7E6C (* Initialize local data structures *)
2967 7E6C FOR SBTSubInx := 1 TO MaxNooSymbols DO
2968 7E87 SymbolTable(.SBTSubInx.).NameReference := 0;
2969 7EAE LatestInsert := 0;
2970 7EC0 CurrentSymbolCount := 0;
2971 7ED2 CurrentUrsCount := 0;
2972 7EEA CurrentNameTableIndex := 1;
2973 7EF3
2974 7EF3 GetInputFiles(Status, LogFile);
2975 7F1F IF Status = (..) THEN
2976 7F41 BEGIN
2977 7F46 PutTargetFile(Status, TargetFile, LogFile);
2978 7F82 END;
2979 7F82 END; (*PASS1*)
2980 7F88
2981 7F88 (* BEGIN (*PASS1 SEGMENT*)
2982 7F88 (* END. (*PASS1 SEGMENT*)
2983 7F88
2984 7F88 (*$I B:lnkp2.pas Procedure pass2 *)
2985 7F88 (******************************************************************************)
2986 7F88 (* *)
2987 7F88 (* Copyright (1985) by Metanic Aps., Denmark *)
2988 7F88 (* *)
2989 7F88 (* Author: Lars Gregers Jakobsen. *)
2990 7F88 (* *)
2991 7F88 (******************************************************************************)
2992 7F88 (*
2993 7F88 SEGMENT pass2;
2994 7F88
2995 7F88 *)
2996 7F88 PROCEDURE Pass2(Status: StatusType
2997 7F88 );
2998 7F88
2999 7F88 BEGIN (*PASS2*)
3000 7F88 END; (*PASS2*)
3001 7F96
3002 7F96 (* BEGIN (*LNKPASS2*)
3003 7F96 (* END. (*LNKPASS2*)
3004 7F96
3005 7F96
3006 7F96
3007 7F96 BEGIN (*LINK*)
3008 7F96 TestInit(Input,Output);
3009 7FAF Status := (..);
3010 7FC3 Init(Status);
3011 7FCF IF Status = (..) THEN
3012 7FE5 SetUp(Status, TargetFile, LogFile, Output);
3013 7FFD IF test((.0,16,17.)) THEN
3014 8017 BEGIN
3015 801C write(TestOut, 'Link-MAIN-1 '); TSTstat(Status); TSTindt; TSTmem; TSTln
3016 8060 END;
3017 8063 IF Status = (..) THEN
3018 8079 Pass1(Status, TargetFile, LogFile);
3019 808D IF test((.0,16,17.)) THEN
3020 80A7 BEGIN
3021 80AC write(TestOut, 'Link-MAIN-2 '); TSTstat(Status); TSTln
3022 80EA END;
3023 80ED IF Status = (..) THEN
3024 8103 Pass2(Status);
3025 8119 IF test((.0,16,17.)) THEN
3026 8133 BEGIN
3027 8138 write(TestOut, 'Link-MAIN-3 '); TSTstat(Status); TSTln
3028 8176 END;
3029 8179 IF Status = (..) THEN
3030 818F Term(Status);
3031 819B IF test((.0,16,17.)) THEN
3032 81B5 BEGIN
3033 81BA write(TestOut, 'Link-MAIN-4 '); TSTstat(Status); TSTln
3034 81F8 END;
3035 81FB IF Status = (..) THEN
3036 8211 BEGIN
3037 8216 writeln(output, 'LINK -- Normal termination')
3038 824C END
3039 824F ELSE
3040 8252 BEGIN
3041 8257 writeln(output, 'LINK -- Abnormal termination.');
3042 8293 FOR StatusInx := Success TO Error DO
3043 82A5 IF StatusInx IN Status THEN
3044 82B8 writeln(output, ' #Error: ', ord(StatusInx):3 );
3045 82FC END
3046 82FC END.
«eof»