|
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: 187264 (0x2db80)
Types: TextFile
Names: »LNK.PRN«
└─⟦94d85ef43⟧ Bits:30009789/_.ft.Ibm2.50006584.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 CONST
21 0000
22 0000 (*$I B:LNKDC0-0.pas Configuration Constants *)
23 0000 (******************************************************************************)
24 0000 (* *)
25 0000 (* Copyright (1985) by Metanic Aps., Denmark *)
26 0000 (* *)
27 0000 (* Author: Lars Gregers Jakobsen. *)
28 0000 (* *)
29 0000 (******************************************************************************)
30 0000
31 0000 (* $I B:LNKDC0-0.pas Configuration Constants *)
32 0000
33 0000 ConfigurationNo = 'C0B CP/M';
34 0008
35 0008 CommandLineLength = 127;
36 0008 FileNameLength = 14;
37 0008 MaxSymbolNameIndex = 32; (*?*)
38 0008 MaxNooInputFiles = 5; (*?*)
39 0008 MaxNooModules = 10; (*?*)
40 0008 MaxNooSections = 40; (*?*)
41 0008 MaxNooSegments = 5; (*?*)
42 0008 MaxNooSymbols = 100; (*?*)
43 0008 MaxNooExternalImportSymbols = 100; (*?*)
44 0008 MaxNameTableIndex = 300; (*?*)
45 0008 MaxHeapIndex = 11; (* >= MaxNooModules + 1 *)
46 0008 OM_Format1 = 1;
47 0008 OF_Format1 = 1;
48 0008 LogFilePageSize = 65; (*First line is #1. Last line is #65*)
49 0008
50 0008 (* *)
51 0008 (* *)
52 0008 (******************************************************************************)
53 0008
54 0008 (*#B#*)
55 0008 (*$I A:PrTstCon.pas Declarations of constants for PrTst package *)
56 0008 (* $I A:PrTstCon.pas Declarations of constants for PrTst package *)
57 0008
58 0008 (* This file is part of the ProPascal test option package. Se file
59 0008 PrTst.pas for further explanations of usage
60 0008 *)
61 0008
62 0008 max_test_option_number = 31;
63 0008
64 0008
65 0008
66 0008 (* Other constants *)
67 0008
68 0008 VersionNo = 'V0.02';
69 000D UnResolved = -1; (* Value of field segmentno in VLT *)
70 000D OvrCode = 0; (* For index in bit map *)
71 000D ImageFactor = 4; (* 2 bits in bit map per 8 bits in image *)
72 000D OMF_Address = 4; (* Address of OMF in target file *)
73 000D OMH_Address = 8; (* Address of OMH in target file *)
74 000D LogMargin = 10; (* Size of blank left margin in log file *)
75 000D
76 000D TYPE (*LINK*)
77 000D
78 000D (* General Types *)
79 000D
80 000D i8 = 0..255;
81 000D i16 = 0..65535;
82 000D i32 = integer;
83 000D i32IndexType = (bs0, bs1, bs2, bs3);
84 000D i32ArrayType = ARRAY (.i32IndexType.) OF i8;
85 000D CharSetType = SET OF char;
86 000D
87 000D (* Basic Types *)
88 000D
89 000D StatusBaseType =
90 000D (Success
91 000D ,BadOption
92 000D ,BadLogFileName
93 000D ,BadTargetFileName
94 000D ,BadFileName
95 000D ,NoSuchFile
96 000D ,NoInputFiles
97 000D ,ExtraText
98 000D ,BadFileFormat
99 000D ,BadModuleFormat
100 000D ,UnexpectedEof
101 000D ,RangeError
102 000D ,BadSymbolName
103 000D ,DuplicateModuleName
104 000D ,DuplicateExportSymbol
105 000D ,NoInput
106 000D ,Baddibit
107 000D ,BadRelocationCode
108 000D ,BadImportCode
109 000D ,NameTableOverFlow
110 000D ,ModuleTableOverFlow
111 000D ,SectionTableOverFlow
112 000D ,FileNameTableOverFlow
113 000D ,SymbolTableOverFlow
114 000D ,ExternalImportTableOverFlow
115 000D ,NotFound
116 000D ,NotFinished
117 000D ,HeapEmpty
118 000D ,NoTarget
119 000D ,Error
120 000D );
121 000D
122 000D StatusType = SET OF StatusBaseType;
123 000D
124 000D OF_FormatType = i32;
125 000D OM_FormatType = i32;
126 000D FileKindBaseType = (explicit, implicit, none);
127 000D LogFileKindType = explicit..none;
128 000D TargetFileKindType = explicit..implicit;
129 000D
130 000D SegmentNoType = UnResolved..MaxNooSegments;
131 000D RelocationIndicatorType = SegmentNoType;
132 000D FileAddressType = 0..MaxInt;
133 000D
134 000D CommandLineIndexType = 0..CommandLineLength;
135 000D CommandLineType = String(.CommandLineLength.);
136 000D
137 000D SymbolNameIndexType = 0..MaxSymbolNameIndex;
138 000D SymbolNameSubIndexType = 1..MaxSymbolNameIndex;
139 000D SymbolNameType = RECORD
140 000D Length: SymbolNameIndexType;
141 000D Name: ARRAY (.SymbolNameSubIndexType.) OF i8;
142 000D END;
143 000D ModuleNameType = SymbolNameType;
144 000D FileNameType = STRING(.FileNameLength.);
145 000D
146 000D ImageUnitType = i8;
147 000D QuadImageUnitType = i32;
148 000D BasicFileType = file OF ImageUnitType;
149 000D FileType = RECORD
150 000D F: BasicFileType; (* File systeme file *)
151 000D P: FileAddressType (* Current file address.
152 000D NOT defined when eof(F) = true *)
153 000D END;
154 000D
155 000D PageNoType = i32;
156 000D LineNoType = 0..255;
157 000D LogFileType = RECORD
158 000D F: text; (* File system file *)
159 000D P: PageNoType; (* No of page started upon *)
160 000D L: LineNoType; (* No of line just printed within current page *)
161 000D END;
162 000D
163 000D (* Table Index Types *)
164 000D
165 000D ExternalImportTableIndexType = 0..MaxNooExternalImportSymbols;
166 000D FileNameTableIndexType = -1..MaxNooInputFiles;
167 000D ModuleTableIndexType = 0..MaxNooModules;
168 000D NameTableIndexType = 0..MaxNameTableIndex;
169 000D SectionTableIndexType = 0..MaxNooSections;
170 000D SymbolTableIndexType = 0..MaxNooSymbols;
171 000D HeapIndexType = 0..MaxHeapIndex;
172 000D
173 000D (* Table Sub Index Types *)
174 000D
175 000D ExternalImportTableSubIndexType = 1..MaxNooExternalImportSymbols;
176 000D ModuleTableSubIndexType = 1..MaxNooModules;
177 000D NameTableSubIndexType = 1..MaxNameTableIndex;
178 000D SectionTableSubIndexType = 1..MaxNooSections;
179 000D SymbolTableSubIndexType = 1..MaxNooSymbols;
180 000D
181 000D
182 000D
183 000D (* Table Record Types *)
184 000D
185 000D ExternalImportTableRecordType = RECORD
186 000D SymbolNo: SymbolTableIndexType
187 000D (* Points to VLT entry holding value *)
188 000D END;
189 000D
190 000D FileNameTableRecordType = FileNameType;
191 000D
192 000D ModuleTableRecordType = RECORD
193 000D ModuleNameReference: SymbolTableIndexType;
194 000D (* Points to SBT entry holding module name *)
195 000D FileNameReference: FileNameTableIndexType;
196 000D (* Points to FNT entry holding name of file *)
197 000D CurrentFileAddress: FileAddressType;
198 000D (* Offset (in octets) relative to start of file. First octet
199 000D in file is # 0 *)
200 000D Referenced: Boolean;
201 000D (* True if module referenced. Not used. *)
202 000D NooSegments: SegmentNoType;
203 000D (* Noo Segments in module *)
204 000D SCTBase: SectionTableIndexType;
205 000D (* Points to SCT entry just below the entries of this module.
206 000D Used by putEXP during relocation of exported symbols *)
207 000D NooExternalImportSymbols: ExternalImportTableIndexType;
208 000D (* Noo External import symbols in module *)
209 000D EITOffset: ExternalImportTableIndexType;
210 000D (* Points to EIT entry just below the entries of this module.
211 000D Used during pass 2 *)
212 000D SBTLinkHead: SymbolTableIndexType
213 000D (* Points to first SBT entry in ordered linked list using
214 000D sortlink as link field *)
215 000D END;
216 000D
217 000D OptionTableRecordType = RECORD
218 000D LogFileKind: LogFileKindType;
219 000D TargetFileKind: TargetFileKindType
220 000D END;
221 000D
222 000D SectionTableRecordType = RECORD
223 000D ModuleNo: ModuleTableIndexType;
224 000D (* Points to MDT entry holding module description *)
225 000D SegmentNo: SegmentNoType;
226 000D (* *)
227 000D ImageSize: FileAddressType;
228 000D (* Size of image in quadimageunits.
229 000D Size of bitmap rid in imageunits *)
230 000D OvrSize: FileAddressType;
231 000D (* Size of overrun store in octets *)
232 000D RelocationConstant: FileAddressType;
233 000D (* Amount (in octets) to offset section during relocation *)
234 000D END;
235 000D
236 000D SymbolTableRecordType = RECORD
237 000D ModuleNo: ModuleTableIndexType;
238 000D (* if symbol resolved: Points to MDT entry of exporting module.
239 000D if not : Points to MDT entry of importing module *)
240 000D NameReference: NameTableIndexType;
241 000D (* Points to first octet of name (length field) in NMT *)
242 000D SortLink: SymbolTableIndexType
243 000D (* Points to SBT entry of next symbol according to
244 000D some ordering (e.g. alphabetically) *)
245 000D END;
246 000D
247 000D ValueTableRecordType = RECORD
248 000D SegmentNo: SegmentNoType;
249 000D (* < 0 : Symbol has not been resolved.
250 000D = 0 : Symbol is absolute.
251 000D 0 < s <= MDT(SBT.ModuleNo).NooSegments:Symbol is relocatable
252 000D and field indicates number of segment. *)
253 000D Value: i32
254 000D (* if symbol resolved: Value of symbol.
255 000D if not : Points to EIT entry of the symbol in the
256 000D reduced EIT written to targetmodule *)
257 000D END;
258 000D
259 000D (* Table Types *)
260 000D
261 000D
262 000D ExternalImportTableType = ARRAY (.ExternalImportTableSubIndexType.) OF
263 000D ExternalImportTableRecordType;
264 000D
265 000D FileNameTableType = ARRAY (.FileNameTableIndexType.) OF
266 000D FileNameTableRecordType;
267 000D
268 000D ModuleTableType = ARRAY (.ModuleTableSubIndexType.) OF
269 000D ModuleTableRecordType;
270 000D
271 000D OptionTableType = OptionTableRecordType;
272 000D
273 000D NameTableType = ARRAY (.NameTableSubIndexType.) OF i8;
274 000D
275 000D SectionTableType = ARRAY (.SectionTableSubIndexType.) OF
276 000D SectionTableRecordType;
277 000D
278 000D SymbolTableType = ARRAY (.SymbolTableSubIndexType.) OF
279 000D SymbolTableRecordType;
280 000D
281 000D ValueTableType = ARRAY (.SymbolTableSubIndexType.) OF
282 000D ValueTableRecordType;
283 000D
284 000D
285 000D (* Other major data structures *)
286 000D
287 000D HeapType = ARRAY (.ModuleTableIndexType.) OF SymbolTableIndexType;
288 000D
289 000D BitMapBufferTagType = (bit, byt);
290 000D BitMapBufferType = RECORD
291 000D P: 0..16;
292 000D CASE BitMapBufferTagType OF
293 000D bit: (I: SET OF 0..15);
294 000D byt: (Y0: i8;
295 000D Y1: i8
296 000D )
297 000D END;
298 000D
299 000D BitMappedFileType = RECORD
300 000D F: BasicFileType;
301 000D B: BitMapBufferType
302 000D END;
303 000D
304 000D (*#B#*)
305 000D (*$I A:PrTstTyp.pas Declarations of types for PrTst package *)
306 000D (* $I A:PrTstTyp.pas Declarations of types for PrTst package *)
307 000D
308 000D (* This file is part of the ProPascal test option package. Se file
309 000D PrTst.pas for further explanations of usage
310 000D *)
311 000D
312 000D test_option_type = 0..max_test_option_number;
313 000D test_option_set_type = SET OF test_option_type;
314 000D
315 000D
316 000D
317 000D
318 000D COMMON (*LINK*)
319 000D
320 000D (* Permanent Tables *)
321 000D
322 000D OptionTable: OptionTableType;
323 000D
324 000D FileNameTable: FilenameTableType;
325 000D CurFileNo: FileNameTableIndexType;
326 000D (* Points to highest entry used *)
327 000D
328 000D ModuleTable: ModuleTableType;
329 000D CurModuleNo: ModuleTableIndexType;
330 000D (* Points to highest entry used *)
331 000D TargetModuleNo: ModuleTableIndexType;
332 000D (* Points to entry of target module *)
333 000D
334 000D SectionTable: SectionTableType;
335 000D SCTOffset: SectionTableIndexType;
336 000D (* Points to highest entry used *)
337 000D TargetSectionOffset: SectionTableIndexType;
338 000D (* Points to entry just below target sections *)
339 000D CurSegmentCount: SegmentNoType;
340 000D (* Number of segments in target module *)
341 000D
342 000D ValueTable: ValueTableType;
343 000D NooExpSymbols: i32;
344 000D (* Number of EXP symbols in target module *)
345 000D
346 000D ExternalImportTable: ExternalImportTableType;
347 000D CurExternalImportSymbolNo: ExternalImportTableIndexType;
348 000D (* Points to highest entry used *)
349 000D NooExiSymbols: i32;
350 000D (* Number of EXI symbols in target module *)
351 000D
352 000D (*#B#*)
353 000D (*$I A:PrTstCom.pas Declarations of global variables for PrTst package *)
354 000D (* $I A:PrTstCom.pas Declarations of global variables for PrTst package *)
355 000D
356 000D (* This file is part of the ProPascal test option package. Se file
357 000D PrTst.pas for further explanations of usage
358 000D *)
359 000D
360 000D test_options: test_option_set_type;
361 000D test_out: text;
362 000D test_global: boolean;
363 000D
364 000D
365 000D
366 000D (* *)
367 000D (* *)
368 000D (******************************************************************************)
369 000D
370 000D
371 000D VAR (*LINK*)
372 000D
373 000D (* Misc. Variables *)
374 000D
375 000D Status: StatusType;
376 000D TargetFile: FileType;
377 000D LogFile: LogFileType;
378 000D SCTSubInx: SectionTableSubIndexType;
379 000D
380 000D (*#B#*)
381 000D (*$I A:PrTstExt.pas External Decl. of standard test procedures *)
382 000D (* $I A:ProTstExt.pas Declarations of external procedures for ProTst package *)
383 000D
384 000D (* This file is part of the ProPascal test option package. Se file
385 000D ProTst.pas for further explanations of usage
386 000D *)
387 000D
388 000D FUNCTION test(list: test_option_set_type
389 000D ): boolean; EXTERNAL;
390 000D
391 000D PROCEDURE test_init(VAR in_file,
392 000D out_file: text
393 000D ); EXTERNAL;
394 000D
395 000D
396 000D (*#B#*)
397 000D (*$I B:LnkDF1.pas Global test output primitives *)
398 000D (******************************************************************************)
399 000D (* *)
400 000D (* Copyright (1985) by Metanic Aps., Denmark *)
401 000D (* *)
402 000D (* Author: Lars Gregers Jakobsen. *)
403 000D (* *)
404 000D (******************************************************************************)
405 000D
406 000D (* File LnkDF1 defines the test output primitives used for debugging
407 000D program link and its associated subroutines and functions.
408 000D *)
409 000D
410 000D FUNCTION memavail: integer; EXTERNAL;
411 000D
412 000D PROCEDURE TSTasc(N: i8
413 000D );
414 000D
415 000D BEGIN (*TSTASC*)
416 000D IF (31 < N) and (N < 127) THEN
417 0031 write(TestOut, chr(N) )
418 004A ELSE
419 004F write(TestOut, '+')
420 0067 END; (*TSTASC*)
421 0070
422 0070 PROCEDURE TSThex(N: i8
423 0070 );
424 0070
425 0070 VAR
426 0070 Nibble: i8;
427 0070
428 0070 BEGIN (*TSTHEX*)
429 0070 Nibble := N div 16;
430 008F IF Nibble < 10 THEN
431 0098 write(TestOut, chr( ord('0') + Nibble ) )
432 00B8 ELSE
433 00BD write(TestOut, chr( ord('A') - 10 + Nibble ) );
434 00E0 Nibble := N mod 16;
435 00F1 IF Nibble < 10 THEN
436 00FA write(TestOut, chr( ord('0') + Nibble ) )
437 011A ELSE
438 011F write(TestOut, chr( ord('A') - 10 + Nibble ) )
439 013F END; (*TSTHEX*)
440 0148
441 0148 PROCEDURE TSTbool(A: boolean
442 0148 );
443 0148
444 0148 BEGIN (*TSTBOOL*)
445 0148 IF A THEN
446 015B write(TestOut, 'T')
447 0173 ELSE
448 0178 write(TestOut, 'F')
449 0190 END; (*TSTBOOL*)
450 0199
451 0199 PROCEDURE TSTindt;
452 0199
453 0199 BEGIN (*TSTindt*)
454 0199 write(TestOut, ' ':3)
455 01B9 END; (*TSTindt*)
456 01C2
457 01C2 PROCEDURE TSTln;
458 01C2
459 01C2 BEGIN (*TSTln*)
460 01C2 writeln(TestOut)
461 01D9 END; (*TSTln*)
462 01E2
463 01E2 PROCEDURE TSTsymbol(S: SymbolNameType
464 01E2 );
465 01E2
466 01E2 VAR
467 01E2 I: SymbolNameIndexType;
468 01E2
469 01E2 BEGIN (*TSTSYMBOL*)
470 01E2 WITH S DO
471 0204 BEGIN
472 0209 write(TestOut, 'SYMBOLÆ', Length:1, 'Å=');
473 024F FOR I := 1 TO Length DO
474 0268 TSTasc(Name(.I.));
475 028E TSTln;
476 0296 END
477 0296 END; (*TSTSYMBOL*)
478 029C
479 029C PROCEDURE TSTstat(Status: StatusType
480 029C );
481 029C
482 029C VAR
483 029C Inx: StatusBaseType;
484 029C
485 029C BEGIN (*TSTstat*)
486 029C write(TestOut, 'STAT=(');
487 02C9 IF Status = (..) THEN
488 02E2 write(TestOut, 'SUCCESS)' )
489 0306 ELSE
490 030C BEGIN
491 0311 FOR Inx := succ(Success) TO Error DO
492 0322 IF Inx IN Status THEN
493 0339 write(TestOut, ' ', ord(Inx):1);
494 036D write(TestOut, ' )');
495 038E END
496 038E END; (*TSTstat*)
497 0394
498 0394 PROCEDURE TSTmem;
499 0394
500 0394 BEGIN (*TSTmem*)
501 0394 write(TestOut, 'MEMAVAIL=', memavail:1)
502 03CC END; (*TSTmem*)
503 03D5
504 03D5 PROCEDURE TSTeit(Inx: ExternalImportTableIndexType
505 03D5 );
506 03D5
507 03D5 BEGIN (*TSTeit*)
508 03D5 WITH ExternalImportTable(.Inx.) DO
509 03F6 writeln(TestOut, 'EITÆ', Inx:1, '/', CurExternalImportSymbolNo:1,
510 0441 'Å=(SblNo=', SymbolNo:1, ')' )
511 0475 END; (*TSTeit*)
512 047E
513 047E PROCEDURE TSTfnt(Inx: FileNameTableIndexType
514 047E );
515 047E
516 047E BEGIN (*TSTfnt*)
517 047E writeln(TestOut, 'FNTÆ', Inx:1, '/', CurFileNo:1,
518 04D1 'Å=(FlNm=', FileNameTable(.inx.), ')' )
519 050C END; (*TSTfnt*)
520 0515
521 0515 PROCEDURE TSTheap(Heap: HeapType
522 0515 ;HeapMax: ModuleTableIndexType
523 0515 );
524 0515
525 0515 VAR
526 0515 I: ModuleTableIndexType;
527 0515
528 0515 BEGIN (*TSTHEAP*)
529 0515 TSTindt; TSTindt; TSTindt;
530 0540 write(TestOut, 'HeapÆ',HeapMax:2,'Å=(' );
531 0585 FOR I := 1 TO HeapMax + 1 DO
532 05AB write(TestOut, Heap(.I.):2, ' ':1);
533 05F1 writeln(TestOut, ')');
534 060C END; (*TSTHEAP*)
535 0612
536 0612 PROCEDURE TSTmdt(Inx: ModuleTableIndexType
537 0612 );
538 0612
539 0612 BEGIN (*TST*)
540 0612 WITH moduleTable(.Inx.) DO
541 0639 BEGIN
542 063E write(TestOut, 'MDTÆ', Inx:1, '/', CurModuleNo:1,
543 0689 'Å=(MdNm#=', ModuleNameReference:1, ' ':2
544 06B7 ,'Fn#=', FileNameReference:1, ' ':2
545 06E7 ,'CurFlAddr=', CurrentFileAddress:1, ' ':2
546 071A ,'Refd='
547 0728 );
548 0735 TSTbool(Referenced);
549 074C TSTln;
550 0754 TSTindt; TSTindt; TSTindt;
551 0762 writeln(TestOut ,'SCTbase=', SCTbase:1, ' ':2
552 07A2 ,'#Sgm=', NooSegments:1, ' ':2
553 07D6 ,'EIT#=', EITOffset:1, ' ':2
554 080A ,'#EIsbl=', NooExternalImportSymbols:1, ' ':2
555 0840 ,'SBTLH=', SBTlinkHead:1
556 086C ,')'
557 0872 );
558 087E END
559 087E END; (*TST*)
560 0884
561 0884 PROCEDURE TSTopt;
562 0884
563 0884 BEGIN (*TSTopt*)
564 0884 writeln(TestOut, 'OPT=(LogKind=', ord(OptionTable.LogFileKind):1, ' ':2
565 08C7 ,'TargetKind=', ord(OptionTable.TargetFileKind):1
566 08EE ,')' )
567 08FD END; (*TSTopt*)
568 0906
569 0906 PROCEDURE TSTsct(Inx: SectionTableIndexType
570 0906 );
571 0906
572 0906 BEGIN (*TSTsct*)
573 0906 WITH SectionTable(.Inx.) DO
574 092D BEGIN
575 0932 writeln(TestOut, 'SCT=Æ', Inx:1, '/', SCTOffset:1, '/', CurSegmentCount:1
576 0992 ,'Å=(Mdl#=', ModuleNo:1, ' ':2
577 09C5 ,'Sgm#=', SegmentNo:1
578 09ED );
579 09F6 writeln(TestOut, ' ImgSz=', ImageSize, ' ':2
580 0A37 ,'OvrSz=', OvrSize, ' ':2
581 0A68 ,'RlConst=', RelocationConstant
582 0A83 ,')'
583 0A98 );
584 0AA4 END
585 0AA4 END; (*TSTsct*)
586 0AAA
587 0AAA PROCEDURE TSTvlt(Inx: SymbolTableIndexType
588 0AAA );
589 0AAA
590 0AAA BEGIN (*TSTvlt*)
591 0AAA WITH ValueTable(.Inx.) DO
592 0AD1 BEGIN
593 0AD6 write(TestOut, 'VLTÆ',Inx:1,'Å=(Segm#=', SegmentNo:1
594 0B2C , ' Value=', Value:1, ')' )
595 0B62 END
596 0B65 END; (*TSTvlt*)
597 0B6B
598 0B6B (* *)
599 0B6B (* *)
600 0B6B (******************************************************************************)
601 0B6B
602 0B6B (*$I B:LnkDF2.pas Global access primitives *)
603 0B6B (******************************************************************************)
604 0B6B (* *)
605 0B6B (* Copyright (1985) by Metanic Aps., Denmark *)
606 0B6B (* *)
607 0B6B (* Author: Lars Gregers Jakobsen. *)
608 0B6B (* *)
609 0B6B (******************************************************************************)
610 0B6B
611 0B6B (* File LnkDF2X holds the access primitives used by the
612 0B6B linker to access input and output files. *)
613 0B6B
614 0B6B FUNCTION OPTLFK: LogFileKindType;
615 0B6B
616 0B6B BEGIN (*OPTLFK*)
617 0B6B optlfk := OptionTable.LogFileKind;
618 0B81 END; (*OPTLFK*)
619 0B87
620 0B87 PROCEDURE FNTP(VAR Status: StatusType
621 0B87 ; FileName: FileNameType
622 0B87 );
623 0B87
624 0B87 BEGIN (*FNTP*)
625 0B87 IF CurFileNo < MaxNooInputFiles THEN
626 0B9F BEGIN
627 0BA4 CurFileNo := CurFileNo + 1;
628 0BBA FileNameTable(.CurFileNo.) := FileName;
629 0BE4 END
630 0BE4 ELSE
631 0BE6 Status := Status + (.FileNameTableOverFlow.);
632 0C0D (*#B#*)
633 0C0D IF test((.0,6.)) THEN
634 0C23 BEGIN
635 0C28 write(TestOut, 'FNTP '); TSTstat(Status); TSTindt;
636 0C67 TSTfnt(CurFileNo); TSTln
637 0C76 END
638 0C79 (*#E#*)
639 0C79 END; (*FNTP*)
640 0C7F
641 0C7F PROCEDURE EITP(VAR Status: StatusType
642 0C7F ; SymbolTableEntryNo: SymbolTableIndexType
643 0C7F );
644 0C7F
645 0C7F BEGIN (*EITP*)
646 0C7F IF CurExternalImportSymbolNo < MaxNooExternalImportSymbols THEN
647 0C97 BEGIN
648 0C9C CurExternalImportSymbolNo := CurExternalImportSymbolNo + 1;
649 0CB2 ExternalImportTable(.CurExternalImportSymbolNo
650 0CB7 .).SymbolNo := SymbolTableEntryNo
651 0CC2 END
652 0CCB ELSE
653 0CCD Status := Status + (.ExternalImportTableOverFlow.);
654 0CF5 (*#B#*)
655 0CF5 IF test((.0,7.)) THEN
656 0D0B BEGIN
657 0D10 write(TestOut, 'EITP '); TSTstat(Status); TSTln;
658 0D4F TSTeit(CurExternalImportSymbolNo)
659 0D5B END
660 0D5E (*#E#*)
661 0D5E END; (*EITP*)
662 0D64
663 0D64 (* ModuleTable *)
664 0D64
665 0D64 PROCEDURE MDTA(VAR Status: StatusType
666 0D64 ;VAR ModuleNo: ModuleTableIndexType (*Points to least, vacant entry in MDT*)
667 0D64 ; ModuleCount: ModuleTableIndexType
668 0D64 );
669 0D64
670 0D64 BEGIN (*MDTA*)
671 0D64 ModuleNo := CurModuleNo;
672 0D80 IF CurModuleNo > MaxNooModules - ModuleCount THEN
673 0DA7 Status := Status + (.ModuleTableOverFlow.)
674 0DBD ELSE
675 0DD0 BEGIN
676 0DD5 ModuleNo := CurModuleNo + 1;
677 0DF1 CurModuleNo := CurModuleNo + ModuleCount;
678 0E0E END;
679 0E0E (*#B#*)
680 0E0E IF test((.0,6.)) THEN
681 0E25 BEGIN
682 0E2A write(TestOut, 'MDTA '); TSTstat(Status); TSTindt;
683 0E69 writeln(TestOut, 'ModuleNo, Count, CurModuleNo= ',
684 0EA3 ModuleNo:1, ' ',
685 0EC1 ModuleCount:1, ' ', CurModuleNo:1
686 0EE6 );
687 0EEF END;
688 0EEF (*#E#*)
689 0EEF END; (*MDTA*)
690 0EF5
691 0EF5 (* SectionTable *)
692 0EF5
693 0EF5 PROCEDURE SCTA(VAR Status: StatusType
694 0EF5 ;VAR SectionNo: SectionTableIndexType (*Points to highest, used entry in SCT*)
695 0EF5 ; SectionCount: SegmentNoType
696 0EF5 );
697 0EF5
698 0EF5 BEGIN (*SCTA*)
699 0EF5 SectionNo := SCTOffset;
700 0F11 IF SCTOffset > MaxNooSections - SectionCount THEN
701 0F38 Status := Status + (.SectionTableOverFlow.)
702 0F4E ELSE
703 0F61 BEGIN
704 0F66 SCTOffset := SCTOffset + SectionCount;
705 0F83 END;
706 0F83 (*#B#*)
707 0F83 IF test((.0,6.)) THEN
708 0F9A BEGIN
709 0F9F write(TestOut, 'SCTA '); TSTstat(Status); TSTindt;
710 0FDE writeln(TestOut, 'SectionNo, Count, SCTOffset= ',
711 1017 SectionNo:11, ' ', SectionCount:1, ' ',
712 104F SCTOffset:1
713 105A );
714 1063 END;
715 1063 (*#E#*)
716 1063 END; (*SCTA*)
717 1069
718 1069 (* *)
719 1069 (* *)
720 1069 (******************************************************************************)
721 1069
722 1069
723 1069
724 1069 (*$I B:LnkDF7.pas Log File access primitives *)
725 1069 (******************************************************************************)
726 1069 (* *)
727 1069 (* Copyright (1985) by Metanic Aps., Denmark *)
728 1069 (* *)
729 1069 (* Author: Lars Gregers Jakobsen. *)
730 1069 (* *)
731 1069 (******************************************************************************)
732 1069
733 1069
734 1069 PROCEDURE WriteSymbolName(VAR F: text
735 1069 ; SymbolName: SymbolNameType
736 1069 ; FieldSize: i8
737 1069 );
738 1069
739 1069 VAR
740 1069 I: i8;
741 1069 N: i8;
742 1069
743 1069 BEGIN (*WRITESYMBOLNAME*)
744 1069 WITH SymbolName DO
745 108B BEGIN
746 1090 IF Length < FieldSize THEN
747 10A8 N := Length
748 10AD ELSE
749 10B9 N := FieldSize;
750 10C4 FOR I := 1 TO N DO
751 10DA IF Name(.I.) in (.32..127.) THEN
752 1111 write(F, chr(Name(.I.)) );
753 1152 FOR I := N+1 TO FieldSize DO
754 1174 write(F, ' ');
755 11A0 END
756 11A0 END; (*WRITESYMBOLNAME*)
757 11A6
758 11A6 PROCEDURE LogInit(VAR LogFile: LogFileType
759 11A6 ; FileName: FileNameType
760 11A6 );
761 11A6
762 11A6 BEGIN (*LOGINIT*)
763 11A6 WITH LogFile DO
764 11BF BEGIN
765 11C4 assign(F, FileName);
766 11DB rewrite(F);
767 11EE P := 0;
768 1205 L := LogFilePageSize;
769 1216 END
770 1216 END; (*LOGINIT*)
771 121C
772 121C PROCEDURE LogTerm(VAR LogFile: LogFileType
773 121C );
774 121C
775 121C BEGIN (*LOGTERM*)
776 121C WITH LogFile DO
777 1235 BEGIN
778 123A close(F);
779 1247 END
780 1247 END; (*LOGTERM*)
781 124D
782 124D FUNCTION LogFF(VAR LogFile: LogFileType
783 124D ; Delta: LineNoType
784 124D ): boolean;
785 124D
786 124D CONST
787 124D LogFFDelta = 5;
788 124D
789 124D BEGIN (*LOGFF*)
790 124D WITH LogFile DO
791 1266 IF L >= LogFilePageSize - Delta THEN
792 128C BEGIN
793 1291 LogFF := true;
794 129A P := P + 1;
795 12B9 L := LogFFDelta;
796 12CA page(F);
797 12DD writeln(F);
798 12F6 writeln(F);
799 130F writeln(F, ' ':LogMargin, 'LINKER '
800 1338 , VersionNo, ' '
801 134F , ConfigurationNo
802 1358 , ' ':30
803 1368 , 'SIDE # ', P:2);
804 1398 writeln(F);
805 13B1 writeln(F);
806 13CA END
807 13CA ELSE
808 13CC LogFF := false;
809 13D5 END; (*LOGFF*)
810 13DE
811 13DE PROCEDURE LogCmd(VAR LogFile: LogFileType
812 13DE ; CommandLine: CommandLineType
813 13DE );
814 13DE
815 13DE CONST Delta = 5;
816 13DE
817 13DE BEGIN (*LOGCMD*)
818 13DE IF OptionTable.LogFileKind <> none THEN
819 13F3 BEGIN
820 13F8 IF LogFF(LogFile, Delta) THEN BEGIN END;
821 140D WITH LogFile DO
822 141E BEGIN
823 1423 writeln(F);
824 143C writeln(F, ' ':LogMargin, 'AKTIVERINGSKOMMANDO: ');
825 1480 writeln(F);
826 1499 writeln(F, ' ':LogMargin, CommandLine);
827 14CB writeln(F);
828 14E4 END
829 14E4 END
830 14E4 END; (*LOGCMD*)
831 14EA
832 14EA PROCEDURE LogHSsgd(VAR LogFile: LogFileType
833 14EA );
834 14EA
835 14EA BEGIN (*LOGHSSGD*)
836 14EA IF OptionTable.LogFileKind <> none THEN
837 14FF WITH LogFile DO
838 1510 BEGIN
839 1515 L := L + 2;
840 1536 writeln(F, ' ':LogMargin, 'SGM'
841 155B , ' ':2, 'ADRESSE':9
842 157C , ' ':2, 'STØRRELSE'
843 1597 , ' ':2, 'MODUL'
844 15B2 );
845 15BF writeln(F);
846 15D8 END
847 15D8 END; (*LOGHSSGD*)
848 15DE
849 15DE PROCEDURE LogHsgd(VAR LogFile: LogFileType
850 15DE );
851 15DE
852 15DE BEGIN (*LOGHSGD*)
853 15DE IF OptionTable.LogFileKind <> none THEN
854 15F3 BEGIN
855 15F8 IF LogFF(LogFile, 6) THEN BEGIN END;
856 160D WITH LogFile DO
857 161E BEGIN
858 1623 L := L + 3;
859 1644 writeln(F);
860 165D writeln(F, ' ':LogMargin, 'LOKALISERINGSPLAN:');
861 169E writeln(F);
862 16B7 END;
863 16B7 LogHSsgd(LogFile);
864 16C6 END;
865 16C6 END; (*LOGHSGD*)
866 16CC
867 16CC PROCEDURE LogSGD(VAR LogFile: LogFileType
868 16CC ; SegmentNo: RelocationIndicatorType
869 16CC ; StartAddress: FileAddressType
870 16CC ; Size: FileAddressType
871 16CC ; ModuleName: SymbolNameType
872 16CC );
873 16CC
874 16CC BEGIN (*LOGSGD*)
875 16CC IF OptionTable.LogFileKind <> none THEN
876 16F6 BEGIN
877 16FB IF LogFF(LogFile, 1) THEN
878 1710 LogHSsgd(LogFile);
879 171F WITH LogFile DO
880 1730 BEGIN
881 1735 L := L + 1;
882 1753 write(F, ' ':LogMargin, SegmentNo:3
883 177D , ' ':2, StartAddress:9
884 1792 , ' ':2, Size:9
885 17A7 , ' ':2
886 17B0 );
887 17B9 WriteSymbolName(F, ModuleName, 20);
888 17D3 writeln(F);
889 17EC END;
890 17EC END
891 17EC END; (*LOGSGD*)
892 17F2
893 17F2 PROCEDURE LogHSxp(VAR LogFile: LogFileType
894 17F2 );
895 17F2
896 17F2 BEGIN (*LOGHSXP*)
897 17F2 IF OptionTable.LogFileKind <> none THEN
898 1807 WITH LogFile DO
899 1818 BEGIN
900 181D L := L + 2;
901 183E writeln(F, ' ':LogMargin, 'SGM'
902 1863 , ' ':2, 'VÆRDI':9
903 1882 , ' ':2, 'SYMBOL', ' ':14
904 18A7 , ' ':2, 'MODUL'
905 18BE );
906 18CB writeln(F);
907 18E4 END
908 18E4 END; (*LOGHSXP*)
909 18EA
910 18EA PROCEDURE LogHxpN(VAR LogFile: LogFileType
911 18EA );
912 18EA
913 18EA BEGIN (*LOGHXPN*)
914 18EA IF OptionTable.LogFileKind <> none THEN
915 18FF BEGIN
916 1904 IF LogFF(LogFile, 6) THEN BEGIN END;
917 1919 WITH LogFile DO
918 192A BEGIN
919 192F L := L + 3;
920 1950 writeln(F);
921 1969 writeln(F, ' ':LogMargin, 'EXPORTEREDE SYMBOLER (NAVNEORDEN):');
922 19BA writeln(F);
923 19D3 END;
924 19D3 LogHSxp(LogFile);
925 19E2 END
926 19E2 END; (*LOGHXPN*)
927 19E8
928 19E8 PROCEDURE LogHxpV(VAR LogFile: LogFileType
929 19E8 );
930 19E8
931 19E8 BEGIN (*LOGHXPV*)
932 19E8 IF OptionTable.LogFileKind <> none THEN
933 19FD BEGIN
934 1A02 IF LogFF(LogFile, 6) THEN BEGIN END;
935 1A17 WITH LogFile DO
936 1A28 BEGIN
937 1A2D L := L + 3;
938 1A4E writeln(F);
939 1A67 writeln(F, ' ':LogMargin, 'EXPORTEREDE SYMBOLER (VÆRDIORDEN):');
940 1AB8 writeln(F);
941 1AD1 END;
942 1AD1 LogHSxp(LogFile);
943 1AE0 END
944 1AE0 END; (*LOGHXPV*)
945 1AE6
946 1AE6 PROCEDURE LogXP(VAR LogFile: LogFileType
947 1AE6 ; SegmentNo: RelocationIndicatorType
948 1AE6 ; Value: i32
949 1AE6 ; SymbolName: SymbolNameType
950 1AE6 ; ModuleName: ModuleNameType
951 1AE6 );
952 1AE6
953 1AE6 BEGIN (*LOGXP*)
954 1AE6 IF OptionTable.LogFileKind <> none THEN
955 1B25 BEGIN
956 1B2A IF LogFF(LogFile,1) THEN
957 1B3F LogHSxp(LogFile);
958 1B4E WITH LogFile DO
959 1B5F BEGIN
960 1B64 L := L + 1;
961 1B82 write(F, ' ':LogMargin, SegmentNo:3
962 1BAC , ' ':2, Value:9
963 1BC1 , ' ':2
964 1BCA );
965 1BD3 WriteSymbolName(F, SymbolName, 20);
966 1BED write(F, ' ':2);
967 1C0F WriteSymbolName(F, ModuleName, 20);
968 1C29 writeln(F);
969 1C42 END
970 1C42 END
971 1C42 END; (*LOGXP*)
972 1C48
973 1C48 PROCEDURE LogHSurs(VAR LogFile: LogFileType
974 1C48 );
975 1C48
976 1C48 BEGIN (*LOGHSURS*)
977 1C48 IF OptionTable.LogFileKind <> none THEN
978 1C5D BEGIN
979 1C62 WITH LogFile DO
980 1C73 BEGIN
981 1C78 L := L + 2;
982 1C99 writeln(F, ' ':LogMargin
983 1CB2 , ' ':16, 'SYMBOL', ' ':14
984 1CD7 , ' ':2, 'MODUL');
985 1CFB writeln(F);
986 1D14 END
987 1D14 END
988 1D14 END; (*LOGHSURS*)
989 1D1A
990 1D1A PROCEDURE LogHurs(VAR LogFile: LogFileType
991 1D1A );
992 1D1A
993 1D1A BEGIN (*LOGHURS*)
994 1D1A IF OptionTable.LogFileKind <> none THEN
995 1D2F BEGIN
996 1D34 IF LogFF(LogFile, 6)THEN BEGIN END;
997 1D49 WITH LogFile DO
998 1D5A BEGIN
999 1D5F L := L + 3;
1000 1D80 writeln(F);
1001 1D99 writeln(F, ' ':LogMargin, 'UTILFREDSSTILLEDE REFERENCER:');
1002 1DE5 writeln(F);
1003 1DFE END;
1004 1DFE LogHSurs(LogFile);
1005 1E0D END
1006 1E0D END; (*LOGHURS*)
1007 1E13
1008 1E13 PROCEDURE LogURS(VAR LogFile: LogFileType
1009 1E13 ; ModuleName: ModuleNameType
1010 1E13 ; SymbolName: SymbolNameType
1011 1E13 );
1012 1E13
1013 1E13 BEGIN (*LOGURS*)
1014 1E13 IF OptionTable.LogFileKind <> none THEN
1015 1E52 BEGIN
1016 1E57 IF LogFF(LogFile, 1) THEN
1017 1E6C LogHSurs(LogFile);
1018 1E7B WITH LogFile DO
1019 1E8C BEGIN
1020 1E91 L := L + 1;
1021 1EAF write(F, ' ':LogMargin
1022 1EC8 , ' ':16
1023 1ED1 );
1024 1EDA WriteSymbolName(F, SymbolName, 20);
1025 1EF4 write(F, ' ':2);
1026 1F16 WriteSymbolName(F, ModuleName, 20);
1027 1F30 writeln(F);
1028 1F49 END
1029 1F49 END
1030 1F49 END; (*LOGURS*)
1031 1F4F
1032 1F4F PROCEDURE LogHSdds(VAR LogFile: LogFileType
1033 1F4F );
1034 1F4F
1035 1F4F BEGIN (*LOGHSDDS*)
1036 1F4F IF OptionTable.LogFileKind <> none THEN
1037 1F64 WITH LogFile DO
1038 1F75 BEGIN
1039 1F7A L := L + 2;
1040 1F9B writeln(F, ' ':LogMargin, 'SGM'
1041 1FC0 , ' ':2, 'VÆRDI':9
1042 1FDF , ' ':2, 'SYMBOL', ' ':14
1043 2004 , ' ':2, 'MODUL'
1044 201B );
1045 2028 writeln(F);
1046 2041 END;
1047 2041 END; (*LOGHSDDS*)
1048 2047
1049 2047 PROCEDURE LogHdds(VAR LogFile: LogFileType
1050 2047 );
1051 2047
1052 2047 BEGIN (*LOGHDDS*)
1053 2047 IF OptionTable.LogFileKind <> none THEN
1054 205C BEGIN
1055 2061 IF LogFF(LogFile, 6) THEN BEGIN END;
1056 2076 WITH LogFile DO
1057 2087 BEGIN
1058 208C L := L + 2;
1059 20AD writeln(F);
1060 20C6 writeln(F, ' ':LogMargin, 'DOBBELTDEFINEREDE SYMBOLER:');
1061 2110 writeln(F);
1062 2129 END;
1063 2129 LogHSdds(LogFile);
1064 2138 END
1065 2138 END; (*LOGHDDS*)
1066 213E
1067 213E PROCEDURE LogDDS(VAR LogFile: LogFileType
1068 213E ; RelocationIndicator: RelocationIndicatorType
1069 213E ; Value: i32
1070 213E ; SymbolName: SymbolNameType
1071 213E ; ModuleName: ModuleNameType
1072 213E );
1073 213E
1074 213E BEGIN (*LOGDDS*)
1075 213E IF OptionTable.LogFileKind <> none THEN
1076 217D BEGIN
1077 2182 IF LogFF(LogFile, 1) THEN
1078 2197 LogHSdds(LogFile);
1079 21A6 WITH LogFile DO
1080 21B7 BEGIN
1081 21BC L := L + 1;
1082 21DA write(F, ' ':LogMargin, ord(RelocationIndicator):3
1083 2204 , ' ':2, Value:9
1084 2219 , ' ':2
1085 2222 );
1086 222B WriteSymbolName(F, SymbolName, 20);
1087 2245 write(F, ' ':2);
1088 2267 WriteSymbolName(F, ModuleName, 20);
1089 2281 writeln(F);
1090 229A END
1091 229A END
1092 229A END; (*LOGDDS*)
1093 22A0
1094 22A0 PROCEDURE LogOFFerror(VAR LogFile: LogFileType
1095 22A0 ; FileNo: FileNameTableIndexType
1096 22A0 );
1097 22A0
1098 22A0 BEGIN (*LOGOFFERROR*)
1099 22A0 IF OptionTable.LogFileKind <> none THEN
1100 22B5 BEGIN
1101 22BA IF LogFF(LogFile, 2) THEN BEGIN END;
1102 22CF WITH LogFile DO
1103 22E0 BEGIN
1104 22E5 L := L + 2;
1105 2306 writeln(F, ' ':LogMargin, '*** FILFORMATFEJL *** FIL # ', FileNo:1
1106 2359 , ' ***'
1107 2366 );
1108 2373 END;
1109 2373 END
1110 2373 END; (*LOGOFFERROR*)
1111 2379
1112 2379
1113 2379 PROCEDURE LogOMFerror(VAR LogFile: LogFileType
1114 2379 ; FileNo: FileNameTableIndexType
1115 2379 ; Position: FileAddressType
1116 2379 );
1117 2379
1118 2379 BEGIN (*LOGOMFERROR*)
1119 2379 IF OptionTable.LogFileKind <> none THEN
1120 238E BEGIN
1121 2393 IF LogFF(LogFile, 2) THEN BEGIN END;
1122 23A8 WITH LogFile DO
1123 23B9 BEGIN
1124 23BE L := L + 2;
1125 23DF writeln(F, ' ':LogMargin, '*** MODULFORMATFEJL *** FIL # ', FileNo:1
1126 2434 , ' *** POSITION # ', Position:1
1127 245D , ' ***'
1128 246A );
1129 2477 END;
1130 2477 END
1131 2477 END; (*LOGOMFERROR*)
1132 247D
1133 247D PROCEDURE LogEOFerror(VAR LogFile: LogFileType
1134 247D ; FileNo: FileNameTableIndexType
1135 247D ; Position: FileAddressType
1136 247D );
1137 247D
1138 247D BEGIN (*LOGEOFERROR*)
1139 247D IF OptionTable.LogFileKind <> none THEN
1140 2492 BEGIN
1141 2497 IF LogFF(LogFile, 2) THEN BEGIN END;
1142 24AC WITH LogFile DO
1143 24BD BEGIN
1144 24C2 L := L + 2;
1145 24E3 writeln(F, ' ':LogMargin, '*** FILLÆNGDEFEJL *** FIL # ', FileNo:1
1146 2536 , ' *** POSITION # ', Position:1
1147 255F , ' ***'
1148 256C );
1149 2579 END;
1150 2579 END
1151 2579 END; (*LOGEOFERROR*)
1152 257F
1153 257F (* *)
1154 257F (* *)
1155 257F (******************************************************************************)
1156 257F
1157 257F
1158 257F (*$I B:LnkDF8.pas Object File access primitives *)
1159 257F (******************************************************************************)
1160 257F (* *)
1161 257F (* Copyright (1985) by Metanic Aps., Denmark *)
1162 257F (* *)
1163 257F (* Author: Lars Gregers Jakobsen. *)
1164 257F (* *)
1165 257F (******************************************************************************)
1166 257F
1167 257F PROCEDURE FilAsg(VAR Fl: FileType
1168 257F ;Fn: FileNameType
1169 257F );
1170 257F
1171 257F BEGIN (*FILASG*)
1172 257F (*#B#*)
1173 257F IF test((.0,1.)) THEN
1174 259D writeln(TestOut, 'FILasg FlNm=', Fn);
1175 25DA (*#E#*)
1176 25DA assign(Fl.F, Fn)
1177 25F7 END; (*FILASG*)
1178 25FD
1179 25FD PROCEDURE FilRst(VAR Status: StatusType
1180 25FD ;VAR Fl: FileType
1181 25FD );
1182 25FD
1183 25FD BEGIN (*FILRST*)
1184 25FD WITH Fl DO
1185 2616 BEGIN
1186 261B P := 0;
1187 262C reset(F);
1188 263F IF eof(F) THEN
1189 2655 Status := Status + (.UnExpectedEof.);
1190 267B (*#B#*)
1191 267B IF test((.0,1.)) THEN
1192 2691 BEGIN
1193 2696 write(TestOut, 'FILrst'); TSTstat(Status); TSTln;
1194 26D2 END;
1195 26D2 (*#E#*)
1196 26D2 END
1197 26D2 END; (*FILRST*)
1198 26D8
1199 26D8 PROCEDURE FilRwt(VAR Fl: FileType
1200 26D8 );
1201 26D8
1202 26D8 BEGIN (*FILRWT*)
1203 26D8 (*#B#*)
1204 26D8 IF test((.0,1.)) THEN
1205 26F6 writeln(TestOut, 'FILrwt');
1206 271B (*#E#*)
1207 271B WITH Fl DO
1208 272C BEGIN
1209 2731 rewrite(F);
1210 273E P := 0;
1211 2755 END
1212 2755 END; (*FILRWT*)
1213 275B
1214 275B PROCEDURE FilCls(VAR Fl: FileType
1215 275B );
1216 275B
1217 275B BEGIN (*FILCLS*)
1218 275B close(Fl.F);
1219 2776 END; (*FILCLS*)
1220 277C
1221 277C PROCEDURE FilSeek(VAR Status: StatusType
1222 277C ;VAR Fl: FileType
1223 277C ; Position: FileAddressType
1224 277C );
1225 277C
1226 277C BEGIN (*FILSEEK*)
1227 277C WITH Fl DO
1228 2795 BEGIN
1229 279A P := Position;
1230 27AC seek(F, Position);
1231 27C5 IF eof(F) THEN
1232 27DB Status := Status + (.UnExpectedEof.);
1233 2801 (*#B#*)
1234 2801 IF test((.0,1,2.)) THEN
1235 2818 BEGIN
1236 281D write(TestOut, 'FILSEEK '); TSTstat(Status); TSTindt;
1237 285C write(TestOut, 'P=', P:1
1238 2887 , ' EOF='); TSTbool(eof(F));
1239 28BD TSTln;
1240 28C5 END;
1241 28C5 (*#E#*)
1242 28C5 END
1243 28C5 END; (*FILSEEK*)
1244 28CB
1245 28CB PROCEDURE FGi8(VAR Status: StatusType
1246 28CB ;VAR Fl: FileType
1247 28CB ;VAR V: i8
1248 28CB );
1249 28CB
1250 28CB BEGIN (*FGI8*)
1251 28CB WITH Fl DO
1252 28E4 BEGIN
1253 28E9 IF not eof(F) THEN
1254 28FB BEGIN
1255 2900 read(F,V);
1256 2929 P := P + 1;
1257 294B END
1258 294B ELSE
1259 294D BEGIN
1260 2952 Status := Status + (.UnexpectedEof.);
1261 2978 V := 0
1262 2983 END;
1263 2985 (*#B#*)
1264 2985 IF test((.0,2.)) THEN
1265 299C BEGIN
1266 29A1 write(TestOut, 'FGI8 '); TSTstat(Status); TSTindt;
1267 29E0 write(TestOut, 'P=', P:1,' V=', V:1, ' EOF='); TSTbool(eof(F));
1268 2A5E TSTln;
1269 2A66 END;
1270 2A66 (*#E#*)
1271 2A66 END;
1272 2A66 END; (*FGI8*)
1273 2A6C
1274 2A6C PROCEDURE FGi32(VAR Status: StatusType
1275 2A6C ;VAR Fl: FileType
1276 2A6C ;VAR V: i32
1277 2A6C );
1278 2A6C
1279 2A6C VAR
1280 2A6C I: I32IndexType;
1281 2A6C N: I32ArrayType;
1282 2A6C
1283 2A6C BEGIN (*FGI32*)
1284 2A6C WITH Fl DO
1285 2A85 BEGIN
1286 2A8A P := P + 4;
1287 2AAE FOR I := bs3 DOWNTO bs0 DO
1288 2ABF IF not eof(f) THEN
1289 2AD8 read(F, N(.I.) )
1290 2B09 ELSE
1291 2B0F BEGIN
1292 2B14 Status := Status + (.UnexpectedEof.);
1293 2B3A N(.I.) := 0
1294 2B50 END;
1295 2B5C move(N, V, 4);
1296 2B75 (*#B#*)
1297 2B75 IF test((.0,2.)) THEN
1298 2B8C BEGIN
1299 2B91 write(TestOut, 'FGI32 '); TSTstat(Status); TSTindt;
1300 2BD0 write(TestOut, 'P=', P:1,' V=', V:1,
1301 2C22 ' N=(',N(.bs3.):3,'/',N(.bs2.):3
1302 2C54 ,'/',N(.bs1.):3,'/',N(.bs0.):3,') EOF=');
1303 2CA0 TSTbool(eof(F)); TSTln;
1304 2CBD END;
1305 2CBD (*#E#*)
1306 2CBD END;
1307 2CBD END; (*FGI32*)
1308 2CC3
1309 2CC3 PROCEDURE FGSym(VAR Status: StatusType
1310 2CC3 ;VAR Fl: FileType
1311 2CC3 ;VAR SymbolName: SymbolNameType
1312 2CC3 );
1313 2CC3
1314 2CC3 VAR
1315 2CC3 I: i8;
1316 2CC3 N: i8;
1317 2CC3
1318 2CC3 BEGIN (*FGSYM*)
1319 2CC3 WITH Fl, SymbolName DO
1320 2CE8 BEGIN
1321 2CED (*#B#*)
1322 2CED IF test((.0,2.)) THEN
1323 2D04 BEGIN
1324 2D09 write(TestOut, 'FGSYM-1 '); TSTstat(Status); TSTindt;
1325 2D48 write(TestOut, 'P=', P:1, ' F^=',F^:3, ' EOF=');
1326 2DBC TSTbool(eof(F)); TSTln
1327 2DD6 END;
1328 2DD9 (*#E#*)
1329 2DD9 IF not eof(F) THEN
1330 2DF2 BEGIN
1331 2DF7 read(F, N);
1332 2E1A P := P + 1 + N;
1333 2E49 IF (0 < N) and (N <= MaxSymbolNameIndex) THEN
1334 2E67 BEGIN
1335 2E6C Length := N;
1336 2E84 FOR I := 1 TO N DO
1337 2E9B IF not eof(F) THEN
1338 2EB4 read(F, Name(.I.) )
1339 2EED ELSE
1340 2EF3 Status := Status + (.UnexpectedEof.)
1341 2F09 END
1342 2F23 ELSE
1343 2F26 BEGIN
1344 2F2B Status := Status + (.BadSymbolName.);
1345 2F51 FOR I := 1 TO N DO
1346 2F67 IF not eof(F) THEN
1347 2F80 read(F, Name(.1.) )
1348 2FA7 ELSE
1349 2FAD Status := Status + (.UnexpectedEof.)
1350 2FC3 END
1351 2FDD END
1352 2FDD ELSE
1353 2FDF Status := Status + (.UnexpectedEof.);
1354 3005 (*#B#*)
1355 3005 IF test((.0,2.)) THEN
1356 301B BEGIN
1357 3020 write(TestOut, 'FGSYM-2 '); TSTstat(Status); TSTindt;
1358 305F TSTsymbol(SymbolName);
1359 306E END;
1360 306E (*#E#*)
1361 306E END
1362 306E END; (*FGSYM*)
1363 3074
1364 3074 PROCEDURE FPi8(VAR Fl: FileType
1365 3074 ; V: i8
1366 3074 );
1367 3074
1368 3074 BEGIN (*FPI8*)
1369 3074 WITH Fl DO
1370 308D BEGIN
1371 3092 (*#B#*)
1372 3092 IF test((.0,3.)) THEN
1373 30A8 BEGIN
1374 30AD writeln(TestOut, 'FPI8 ', 'P=', P:1,' V=', V:1);
1375 3116 END;
1376 3116 (*#E#*)
1377 3116 write(F,V);
1378 313B P := P + 1
1379 3154 END
1380 315D END; (*FPI8*)
1381 3163
1382 3163 PROCEDURE FPi32(VAR Fl: FileType
1383 3163 ; V: i32
1384 3163 );
1385 3163
1386 3163 VAR
1387 3163 I: I32IndexType;
1388 3163 N: I32ArrayType;
1389 3163
1390 3163 BEGIN (*FPI32*)
1391 3163 move(V, N, 4);
1392 3185 WITH Fl DO
1393 3196 BEGIN
1394 319B (*#B#*)
1395 319B IF test((.0,3.)) THEN
1396 31B2 BEGIN
1397 31B7 writeln(TestOut, 'FPI32 ', 'P=', P:1,' V=', V:1,
1398 321A ' N=(',N(.bs3.):3,'/',N(.bs2.):3
1399 324C ,'/',N(.bs1.):3,'/',N(.bs0.):3,')');
1400 328E END;
1401 328E (*#E#*)
1402 328E P := P + 4;
1403 32B8 FOR I := bs3 DOWNTO bs0 DO
1404 32C9 write(F, N(.I.) )
1405 32FA END
1406 3307 END; (*FPI32*)
1407 330D
1408 330D PROCEDURE FPSym(VAR Fl: FileType
1409 330D ; SymbolName: SymbolNameType
1410 330D );
1411 330D
1412 330D VAR
1413 330D I: SymbolNameIndexType;
1414 330D
1415 330D BEGIN (*FPSYM*)
1416 330D WITH Fl, SymbolName DO
1417 333B BEGIN
1418 3340 (*#B#*)
1419 3340 IF test((.0,3.)) THEN
1420 3357 BEGIN
1421 335C write(TestOut, 'FPSYM-2 '); TSTstat(Status); TSTindt;
1422 3399 write(TestOut, 'P=', P:1); TSTindt; TSTsymbol(SymbolName);
1423 33DB END;
1424 33DB (*#E#*)
1425 33DB P := P + 1 + Length;
1426 340B write(F, Length);
1427 3434 FOR I := 1 TO Length DO
1428 344D write(F, Name(.I.) )
1429 347F END
1430 348C END; (*FPSYM*)
1431 3492
1432 3492 (* *)
1433 3492 (* *)
1434 3492 (******************************************************************************)
1435 3492
1436 3492 (*$I B:lnkp0.pas Procedure setup *)
1437 3492 (******************************************************************************)
1438 3492 (* *)
1439 3492 (* Copyright (1985) by Metanic Aps., Denmark *)
1440 3492 (* *)
1441 3492 (* Author: Lars Gregers Jakobsen. *)
1442 3492 (* *)
1443 3492 (******************************************************************************)
1444 3492
1445 3492
1446 3492 PROCEDURE SetUp(VAR Status: StatusType
1447 3492 ;VAR TargetFile: FileType
1448 3492 ;VAR LogFile: LogFileType
1449 3492 ;VAR Out_file: text
1450 3492 );
1451 3492
1452 3492 CONST
1453 3492 InputFileNameSuffix = 'OBJ';
1454 3495 TargetFileNameSuffix = 'OUT';
1455 3498 LogFileNameSuffix = 'MAP';
1456 349B
1457 349B VAR
1458 349B CommandLine: CommandLineType;
1459 349B Current: CommandLineIndexType;
1460 349B FileName: FileNameType;
1461 349B
1462 349B PROCEDURE SkipBlanks;
1463 349B
1464 349B BEGIN (*SKIPBLANKS*)
1465 349B WHILE (CommandLine(.Current.) = ' ') and
1466 34C4 (Current < length(CommandLine)) DO
1467 34E9 Current := Current + 1;
1468 3509 END; (*SKIPBLANKS*)
1469 350F
1470 350F PROCEDURE DecodeFileName(VAR Status: StatusType
1471 350F ;VAR FileName: FileNameType
1472 350F ; Suffix: FileNameType
1473 350F ; Terminators: CharSetType
1474 350F );
1475 350F
1476 350F VAR
1477 350F I: CommandLineIndexType;
1478 350F
1479 350F BEGIN (*DECODEFILENAME*)
1480 350F I := 0;
1481 3520 WHILE (Current + I < length(CommandLine) ) and
1482 354A not ( CommandLine(.Current + I.) in Terminators ) DO
1483 358B I := I + 1;
1484 35A3 IF (0 < I) and (I <= FileNameLength) THEN
1485 35C6 BEGIN
1486 35CB FileName := Copy(CommandLine, Current, I);
1487 35F9 Current := Current + I;
1488 361E IF (pos('.', FileName) = 0) THEN
1489 3639 IF (length(FileName) <= FileNameLength - 4) THEN
1490 364C FileName := concat(FileName, '.', Suffix)
1491 3675 ELSE
1492 3680 Status := Status + (.BadFileName.)
1493 3696 END
1494 36A4 ELSE
1495 36A6 Status := Status + (.BadFileName.);
1496 36CA (*#B#*)
1497 36CA IF test((.0,16,18.)) THEN
1498 36E4 BEGIN
1499 36E9 write(TestOut, 'DecodeFileName '); TSTstat(Status);
1500 372D TSTindt; write(TestOut, 'Curr=', Current:1);
1501 3769 TSTindt; write(TestOut, 'I=', I:1);
1502 379E TSTindt; writeln(TestOut, 'FileName=', FileName)
1503 37D5 END
1504 37D8 (*#E#*)
1505 37D8 END; (*DECODEFILENAME*)
1506 37DE
1507 37DE
1508 37DE BEGIN (*SETUP*)
1509 37DE Getcomm(CommandLine);
1510 37F9 CommandLine := concat(CommandLine, ' ');
1511 381B Current := 1;
1512 3824 Status := (..);
1513 383B SkipBlanks; (*Leaving current pointing at next non blank*)
1514 3847 (*Interpret option list*)
1515 3847 (*#B#*)
1516 3847 IF test((.0,16,18.)) THEN
1517 3861 BEGIN
1518 3866 write(TestOut, 'Setup-1 '); write(TestOut, 'Curr=', Current:1);
1519 38BF TSTindt; write(TestOut, 'Lng(ComLin)=', Length(CommandLine):1);
1520 38FC TSTindt; TSTmem; TSTln;
1521 390A TSTindt; writeln(TestOut, 'ComLin=', CommandLine)
1522 3940 END;
1523 3943 (*#E#*)
1524 3943 WHILE (Current < length(CommandLine)) and
1525 3958 (CommandLine(.Current.) = '/') and
1526 397A (Status = (..)) DO
1527 3996 BEGIN
1528 399B Current := Current + 1;
1529 39B1 CASE CommandLine(.Current.) OF
1530 39CC 'M','m':
1531 39CC BEGIN
1532 39D1 Current := Current + 1;
1533 39E7 IF CommandLine(.Current.) = '=' THEN
1534 3A03 BEGIN
1535 3A08 Current := Current + 1;
1536 3A1E DecodeFileName(Status, FileNametable(.-1.)
1537 3A2A , LogFileNameSuffix, (.' ', '/', ','.) );
1538 3A52 IF Status = (..) THEN
1539 3A6A OptionTable.LogFileKind := Explicit
1540 3A6F END
1541 3A74 ELSE
1542 3A76 OptionTable.LogFileKind := Implicit
1543 3A7B END;
1544 3A83 'O','o':
1545 3A83 BEGIN
1546 3A88 Current := Current + 1;
1547 3A9E IF CommandLine(.Current.) = '=' THEN
1548 3ABA BEGIN
1549 3ABF Current := Current + 1;
1550 3AD5 DecodeFileName(Status, FileNameTable(.0.)
1551 3AE1 , TargetFileNameSuffix, (.' ', '/', ','.) );
1552 3B09 IF Status = (..) THEN
1553 3B21 OptionTable.TargetFileKind := Explicit
1554 3B26 END
1555 3B2B ELSE
1556 3B2D OptionTable.TargetFileKind := Implicit
1557 3B32 END;
1558 3B39 OTHERWISE
1559 3B39 Status := Status + (.BadOption.)
1560 3B4F END; (*CASE*)
1561 3B72 (*#B#*)
1562 3B72 IF test((.0,16,18.)) THEN
1563 3B8C BEGIN
1564 3B91 write(TestOut, 'Setup-2 '); TSTstat(Status);
1565 3BCE TSTindt; writeln(TestOut, 'Curr=', Current:1);
1566 3C06 TSTindt; TSTopt;
1567 3C11 TSTindt; TSTfnt(-1);
1568 3C1F TSTindt; TSTfnt(0)
1569 3C2A END;
1570 3C2D (*#E#*)
1571 3C2D END; (*WHILE*)
1572 3C30 IF Status = (..) THEN (*Interpret file list*)
1573 3C49 BEGIN
1574 3C4E SkipBlanks;
1575 3C5A IF Current < length(CommandLine) THEN
1576 3C72 Status := Status + (.NotFinished.);
1577 3C9A WHILE (Current < length(CommandLine)) and
1578 3CAF (NotFinished IN Status) DO
1579 3CD0 BEGIN
1580 3CD5 DecodeFileName(Status, FileName
1581 3CE1 , InputFileNameSuffix, (.' ', ','.) );
1582 3D0D IF not (BadFileName IN Status) THEN
1583 3D28 BEGIN
1584 3D2D (*#B#*)
1585 3D2D IF test((.0,16,18.)) THEN
1586 3D47 BEGIN
1587 3D4C write(TestOut, 'Setup-3 '); TSTstat(Status); TSTindt;
1588 3D8C write(TestOut, 'fstat(FileName)=');
1589 3DBB TSTbool(fstat(FileName)); TSTln;
1590 3DD7 END;
1591 3DD7 (*#E#*)
1592 3DD7 IF fstat(FileName) THEN
1593 3DEC FNTP(Status, FileName)
1594 3E07 ELSE
1595 3E0C Status := Status + (.NoSuchFile.);
1596 3E30 END;
1597 3E30 IF NotFinished IN Status THEN
1598 3E4A CASE CommandLine(.Current.) OF
1599 3E68 ' ':
1600 3E68 Status := Status - (.NotFinished.);
1601 3E92 ',':
1602 3E92 BEGIN
1603 3E97 Current := Current + 1 (*Skip the comma*)
1604 3E9C END
1605 3EAD END (*CASE CommandLine(.Current.) OF*)
1606 3EBC END (* WHILE *** DO *)
1607 3EBC END; (* IF Status = (..) -- End interpret file list *)
1608 3EBF IF CurFileNo <= 0 THEN
1609 3ED0 Status := Status + (.NoInputFiles.);
1610 3EF4 IF Current < length(CommandLine) THEN
1611 3F0C Status := Status + (.ExtraText.);
1612 3F30 IF Status = (..) THEN
1613 3F49 BEGIN
1614 3F4E FileName := copy(FileNameTable(.1.), 1, pos('.',FileNameTable(.1.)) );
1615 3F7A IF OptionTable.LogFileKind = Implicit THEN
1616 3F86 FileNameTable(.-1.) := concat(FileName, LogFileNameSuffix);
1617 3FA7 IF OptionTable.TargetFileKind = Implicit THEN
1618 3FB3 FileNameTable(. 0.) := concat(FileName, TargetFileNameSuffix);
1619 3FD4
1620 3FD4 IF (OptionTable.LogFileKind <> none) and
1621 3FDE ( (not checkfn(FileNameTable(.-1.) ) ) or
1622 3FED (fstat(FileNameTable(.-1.) ) )
1623 3FF7 ) THEN
1624 4000 Status := Status + (.badlogfilename.);
1625 4024 IF (not checkfn(FileNameTable(.0.) ) ) or
1626 4034 (fstat(FileNameTable(.0.) ) ) THEN
1627 4044 Status := Status + (.badtargetfilename.);
1628 4068
1629 4068 (*#B#*)
1630 4068 IF test((.0,16,18.)) THEN
1631 4081 BEGIN
1632 4086 write(TestOut, 'Setup-4 '); TSTstat(Status); TSTln;
1633 40C6 TSTindt; TSTopt;
1634 40D1 TSTindt; TSTfnt(-1);
1635 40DF TSTindt; TSTfnt(0);
1636 40ED TSTindt; TSTfnt(1)
1637 40F8 END;
1638 40FB (*#E#*)
1639 40FB
1640 40FB IF Status = (..) THEN
1641 4113 BEGIN
1642 4118 IF OptionTable.LogFileKind <> None THEN
1643 4124 BEGIN
1644 4129 LogInit(LogFile, FileNameTable(.-1.) );
1645 4143 LogCmd(LogFile, CommandLine);
1646 4161 END;
1647 4161 FilAsg(TargetFile, FileNameTable(.0.) );
1648 417B FilRwt(TargetFile);
1649 418A END
1650 418A ELSE
1651 418C Status := Status + (.NoTarget.);
1652 41B4 END
1653 41B4 ELSE
1654 41B6 BEGIN
1655 41BB Status := Status + (.Notarget.);
1656 41E3 writeln(out_file, CommandLine);
1657 420C writeln(out_file, '^':Current);
1658 422F END
1659 422F END; (*SETUP*)
1660 4235
1661 4235 (* *)
1662 4235 (* *)
1663 4235 (******************************************************************************)
1664 4235
1665 4235 (*$I B:lnkp1.pas Procedure pass1 *)
1666 4235 (******************************************************************************)
1667 4235 (* *)
1668 4235 (* Copyright (1985) by Metanic Aps., Denmark *)
1669 4235 (* *)
1670 4235 (* Author: Lars Gregers Jakobsen. *)
1671 4235 (* *)
1672 4235 (******************************************************************************)
1673 4235
1674 4235 PROCEDURE Pass1(VAR Status: StatusType
1675 4235 ;VAR TargetFile: FileType
1676 4235 ;VAR LogFile: LogFileType
1677 4235 );
1678 4235
1679 4235 (* Pass1 of the linker performs the gathering of export and
1680 4235 import information from the input files as well as calculation
1681 4235 of final memory map and all operations on the symbol table
1682 4235 including reporting to the log file.
1683 4235 The following statusvalues may be returned:
1684 4235 Success: ok. All other parameters meaningful.
1685 4235
1686 4235 *)
1687 4235
1688 4235
1689 4235 VAR
1690 4235 SymbolTable: SymbolTableType;
1691 4235 LatestInsert: SymbolTableIndexType; (*Points to SBT entry of latest insert*)
1692 4235 CurrentSymbolCount: SymbolTableIndexType; (*Number of SBT entries currently used*)
1693 4235
1694 4235 NameTable: NameTableType;
1695 4235 CurrentNameTableIndex: NameTableIndexType; (*Least index vacant -
1696 4235 NOT count of strings*)
1697 4235
1698 4235
1699 4235 (* MISC. VARIABLES *)
1700 4235
1701 4235 SBTSubInx: SymbolTableSubIndexType;
1702 4235
1703 4235 (*#B#*)
1704 4235 (*$I B:LnkDF3.pas Definitions of pass1 local test output primitives *)
1705 4235 (******************************************************************************)
1706 4235 (* *)
1707 4235 (* Copyright (1985) by Metanic Aps., Denmark *)
1708 4235 (* *)
1709 4235 (* Author: Lars Gregers Jakobsen. *)
1710 4235 (* *)
1711 4235 (******************************************************************************)
1712 4235
1713 4235 PROCEDURE TSTnmt(Inx: NameTableIndexType
1714 4235 );
1715 4235
1716 4235 VAR
1717 4235 i : 0..9;
1718 4235
1719 4235 BEGIN (*TSTnmt*)
1720 4235 write(TestOut, 'NMTÆ', inx:1
1721 426B , ';../', CurrentNameTableIndex:1,'Å=(' );
1722 42AD FOR i := 0 TO 7 DO
1723 42BE IF (Inx + i) IN (.1..MaxNameTableIndex.) THEN
1724 430F TSTasc( NameTable(. Inx+i .) )
1725 433E ELSE
1726 4344 write(TestOut, '-');
1727 4369 write(TestOut, '/');
1728 4384 IF Inx IN (.1..MaxNameTableIndex.) THEN
1729 43BF TSThex( NameTable(. Inx .) )
1730 43D7 ELSE
1731 43DC write(TestOut, '--');
1732 43FD FOR i := 1 TO 7 DO
1733 440E BEGIN
1734 4413 write(TestOut, '-');
1735 442E IF (Inx + i) IN (.1..MaxNameTableIndex.) THEN
1736 447F TSThex( NameTable(. Inx+i .) )
1737 44AE ELSE
1738 44B4 write(TestOut, '--');
1739 44D5 END;
1740 44DF writeln(TestOut, ')' )
1741 44F7 END; (*TSTnmt*)
1742 4500
1743 4500 PROCEDURE TSTsbt(Inx: SymbolTableIndexType
1744 4500 );
1745 4500
1746 4500 BEGIN (*TSTsbt*)
1747 4500 WITH SymbolTable(.Inx.) DO
1748 4527 BEGIN
1749 452C write(TestOut, 'SBTÆ', Inx:1
1750 4557 , '/', LatestInsert:1
1751 457A , '/', CurrentSymbolCount:1
1752 459D , 'Å=(Module#=', ModuleNo:1, ' '
1753 45D0 , 'NameRef=', NameReference:1, ' '
1754 4607 , 'SortLink=', SortLink:1, ')'
1755 463F );
1756 464B END
1757 464B END; (*TSTsbt*)
1758 4651
1759 4651 (* *)
1760 4651 (* *)
1761 4651 (******************************************************************************)
1762 4651
1763 4651 (*$I B:LnkDF4.pas Definitions of pass1 local access primitives *)
1764 4651 (******************************************************************************)
1765 4651 (* *)
1766 4651 (* Copyright (1985) by Metanic Aps., Denmark *)
1767 4651 (* *)
1768 4651 (* Author: Lars Gregers Jakobsen. *)
1769 4651 (* *)
1770 4651 (******************************************************************************)
1771 4651
1772 4651
1773 4651 PROCEDURE NMTP(VAR Status: StatusType
1774 4651 ;VAR NameReference: NameTableIndexType
1775 4651 ; SymbolName: SymbolNameType
1776 4651 );
1777 4651
1778 4651 VAR
1779 4651 I: SymbolNameIndexType;
1780 4651
1781 4651 BEGIN (*NMTP*)
1782 4651 WITH SymbolName DO
1783 4673 BEGIN
1784 4678 IF CurrentNameTableIndex + Length + 1 > MaxNameTableIndex THEN
1785 46AC Status := Status + (.NameTableOverFlow.)
1786 46C2 ELSE
1787 46D6 BEGIN
1788 46DB Namereference := CurrentNameTableIndex + 1;
1789 4705 CurrentNameTableIndex := NameReference + Length;
1790 4738 NameTable(.NameReference.) := Length;
1791 475C FOR I := 1 TO Length DO
1792 4775 NameTable(.NameReference + I.) := Name(.I.);
1793 47C6 END;
1794 47C6 (*#B#*)
1795 47C6 IF test((.0,9.)) THEN
1796 47DF BEGIN
1797 47E4 write(TestOut, 'NMTP '); TSTstat(Status); TSTindt;
1798 4823 writeln(TestOut, 'Length=', Length:1);
1799 485A TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1800 487D END;
1801 487D (*#E#*)
1802 487D END
1803 487D END; (*NMTP*)
1804 4883
1805 4883 FUNCTION NMTfail( NameReference: NameTableIndexType
1806 4883 ; SymbolName: SymbolNameType
1807 4883 ): boolean;
1808 4883
1809 4883 (* NMTfail returns one of the following values:
1810 4883 FALSE: If the exact same symbolname was found in NMT - i.e.
1811 4883
1812 4883 NameReference <> 0 AND
1813 4883 NMT(.NameReference.) = SymbolName.Length AND
1814 4883 FOR i = 1 TO length:
1815 4883 NMT(.NameReference+i.) = SymbolName.Name(.i.)
1816 4883
1817 4883 OR If an empty entry was found in NMT - i.e.
1818 4883
1819 4883 NameReference = 0.
1820 4883
1821 4883
1822 4883 TRUE: In all other cases.
1823 4883 *)
1824 4883
1825 4883 LABEL
1826 4883 99;
1827 4883
1828 4883 VAR
1829 4883 I: SymbolNameIndexType;
1830 4883
1831 4883 BEGIN (*NMTFAIL*)
1832 4883 NMTfail := false;
1833 48A9 WITH SymbolName DO
1834 48AE BEGIN
1835 48B3 IF NameReference <> 0 THEN
1836 48C3 IF length <> NameTable(.NameReference.) THEN
1837 48DF NMTfail := true
1838 48E4 ELSE
1839 48EB BEGIN
1840 48F0 FOR I := 1 TO Length DO
1841 4909 IF Name(.I.) <> NameTable(.NameReference + I.) THEN
1842 4950 BEGIN
1843 4955 NMTfail := true;
1844 495E GOTO 99;
1845 4966 END;
1846 4970 99:; END;
1847 4970 (*#B#*)
1848 4970 IF test((.0,9.)) THEN
1849 4989 BEGIN
1850 498E writeln(TestOut, 'NMTfail ', 'NameRef=', NameReference:1);
1851 49DF TSTindt; TSTindt; TSTindt; TSTsymbol(SymbolName);
1852 49F8 TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1853 4A17 END;
1854 4A17 (*#E#*)
1855 4A17 END
1856 4A17 END; (*NMTFAIL*)
1857 4A20
1858 4A20 PROCEDURE NMTG( NameReference: NameTableIndexType
1859 4A20 ;VAR SymbolName: SymbolNameType
1860 4A20 );
1861 4A20
1862 4A20 VAR
1863 4A20 I: SymbolNameIndexType;
1864 4A20
1865 4A20 BEGIN (*NMTG*)
1866 4A20 WITH SymbolName DO
1867 4A39 BEGIN
1868 4A3E Length := NameTable(.NameReference.);
1869 4A5F FOR I := 1 TO Length DO
1870 4A7C Name(.I.) := NameTable(. NameReference + I .);
1871 4ACC (*#B#*)
1872 4ACC IF test((.0,9,13.)) THEN
1873 4AE4 BEGIN
1874 4AE9 write(TestOut, 'NMTG '); TSTindt;
1875 4B14 write(TestOut, 'NameRef=', NameReference:1); TSTindt;
1876 4B52 TSTsymbol(SymbolName);
1877 4B61 END;
1878 4B61 (*#E#*)
1879 4B61 END
1880 4B61 END; (*NMTG*)
1881 4B67
1882 4B67 PROCEDURE Hash(VAR SymbolName: SymbolNameType
1883 4B67 ;VAR SBTInx: SymbolTableIndexType
1884 4B67 );
1885 4B67
1886 4B67 BEGIN (*HASH*)
1887 4B67 SBTInx := 1
1888 4B7A END; (*HASH*)
1889 4B82
1890 4B82 PROCEDURE SBTS(VAR Status: StatusType
1891 4B82 ;VAR SBTInx: SymbolTableIndexType
1892 4B82 ; SymbolName: SymbolNameType
1893 4B82 );
1894 4B82
1895 4B82 (* SBTS returns one of the following Status codes:
1896 4B82 Success: SymbolName found in SBT. SBTInx reflects
1897 4B82 SymbolName.
1898 4B82 NotFound: SymbolName NOT found in SBT. SBTInx
1899 4B82 indicates the entry into which Symbol should be
1900 4B82 registered.
1901 4B82 SymbolTableOverFlow: SymbolName NOT found in SBT.
1902 4B82 SBTInx is not valid. There
1903 4B82 is no room in SBT for further updates.
1904 4B82
1905 4B82 Search SBT to find the Entry for SYMBOLNAME retaining the index
1906 4B82 of the first vacant record as SYMBOLTABLEENTRYNO if the search
1907 4B82 fails. Otherwise return found index. Set Status to Success or
1908 4B82 NotFound according to outcome. Set Status to SBTOverFlow if
1909 4B82 no vacant is available and symbol is not found.
1910 4B82
1911 4B82 A SBT record is vacant if Namereference = 0.
1912 4B82 *)
1913 4B82
1914 4B82
1915 4B82 BEGIN (*SBTS*)
1916 4B82 (* Assume existence of entry in SBT with NameReference = 0 *)
1917 4B82 Hash(SymbolName, SBTInx);
1918 4BB6 (*#B#*)
1919 4BB6 IF test((.0,9.)) THEN
1920 4BCE BEGIN
1921 4BD3 write(TestOut, 'SBTS-1 '); TSTstat(Status); TSTln;
1922 4C12 TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1923 4C35 END;
1924 4C35 (*#E#*)
1925 4C35 WHILE NMTfail(Symboltable(.SBTInx.).NameReference, SymbolName) DO
1926 4C6E BEGIN
1927 4C73 (* HASH NEXT TRY *)
1928 4C73 IF MaxNooSymbols <= SBTInx THEN
1929 4C8A SBTInx := 0;
1930 4C97 SBTInx := SBTInx + 1;
1931 4CB7
1932 4CB7 (*#B#*)
1933 4CB7 IF test((.0,9.)) THEN
1934 4CCF BEGIN
1935 4CD4 write(TestOut, 'SBTS-2 '); TSTstat(Status); TSTln;
1936 4D13 TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1937 4D36 END;
1938 4D36 (*#E#*)
1939 4D36
1940 4D36 END;
1941 4D39 IF SymbolTable(.SBTInx.).NameReference = 0 THEN
1942 4D5F IF CurrentSymbolCount >= MaxNooSymbols - 1 THEN
1943 4D78 Status := Status + (.SymbolTableOverFlow.)
1944 4D8E ELSE
1945 4DA1 Status := Status + (.NotFound.);
1946 4DC9 (*#B#*)
1947 4DC9 IF test((.0,10.)) THEN
1948 4DE1 BEGIN
1949 4DE6 write(TestOut, 'SBTS-3 '); TSTstat(Status); TSTln;
1950 4E25 TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1951 4E48 END;
1952 4E48 (*#E#*)
1953 4E48 END; (*SBTS*)
1954 4E4E
1955 4E4E PROCEDURE SBTEX(VAR Status: StatusType
1956 4E4E ;VAR SymbolTableEntryNo: SymbolTableIndexType
1957 4E4E ; SymbolName: SymbolNameType
1958 4E4E ; P_ModuleNo: ModuleTableIndexType
1959 4E4E ; P_SegmentNo: SegmentNoType
1960 4E4E ; Item: i32
1961 4E4E );
1962 4E4E
1963 4E4E BEGIN (*SBTEX*)
1964 4E4E SBTS(Status, SymbolTableEntryNo, SymbolName);
1965 4E8D IF not (SymbolTableOverFlow IN Status) THEN
1966 4EA8 WITH SymbolTable(.SymbolTableEntryNo.)
1967 4EC5 ,ValueTable(.SymbolTableEntryNo.) DO
1968 4EE9 IF NotFound IN Status THEN
1969 4F04 BEGIN (*Symbol is NOT in SBT and thus not resolved*)
1970 4F09 Status := Status - (.NotFound.);
1971 4F31 NMTP(Status, NameReference, SymbolName);
1972 4F54 IF not (NameTableOverFlow IN Status) THEN
1973 4F6F BEGIN
1974 4F74 CurrentSymbolCount := CurrentSymbolCount + 1;
1975 4F9C ModuleNo := P_ModuleNo;
1976 4FB0 IF LatestInsert <> 0 THEN
1977 4FC4 SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
1978 4FF7 LatestInsert := SymbolTableEntryNo;
1979 5012 SortLink := SymbolTableEntryNo;
1980 502E SegmentNo := P_SegmentNo;
1981 5042 Value := Item
1982 504D END
1983 5056 END (*IF NotFound IN Status*)
1984 5056 ELSE (* SUCCESS: Symbol is in SBT*)
1985 5059 BEGIN
1986 505E IF SegmentNo > UnResolved THEN
1987 5075 Status := Status + (.DuplicateExportSymbol.)
1988 508B ELSE (*Symbol NOT previously resolved i.e. imported only*)
1989 509E BEGIN
1990 50A3 ModuleNo := P_ModuleNo;
1991 50B7 IF LatestInsert <> 0 THEN
1992 50CB SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
1993 50FE LatestInsert := SymbolTableEntryNo;
1994 5119 SortLink := SymbolTableEntryNo;
1995 5135 SegmentNo := P_SegmentNo;
1996 5149 Value := Item
1997 5154 END
1998 515D END; (*ELSE (i.e. Success IN Status)*)
1999 515D (*#B#*)
2000 515D IF test((.0,10.)) THEN
2001 5176 BEGIN
2002 517B write(TestOut, 'SBTEX '); TSTstat(Status);
2003 51B7 TSTindt; TSTsymbol(SymbolName);
2004 51CA TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
2005 51ED TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
2006 520C END;
2007 520C (*#E#*)
2008 520C END; (*SBTEX*)
2009 5212
2010 5212
2011 5212 PROCEDURE SBTIM(VAR Status: StatusType
2012 5212 ;VAR SymbolTableEntryNo: SymbolTableIndexType
2013 5212 ;VAR SymbolName: SymbolNameType
2014 5212 ; P_ModuleNo: ModuleTableIndexType
2015 5212 );
2016 5212
2017 5212 BEGIN (*SBTIM*)
2018 5212 SBTS(Status, SymbolTableEntryNo, SymbolName);
2019 523B IF Not (SymbolTableOverFlow IN Status) THEN
2020 5256 BEGIN
2021 525B IF NotFound IN Status THEN
2022 5276 WITH SymbolTable(.SymbolTableEntryNo.)
2023 5293 ,ValueTable(.SymbolTableEntryNo.) DO
2024 52B7 BEGIN
2025 52BC Status := Status - (.NotFound.);
2026 52E4 NMTP(Status, NameReference, SymbolName);
2027 5306 IF not (NameTableOverFlow IN Status) THEN
2028 5320 BEGIN
2029 5325 CurrentSymbolCount := CurrentSymbolCount + 1;
2030 534D ModuleNo := P_ModuleNo;
2031 5361 SortLink := 0;
2032 5372 SegmentNo := UnResolved;
2033 537F Value := 0;
2034 5395 END
2035 5395 END;
2036 5395 EITP(Status,SymbolTableEntryNo)
2037 53AC END;
2038 53AF (*#B#*)
2039 53AF IF test((.0,10.)) THEN
2040 53C8 BEGIN
2041 53CD write(TestOut, 'SBTIM '); TSTstat(Status); TSTln;
2042 540C TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
2043 542F TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
2044 544E END;
2045 544E (*#E#*)
2046 544E END; (*SBTIM*)
2047 5454
2048 5454 (* *)
2049 5454 (* *)
2050 5454 (******************************************************************************)
2051 5454
2052 5454
2053 5454 (*$I B:lnkp1-1.pas getinputfiles *)
2054 5454 (******************************************************************************)
2055 5454 (* *)
2056 5454 (* Copyright (1985) by Metanic Aps., Denmark *)
2057 5454 (* *)
2058 5454 (* Author: Lars Gregers Jakobsen. *)
2059 5454 (* *)
2060 5454 (******************************************************************************)
2061 5454
2062 5454 PROCEDURE GetInputFiles(VAR GStatus: StatusType
2063 5454 ;VAR LogFile: LogFileType
2064 5454 );
2065 5454
2066 5454 VAR
2067 5454 InputFile: FileType;
2068 5454 FileNo: FileNameTableIndexType;
2069 5454 Status: StatusType;
2070 5454
2071 5454 PROCEDURE ValidateFileFormat(VAR Status: StatusType
2072 5454 ;VAR F: FileType
2073 5454 ; Format: OF_FormatType
2074 5454 );
2075 5454
2076 5454 VAR
2077 5454 OFF_Format: OF_FormatType;
2078 5454
2079 5454 BEGIN (*VALIDATEFILEFORMAT*)
2080 5454 FGi32(Status, F, OFF_Format);
2081 547A IF OFF_Format <> Format THEN
2082 548E Status := Status + (.BadFileFormat.);
2083 54B4 (*#B#*)
2084 54B4 IF test((.0,16,19.)) THEN
2085 54CE BEGIN
2086 54D3 write(TestOut, 'GetFFvalid '); TSTstat(Status); TSTindt;
2087 5516 writeln(TestOut, 'OFF_Format=', OFF_Format);
2088 554C END;
2089 554C (*#E#*)
2090 554C END; (*VALIDATEFILEFORMAT*)
2091 5552
2092 5552 PROCEDURE GetModules(VAR GStatus: StatusType
2093 5552 ;VAR LogFile: LogFileType
2094 5552 ; FileNumber: FileNameTableIndexType
2095 5552 ;VAR Fl: FileType
2096 5552 ; StartAddressOfNextModule: FileAddressType
2097 5552 );
2098 5552
2099 5552 VAR
2100 5552 Status: StatusType;
2101 5552
2102 5552 PROCEDURE ValidateModuleFormat(VAR Status: StatusType
2103 5552 ;VAR F: FileType
2104 5552 ; Format: OM_FormatType
2105 5552 );
2106 5552
2107 5552 VAR
2108 5552 OMF_Format: OM_FormatType;
2109 5552
2110 5552 BEGIN (*VALIDATEMODULEFORMAT*)
2111 5552 FGi32(Status, F, OMF_Format);
2112 5578 IF OMF_Format <> Format THEN
2113 558C Status := Status + (.BadModuleFormat.);
2114 55B2 (*#B#*)
2115 55B2 IF test((.0,16,19.)) THEN
2116 55CC BEGIN
2117 55D1 write(TestOut, 'GetMFvalid '); TSTstat(Status); TSTindt;
2118 5614 writeln(TestOut, 'OMF_Format=',OMF_Format);
2119 564A END;
2120 564A (*#E#*)
2121 564A END; (*VALIDATEMODULEFORMAT*)
2122 5650
2123 5650
2124 5650 PROCEDURE GetModuleHeader(VAR GStatus: StatusType
2125 5650 ;VAR LogFile: LogFileType
2126 5650 ; FileNo:
2127 5650 FileNameTableIndexType
2128 5650 ;VAR Fl: FileType
2129 5650 ;VAR StartAddressOfNextModule:
2130 5650 FileAddressType
2131 5650 );
2132 5650
2133 5650 VAR
2134 5650 Status: StatusType;
2135 5650 SegmentNo: SegmentNoType;
2136 5650 SymbolNo: SymbolTableIndexType;
2137 5650 ModuleNo: ModuleTableIndexType;
2138 5650 MdtRec: ModuleTableRecordType;
2139 5650 NooExpSymbols: QuadImageUnitType;
2140 5650 NooExiSymbols: QuadImageUnitType;
2141 5650
2142 5650 PROCEDURE GetINX(VAR Status: StatusType
2143 5650 ;VAR ModuleNo: ModuleTableIndexType
2144 5650 ;VAR Fl: FileType
2145 5650 ;VAR StartAddressOfNextModule:
2146 5650 FileAddressType
2147 5650 ;VAR NooExpSymbols: QuadImageUnitType
2148 5650 ;VAR NooExiSymbols: QuadImageUnitType
2149 5650 );
2150 5650
2151 5650 VAR
2152 5650 OMH_ModuleSize: QuadImageUnitType;
2153 5650 OMH_NooSegments: QuadImageUnitType;
2154 5650 OMH_ModuleName: ModuleNameType;
2155 5650
2156 5650 BEGIN (*GETINX*)
2157 5650 WITH ModuleTable(.ModuleNo.) DO
2158 567B BEGIN
2159 5680 FGi32(Status, Fl, OMH_ModuleSize);
2160 569E FGi32(Status, Fl, OMH_NooSegments);
2161 56BC FGi32(Status, Fl, NooExpSymbols);
2162 56D9 FGi32(Status, Fl, NooExiSymbols);
2163 56F6 StartAddressOfNextModule :=
2164 5701 StartAddressOfNextModule + abs(OMH_moduleSize);
2165 571D IF (OMH_NooSegments > MaxNooSegments) or
2166 5731 (Noo_ExiSymbols > MaxNooExternalImportSymbols) THEN
2167 5752 Status := Status + (.RangeError.)
2168 5768 ELSE
2169 577B BEGIN
2170 5780 Referenced := false;
2171 5791 NooSegments := OMH_NooSegments;
2172 57B0 IF NooSegments > CurSegmentCount THEN
2173 57CC CurSegmentCount := NooSegments;
2174 57E2 NooExternalImportSymbols := NooExiSymbols;
2175 5806 LatestInsert := 0;
2176 5818 FGsym(Status, Fl, OMH_ModuleName);
2177 5836 IF Status = (..) THEN
2178 584F BEGIN
2179 5854 SBTEX(Status
2180 5859 ,ModuleNameReference
2181 5860 ,OMH_ModuleName
2182 5867 ,ModuleNo
2183 586F ,0,0);
2184 588C IF not (SymbolTableOverFlow IN Status) THEN
2185 58A6 ValueTable(.ModuleNameReference.).SegmentNo := UnResolved;
2186 58C5 IF DuplicateExportSymbol IN Status THEN
2187 58DF Status := Status - (.DuplicateExportSymbol.) +
2188 58FE (.DuplicateModuleName.);
2189 590E END
2190 590E END
2191 590E END
2192 590E END; (*GETINX*)
2193 5914
2194 5914
2195 5914 PROCEDURE GetSGDs(VAR Status: StatusType
2196 5914 ; SCTBase: SectionTableIndexType
2197 5914 ; NooSegments: SegmentNoType
2198 5914 ; P_ModuleNo: ModuleTableIndexType
2199 5914 ;VAR Fl: FileType
2200 5914 );
2201 5914
2202 5914 LABEL
2203 5914 99;
2204 5914
2205 5914 VAR
2206 5914 SegmentInx: SegmentNoType;
2207 5914 Dummy32: QuadImageUnitType;
2208 5914
2209 5914 BEGIN (*GETSEGMENTDESCRIPTORS*)
2210 5914 FOR SegmentInx := 1 TO NooSegments DO
2211 5936 BEGIN
2212 593B IF Status <> (..) THEN
2213 5954 GOTO 99;
2214 595C WITH SectionTable(.SCTbase + SegmentInx.) DO
2215 598A BEGIN
2216 598F SegmentNo := SegmentInx;
2217 599E ModuleNo := P_ModuleNo;
2218 59B2 FGi32(Status, Fl, Dummy32);
2219 59D0 ImageSize := abs(Dummy32);
2220 59EB FGi32(Status, Fl, Dummy32);
2221 5A09 OvrSize := abs(Dummy32);
2222 5A26 (*#B#*)
2223 5A26 IF test((.0,16,19.)) THEN
2224 5A40 BEGIN
2225 5A45 write(TestOut, 'GetSGDs '); TSTstat(Status);
2226 5A81 TSTindt; TSTsct(SCTbase + SegmentInx); TSTln
2227 5AA2 END;
2228 5AA5 (*#E#*)
2229 5AA5 END;
2230 5AA5 END;
2231 5AAF 99:; END; (*GETSEGMENTDESCRIPTORS*)
2232 5AB5
2233 5AB5 PROCEDURE GetEXP(VAR GStatus: StatusType
2234 5AB5 ;VAR LogFile: LogFileType
2235 5AB5 ;VAR Fl: FileType
2236 5AB5 ;VAR LinkHead: SymbolTableIndexType
2237 5AB5 ; ModuleNo: ModuleTableIndexType
2238 5AB5 ; NooExpSymbols: i32
2239 5AB5 );
2240 5AB5
2241 5AB5 VAR
2242 5AB5 Status: StatusType;
2243 5AB5 SymbolCount: i32;
2244 5AB5 DuplicateCount: i32;
2245 5AB5 RelocationIndicator: RelocationIndicatorType;
2246 5AB5 EXP_RelocationIndicator: ImageUnitType;
2247 5AB5 EXP_Item: QuadImageUnitType;
2248 5AB5 EXP_SymbolName: SymbolNameType;
2249 5AB5 SymbolTableEntryNo: SymbolTableIndexType; (*DUMMY*)
2250 5AB5 ModuleName: ModuleNameType;
2251 5AB5
2252 5AB5 BEGIN (*GETEXPORTLIST*)
2253 5AB5 Status := (..);
2254 5AD5 LinkHead := 0;
2255 5AE2 LatestInsert := 0;
2256 5AF4 SymbolCount := 0;
2257 5B03 DuplicateCount := 0;
2258 5B12 IF SymbolCount < NooExpSymbols THEN
2259 5B27 BEGIN
2260 5B2C SymbolCount := SymbolCount + 1;
2261 5B3C FGi8( Status, Fl, EXP_RelocationIndicator);
2262 5B5B IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
2263 5B6D RelocationIndicator := EXP_RelocationIndicator
2264 5B72 ELSE
2265 5B81 Status := Status + (.RangeError.);
2266 5BA9 FGi32(Status, Fl, EXP_Item);
2267 5BC8 FGsym(Status, Fl, EXP_SymbolName);
2268 5BE7 IF Status = (..) THEN
2269 5C01 BEGIN
2270 5C06 SBTEX(Status
2271 5C0B ,LinkHead
2272 5C13 ,EXP_SymbolName
2273 5C1A ,ModuleNo
2274 5C22 ,EXP_RelocationIndicator
2275 5C29 ,EXP_Item
2276 5C34 );
2277 5C41 IF DuplicateExportSymbol IN Status THEN
2278 5C5A BEGIN
2279 5C5F DuplicateCount := DuplicateCount + 1;
2280 5C6F IF DuplicateCount <= 1 THEN
2281 5C82 LogHdds(LogFile);
2282 5C91 NMTG(SymbolTable(.
2283 5C96 ModuleTable(.ModuleNo
2284 5C96 .).ModuleNameReference
2285 5CAA .).NameReference
2286 5CBC ,ModuleName
2287 5CC5 );
2288 5CD4 LogDDS(LogFile
2289 5CD9 ,EXP_RelocationIndicator
2290 5CE0 ,EXP_Item
2291 5CEB ,EXP_SymbolName
2292 5CF1 ,ModuleName
2293 5CF9 );
2294 5D04 END
2295 5D04 END;
2296 5D04 GStatus := GStatus + Status;
2297 5D2F END;
2298 5D2F WHILE (GStatus <= (.DuplicateExportSymbol.)) and
2299 5D47 (SymbolCount < NooExpSymbols) DO
2300 5D62 BEGIN
2301 5D67 SymbolCount := SymbolCount + 1;
2302 5D77 Status := (..);
2303 5D8F FGi8( Status, Fl, EXP_RelocationIndicator);
2304 5DAE IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
2305 5DC0 RelocationIndicator := EXP_RelocationIndicator
2306 5DC5 ELSE
2307 5DD4 Status := Status + (.RangeError.);
2308 5DFC FGi32(Status, Fl, EXP_Item);
2309 5E1B FGsym(Status, Fl, EXP_SymbolName);
2310 5E3A IF Status = (..) THEN
2311 5E54 BEGIN
2312 5E59 SBTEX(Status
2313 5E5E ,SymbolTableEntryNo
2314 5E66 ,EXP_SymbolName
2315 5E6E ,ModuleNo
2316 5E76 ,EXP_RelocationIndicator
2317 5E7D ,EXP_Item
2318 5E88 );
2319 5E95 IF DuplicateExportSymbol IN Status THEN
2320 5EAE BEGIN
2321 5EB3 DuplicateCount := DuplicateCount + 1;
2322 5EC3 IF DuplicateCount <= 1 THEN
2323 5ED6 LogHdds(LogFile);
2324 5EE5 NMTG(SymbolTable(.
2325 5EEA ModuleTable(.ModuleNo
2326 5EEA .).ModuleNameReference
2327 5EFE .).NameReference
2328 5F10 ,ModuleName
2329 5F19 );
2330 5F28 LogDDS(LogFile
2331 5F2D ,EXP_RelocationIndicator
2332 5F34 ,EXP_Item
2333 5F3F ,EXP_SymbolName
2334 5F45 ,ModuleName
2335 5F4D );
2336 5F58 END
2337 5F58 END;
2338 5F58 GStatus := GStatus + Status
2339 5F6E END; (*WHILE ... DO*)
2340 5F86 END; (*GETEXPORTLIST*)
2341 5F8C
2342 5F8C PROCEDURE GetEXI(VAR Status: StatusType
2343 5F8C ;VAR Fl: FileType
2344 5F8C ; ModuleNo: ModuleTableIndexType
2345 5F8C ; NooExternalImportSymbols: i32
2346 5F8C );
2347 5F8C
2348 5F8C VAR
2349 5F8C SymbolTableEntryNo: SymbolTableIndexType;
2350 5F8C SymbolCount: i32;
2351 5F8C EXI_SymbolName: SymbolNameType;
2352 5F8C
2353 5F8C BEGIN (*GETEXTERNALIMPORTLIST*)
2354 5F8C SymbolCount := 0;
2355 5FA3 WHILE (Status = (..)) and
2356 5FB9 (SymbolCount < NooExternalImportSymbols) DO
2357 5FD3 BEGIN
2358 5FD8 SymbolCount := SymbolCount + 1;
2359 5FE8 FGsym(Status, Fl, EXI_SymbolName);
2360 6006 IF Status = (..) THEN
2361 601E SBTIM(Status
2362 6023 ,SymbolTableEntryNo
2363 602A ,EXI_SymbolName
2364 6032 ,ModuleNo
2365 603A );
2366 6048 END; (*WHILE ... DO*)
2367 604B END; (*GETEXTERNALIMPORTLIST*)
2368 6051
2369 6051
2370 6051
2371 6051 BEGIN (*GETMODULEHEADER*)
2372 6051 Status := (..);
2373 6071 MDTA(Status, ModuleNo, 1);
2374 608C IF Status = (..) THEN
2375 60A6 BEGIN
2376 60AB GetINX(Status, ModuleNo, Fl
2377 60C0 , StartAddressOfNextModule
2378 60C7 , NooExpSymbols
2379 60CE , NooExiSymbols);
2380 60E5 IF Status = (..) THEN
2381 60FF WITH ModuleTable(.ModuleNo.) DO
2382 611E BEGIN
2383 6123 FileNameReference := FileNo;
2384 6132 SCTA(Status, SCTBase, NooSegments);
2385 615C IF Status = (..) THEN
2386 6176 BEGIN
2387 617B GetSGDs(Status
2388 6180 ,SCTBase
2389 6188 ,NooSegments
2390 6197 ,ModuleNo
2391 61A6 ,Fl
2392 61AD );
2393 61B7 IF Status = (..) THEN
2394 61D1 BEGIN
2395 61D6 SymbolTable(.ModuleNameReference
2396 61DB .).ModuleNo := ModuleNo;
2397 61FC GetEXP(Status
2398 6201 ,LogFile
2399 6209 ,Fl
2400 6210 ,SBTLinkHead
2401 6217 ,ModuleNo
2402 6222 ,NooExpSymbols
2403 6229 );
2404 6236 IF Status <= (.DuplicateExportSymbol.) THEN
2405 6252 BEGIN
2406 6257 EITOffset := CurExternalImportSymbolNo;
2407 626F GetEXI(Status
2408 6274 ,Fl
2409 627C ,ModuleNo
2410 6283 ,NooExiSymbols
2411 628A );
2412 6297 CurrentFileAddress := Fl.P;
2413 62B6 END
2414 62B6 END
2415 62B6 END
2416 62B6 END;
2417 62B6 END;
2418 62B6 GStatus := GStatus + Status;
2419 62E1 (*#B#*)
2420 62E1 IF test((.0,6,16,19.)) THEN
2421 62FA BEGIN
2422 62FF write(TestOut, 'GetOMH '); TSTstat(Status); TSTln;
2423 633F TSTindt; TSTindt; TSTindt; TSTmdt(ModuleNo);
2424 6357 END;
2425 6357 (*#E#*)
2426 6357 END; (*GETMODULEHEADER*)
2427 635D
2428 635D BEGIN (*GETMODULES*)
2429 635D REPEAT
2430 636A Status := (..);
2431 6382 FilSeek(Status, InputFile, StartAddressOfNextModule);
2432 63A3 IF not (UnexpectedEof IN Status) THEN
2433 63BC BEGIN
2434 63C1 ValidateModuleFormat(Status, InputFile, OM_Format1);
2435 63E1 IF UnexpectedEof IN Status THEN
2436 63F9 BEGIN
2437 63FE LogEOFerror(LogFile, FileNumber, InputFile.P)
2438 641E END
2439 6421 ELSE IF (BadModuleFormat IN Status) THEN
2440 643B BEGIN
2441 6440 LogOMFerror(LogFile, FileNumber, InputFile.P)
2442 6460 END
2443 6463 ELSE (* Status = (..) *)
2444 6465 GetModuleHeader(Status
2445 646A ,LogFile
2446 6472 ,FileNumber
2447 6479 ,InputFile
2448 6480 ,StartAddressOfNextModule
2449 6488 );
2450 6497 GStatus := GStatus + Status;
2451 64C2 END
2452 64C2 UNTIL Status - (.DuplicateExportSymbol, BadSymbolName.) <> (..);
2453 64E0 END; (*GETMODULES*)
2454 64E6
2455 64E6 BEGIN (*GETINPUTFILES*)
2456 64E6 FOR FileNo := 1 TO CurFileNo DO
2457 6508 BEGIN
2458 650D Status := (..);
2459 6525 FilAsg(InputFile, FileNameTable(.FileNo.));
2460 6551 FilRst(Status, InputFile);
2461 6569 IF Status = (..) THEN
2462 6583 BEGIN
2463 6588 ValidateFileFormat (Status, InputFile, OF_Format1);
2464 65A8 IF Status = (..) THEN
2465 65C2 GetModules(Status, LogFile, FileNo, InputFile, 4)
2466 65ED ELSE IF BadFileFormat IN Status THEN
2467 6610 LogOFFerror(LogFile, FileNo);
2468 6626 END;
2469 6626 IF UnexpectedEof IN Status THEN
2470 663F LogEOFerror(LogFile, FileNo, InputFile.P);
2471 665E FilCls(InputFile);
2472 666E GStatus := GStatus + Status;
2473 6699 END;
2474 66A3 IF CurModuleNo <= 0 THEN
2475 66B4 GStatus := GStatus + (.NoInput.);
2476 66DA END; (*GETINPUTFILES*)
2477 66E3
2478 66E3 (* *)
2479 66E3 (* *)
2480 66E3 (******************************************************************************)
2481 66E3
2482 66E3 (*$I B:lnkp1-2.pas putmodule *)
2483 66E3 (******************************************************************************)
2484 66E3 (* *)
2485 66E3 (* Copyright (1985) by Metanic Aps., Denmark *)
2486 66E3 (* *)
2487 66E3 (* Author: Lars Gregers Jakobsen. *)
2488 66E3 (* *)
2489 66E3 (******************************************************************************)
2490 66E3
2491 66E3 PROCEDURE PutTargetFile(VAR Status: StatusType
2492 66E3 ;VAR TargetFile: FileType
2493 66E3 ;VAR LogFile: LogFileType
2494 66E3 );
2495 66E3
2496 66E3 PROCEDURE PutFF(VAR Fl: FileType
2497 66E3 );
2498 66E3
2499 66E3 BEGIN (*PUTFF*)
2500 66E3 FPi32(Fl, OF_Format1);
2501 6702 END; (*OUTFF*)
2502 6708
2503 6708 PROCEDURE PutModule(VAR Status: StatusType
2504 6708 ;VAR TargetFile: FileType
2505 6708 ;VAR LogFile: LogFileType
2506 6708 );
2507 6708
2508 6708 PROCEDURE PutMF(VAR Fl: FileType
2509 6708 );
2510 6708
2511 6708 BEGIN (*PUTMF*)
2512 6708 FPi32(Fl, OM_Format1);
2513 6727 END; (*OUTMF*)
2514 672D
2515 672D PROCEDURE PutINX(VAR Status: StatusType
2516 672D ;VAR Fl: FileType
2517 672D ;VAR LogFile: LogFileType
2518 672D );
2519 672D
2520 672D VAR
2521 672D OMH_ModuleName: ModuleNameType;
2522 672D
2523 672D BEGIN (*PUTINX*)
2524 672D FPi32(Fl,0); (* OMH_Module *)
2525 674C FPi32(Fl,0); (* OMH_NooSegments *)
2526 6763 FPi32(Fl,0); (* OMH_NooExportSymbols *)
2527 677A FPi32(Fl,0); (* OMH_NooExtImportSymbols *)
2528 6791 NMTG(SymbolTable(.ModuleTable(.1.).ModuleNameReference
2529 6796 .).NameReference
2530 67AA , OMH_ModuleName
2531 67B3 );
2532 67C2 FPsym(Fl, OMH_ModuleName);
2533 67D9 END; (*PUTINX*)
2534 67DF
2535 67DF PROCEDURE PutSGDs(VAR Status: StatusType
2536 67DF ;VAR Fl: Filetype
2537 67DF ;VAR LogFile: LogFileType
2538 67DF );
2539 67DF
2540 67DF VAR
2541 67DF SRCinx: SectionTableIndexType;
2542 67DF DSTinx: SectionTableIndexType;
2543 67DF ModuleName: ModuleNameType;
2544 67DF
2545 67DF PROCEDURE PutSGD(VAR TargetFile: FileType
2546 67DF ; Section: SectionTableRecordType
2547 67DF );
2548 67DF
2549 67DF BEGIN (*PUTSGD*)
2550 67DF WITH Section DO
2551 6801 BEGIN
2552 6806 FPi32(TargetFile, ImageSize);
2553 681B FPi32(TargetFile, OvrSize);
2554 6830 END;
2555 6830 END; (*PUTSGD*)
2556 6836
2557 6836 BEGIN (*PUTSGDS*)
2558 6836 Status := (..);
2559 6855 SCTA(Status, TargetSectionOffset, CurSegmentCount);
2560 686F IF not (SectionTableOverFlow IN Status) THEN
2561 688A BEGIN
2562 688F IF CurSegmentCount > 0 THEN
2563 68A0 LogHSgd(LogFile);
2564 68AF FOR DSTinx := 1 TO CurSegmentCount DO
2565 68C9 WITH SectionTable(.TargetSectionOffset + DSTinx.) DO
2566 68F7 BEGIN
2567 68FC ModuleNo := TargetModuleNo;
2568 690A SegmentNo := DSTinx;
2569 691F ImageSize := 0; (*TO BE UPDATED*)
2570 6936 OvrSize := 0;
2571 694F RelocationConstant := 0;
2572 6968 FOR SRCinx := 1 TO TargetSectionOffset DO
2573 6982 IF SectionTable(.SRCinx.).SegmentNo = DSTinx THEN
2574 69A0 BEGIN
2575 69A5 SectionTable(.SRCinx.).RelocationConstant :=
2576 69BE ImageSize * ImageFactor;
2577 69DF ImageSize := ImageSize +
2578 69F8 SectionTable(.SRCinx.).ImageSize;
2579 6A1C WITH SectionTable(.SRCinx.) DO (*Log memory map element*)
2580 6A3B IF SectionTable(.SRCinx.).ImageSize > 0 THEN
2581 6A67 BEGIN
2582 6A6C NMTG(SymbolTable(.ModuleTable(.
2583 6A71 ModuleNo.).ModuleNameReference
2584 6A89 .).Namereference
2585 6A9B ,ModuleName
2586 6AA4 );
2587 6AB3 LogSGD(LogFile
2588 6AB8 ,DSTinx
2589 6ABF ,RelocationConstant
2590 6AC6 ,ImageSize*ImageFactor
2591 6AE3 ,ModuleName
2592 6AF3 );
2593 6AFE END;
2594 6AFE (*#B#*)
2595 6AFE IF test((.0,6,16,19.)) THEN
2596 6B18 BEGIN
2597 6B1D write(TestOut, 'PutSGDs-1');
2598 6B45 TSTsct(SRCinx);
2599 6B54 END;
2600 6B54 (*#E#*)
2601 6B54 END; (* FOR SRCinx := ... *)
2602 6B5E PutSGD(Fl, SectionTable(.TargetSectionOffset +
2603 6B6A DSTinx.) );
2604 6B91 (*#B#*)
2605 6B91 IF test((.0,6,16,19.)) THEN
2606 6BAB BEGIN
2607 6BB0 write(TestOut, 'PutSGDs-2');
2608 6BD8 TSTsct(TargetSectionOffset + DSTinx);
2609 6BF6 END;
2610 6BF6 (*#E#*)
2611 6BF6 END; (* FOR DSTinx := ... *)
2612 6C00 END; (* allocation ok *)
2613 6C00 END; (*PUTSGDS*)
2614 6C06
2615 6C06 PROCEDURE PutEXP(VAR Status: StatusType
2616 6C06 ;VAR Target: FileType
2617 6C06 ;VAR LogFile: LogFileType
2618 6C06 );
2619 6C06
2620 6C06 VAR
2621 6C06 MDTInx: ModuleTableIndexType;
2622 6C06 ModuleName: ModuleNameType;
2623 6C06 Heap: HeapType;
2624 6C06 HeapMax: HeapIndexType;
2625 6C06 Winner: SymboltableIndexType;
2626 6C06 SymbolNo: SymbolTableIndexType;
2627 6C06 EXP_RelocationIndicator: RelocationIndicatorType;
2628 6C06 EXP_Item: i32;
2629 6C06 EXP_SymbolName: SymbolNameType;
2630 6C06 SbtInx: SymbolTableIndexType;
2631 6C06
2632 6C06 FUNCTION NameSwop(VAR A
2633 6C06 , B: SymbolNameType
2634 6C06 ): boolean;
2635 6C06
2636 6C06 VAR
2637 6C06 I: integer;
2638 6C06
2639 6C06 BEGIN (*NAMESWOP*)
2640 6C06 I := 1;
2641 6C1D IF B.Length < A.Length THEN
2642 6C39 BEGIN
2643 6C3E WHILE (I <= B.Length) and (A.Name(.I.) >= B.Name(.I.)) DO
2644 6CA5 I := I + 1;
2645 6CB8 NameSwop := (I > B.Length);
2646 6CDC END
2647 6CDC ELSE
2648 6CDF BEGIN
2649 6CE4 WHILE (I <= A.Length) and (A.Name(.I.) <= B.Name(.I.)) DO
2650 6D4E I := I + 1;
2651 6D61 NameSwop := not (I > A.Length);
2652 6D85 END;
2653 6D85 (*#B#*)
2654 6D85 IF test((.0,13.)) THEN
2655 6D9E BEGIN
2656 6DA3 writeln(TestOut, 'NameSwop ', 'I=', I:1);
2657 6DE6 TSTindt; TSTindt; TSTindt;
2658 6DF4 write(TestOut, 'A='); TSTsymbol(A);
2659 6E1F TSTindt; TSTindt; TSTindt;
2660 6E2D write(TestOut, 'B='); TSTsymbol(B);
2661 6E58 END
2662 6E58 (*#E#*)
2663 6E58 END; (*NAMESWOP*)
2664 6E61
2665 6E61 PROCEDURE InHeap( New: SymbolTableIndexType
2666 6E61 );
2667 6E61
2668 6E61 VAR
2669 6E61 I,J: integer;
2670 6E61 Z,V: SymbolNameType;
2671 6E61 Swop: boolean;
2672 6E61
2673 6E61 BEGIN (*INHEAP*)
2674 6E61 HeapMax := HeapMax + 1;
2675 6E87 I := HeapMax;
2676 6E96 NMTG(SymbolTable(.New.).NameReference, Z);
2677 6EC7 IF I > 1 THEN
2678 6EDE REPEAT
2679 6EE3 J := I div 2;
2680 6EFB NMTG(SymbolTable(. Heap(.J.) .).NameReference, V);
2681 6F3F Swop := NameSwop(V,Z);
2682 6F5D IF Swop THEN
2683 6F66 BEGIN
2684 6F6B Heap(.I.) := Heap(.J.);
2685 6FA9 I := J
2686 6FAE END
2687 6FB6 UNTIL (I <= 1) or ( not Swop );
2688 6FD5 Heap(.I.) := New;
2689 6FFC (*#B#*)
2690 6FFC IF test((.0,13.)) THEN
2691 7015 BEGIN
2692 701A writeln(TestOut, 'InHeap New=', New:1);
2693 7057 TSTheap(Heap, HeapMax);
2694 7072 END;
2695 7072 (*#E#*)
2696 7072 END; (*INHEAP*)
2697 7078
2698 7078 PROCEDURE SelectWinner(VAR Status: StatusType
2699 7078 );
2700 7078
2701 7078 VAR
2702 7078 I,J: integer;
2703 7078 Swop: boolean;
2704 7078 V,W,Z: SymbolNameType;
2705 7078 New: SymbolTableIndexType;
2706 7078
2707 7078 BEGIN (*SELECTWINNER*)
2708 7078 IF (0 < HeapMax) THEN
2709 7094 BEGIN
2710 7099 Winner := Heap(.1.);
2711 70AF WITH Symboltable(.Winner.) DO
2712 70CB IF SortLink <> Winner THEN
2713 70DF New := SortLink
2714 70E4 ELSE
2715 70F8 BEGIN (* Chain exhausted - descrease size of heap *)
2716 70FD New := Heap(.HeapMax.);
2717 711F HeapMax := HeapMax - 1;
2718 713D END;
2719 713D I := 1;
2720 714C IF HeapMax >= 2 THEN
2721 7160 BEGIN
2722 7165 J := 2;
2723 7174 Heap(.HeapMax + 1.) := New;
2724 71A0 NMTG(SymbolTable(.New.).NameReference, Z);
2725 71D1 REPEAT
2726 71D6 (* J <= HeapMax *)
2727 71D6
2728 71D6 NMTG(SymbolTable(.Heap(. J .).).NameReference, V);
2729 721E NMTG(SymbolTable(.Heap(.J+1.).).NameReference, W);
2730 7269 IF NameSwop(V,W) THEN
2731 7285 BEGIN
2732 728A V := W;
2733 72A4 J := J + 1
2734 72AD END;
2735 72B4
2736 72B4 Swop := NameSwop(Z,V);
2737 72D2 IF Swop THEN
2738 72DB BEGIN
2739 72E0 Heap(.I.) := Heap(.J.);
2740 731E I := J;
2741 732B J := I + I;
2742 733D END;
2743 733D
2744 733D (*#B#*)
2745 733D IF test((.0,13.)) THEN
2746 7356 BEGIN
2747 735B write(TestOut, 'SLCT-W-1 ', 'I=' , I:1
2748 7395 , ' ':2 , 'J=' , J:1
2749 73B9 , ' ':2 , 'New=', New:1
2750 73E4 , ' ':2 , 'Swop='
2751 73FB ); TSTbool(Swop); TSTln;
2752 741A TSTheap(Heap, HeapMax);
2753 7435 END
2754 7435 (*#E#*)
2755 7435
2756 7435 UNTIL (not Swop) or (J > HeapMax);
2757 745B END;
2758 745B Heap(.I.) := New;
2759 7482 END
2760 7482 ELSE
2761 7485 Status := Status + (.HeapEmpty.);
2762 74AD (*#B#*)
2763 74AD IF test((.0,13,16,19.)) THEN
2764 74C7 BEGIN
2765 74CC write(TestOut, 'SLCT-W-2 '); TSTstat(Status); TSTindt;
2766 750B writeln(TestOut, 'HeapMax=', HeapMax:1
2767 753E , ' ':2, 'Winner=', Winner:1
2768 7570 );
2769 7579 END;
2770 7579 (*#E#*)
2771 7579 END; (*SELECTWINNER*)
2772 757F
2773 757F
2774 757F BEGIN (*PUTEXP*)
2775 757F
2776 757F (*#B#*)
2777 757F IF test((.0,13.)) THEN
2778 75A0 BEGIN
2779 75A5 writeln(TestOut, 'PUTEXP ');
2780 75CD FOR SbtInx := 1 TO MaxNooSymbols DO
2781 75DE WITH SymbolTable(.SbtInx.), ValueTable(.SbtInx.) DO
2782 7614 IF NameReference <> 0 THEN
2783 7629 BEGIN
2784 762E TSTindt; TSTindt; TSTindt; TSTsbt(SbtInx);
2785 764A TSTindt; TSTvlt(SbtInx); TSTln;
2786 765F END;
2787 7669 END;
2788 7669 (*#E#*)
2789 7669
2790 7669 (*Initialize selection*)
2791 7669 HeapMax := 0;
2792 7672 FOR MDTInx := 1 TO TargetModuleNo - 1 DO
2793 7699 IF ModuleTable(.MDTInx
2794 769E .).SBTLinkHead IN (.1..MaxNooSymbols.) THEN
2795 76CC InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
2796 76FF
2797 76FF IF HeapMax > 0 THEN
2798 770F LogHxpN(LogFile);
2799 771E NooExpSymbols := 0;
2800 7730
2801 7730 WHILE (Status = (..)) DO
2802 7749 BEGIN
2803 774E SelectWinner(Status);
2804 7761 IF Status = (..) THEN
2805 777A WITH SymbolTable(.Winner.), ValueTable(.Winner.) DO
2806 77B3 IF SegmentNo > UnResolved THEN
2807 77C4 BEGIN
2808 77C9 NooExpSymbols := NooExpSymbols + 1;
2809 77DF IF (SegmentNo > 0) THEN (*relocatable*)
2810 77F6 WITH SectionTable(.ModuleTable(.ModuleNo
2811 77FB .).SCTbase +
2812 7813 SegmentNo
2813 7813 .) DO
2814 7844 BEGIN
2815 7849 Value := Value + RelocationConstant;
2816 7875 END;
2817 7875 EXP_RelocationIndicator := SegmentNo;
2818 7887 EXP_Item := Value;
2819 789A NMTG(NameReference, EXP_SymbolName);
2820 78BD FPi8(Target, EXP_RelocationIndicator);
2821 78D4 FPi32(Target, EXP_Item);
2822 78E9 FPsym(Target, EXP_SymbolName);
2823 7900 IF (Status = (..)) and (OPTlfk <> none) THEN
2824 7929 BEGIN
2825 792E NMTG(SymbolTable(.
2826 7933 ModuleTable(.ModuleNo
2827 7933 .).ModuleNameReference
2828 794B .).NameReference
2829 795D ,ModuleName
2830 7966 );
2831 7975 LogXP(LogFile
2832 797A ,EXP_RelocationIndicator
2833 7981 ,EXP_Item
2834 7988 ,EXP_SymbolName
2835 798E ,ModuleName
2836 7996 )
2837 799E END;
2838 79A1 END;
2839 79A1 END;
2840 79A4 Status := Status - (.HeapEmpty.);
2841 79CC IF (HeapEmpty IN Status) and (OPTlfk <> none) THEN
2842 79F7 BEGIN (*sort sbt/vlt by value and log*)
2843 79FC END
2844 79FC END; (*PUTEXP*)
2845 7A02
2846 7A02
2847 7A02 PROCEDURE PutEXI(VAR Status: StatusType
2848 7A02 ;VAR Target: FileType
2849 7A02 ;VAR LogFile: LogFileType
2850 7A02 );
2851 7A02
2852 7A02 LABEL
2853 7A02 1;
2854 7A02
2855 7A02 VAR
2856 7A02 ModuleName: ModuleNameType;
2857 7A02 SymbolName: SymbolNameType;
2858 7A02 ExiInx1: ExternalImportTableIndexType;
2859 7A02 ExiInx: ExternalImportTableIndexType;
2860 7A02
2861 7A02 (* TargetModuleNo is a global variable *)
2862 7A02
2863 7A02 BEGIN (*PUTEXI*)
2864 7A02 NooExiSymbols := 0;
2865 7A1C
2866 7A1C ExiInx1 := 1;
2867 7A25 FOR ExiInx1 := 1 TO CurExternalImportSymbolNo DO
2868 7A3F BEGIN
2869 7A44 (*#B#*)
2870 7A44 IF test((.0,7.)) THEN
2871 7A5B BEGIN
2872 7A60 write(TestOut, 'PUTEXI-1 ');
2873 7A88 TSTeit(ExiInx1);
2874 7A97 END;
2875 7A97 (*#E#*)
2876 7A97 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2877 7AAA .).SegmentNo = UnResolved) THEN
2878 7AC2 GOTO 1;
2879 7ACA END;
2880 7AD4
2881 7AD4 1: IF (CurExternalImportSymbolNo > 0) THEN
2882 7AE5 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2883 7AF8 .).SegmentNo = UnResolved) THEN
2884 7B10 BEGIN
2885 7B15 LogHurs(LogFile);
2886 7B24 FOR ExiInx := ExiInx1 TO CurExternalImportSymbolNo DO
2887 7B3F BEGIN
2888 7B44 (*#B#*)
2889 7B44 IF test((.0,7.)) THEN
2890 7B5B BEGIN
2891 7B60 write(TestOut, 'PUTEXI-2 ');
2892 7B88 TSTeit(ExiInx);
2893 7B97 END;
2894 7B97 (*#E#*)
2895 7B97 WITH ExternalImportTable(.ExiInx.) DO
2896 7BB0 WITH ValueTable(.SymbolNo.),
2897 7BCD SymbolTable(.SymbolNo.) DO
2898 7BEB IF SegmentNo = UnResolved THEN
2899 7BFC BEGIN
2900 7C01 NooExiSymbols := NooExiSymbols + 1;
2901 7C17 Value := NooExiSymbols;
2902 7C2E NMTG(NameReference, SymbolName);
2903 7C51 FPsym(Target, SymbolName);
2904 7C68 NMTG(SymbolTable(.
2905 7C6D ModuleTable(.ModuleNo
2906 7C6D .).ModuleNameReference
2907 7C85 .).NameReference
2908 7C97 ,ModuleName
2909 7CA0 );
2910 7CAF LogURS(LogFile, ModuleName, SymbolName);
2911 7CCE (*#B#*)
2912 7CCE IF test((.0,16,19.)) THEN
2913 7CE8 BEGIN
2914 7CED writeln(TestOut, 'PutEXI '
2915 7D08 , 'SymbolNo=', SymbolNo:1
2916 7D37 , ' ':2, 'Value=', Value:1);
2917 7D6E END;
2918 7D6E (*#E#*)
2919 7D6E END;
2920 7D6E
2921 7D6E END;
2922 7D78 END;
2923 7D78 END; (*PUTEXI*)
2924 7D7E
2925 7D7E (* TargetModuleNo is a global variable *)
2926 7D7E
2927 7D7E BEGIN (*PUTMODULE*)
2928 7D7E MDTA(Status, TargetModuleNo, 1);
2929 7D9C IF not (ModuleTableOverFlow IN Status) THEN
2930 7DB7 BEGIN
2931 7DBC PutMF(TargetFile);
2932 7DCB PutINX(Status, TargetFile, LogFile);
2933 7DEC IF Status = (..) THEN
2934 7E05 BEGIN (*Calculate memory map, write sgd, and log*)
2935 7E0A PutSGDs(Status, TargetFile, LogFile);
2936 7E2B
2937 7E2B IF not (SectionTableOverFlow IN Status) THEN
2938 7E46 BEGIN (*Relocate symbol table, write export list, and log*)
2939 7E4B PutEXP(Status, TargetFile, LogFile);
2940 7E6C IF Status = (..) THEN
2941 7E85 BEGIN (*Write EXI while logging unresolved references*)
2942 7E8A PutEXI(Status, TargetFile, LogFile);
2943 7EAB END;
2944 7EAB END;
2945 7EAB END;
2946 7EAB END;
2947 7EAB END; (*PUTMODULE*)
2948 7EB1
2949 7EB1 BEGIN (*PUTTARGETFILE*)
2950 7EB1 PutFF(TargetFile);
2951 7EC8 PutModule(Status, TargetFile, LogFile);
2952 7EE9 END; (*PUTTARGETFILE*)
2953 7EEF
2954 7EEF (* *)
2955 7EEF (* *)
2956 7EEF (******************************************************************************)
2957 7EEF
2958 7EEF
2959 7EEF BEGIN (*PASS1*)
2960 7EEF
2961 7EEF (* Initialize local data structures *)
2962 7EEF FOR SBTSubInx := 1 TO MaxNooSymbols DO
2963 7F0A SymbolTable(.SBTSubInx.).NameReference := 0;
2964 7F30 LatestInsert := 0;
2965 7F42 CurrentSymbolCount := 0;
2966 7F54 CurrentNameTableIndex := 0;
2967 7F62
2968 7F62 GetInputFiles(Status, LogFile);
2969 7F8E IF Status = (..) THEN
2970 7FB0 BEGIN
2971 7FB5 PutTargetFile(Status, TargetFile, LogFile);
2972 7FF1 END;
2973 7FF1 END; (*PASS1*)
2974 7FF7
2975 7FF7 (* *)
2976 7FF7 (* *)
2977 7FF7 (******************************************************************************)
2978 7FF7
2979 7FF7 (*$I B:lnkp2.pas Procedure pass2 *)
2980 7FF7 (******************************************************************************)
2981 7FF7 (* *)
2982 7FF7 (* Copyright (1985) by Metanic Aps., Denmark *)
2983 7FF7 (* *)
2984 7FF7 (* Author: Lars Gregers Jakobsen. *)
2985 7FF7 (* *)
2986 7FF7 (******************************************************************************)
2987 7FF7
2988 7FF7 PROCEDURE Pass2(VAR Status: StatusType
2989 7FF7 ;VAR TargetFile: FileType
2990 7FF7 ;VAR LogFile: LogFileType
2991 7FF7 );
2992 7FF7
2993 7FF7 LABEL
2994 7FF7 999;
2995 7FF7
2996 7FF7 VAR
2997 7FF7 SegmentInx: SegmentNoType;
2998 7FF7 ModuleInx: ModuleTableIndexType;
2999 7FF7 Crid: BitMappedFileType; (*Composite relocation import directory*)
3000 7FF7 Covr: FileType; (*Composite overrun store*)
3001 7FF7
3002 7FF7 (*#B#*)
3003 7FF7 (*$I B:LNKDF5.PAS Bit Map Buffer Test Output *)
3004 7FF7 (******************************************************************************)
3005 7FF7 (* *)
3006 7FF7 (* Copyright (1985) by Metanic Aps., Denmark *)
3007 7FF7 (* *)
3008 7FF7 (* Author: Lars Gregers Jakobsen. *)
3009 7FF7 (* *)
3010 7FF7 (******************************************************************************)
3011 7FF7
3012 7FF7 PROCEDURE TSTbmb(Bmb: BitMapBufferType
3013 7FF7 );
3014 7FF7
3015 7FF7 VAR
3016 7FF7 I: 0..15;
3017 7FF7
3018 7FF7 BEGIN (*TSTBMB*)
3019 7FF7 write(TestOut, 'Y1,Y0,I,P= ', Bmb.Y1:3, ' ', Bmb.Y0:3, ' ');
3020 806E FOR I := 15 DOWNTO 8 DO
3021 807F IF I IN Bmb.I THEN
3022 8096 write(TestOut, '1')
3023 80AE ELSE
3024 80B4 write(TestOut, '0');
3025 80D9 write(TestOut, ' ');
3026 80F4 FOR I := 7 DOWNTO 0 DO
3027 8105 IF I IN Bmb.I THEN
3028 811C write(TestOut, '1')
3029 8134 ELSE
3030 813A write(TestOut, '0');
3031 815F write(TestOut, ' ', Bmb.P:3, ' ');
3032 819B END; (*TSTBMB*)
3033 81A1
3034 81A1 (* *)
3035 81A1 (* *)
3036 81A1 (******************************************************************************)
3037 81A1
3038 81A1 (*$I B:LNKDF6.PAS Bit Map Access Primitives *)
3039 81A1 (******************************************************************************)
3040 81A1 (* *)
3041 81A1 (* Copyright (1985) by Metanic Aps., Denmark *)
3042 81A1 (* *)
3043 81A1 (* Author: Lars Gregers Jakobsen. *)
3044 81A1 (* *)
3045 81A1 (******************************************************************************)
3046 81A1
3047 81A1 PROCEDURE BMG2(VAR BM: BitMappedFileType
3048 81A1 ;VAR Relocatable: boolean
3049 81A1 ;VAR Importable: boolean
3050 81A1 );
3051 81A1
3052 81A1 BEGIN (*BMG2*)
3053 81A1 WITH BM, BM.B DO
3054 81C8 BEGIN
3055 81CD IF P <= 8 THEN
3056 81DE BEGIN
3057 81E3 read(F, Y1);
3058 820E P := P + 8;
3059 8231 END;
3060 8231 P := P - 1;
3061 8251 Relocatable := P IN I;
3062 827F P := P - 1;
3063 829F Importable := P IN I;
3064 82CD (*#B#*)
3065 82CD IF test((.0,4.)) THEN
3066 82E4 BEGIN
3067 82E9 write(TestOut, 'BMG2 '); TSTbmb(BM.B);
3068 831D write(TestOut, 'R,I= ');
3069 8341 TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
3070 8368 END;
3071 8368 (*#E#*)
3072 8368
3073 8368 END;
3074 8368 END; (*BMG2*)
3075 836E
3076 836E PROCEDURE BMG6(VAR BM: BitMappedFileType
3077 836E ;VAR Index:i8
3078 836E );
3079 836E
3080 836E VAR
3081 836E J: 1..6;
3082 836E
3083 836E BEGIN (*BMG6*)
3084 836E Index := 0;
3085 8383 WITH BM, BM.B DO
3086 83A2 BEGIN
3087 83A7 IF P < 14 THEN
3088 83B5 BEGIN
3089 83BA read(F, Y0);
3090 83E4 FOR J := 1 TO 6 DO
3091 83F5 Index := Index + Index + ord( (P-J) IN I );
3092 8460 Y1 := Y0;
3093 8478 P := P + 2; (* = P - 6 + 8 *)
3094 849B END
3095 849B ELSE
3096 849E BEGIN
3097 84A3 FOR J := 1 TO 6 DO
3098 84B4 Index := Index + Index + ord( (P-J) IN I );
3099 851F P := P - 6;
3100 8542 END;
3101 8542 (*#B#*)
3102 8542 IF test((.0,4.)) THEN
3103 8559 BEGIN
3104 855E write(TestOut, 'BMG6 '); TSTbmb(BM.B);
3105 8592 writeln(TestOut, 'Index= ',Index:1);
3106 85CB END;
3107 85CB (*#E#*)
3108 85CB END;
3109 85CB END; (*BMG6*)
3110 85D1
3111 85D1 PROCEDURE BMP2(VAR BM: BitMappedFileType
3112 85D1 ; Relocatable: boolean
3113 85D1 ; Importable: boolean
3114 85D1 );
3115 85D1
3116 85D1 BEGIN (*BMP2*)
3117 85D1 WITH BM, BM.B DO
3118 85F8 BEGIN
3119 85FD P := P - 1;
3120 8617 IF Relocatable THEN
3121 8623 I := I + (.P.);
3122 865B P := P - 1;
3123 867B IF Importable THEN
3124 8687 I := I + (.P.);
3125 86BF IF P <= 8 THEN (* always >= 8 *)
3126 86D6 BEGIN
3127 86DB write(F, Y1);
3128 8706 Y1 := 0;
3129 8715 P := 16 (* = P + 8 *)
3130 8720 END;
3131 8722 (*#B#*)
3132 8722 IF test((.0,4.)) THEN
3133 8739 BEGIN
3134 873E write(TestOut, 'BMP2 '); TSTbmb(BM.B);
3135 8772 write(TestOut, 'R,I= ');
3136 8796 TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
3137 87B5 END;
3138 87B5 (*#E#*)
3139 87B5 END
3140 87B5 END; (*BMP2*)
3141 87BB
3142 87BB PROCEDURE BMP6(VAR BM: BitMappedFileType
3143 87BB ; Index:i8
3144 87BB );
3145 87BB
3146 87BB VAR
3147 87BB J: 0..5;
3148 87BB
3149 87BB BEGIN (*BMP6*)
3150 87BB WITH BM, BM.B DO
3151 87E2 BEGIN
3152 87E7 P := P - 6;
3153 8804 FOR J := 0 TO 5 DO
3154 8815 BEGIN
3155 881A IF odd(Index) THEN
3156 8828 I := I + (.P+J.);
3157 886A Index := Index div 2
3158 886F END;
3159 8881 (*#B#*)
3160 8881 IF test((.0,4.)) THEN
3161 8898 BEGIN
3162 889D write(TestOut, 'BMP6 '); TSTbmb(BM.B);
3163 88D1 writeln(TestOut, 'Index= ', Index:1);
3164 8906 END;
3165 8906 (*#E#*)
3166 8906 IF P <= 8 THEN
3167 891D BEGIN
3168 8922 write(F, Y1);
3169 894D Y1 := Y0;
3170 8965 Y0 := 0;
3171 8973 P := P + 8;
3172 8996 END;
3173 8996 END;
3174 8996 END; (*BMP6*)
3175 899C
3176 899C (* *)
3177 899C (* *)
3178 899C (******************************************************************************)
3179 899C
3180 899C
3181 899C PROCEDURE LinkSection(VAR Status: StatusType
3182 899C ;VAR TargetFile: FileType
3183 899C ;VAR LogFile: LogFileType
3184 899C ;VAR Crid: BitMappedFileType
3185 899C ;VAR Covr: FileType
3186 899C ;VAR SCTrec: SectionTableRecordType
3187 899C ;VAR MDTrec: ModuleTableRecordType
3188 899C );
3189 899C
3190 899C LABEL
3191 899C 99;
3192 899C
3193 899C VAR
3194 899C Oimg: FileType;
3195 899C Orid: BitMappedFileType;
3196 899C Oovr: FileType;
3197 899C ImageUnit: ImageUnitType;
3198 899C QuadImageUnit: QuadImageUnitType;
3199 899C Relocatable: boolean;
3200 899C Importable: boolean;
3201 899C Index: i8;
3202 899C Address: FileAddressType; (*relative to current obj. section*)
3203 899C LocalImageSize: FileAddressType;
3204 899C OvrIndex: QuadImageUnitType;
3205 899C
3206 899C
3207 899C BEGIN (*LINKSECTION*)
3208 899C WITH MDTrec, SCTrec DO
3209 89C1 BEGIN
3210 89C6 IF ImageSize > 0 THEN
3211 89DE BEGIN
3212 89E3 FilAsg(Oimg, FileNameTable(.FileNameReference.));
3213 8A14 FilRst(Status, Oimg);
3214 8A2B FilSeek(Status, Oimg, CurrentFileAddress);
3215 8A52 CurrentFileAddress := CurrentFileAddress + ImageSize * ImageFactor;
3216 8A8C
3217 8A8C WITH Orid DO
3218 8A91 BEGIN
3219 8A96 assign(F, FileNameTable(.FileNameReference.));
3220 8AC6 reset(F);
3221 8ADA seek(F, CurrentFileAddress);
3222 8AF6 WITH B DO
3223 8B08 BEGIN
3224 8B0D P := 16;
3225 8B14 I := (..);
3226 8B2C read(F, Y1);
3227 8B53 END;
3228 8B53 END;
3229 8B53 CurrentFileAddress := CurrentFileAddress + ImageSize;
3230 8B82
3231 8B82 IF OvrSize > 0 THEN
3232 8BA2 BEGIN
3233 8BA7 FilAsg(Oovr, FileNameTable(.FileNameReference.));
3234 8BD8 FilRst(Status, Oovr);
3235 8BEF FilSeek(Status, Oovr, CurrentFileAddress);
3236 8C16 CurrentFileAddress := CurrentFileAddress + OvrSize;
3237 8C47 END
3238 8C47 ELSE
3239 8C4A Oovr.P := CurrentFileAddress;
3240 8C61
3241 8C61 (*CurrentFileAddress now reflects starting position of
3242 8C61 next section in file if any*)
3243 8C61
3244 8C61 Address := 0;
3245 8C70 LocalImageSize := (ImageSize - 1) * ImageFactor;
3246 8C95 WHILE (Address <= LocalImageSize) and (Status = (..)) DO
3247 8CC6 BEGIN
3248 8CCB BMG2(Orid, Relocatable, Importable);
3249 8CEB IF Relocatable <> Importable THEN
3250 8CF9 BEGIN
3251 8CFE BMG6(Orid, Index);
3252 8D16 FGi32(Status, Oimg, QuadImageUnit);
3253 8D35 IF Relocatable THEN
3254 8D41 (* Relocate *)
3255 8D41 IF Index IN (.1..NooSegments.) THEN
3256 8D6F WITH SectionTable(.SCTBase + Index.) DO
3257 8DA6 QuadImageUnit := QuadImageUnit + RelocationConstant
3258 8DAF ELSE
3259 8DC8 Status := Status + (.BadRelocationCode.)
3260 8DDE ELSE
3261 8DF2 (* Import *)
3262 8DF2 BEGIN (*IMPORT*)
3263 8DF7 IF Index = OvrCode THEN
3264 8E03 IF Oovr.P < CurrentFileAddress - 3 THEN
3265 8E2A FGi32(Status, Oovr, OvrIndex)
3266 8E46 ELSE
3267 8E4C Status := Status + (.UnexpectedEof.)
3268 8E62 ELSE
3269 8E75 OvrIndex := Index;
3270 8E85 IF OvrIndex IN (.1..NooExternalImportSymbols.) THEN
3271 8EB5 WITH ValueTable(.ExternalImportTable(.EITOffset + OvrIndex
3272 8EC0 .).SymbolNo
3273 8EE6 .) DO
3274 8EFE IF SegmentNo > UnResolved THEN
3275 8F0F BEGIN
3276 8F14 QuadImageUnit := QuadImageUnit + Value; (*?* + ? *)
3277 8F30 Importable := false;
3278 8F39 Relocatable := SegmentNo > 0;
3279 8F56 Index := SegmentNo;
3280 8F69 END
3281 8F69 ELSE
3282 8F6C IF Value IN (.0..63.) THEN
3283 8F8F Index := Value
3284 8F94 ELSE
3285 8FAB BEGIN
3286 8FB0 Index := OvrCode;
3287 8FB9 FPi32(Covr, Value);
3288 8FD4 END
3289 8FD4 ELSE
3290 8FD7 Status := Status + (.BadImportCode.)
3291 8FED END; (*IMPORT*)
3292 8FFE FPi32(TargetFile, QuadImageUnit);
3293 9013 BMP2(Crid, Relocatable, Importable);
3294 9030 BMP6(Crid, Index);
3295 9043 Address := Address + ImageFactor;
3296 905E END
3297 905E ELSE
3298 9061 IF Relocatable THEN
3299 906D BEGIN
3300 9072 Status := Status + (.Baddibit.);
3301 9099 GOTO 99; (*EXIT procedure*)
3302 90A1 END
3303 90A1 ELSE
3304 90A4 BEGIN
3305 90A9 FGi8(Status, Oimg, ImageUnit);
3306 90C8 FPi8(TargetFile, ImageUnit);
3307 90DB BMP2(Crid, Relocatable, Importable);
3308 90F8 Address := Address + 1;
3309 910B END;
3310 910B END;
3311 910E LocalImageSize := ImageSize * ImageFactor;
3312 9130 WHILE (Address < LocalImageSize) and (Status = (..)) DO
3313 9161 BEGIN
3314 9166 BMG2(Orid, Relocatable, Importable);
3315 9186 IF Relocatable or Importable THEN
3316 9195 BEGIN
3317 919A Status := Status + (.Baddibit.);
3318 91C1 GOTO 99; (*EXIT procedure*)
3319 91C9 END
3320 91C9 ELSE
3321 91CC BEGIN
3322 91D1 FGi8(Status, Oimg, ImageUnit);
3323 91F0 FPi8(TargetFile, ImageUnit);
3324 9203 BMP2(Crid, Relocatable, Importable);
3325 9220 Address := Address + 1;
3326 9233 END;
3327 9233 END;
3328 9236 END; (* IF ImageSize > 0 THEN *)
3329 9236 99: END; (* WITH MDTrec, SCTrec DO *)
3330 9236 END; (*LINKSECTION*)
3331 923F
3332 923F PROCEDURE CopyBuffer(VAR Status: StatusType
3333 923F ;VAR Buffer: BasicFileType
3334 923F ;VAR TargetFile: FileType
3335 923F ;VAR Size: FileAddressType
3336 923F );
3337 923F
3338 923F VAR
3339 923F Item: i8;
3340 923F Start: FileAddressType;
3341 923F
3342 923F BEGIN (*COPYBUFFER*)
3343 923F reset(Buffer);
3344 925A Start := TargetFile.P;
3345 9271 WHILE not eof(Buffer) DO
3346 928A BEGIN
3347 928F read(Buffer, Item);
3348 92B2 FPi8(TargetFile, Item); (*Advancing TargetFile.P*)
3349 92C5 END;
3350 92C8 Size := TargetFile.P - Start;
3351 92EE (*#B#*)
3352 92EE IF test((.0,20.)) THEN
3353 9308 BEGIN
3354 930D writeln(TestOut, 'CPYBUF ', 'Start= ', Start:1
3355 934C , ' End= ', TargetFile.P:1
3356 9372 , ' Size= ', Size:1
3357 9397 );
3358 93A0 END;
3359 93A0 (*#E#*)
3360 93A0 END; (*COPYBUFFER*)
3361 93A6
3362 93A6 PROCEDURE UPDINX(VAR Status: StatusType
3363 93A6 VAR TargetFile: FileType
3364 93A6 );
3365 93A6
3366 93A6 VAR
3367 93A6 ModuleSize: i32;
3368 93A6 ModuleName: ModuleNameType;
3369 93A6 SegmentInx: SegmentNoType;
3370 93A6
3371 93A6 BEGIN (*UPDINX*)
3372 93A6 ModuleSize := TargetFile.P - OMF_Address;
3373 93CD update(TargetFile.F);
3374 93E0 FilSeek(Status, TargetFile, OMH_Address);
3375 93FE IF Status = (..) THEN
3376 9417 BEGIN
3377 941C FPi32(TargetFile, ModuleSize);
3378 9431 FPi32(TargetFile, CurSegmentCount);
3379 944B FPi32(TargetFile, NooExpSymbols);
3380 9463 FPi32(TargetFile, NooExiSymbols);
3381 947B FGsym(Status, TargetFile, ModuleName); (*skip past name*)
3382 9499 IF Status = (..) THEN
3383 94B2 FOR SegmentInx := 1 TO CurSegmentCount DO
3384 94CC WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3385 94FA BEGIN
3386 94FF FPi32(TargetFile, ImageSize);
3387 951B FPi32(TargetFile, OvrSize);
3388 9539 END;
3389 9543 END;
3390 9543 END; (*UPDINX*)
3391 9549
3392 9549 BEGIN (*PASS2*)
3393 9549 FOR SegmentInx := 1 TO CurSegmentCount DO
3394 956B BEGIN
3395 9570 WITH Crid DO
3396 9575 BEGIN
3397 957A rewrite(F);
3398 958E WITH B DO
3399 95A0 BEGIN
3400 95A5 P := 16;
3401 95AC I := (..)
3402 95B9 END
3403 95C4 END;
3404 95C4 FilRwt(Covr);
3405 95D4 FOR ModuleInx := 1 TO TargetModuleNo - 1 DO
3406 95FB BEGIN
3407 9600 (*#B#*)
3408 9600 IF test((.0,20.)) THEN
3409 961A BEGIN
3410 961F write(TestOut, 'Pass-2 '); TSTstat(Status); TSTindt;
3411 965E writeln(TestOut, 'SgmInx= ', SegmentInx:1
3412 968D , ' MdlInx= ', ModuleInx:1
3413 96B4 );
3414 96BD TSTindt; TSTindt; TSTindt;
3415 96CB TSTmdt(ModuleInx);
3416 96DA TSTindt; TSTindt; TSTindt;
3417 96E8 TSTsct(ModuleTable(.ModuleInx.).SCTBase + SegmentInx);
3418 971E END;
3419 971E (*#E#*)
3420 971E IF (SectionTable(.ModuleTable(.ModuleInx
3421 9723 .).SCTBase + SegmentInx
3422 9737 .).ModuleNo = ModuleInx) THEN
3423 9765 BEGIN
3424 976A LinkSection(Status, TargetFile, LogFile, Crid, Covr
3425 978C ,SectionTable(.ModuleTable(.ModuleInx
3426 9794 .).SCTBase + SegmentInx
3427 97A8 .)
3428 97CF ,ModuleTable(.ModuleInx.)
3429 97E4 );
3430 97E8 IF Status <> (..) THEN
3431 9801 GOTO 999; (************* EXIT BOTH FOR LOOPS **************)
3432 9809 END;
3433 9809 END;
3434 9813 WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3435 9841 BEGIN
3436 9846 CopyBuffer(Status, Crid.F, TargetFile, ImageSize);
3437 986D CopyBuffer(Status, Covr.F, TargetFile, OvrSize);
3438 9896 END;
3439 9896 END;
3440 98A0 999:
3441 98A0 (*backpatch info to target.inx*)
3442 98A0 UPDINX(Status, TargetFile);
3443 98B6
3444 98B6 END; (*PASS2*)
3445 98BF
3446 98BF (* *)
3447 98BF (* *)
3448 98BF (******************************************************************************)
3449 98BF
3450 98BF
3451 98BF
3452 98BF BEGIN (*LINK*)
3453 98BF (*#B#*)
3454 98BF TestInit(Input,Output);
3455 98D8 (*#E#*)
3456 98D8 Status := (..);
3457 98EC Optiontable.LogFileKind := None;
3458 98F6 OptionTable.TargetFileKind := Implicit;
3459 9900 CurFileNo := 0;
3460 990A CurModuleNo := 0;
3461 9914 FOR SCTSubInx := 1 TO MaxNooSections DO
3462 9926 SectionTable(.SCTSubInx.).SegmentNo := 0;
3463 994A SCTOffset := 0;
3464 9954 CurSegmentCount := 0;
3465 995E CurExternalImportSymbolNo := 0;
3466 9968
3467 9968 SetUp(Status, TargetFile, LogFile, Output);
3468 9980 (*#B#*)
3469 9980 IF test((.0,16,17.)) THEN
3470 999A BEGIN
3471 999F write(TestOut, 'Link-MAIN-1 '); TSTstat(Status); TSTindt; TSTmem; TSTln
3472 99E3 END;
3473 99E6 (*#E#*)
3474 99E6 IF Status = (..) THEN
3475 99FC Pass1(Status, TargetFile, LogFile);
3476 9A10 (*#B#*)
3477 9A10 IF test((.0,16,17.)) THEN
3478 9A2A BEGIN
3479 9A2F write(TestOut, 'Link-MAIN-2 '); TSTstat(Status); TSTln
3480 9A6D END;
3481 9A70 (*#E#*)
3482 9A70 IF Status = (..) THEN
3483 9A86 Pass2(Status, TargetFile, LogFile);
3484 9A9A (*#B#*)
3485 9A9A IF test((.0,16,17.)) THEN
3486 9AB4 BEGIN
3487 9AB9 write(TestOut, 'Link-MAIN-3 '); TSTstat(Status); TSTln
3488 9AF7 END;
3489 9AFA (*#E#*)
3490 9AFA IF Status = (..) THEN
3491 9B10 BEGIN
3492 9B15 writeln(output, 'LINK -- Normal termination')
3493 9B4B END
3494 9B4E ELSE
3495 9B51 BEGIN
3496 9B56 writeln(output, 'LINK -- Abnormal termination.');
3497 9B92
3498 9B92 IF BadOption IN Status THEN
3499 9BA7 writeln(output, 'Bad option');
3500 9BD0 IF BadLogFileName IN Status THEN
3501 9BE5 writeln(output, 'Bad log file name');
3502 9C15 IF BadTargetFileName IN Status THEN
3503 9C2A writeln(output, 'Bad target file name');
3504 9C5D IF BadFileName IN Status THEN
3505 9C72 writeln(output, 'Bad file name');
3506 9C9E IF NoSuchFile IN Status THEN
3507 9CB3 writeln(output, 'No such file');
3508 9CDE IF NoInputFiles IN Status THEN
3509 9CF3 writeln(output, 'No input files');
3510 9D20 IF ExtraText IN Status THEN
3511 9D35 writeln(output, 'Extra text');
3512 9D5E IF BadFileFormat IN Status THEN
3513 9D73 writeln(output, 'Bad file format');
3514 9DA1 IF BadModuleFormat IN Status THEN
3515 9DB6 writeln(output, 'Bad module format');
3516 9DE6 IF UnexpectedEof IN Status THEN
3517 9DFB writeln(output, 'Unexpected EOF');
3518 9E28 IF RangeError IN Status THEN
3519 9E3D writeln(output, 'Range error');
3520 9E67 IF BadSymbolName IN Status THEN
3521 9E7C writeln(output, 'Bad symbol name');
3522 9EAA IF DuplicateModuleName IN Status THEN
3523 9EBF writeln(output, 'Duplicate module name');
3524 9EF3 IF DuplicateExportSymbol IN Status THEN
3525 9F08 writeln(output, 'Duplicate export symbol');
3526 9F3E IF NoInput IN Status THEN
3527 9F53 writeln(output, 'No input');
3528 9F7A IF Baddibit IN Status THEN
3529 9F8F writeln(output, 'Bad dibit');
3530 9FB7 IF BadRelocationCode IN Status THEN
3531 9FCC writeln(output, 'Bad relocation code');
3532 9FFE IF BadImportCode IN Status THEN
3533 A013 writeln(output, 'Bad import code');
3534 A041 IF NameTableOverFlow IN Status THEN
3535 A056 writeln(output, 'Name table overflow');
3536 A088 IF ModuleTableOverFlow IN Status THEN
3537 A09D writeln(output, 'Module table overflow');
3538 A0D1 IF SectionTableOverFlow IN Status THEN
3539 A0E6 writeln(output, 'Section table overflow');
3540 A11B IF FileNameTableOverFlow IN Status THEN
3541 A130 writeln(output, 'File name table overflow');
3542 A167 IF SymbolTableOverFlow IN Status THEN
3543 A17C writeln(output, 'Symbol table overflow');
3544 A1B0 IF ExternalImportTableOverFlow IN Status THEN
3545 A1C5 writeln(output, 'External import table overflow');
3546 A202
3547 A202 IF not (NoTarget IN Status) THEN
3548 A217 erase(TargetFile.F);
3549 A223 END
3550 A223 END.
«eof»