|
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: 167424 (0x28e00)
Types: TextFile
Names: »LNK.PRN«
└─⟦da8d53b95⟧ Bits:30009789/_.ft.Ibm2.50006585.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 VersionNo = 'V0.01';
34 0005 ConfigurationNo = 'C0A CP/M';
35 000D
36 000D CommandLineLength = 127;
37 000D FileNameLength = 14;
38 000D MaxSymbolNameIndex = 2; (*?*)
39 000D MaxNooInputFiles = 2; (*?*)
40 000D MaxNooModules = 2; (*?*)
41 000D MaxNooSections = 2; (*?*)
42 000D MaxNooSegments = 3; (*?*)
43 000D MaxNooSymbols = 7; (*?*)
44 000D MaxNooExternalImportSymbols = 4; (*?*)
45 000D MaxNameTableIndex = 17; (*?*)
46 000D MaxHeapIndex = 3; (* >= MaxNooModules + 1 *)
47 000D OM_Format1 = 1;
48 000D OF_Format1 = 1;
49 000D LogFilePageSize = 65; (*First line is #1. Last line is #65*)
50 000D
51 000D (* *)
52 000D (* *)
53 000D (******************************************************************************)
54 000D
55 000D (*#B#(*$I A:PrTstCon.pas Declarations of constants for PrTst package *)
56 000D
57 000D (* Other constants *)
58 000D
59 000D UnResolved = -1; (* Value of field segmentno in VLT *)
60 000D OvrCode = 0; (* For index in bit map *)
61 000D ImageFactor = 4; (* 2 bits in bit map per 8 bits in image *)
62 000D OMF_Address = 4; (* Address of OMF in target file *)
63 000D OMH_Address = 8; (* Address of OMH in target file *)
64 000D LogMargin = 10; (* Size of blank left margin in log file *)
65 000D
66 000D TYPE (*LINK*)
67 000D
68 000D (* General Types *)
69 000D
70 000D i8 = 0..255;
71 000D i16 = 0..65535;
72 000D i32 = integer;
73 000D i32IndexType = (bs0, bs1, bs2, bs3);
74 000D i32ArrayType = ARRAY (.i32IndexType.) OF i8;
75 000D CharSetType = SET OF char;
76 000D
77 000D (* Basic Types *)
78 000D
79 000D StatusBaseType =
80 000D (Success
81 000D ,BadOption
82 000D ,BadLogFileName
83 000D ,BadTargetFileName
84 000D ,BadFileName
85 000D ,NoSuchFile
86 000D ,NoInputFiles
87 000D ,BadFileFormat
88 000D ,BadModuleFormat
89 000D ,UnexpectedEof
90 000D ,RangeError
91 000D ,BadSymbolName
92 000D ,DuplicateModuleName
93 000D ,DuplicateExportSymbol
94 000D ,NoInput
95 000D ,Baddibit
96 000D ,BadRelocationCode
97 000D ,BadImportCode
98 000D ,NameTableOverFlow
99 000D ,ModuleTableOverFlow
100 000D ,SectionTableOverFlow
101 000D ,FileNameTableOverFlow
102 000D ,SymbolTableOverFlow
103 000D ,ExternalImportTableOverFlow
104 000D ,NotFound
105 000D ,NotFinished
106 000D ,HeapEmpty
107 000D ,NoTarget
108 000D ,Error
109 000D );
110 000D
111 000D StatusType = SET OF StatusBaseType;
112 000D
113 000D OF_FormatType = i32;
114 000D OM_FormatType = i32;
115 000D FileKindBaseType = (explicit, implicit, none);
116 000D LogFileKindType = explicit..none;
117 000D TargetFileKindType = explicit..implicit;
118 000D
119 000D SegmentNoType = UnResolved..MaxNooSegments;
120 000D RelocationIndicatorType = SegmentNoType;
121 000D FileAddressType = 0..MaxInt;
122 000D
123 000D CommandLineIndexType = 0..CommandLineLength;
124 000D CommandLineType = String(.CommandLineLength.);
125 000D
126 000D SymbolNameIndexType = 0..MaxSymbolNameIndex;
127 000D SymbolNameSubIndexType = 1..MaxSymbolNameIndex;
128 000D SymbolNameType = RECORD
129 000D Length: SymbolNameIndexType;
130 000D Name: ARRAY (.SymbolNameSubIndexType.) OF i8;
131 000D END;
132 000D ModuleNameType = SymbolNameType;
133 000D FileNameType = STRING(.FileNameLength.);
134 000D
135 000D ImageUnitType = i8;
136 000D QuadImageUnitType = i32;
137 000D BasicFileType = file OF ImageUnitType;
138 000D FileType = RECORD
139 000D F: BasicFileType; (* File systeme file *)
140 000D P: FileAddressType (* Current file address.
141 000D NOT defined when eof(F) = true *)
142 000D END;
143 000D
144 000D PageNoType = i32;
145 000D LineNoType = 0..255;
146 000D LogFileType = RECORD
147 000D F: text; (* File system file *)
148 000D P: PageNoType; (* No of page started upon *)
149 000D L: LineNoType; (* No of line just printed within current page *)
150 000D END;
151 000D
152 000D (* Table Index Types *)
153 000D
154 000D ExternalImportTableIndexType = 0..MaxNooExternalImportSymbols;
155 000D FileNameTableIndexType = -1..MaxNooInputFiles;
156 000D ModuleTableIndexType = 0..MaxNooModules;
157 000D NameTableIndexType = 0..MaxNameTableIndex;
158 000D SectionTableIndexType = 0..MaxNooSections;
159 000D SymbolTableIndexType = 0..MaxNooSymbols;
160 000D HeapIndexType = 0..MaxHeapIndex;
161 000D
162 000D (* Table Sub Index Types *)
163 000D
164 000D ExternalImportTableSubIndexType = 1..MaxNooExternalImportSymbols;
165 000D ModuleTableSubIndexType = 1..MaxNooModules;
166 000D NameTableSubIndexType = 1..MaxNameTableIndex;
167 000D SectionTableSubIndexType = 1..MaxNooSections;
168 000D SymbolTableSubIndexType = 1..MaxNooSymbols;
169 000D
170 000D
171 000D
172 000D (* Table Record Types *)
173 000D
174 000D ExternalImportTableRecordType = RECORD
175 000D SymbolNo: SymbolTableIndexType
176 000D (* Points to VLT entry holding value *)
177 000D END;
178 000D
179 000D FileNameTableRecordType = FileNameType;
180 000D
181 000D ModuleTableRecordType = RECORD
182 000D ModuleNameReference: SymbolTableIndexType;
183 000D (* Points to SBT entry holding module name *)
184 000D FileNameReference: FileNameTableIndexType;
185 000D (* Points to FNT entry holding name of file *)
186 000D CurrentFileAddress: FileAddressType;
187 000D (* Offset (in octets) relative to start of file. First octet
188 000D in file is # 0 *)
189 000D Referenced: Boolean;
190 000D (* True if module referenced. Not used. *)
191 000D NooSegments: SegmentNoType;
192 000D (* Noo Segments in module *)
193 000D SCTBase: SectionTableIndexType;
194 000D (* Points to SCT entry just below the entries of this module.
195 000D Used by putEXP during relocation of exported symbols *)
196 000D NooExternalImportSymbols: ExternalImportTableIndexType;
197 000D (* Noo External import symbols in module *)
198 000D EITOffset: ExternalImportTableIndexType;
199 000D (* Points to EIT entry just below the entries of this module.
200 000D Used during pass 2 *)
201 000D SBTLinkHead: SymbolTableIndexType
202 000D (* Points to first SBT entry in ordered linked list using
203 000D sortlink as link field *)
204 000D END;
205 000D
206 000D OptionTableRecordType = RECORD
207 000D LogFileKind: LogFileKindType;
208 000D TargetFileKind: TargetFileKindType
209 000D END;
210 000D
211 000D SectionTableRecordType = RECORD
212 000D ModuleNo: ModuleTableIndexType;
213 000D (* Points to MDT entry holding module description *)
214 000D SegmentNo: SegmentNoType;
215 000D (* *)
216 000D ImageSize: FileAddressType;
217 000D (* Size of image in quadimageunits.
218 000D Size of bitmap rid in imageunits *)
219 000D OvrSize: FileAddressType;
220 000D (* Size of overrun store in octets *)
221 000D RelocationConstant: FileAddressType;
222 000D (* Amount (in octets) to offset section during relocation *)
223 000D END;
224 000D
225 000D SymbolTableRecordType = RECORD
226 000D ModuleNo: ModuleTableIndexType;
227 000D (* if symbol resolved: Points to MDT entry of exporting module.
228 000D if not : Points to MDT entry of importing module *)
229 000D NameReference: NameTableIndexType;
230 000D (* Points to first octet of name (length field) in NMT *)
231 000D SortLink: SymbolTableIndexType
232 000D (* Points to SBT entry of next symbol according to
233 000D some ordering (e.g. alphabetically) *)
234 000D END;
235 000D
236 000D ValueTableRecordType = RECORD
237 000D SegmentNo: SegmentNoType;
238 000D (* < 0 : Symbol has not been resolved.
239 000D = 0 : Symbol is absolute.
240 000D 0 < s <= MDT(SBT.ModuleNo).NooSegments:Symbol is relocatable
241 000D and field indicates number of segment. *)
242 000D Value: i32
243 000D (* if symbol resolved: Value of symbol.
244 000D if not : Points to EIT entry of the symbol in the
245 000D reduced EIT written to targetmodule *)
246 000D END;
247 000D
248 000D (* Table Types *)
249 000D
250 000D
251 000D ExternalImportTableType = ARRAY (.ExternalImportTableSubIndexType.) OF
252 000D ExternalImportTableRecordType;
253 000D
254 000D FileNameTableType = ARRAY (.FileNameTableIndexType.) OF
255 000D FileNameTableRecordType;
256 000D
257 000D ModuleTableType = ARRAY (.ModuleTableSubIndexType.) OF
258 000D ModuleTableRecordType;
259 000D
260 000D OptionTableType = OptionTableRecordType;
261 000D
262 000D NameTableType = ARRAY (.NameTableSubIndexType.) OF i8;
263 000D
264 000D SectionTableType = ARRAY (.SectionTableSubIndexType.) OF
265 000D SectionTableRecordType;
266 000D
267 000D SymbolTableType = ARRAY (.SymbolTableSubIndexType.) OF
268 000D SymbolTableRecordType;
269 000D
270 000D ValueTableType = ARRAY (.SymbolTableSubIndexType.) OF
271 000D ValueTableRecordType;
272 000D
273 000D
274 000D (* Other major data structures *)
275 000D
276 000D HeapType = ARRAY (.ModuleTableIndexType.) OF SymbolTableIndexType;
277 000D
278 000D BitMapBufferTagType = (bit, byt);
279 000D BitMapBufferType = RECORD
280 000D P: 0..16;
281 000D CASE BitMapBufferTagType OF
282 000D bit: (I: SET OF 0..15);
283 000D byt: (Y0: i8;
284 000D Y1: i8
285 000D )
286 000D END;
287 000D
288 000D BitMappedFileType = RECORD
289 000D F: BasicFileType;
290 000D B: BitMapBufferType
291 000D END;
292 000D
293 000D (*#B#(*$I A:PrTstTyp.pas Declarations of types for PrTst package *)
294 000D
295 000D
296 000D COMMON (*LINK*)
297 000D
298 000D (* Permanent Tables *)
299 000D
300 000D OptionTable: OptionTableType;
301 000D
302 000D FileNameTable: FilenameTableType;
303 000D CurFileNo: FileNameTableIndexType;
304 000D (* Points to highest entry used *)
305 000D
306 000D ModuleTable: ModuleTableType;
307 000D CurModuleNo: ModuleTableIndexType;
308 000D (* Points to highest entry used *)
309 000D TargetModuleNo: ModuleTableIndexType;
310 000D (* Points to entry of target module *)
311 000D
312 000D SectionTable: SectionTableType;
313 000D SCTOffset: SectionTableIndexType;
314 000D (* Points to highest entry used *)
315 000D TargetSectionOffset: SectionTableIndexType;
316 000D (* Points to entry just below target sections *)
317 000D CurSegmentCount: SegmentNoType;
318 000D (* Number of segments in target module *)
319 000D
320 000D ValueTable: ValueTableType;
321 000D NooExpSymbols: i32;
322 000D (* Number of EXP symbols in target module *)
323 000D
324 000D ExternalImportTable: ExternalImportTableType;
325 000D CurExternalImportSymbolNo: ExternalImportTableIndexType;
326 000D (* Points to highest entry used *)
327 000D NooExiSymbols: i32;
328 000D (* Number of EXI symbols in target module *)
329 000D
330 000D (*#B#(*$I A:PrTstCom.pas Declarations of global variables for PrTst package *)
331 000D
332 000D (* *)
333 000D (* *)
334 000D (******************************************************************************)
335 000D
336 000D
337 000D VAR (*LINK*)
338 000D
339 000D (* Misc. Variables *)
340 000D
341 000D Status: StatusType;
342 000D StatusInx: StatusBaseType;
343 000D TargetFile: FileType;
344 000D LogFile: LogFileType;
345 000D SCTSubInx: SectionTableSubIndexType;
346 000D
347 000D (*#B#(*$I A:PrTstExt.pas External Decl. of standard test procedures *)
348 000D (*#B#(*$I B:LnkDF1.pas Global test output primitives *)
349 000D (*$I B:LnkDF2.pas Global access primitives *)
350 000D (******************************************************************************)
351 000D (* *)
352 000D (* Copyright (1985) by Metanic Aps., Denmark *)
353 000D (* *)
354 000D (* Author: Lars Gregers Jakobsen. *)
355 000D (* *)
356 000D (******************************************************************************)
357 000D
358 000D (* File LnkDF2X holds the access primitives used by the
359 000D linker to access input and output files. *)
360 000D
361 000D FUNCTION OPTLFK: LogFileKindType;
362 000D
363 000D BEGIN (*OPTLFK*)
364 000D optlfk := OptionTable.LogFileKind;
365 0023 END; (*OPTLFK*)
366 0029
367 0029 PROCEDURE FNTP(VAR Status: StatusType
368 0029 ; FileName: FileNameType
369 0029 );
370 0029
371 0029 BEGIN (*FNTP*)
372 0029 IF CurFileNo < MaxNooInputFiles THEN
373 0041 BEGIN
374 0046 CurFileNo := CurFileNo + 1;
375 005C FileNameTable(.CurFileNo.) := FileName;
376 0086 END
377 0086 ELSE
378 0088 Status := Status + (.FileNameTableOverFlow.);
379 00AF (*#B#
380 00AF IF test((.0,6.)) THEN
381 00AF BEGIN
382 00AF write(TestOut, 'FNTP '); TSTstat(Status); TSTindt;
383 00AF TSTfnt(CurFileNo); TSTln
384 00AF END
385 00AF #E#*)
386 00AF END; (*FNTP*)
387 00B5
388 00B5 PROCEDURE EITP(VAR Status: StatusType
389 00B5 ; SymbolTableEntryNo: SymbolTableIndexType
390 00B5 );
391 00B5
392 00B5 BEGIN (*EITP*)
393 00B5 IF CurExternalImportSymbolNo < MaxNooExternalImportSymbols THEN
394 00CD BEGIN
395 00D2 CurExternalImportSymbolNo := CurExternalImportSymbolNo + 1;
396 00E8 ExternalImportTable(.CurExternalImportSymbolNo
397 00ED .).SymbolNo := SymbolTableEntryNo
398 00F8 END
399 0101 ELSE
400 0103 Status := Status + (.ExternalImportTableOverFlow.);
401 012A (*#B#
402 012A IF test((.0,7.)) THEN
403 012A BEGIN
404 012A write(TestOut, 'EITP '); TSTstat(Status); TSTln;
405 012A TSTeit(CurExternalImportSymbolNo)
406 012A END
407 012A #E#*)
408 012A END; (*EITP*)
409 0130
410 0130 (* ModuleTable *)
411 0130
412 0130 PROCEDURE MDTA(VAR Status: StatusType
413 0130 ;VAR ModuleNo: ModuleTableIndexType (*Points to least, vacant entry in MDT*)
414 0130 ; ModuleCount: ModuleTableIndexType
415 0130 );
416 0130
417 0130 BEGIN (*MDTA*)
418 0130 ModuleNo := CurModuleNo;
419 014C IF CurModuleNo > MaxNooModules - ModuleCount THEN
420 0173 Status := Status + (.ModuleTableOverFlow.)
421 0189 ELSE
422 019C BEGIN
423 01A1 ModuleNo := CurModuleNo + 1;
424 01BD CurModuleNo := CurModuleNo + ModuleCount;
425 01DA END;
426 01DA (*#B#
427 01DA IF test((.0,6.)) THEN
428 01DA BEGIN
429 01DA write(TestOut, 'MDTA '); TSTstat(Status); TSTindt;
430 01DA writeln(TestOut, 'ModuleNo, Count, CurModuleNo= ',
431 01DA ModuleNo:1, ' ',
432 01DA ModuleCount:1, ' ', CurModuleNo:1
433 01DA );
434 01DA END;
435 01DA #E#*)
436 01DA END; (*MDTA*)
437 01E0
438 01E0 (* SectionTable *)
439 01E0
440 01E0 PROCEDURE SCTA(VAR Status: StatusType
441 01E0 ;VAR SectionNo: SectionTableIndexType (*Points to highest, used entry in SCT*)
442 01E0 ; SectionCount: SegmentNoType
443 01E0 );
444 01E0
445 01E0 BEGIN (*SCTA*)
446 01E0 SectionNo := SCTOffset;
447 01FC IF SCTOffset > MaxNooSections - SectionCount THEN
448 0223 Status := Status + (.SectionTableOverFlow.)
449 0239 ELSE
450 024C BEGIN
451 0251 SCTOffset := SCTOffset + SectionCount;
452 026E END;
453 026E (*#B#
454 026E IF test((.0,6.)) THEN
455 026E BEGIN
456 026E write(TestOut, 'SCTA '); TSTstat(Status); TSTindt;
457 026E writeln(TestOut, 'SectionNo, Count, SCTOffset= ',
458 026E SectionNo:11, ' ', SectionCount:1, ' ',
459 026E SCTOffset:1
460 026E );
461 026E END;
462 026E #E#*)
463 026E END; (*SCTA*)
464 0274
465 0274 (* *)
466 0274 (* *)
467 0274 (******************************************************************************)
468 0274
469 0274
470 0274
471 0274 (*$I B:LnkDF7.pas Log File access primitives *)
472 0274 (******************************************************************************)
473 0274 (* *)
474 0274 (* Copyright (1985) by Metanic Aps., Denmark *)
475 0274 (* *)
476 0274 (* Author: Lars Gregers Jakobsen. *)
477 0274 (* *)
478 0274 (******************************************************************************)
479 0274
480 0274
481 0274 PROCEDURE WriteSymbolName(VAR F: text
482 0274 ; SymbolName: SymbolNameType
483 0274 ; FieldSize: i8
484 0274 );
485 0274
486 0274 VAR
487 0274 I: i8;
488 0274 N: i8;
489 0274
490 0274 BEGIN (*WRITESYMBOLNAME*)
491 0274 WITH SymbolName DO
492 0296 BEGIN
493 029B IF Length < FieldSize THEN
494 02B3 N := Length
495 02B8 ELSE
496 02C4 N := FieldSize;
497 02CF FOR I := 1 TO N DO
498 02E5 IF Name(.I.) in (.32..127.) THEN
499 031C write(F, chr(Name(.I.)) );
500 035D FOR I := N+1 TO FieldSize DO
501 037F write(F, ' ');
502 03AB END
503 03AB END; (*WRITESYMBOLNAME*)
504 03B1
505 03B1 PROCEDURE LogInit(VAR LogFile: LogFileType
506 03B1 ; FileName: FileNameType
507 03B1 );
508 03B1
509 03B1 BEGIN (*LOGINIT*)
510 03B1 WITH LogFile DO
511 03CA BEGIN
512 03CF assign(F, FileName);
513 03E6 rewrite(F);
514 03F9 P := 0;
515 0410 L := LogFilePageSize;
516 0421 END
517 0421 END; (*LOGINIT*)
518 0427
519 0427 PROCEDURE LogTerm(VAR LogFile: LogFileType
520 0427 );
521 0427
522 0427 BEGIN (*LOGTERM*)
523 0427 WITH LogFile DO
524 0440 BEGIN
525 0445 close(F);
526 0452 END
527 0452 END; (*LOGTERM*)
528 0458
529 0458 FUNCTION LogFF(VAR LogFile: LogFileType
530 0458 ; Delta: LineNoType
531 0458 ): boolean;
532 0458
533 0458 CONST
534 0458 LogFFDelta = 5;
535 0458
536 0458 BEGIN (*LOGFF*)
537 0458 WITH LogFile DO
538 0471 IF L >= LogFilePageSize - Delta THEN
539 0497 BEGIN
540 049C LogFF := true;
541 04A5 P := P + 1;
542 04C4 L := LogFFDelta;
543 04D5 page(F);
544 04E8 writeln(F);
545 0501 writeln(F);
546 051A writeln(F, ' ':LogMargin, 'LINKER '
547 0543 , VersionNo, ' '
548 055A , ConfigurationNo
549 0563 , ' ':30
550 0573 , 'SIDE # ', P:2);
551 05A3 writeln(F);
552 05BC writeln(F);
553 05D5 END
554 05D5 ELSE
555 05D7 LogFF := false;
556 05E0 END; (*LOGFF*)
557 05E9
558 05E9 PROCEDURE LogCmd(VAR LogFile: LogFileType
559 05E9 ; CommandLine: CommandLineType
560 05E9 );
561 05E9
562 05E9 CONST Delta = 5;
563 05E9
564 05E9 BEGIN (*LOGCMD*)
565 05E9 IF OptionTable.LogFileKind <> none THEN
566 05FE BEGIN
567 0603 IF LogFF(LogFile, Delta) THEN BEGIN END;
568 0618 WITH LogFile DO
569 0629 BEGIN
570 062E writeln(F);
571 0647 writeln(F, ' ':LogMargin, 'AKTIVERINGSKOMMANDO: ');
572 068B writeln(F);
573 06A4 writeln(F, ' ':LogMargin, CommandLine);
574 06D6 writeln(F);
575 06EF END
576 06EF END
577 06EF END; (*LOGCMD*)
578 06F5
579 06F5 PROCEDURE LogHSsgd(VAR LogFile: LogFileType
580 06F5 );
581 06F5
582 06F5 BEGIN (*LOGHSSGD*)
583 06F5 IF OptionTable.LogFileKind <> none THEN
584 070A WITH LogFile DO
585 071B BEGIN
586 0720 L := L + 2;
587 0741 writeln(F, ' ':LogMargin, 'SGM'
588 0766 , ' ':2, 'ADRESSE':9
589 0787 , ' ':2, 'STØRRELSE'
590 07A2 , ' ':2, 'MODUL'
591 07BD );
592 07CA writeln(F);
593 07E3 END
594 07E3 END; (*LOGHSSGD*)
595 07E9
596 07E9 PROCEDURE LogHsgd(VAR LogFile: LogFileType
597 07E9 );
598 07E9
599 07E9 BEGIN (*LOGHSGD*)
600 07E9 IF OptionTable.LogFileKind <> none THEN
601 07FE BEGIN
602 0803 IF LogFF(LogFile, 6) THEN BEGIN END;
603 0818 WITH LogFile DO
604 0829 BEGIN
605 082E L := L + 3;
606 084F writeln(F);
607 0868 writeln(F, ' ':LogMargin, 'LOKALISERINGSPLAN:');
608 08A9 writeln(F);
609 08C2 END;
610 08C2 LogHSsgd(LogFile);
611 08D1 END;
612 08D1 END; (*LOGHSGD*)
613 08D7
614 08D7 PROCEDURE LogSGD(VAR LogFile: LogFileType
615 08D7 ; SegmentNo: RelocationIndicatorType
616 08D7 ; StartAddress: FileAddressType
617 08D7 ; Size: FileAddressType
618 08D7 ; ModuleName: SymbolNameType
619 08D7 );
620 08D7
621 08D7 BEGIN (*LOGSGD*)
622 08D7 IF OptionTable.LogFileKind <> none THEN
623 0901 BEGIN
624 0906 IF LogFF(LogFile, 1) THEN
625 091B LogHSsgd(LogFile);
626 092A WITH LogFile DO
627 093B BEGIN
628 0940 L := L + 1;
629 095E write(F, ' ':LogMargin, SegmentNo:3
630 0988 , ' ':2, StartAddress:9
631 099D , ' ':2, Size:9
632 09B2 , ' ':2
633 09BB );
634 09C4 WriteSymbolName(F, ModuleName, 20);
635 09DE writeln(F);
636 09F7 END;
637 09F7 END
638 09F7 END; (*LOGSGD*)
639 09FD
640 09FD PROCEDURE LogHSxp(VAR LogFile: LogFileType
641 09FD );
642 09FD
643 09FD BEGIN (*LOGHSXP*)
644 09FD IF OptionTable.LogFileKind <> none THEN
645 0A12 WITH LogFile DO
646 0A23 BEGIN
647 0A28 L := L + 2;
648 0A49 writeln(F, ' ':LogMargin, 'SGM'
649 0A6E , ' ':2, 'VÆRDI':9
650 0A8D , ' ':2, 'SYMBOL', ' ':14
651 0AB2 , ' ':2, 'MODUL'
652 0AC9 );
653 0AD6 writeln(F);
654 0AEF END
655 0AEF END; (*LOGHSXP*)
656 0AF5
657 0AF5 PROCEDURE LogHxpN(VAR LogFile: LogFileType
658 0AF5 );
659 0AF5
660 0AF5 BEGIN (*LOGHXPN*)
661 0AF5 IF OptionTable.LogFileKind <> none THEN
662 0B0A BEGIN
663 0B0F IF LogFF(LogFile, 6) THEN BEGIN END;
664 0B24 WITH LogFile DO
665 0B35 BEGIN
666 0B3A L := L + 3;
667 0B5B writeln(F);
668 0B74 writeln(F, ' ':LogMargin, 'EXPORTEREDE SYMBOLER (NAVNEORDEN):');
669 0BC5 writeln(F);
670 0BDE END;
671 0BDE LogHSxp(LogFile);
672 0BED END
673 0BED END; (*LOGHXPN*)
674 0BF3
675 0BF3 PROCEDURE LogHxpV(VAR LogFile: LogFileType
676 0BF3 );
677 0BF3
678 0BF3 BEGIN (*LOGHXPV*)
679 0BF3 IF OptionTable.LogFileKind <> none THEN
680 0C08 BEGIN
681 0C0D IF LogFF(LogFile, 6) THEN BEGIN END;
682 0C22 WITH LogFile DO
683 0C33 BEGIN
684 0C38 L := L + 3;
685 0C59 writeln(F);
686 0C72 writeln(F, ' ':LogMargin, 'EXPORTEREDE SYMBOLER (VÆRDIORDEN):');
687 0CC3 writeln(F);
688 0CDC END;
689 0CDC LogHSxp(LogFile);
690 0CEB END
691 0CEB END; (*LOGHXPV*)
692 0CF1
693 0CF1 PROCEDURE LogXP(VAR LogFile: LogFileType
694 0CF1 ; SegmentNo: RelocationIndicatorType
695 0CF1 ; Value: i32
696 0CF1 ; SymbolName: SymbolNameType
697 0CF1 ; ModuleName: ModuleNameType
698 0CF1 );
699 0CF1
700 0CF1 BEGIN (*LOGXP*)
701 0CF1 IF OptionTable.LogFileKind <> none THEN
702 0D30 BEGIN
703 0D35 IF LogFF(LogFile,1) THEN
704 0D4A LogHSxp(LogFile);
705 0D59 WITH LogFile DO
706 0D6A BEGIN
707 0D6F L := L + 1;
708 0D8D write(F, ' ':LogMargin, SegmentNo:3
709 0DB7 , ' ':2, Value:9
710 0DCC , ' ':2
711 0DD5 );
712 0DDE WriteSymbolName(F, SymbolName, 20);
713 0DF8 write(F, ' ':2);
714 0E1A WriteSymbolName(F, ModuleName, 20);
715 0E34 writeln(F);
716 0E4D END
717 0E4D END
718 0E4D END; (*LOGXP*)
719 0E53
720 0E53 PROCEDURE LogHSurs(VAR LogFile: LogFileType
721 0E53 );
722 0E53
723 0E53 BEGIN (*LOGHSURS*)
724 0E53 IF OptionTable.LogFileKind <> none THEN
725 0E68 BEGIN
726 0E6D WITH LogFile DO
727 0E7E BEGIN
728 0E83 L := L + 2;
729 0EA4 writeln(F, ' ':LogMargin
730 0EBD , ' ':16, 'SYMBOL', ' ':14
731 0EE2 , ' ':2, 'MODUL');
732 0F06 writeln(F);
733 0F1F END
734 0F1F END
735 0F1F END; (*LOGHSURS*)
736 0F25
737 0F25 PROCEDURE LogHurs(VAR LogFile: LogFileType
738 0F25 );
739 0F25
740 0F25 BEGIN (*LOGHURS*)
741 0F25 IF OptionTable.LogFileKind <> none THEN
742 0F3A BEGIN
743 0F3F IF LogFF(LogFile, 6)THEN BEGIN END;
744 0F54 WITH LogFile DO
745 0F65 BEGIN
746 0F6A L := L + 3;
747 0F8B writeln(F);
748 0FA4 writeln(F, ' ':LogMargin, 'UTILFREDSSTILLEDE REFERENCER:');
749 0FF0 writeln(F);
750 1009 END;
751 1009 LogHSurs(LogFile);
752 1018 END
753 1018 END; (*LOGHURS*)
754 101E
755 101E PROCEDURE LogURS(VAR LogFile: LogFileType
756 101E ; ModuleName: ModuleNameType
757 101E ; SymbolName: SymbolNameType
758 101E );
759 101E
760 101E BEGIN (*LOGURS*)
761 101E IF OptionTable.LogFileKind <> none THEN
762 105D BEGIN
763 1062 IF LogFF(LogFile, 1) THEN
764 1077 LogHSurs(LogFile);
765 1086 WITH LogFile DO
766 1097 BEGIN
767 109C L := L + 1;
768 10BA write(F, ' ':LogMargin
769 10D3 , ' ':16
770 10DC );
771 10E5 WriteSymbolName(F, SymbolName, 20);
772 10FF write(F, ' ':2);
773 1121 WriteSymbolName(F, ModuleName, 20);
774 113B writeln(F);
775 1154 END
776 1154 END
777 1154 END; (*LOGURS*)
778 115A
779 115A PROCEDURE LogHSdds(VAR LogFile: LogFileType
780 115A );
781 115A
782 115A BEGIN (*LOGHSDDS*)
783 115A IF OptionTable.LogFileKind <> none THEN
784 116F WITH LogFile DO
785 1180 BEGIN
786 1185 L := L + 2;
787 11A6 writeln(F, ' ':LogMargin, 'SGM'
788 11CB , ' ':2, 'VÆRDI':9
789 11EA , ' ':2, 'SYMBOL', ' ':14
790 120F , ' ':2, 'MODUL'
791 1226 );
792 1233 writeln(F);
793 124C END;
794 124C END; (*LOGHSDDS*)
795 1252
796 1252 PROCEDURE LogHdds(VAR LogFile: LogFileType
797 1252 );
798 1252
799 1252 BEGIN (*LOGHDDS*)
800 1252 IF OptionTable.LogFileKind <> none THEN
801 1267 BEGIN
802 126C IF LogFF(LogFile, 6) THEN BEGIN END;
803 1281 WITH LogFile DO
804 1292 BEGIN
805 1297 L := L + 2;
806 12B8 writeln(F);
807 12D1 writeln(F, ' ':LogMargin, 'DOBBELTDEFINEREDE SYMBOLER:');
808 131B writeln(F);
809 1334 END;
810 1334 LogHSdds(LogFile);
811 1343 END
812 1343 END; (*LOGHDDS*)
813 1349
814 1349 PROCEDURE LogDDS(VAR LogFile: LogFileType
815 1349 ; RelocationIndicator: RelocationIndicatorType
816 1349 ; Value: i32
817 1349 ; SymbolName: SymbolNameType
818 1349 ; ModuleName: ModuleNameType
819 1349 );
820 1349
821 1349 BEGIN (*LOGDDS*)
822 1349 IF OptionTable.LogFileKind <> none THEN
823 1388 BEGIN
824 138D IF LogFF(LogFile, 1) THEN
825 13A2 LogHSdds(LogFile);
826 13B1 WITH LogFile DO
827 13C2 BEGIN
828 13C7 L := L + 1;
829 13E5 write(F, ' ':LogMargin, ord(RelocationIndicator):3
830 140F , ' ':2, Value:9
831 1424 , ' ':2
832 142D );
833 1436 WriteSymbolName(F, SymbolName, 20);
834 1450 write(F, ' ':2);
835 1472 WriteSymbolName(F, ModuleName, 20);
836 148C writeln(F);
837 14A5 END
838 14A5 END
839 14A5 END; (*LOGDDS*)
840 14AB
841 14AB PROCEDURE LogOFFerror(VAR LogFile: LogFileType
842 14AB ; FileNo: FileNameTableIndexType
843 14AB );
844 14AB
845 14AB BEGIN (*LOGOFFERROR*)
846 14AB IF OptionTable.LogFileKind <> none THEN
847 14C0 BEGIN
848 14C5 IF LogFF(LogFile, 2) THEN BEGIN END;
849 14DA WITH LogFile DO
850 14EB BEGIN
851 14F0 L := L + 2;
852 1511 writeln(F, ' ':LogMargin, '*** FILFORMATFEJL *** FIL # ', FileNo:1
853 1564 , ' ***'
854 1571 );
855 157E END;
856 157E END
857 157E END; (*LOGOFFERROR*)
858 1584
859 1584
860 1584 PROCEDURE LogOMFerror(VAR LogFile: LogFileType
861 1584 ; FileNo: FileNameTableIndexType
862 1584 ; Position: FileAddressType
863 1584 );
864 1584
865 1584 BEGIN (*LOGOMFERROR*)
866 1584 IF OptionTable.LogFileKind <> none THEN
867 1599 BEGIN
868 159E IF LogFF(LogFile, 2) THEN BEGIN END;
869 15B3 WITH LogFile DO
870 15C4 BEGIN
871 15C9 L := L + 2;
872 15EA writeln(F, ' ':LogMargin, '*** MODULFORMATFEJL *** FIL # ', FileNo:1
873 163F , ' *** POSITION # ', Position:1
874 1668 , ' ***'
875 1675 );
876 1682 END;
877 1682 END
878 1682 END; (*LOGOMFERROR*)
879 1688
880 1688 PROCEDURE LogEOFerror(VAR LogFile: LogFileType
881 1688 ; FileNo: FileNameTableIndexType
882 1688 ; Position: FileAddressType
883 1688 );
884 1688
885 1688 BEGIN (*LOGEOFERROR*)
886 1688 IF OptionTable.LogFileKind <> none THEN
887 169D BEGIN
888 16A2 IF LogFF(LogFile, 2) THEN BEGIN END;
889 16B7 WITH LogFile DO
890 16C8 BEGIN
891 16CD L := L + 2;
892 16EE writeln(F, ' ':LogMargin, '*** FILLÆNGDEFEJL *** FIL # ', FileNo:1
893 1741 , ' *** POSITION # ', Position:1
894 176A , ' ***'
895 1777 );
896 1784 END;
897 1784 END
898 1784 END; (*LOGEOFERROR*)
899 178A
900 178A (* *)
901 178A (* *)
902 178A (******************************************************************************)
903 178A
904 178A
905 178A (*$I B:LnkDF8.pas Object File access primitives *)
906 178A (******************************************************************************)
907 178A (* *)
908 178A (* Copyright (1985) by Metanic Aps., Denmark *)
909 178A (* *)
910 178A (* Author: Lars Gregers Jakobsen. *)
911 178A (* *)
912 178A (******************************************************************************)
913 178A
914 178A PROCEDURE FilAsg(VAR Fl: FileType
915 178A ;Fn: FileNameType
916 178A );
917 178A
918 178A BEGIN (*FILASG*)
919 178A (*#B#
920 178A IF test((.0,1.)) THEN
921 178A writeln(TestOut, 'FILasg FlNm=', Fn);
922 178A #E#*)
923 178A assign(Fl.F, Fn)
924 17AF END; (*FILASG*)
925 17B5
926 17B5 PROCEDURE FilRst(VAR Status: StatusType
927 17B5 ;VAR Fl: FileType
928 17B5 );
929 17B5
930 17B5 BEGIN (*FILRST*)
931 17B5 WITH Fl DO
932 17CE BEGIN
933 17D3 P := 0;
934 17E4 reset(F);
935 17F7 IF eof(F) THEN
936 180D Status := Status + (.UnExpectedEof.);
937 1833 (*#B#
938 1833 IF test((.0,1.)) THEN
939 1833 BEGIN
940 1833 write(TestOut, 'FILrst'); TSTstat(Status); TSTln;
941 1833 END;
942 1833 #E#*)
943 1833 END
944 1833 END; (*FILRST*)
945 1839
946 1839 PROCEDURE FilRwt(VAR Fl: FileType
947 1839 );
948 1839
949 1839 BEGIN (*FILRWT*)
950 1839 (*#B#
951 1839 IF test((.0,1.)) THEN
952 1839 writeln(TestOut, 'FILrwt');
953 1839 #E#*)
954 1839 WITH Fl DO
955 1852 BEGIN
956 1857 rewrite(F);
957 1864 P := 0;
958 187B END
959 187B END; (*FILRWT*)
960 1881
961 1881 PROCEDURE FilCls(VAR Fl: FileType
962 1881 );
963 1881
964 1881 BEGIN (*FILCLS*)
965 1881 close(Fl.F);
966 189C END; (*FILCLS*)
967 18A2
968 18A2 PROCEDURE FilSeek(VAR Status: StatusType
969 18A2 ;VAR Fl: FileType
970 18A2 ; Position: FileAddressType
971 18A2 );
972 18A2
973 18A2 BEGIN (*FILSEEK*)
974 18A2 WITH Fl DO
975 18BB BEGIN
976 18C0 P := Position;
977 18D2 seek(F, Position);
978 18EB IF eof(F) THEN
979 1901 Status := Status + (.UnExpectedEof.);
980 1927 (*#B#
981 1927 IF test((.0,1,2.)) THEN
982 1927 BEGIN
983 1927 write(TestOut, 'FILSEEK '); TSTstat(Status); TSTindt;
984 1927 write(TestOut, 'P=', P:1
985 1927 , ' EOF='); TSTbool(eof(F));
986 1927 TSTln;
987 1927 END;
988 1927 #E#*)
989 1927 END
990 1927 END; (*FILSEEK*)
991 192D
992 192D PROCEDURE FGi8(VAR Status: StatusType
993 192D ;VAR Fl: FileType
994 192D ;VAR V: i8
995 192D );
996 192D
997 192D BEGIN (*FGI8*)
998 192D WITH Fl DO
999 1946 BEGIN
1000 194B IF not eof(F) THEN
1001 195D BEGIN
1002 1962 read(F,V);
1003 198B P := P + 1;
1004 19AD END
1005 19AD ELSE
1006 19AF Status := Status + (.UnexpectedEof.);
1007 19D5 (*#B#
1008 19D5 IF test((.0,2.)) THEN
1009 19D5 BEGIN
1010 19D5 write(TestOut, 'FGI8 '); TSTstat(Status); TSTindt;
1011 19D5 write(TestOut, 'P=', P:1,' V=', V:1, ' EOF='); TSTbool(eof(F));
1012 19D5 TSTln;
1013 19D5 END;
1014 19D5 #E#*)
1015 19D5 END;
1016 19D5 END; (*FGI8*)
1017 19DB
1018 19DB PROCEDURE FGi32(VAR Status: StatusType
1019 19DB ;VAR Fl: FileType
1020 19DB ;VAR V: i32
1021 19DB );
1022 19DB
1023 19DB VAR
1024 19DB I: I32IndexType;
1025 19DB N: I32ArrayType;
1026 19DB
1027 19DB BEGIN (*FGI32*)
1028 19DB WITH Fl DO
1029 19F4 BEGIN
1030 19F9 P := P + 4;
1031 1A1D FOR I := bs3 DOWNTO bs0 DO
1032 1A2E IF not eof(f) THEN
1033 1A47 read(F, N(.I.) )
1034 1A78 ELSE
1035 1A7E Status := Status + (.UnexpectedEof.);
1036 1AAE move(N, V, 4);
1037 1AC7 (*#B#
1038 1AC7 IF test((.0,2.)) THEN
1039 1AC7 BEGIN
1040 1AC7 write(TestOut, 'FGI32 '); TSTstat(Status); TSTindt;
1041 1AC7 write(TestOut, 'P=', P:1,' V=', V:1,
1042 1AC7 ' N=(',N(.bs3.):3,'/',N(.bs2.):3
1043 1AC7 ,'/',N(.bs1.):3,'/',N(.bs0.):3,') EOF=');
1044 1AC7 TSTbool(eof(F)); TSTln;
1045 1AC7 END;
1046 1AC7 #E#*)
1047 1AC7 END;
1048 1AC7 END; (*FGI32*)
1049 1ACD
1050 1ACD PROCEDURE FGSym(VAR Status: StatusType
1051 1ACD ;VAR Fl: FileType
1052 1ACD ;VAR SymbolName: SymbolNameType
1053 1ACD );
1054 1ACD
1055 1ACD VAR
1056 1ACD I: i8;
1057 1ACD N: i8;
1058 1ACD
1059 1ACD BEGIN (*FGSYM*)
1060 1ACD WITH Fl, SymbolName DO
1061 1AF2 BEGIN
1062 1AF7 (*#B#
1063 1AF7 IF test((.0,2.)) THEN
1064 1AF7 BEGIN
1065 1AF7 write(TestOut, 'FGSYM-1 '); TSTstat(Status); TSTindt;
1066 1AF7 write(TestOut, 'P=', P:1, ' F^=',F^:3, ' EOF=');
1067 1AF7 TSTbool(eof(F)); TSTln
1068 1AF7 END;
1069 1AF7 #E#*)
1070 1AF7 IF not eof(F) THEN
1071 1B10 BEGIN
1072 1B15 read(F, N);
1073 1B38 P := P + 1 + N;
1074 1B67 IF (0 < N) and (N <= MaxSymbolNameIndex) THEN
1075 1B85 BEGIN
1076 1B8A Length := N;
1077 1BA2 FOR I := 1 TO N DO
1078 1BB9 IF not eof(F) THEN
1079 1BD2 read(F, Name(.I.) )
1080 1C0B ELSE
1081 1C11 Status := Status + (.UnexpectedEof.)
1082 1C27 END
1083 1C41 ELSE
1084 1C44 BEGIN
1085 1C49 Status := Status + (.BadSymbolName.);
1086 1C6F FOR I := 1 TO N DO
1087 1C85 IF not eof(F) THEN
1088 1C9E read(F, Name(.1.) )
1089 1CC5 ELSE
1090 1CCB Status := Status + (.UnexpectedEof.)
1091 1CE1 END
1092 1CFB END
1093 1CFB ELSE
1094 1CFD Status := Status + (.UnexpectedEof.);
1095 1D23 (*#B#
1096 1D23 IF test((.0,2.)) THEN
1097 1D23 BEGIN
1098 1D23 write(TestOut, 'FGSYM-2 '); TSTstat(Status); TSTindt;
1099 1D23 TSTsymbol(SymbolName);
1100 1D23 END;
1101 1D23 #E#*)
1102 1D23 END
1103 1D23 END; (*FGSYM*)
1104 1D29
1105 1D29 PROCEDURE FPi8(VAR Fl: FileType
1106 1D29 ; V: i8
1107 1D29 );
1108 1D29
1109 1D29 BEGIN (*FPI8*)
1110 1D29 WITH Fl DO
1111 1D42 BEGIN
1112 1D47 (*#B#
1113 1D47 IF test((.0,3.)) THEN
1114 1D47 BEGIN
1115 1D47 writeln(TestOut, 'FPI8 ', 'P=', P:1,' V=', V:1);
1116 1D47 END;
1117 1D47 #E#*)
1118 1D47 write(F,V);
1119 1D6C P := P + 1
1120 1D85 END
1121 1D8E END; (*FPI8*)
1122 1D94
1123 1D94 PROCEDURE FPi32(VAR Fl: FileType
1124 1D94 ; V: i32
1125 1D94 );
1126 1D94
1127 1D94 VAR
1128 1D94 I: I32IndexType;
1129 1D94 N: I32ArrayType;
1130 1D94
1131 1D94 BEGIN (*FPI32*)
1132 1D94 move(V, N, 4);
1133 1DB6 WITH Fl DO
1134 1DC7 BEGIN
1135 1DCC (*#B#
1136 1DCC IF test((.0,3.)) THEN
1137 1DCC BEGIN
1138 1DCC writeln(TestOut, 'FPI32 ', 'P=', P:1,' V=', V:1,
1139 1DCC ' N=(',N(.bs3.):3,'/',N(.bs2.):3
1140 1DCC ,'/',N(.bs1.):3,'/',N(.bs0.):3,')');
1141 1DCC END;
1142 1DCC #E#*)
1143 1DCC P := P + 4;
1144 1DF0 FOR I := bs3 DOWNTO bs0 DO
1145 1E01 write(F, N(.I.) )
1146 1E32 END
1147 1E3F END; (*FPI32*)
1148 1E45
1149 1E45 PROCEDURE FPSym(VAR Fl: FileType
1150 1E45 ; SymbolName: SymbolNameType
1151 1E45 );
1152 1E45
1153 1E45 VAR
1154 1E45 I: SymbolNameIndexType;
1155 1E45
1156 1E45 BEGIN (*FPSYM*)
1157 1E45 WITH Fl, SymbolName DO
1158 1E73 BEGIN
1159 1E78 (*#B#
1160 1E78 IF test((.0,3.)) THEN
1161 1E78 BEGIN
1162 1E78 write(TestOut, 'FPSYM-2 '); TSTstat(Status); TSTindt;
1163 1E78 write(TestOut, 'P=', P:1); TSTindt; TSTsymbol(SymbolName);
1164 1E78 END;
1165 1E78 #E#*)
1166 1E78 P := P + 1 + Length;
1167 1EA2 write(F, Length);
1168 1ECB FOR I := 1 TO Length DO
1169 1EE4 write(F, Name(.I.) )
1170 1F16 END
1171 1F23 END; (*FPSYM*)
1172 1F29
1173 1F29 (* *)
1174 1F29 (* *)
1175 1F29 (******************************************************************************)
1176 1F29
1177 1F29 (*$I B:lnkp0.pas Procedure setup *)
1178 1F29 (******************************************************************************)
1179 1F29 (* *)
1180 1F29 (* Copyright (1985) by Metanic Aps., Denmark *)
1181 1F29 (* *)
1182 1F29 (* Author: Lars Gregers Jakobsen. *)
1183 1F29 (* *)
1184 1F29 (******************************************************************************)
1185 1F29
1186 1F29
1187 1F29 PROCEDURE SetUp(VAR Status: StatusType
1188 1F29 ;VAR TargetFile: FileType
1189 1F29 ;VAR LogFile: LogFileType
1190 1F29 ;VAR Out_file: text
1191 1F29 );
1192 1F29
1193 1F29 CONST
1194 1F29 InputFileNameSuffix = 'OBJ';
1195 1F2C TargetFileNameSuffix = 'OUT';
1196 1F2F LogFileNameSuffix = 'MAP';
1197 1F32
1198 1F32 VAR
1199 1F32 CommandLine: CommandLineType;
1200 1F32 Current: CommandLineIndexType;
1201 1F32 FileName: FileNameType;
1202 1F32
1203 1F32 PROCEDURE SkipBlanks;
1204 1F32
1205 1F32 BEGIN (*SKIPBLANKS*)
1206 1F32 WHILE (CommandLine(.Current.) = ' ') and
1207 1F5B (Current < length(CommandLine)) DO
1208 1F80 Current := Current + 1;
1209 1FA0 END; (*SKIPBLANKS*)
1210 1FA6
1211 1FA6 PROCEDURE DecodeFileName(VAR Status: StatusType
1212 1FA6 ;VAR FileName: FileNameType
1213 1FA6 ; Suffix: FileNameType
1214 1FA6 ; Terminators: CharSetType
1215 1FA6 );
1216 1FA6
1217 1FA6 VAR
1218 1FA6 I: CommandLineIndexType;
1219 1FA6
1220 1FA6 BEGIN (*DECODEFILENAME*)
1221 1FA6 I := 0;
1222 1FB7 WHILE (Current + I < length(CommandLine) ) and
1223 1FE1 not ( CommandLine(.Current + I.) in Terminators ) DO
1224 2022 I := I + 1;
1225 203A IF (0 < I) and (I <= FileNameLength) THEN
1226 205D BEGIN
1227 2062 FileName := Copy(CommandLine, Current, I);
1228 2090 Current := Current + I;
1229 20B5 IF (pos('.', FileName) = 0) THEN
1230 20D0 IF (length(FileName) <= FileNameLength - 4) THEN
1231 20E3 FileName := concat(FileName, '.', Suffix)
1232 210C ELSE
1233 2117 Status := Status + (.BadFileName.)
1234 212D END
1235 213B ELSE
1236 213D Status := Status + (.BadFileName.);
1237 2161 (*#B#
1238 2161 IF test((.0,16,18.)) THEN
1239 2161 BEGIN
1240 2161 write(TestOut, 'DecodeFileName '); TSTstat(Status);
1241 2161 TSTindt; write(TestOut, 'Curr=', Current:1);
1242 2161 TSTindt; write(TestOut, 'I=', I:1);
1243 2161 TSTindt; writeln(TestOut, 'FileName=', FileName)
1244 2161 END
1245 2161 #E#*)
1246 2161 END; (*DECODEFILENAME*)
1247 2167
1248 2167
1249 2167 BEGIN (*SETUP*)
1250 2167 Getcomm(CommandLine);
1251 2182 CommandLine := concat(CommandLine, ' ');
1252 21A4 Current := 1;
1253 21AD Status := (..);
1254 21C4 SkipBlanks; (*Leaving current pointing at next non blank*)
1255 21D0 (*Interpret option list*)
1256 21D0 (*#B#
1257 21D0 IF test((.0,16,18.)) THEN
1258 21D0 BEGIN
1259 21D0 write(TestOut, 'Setup-1 '); write(TestOut, 'Curr=', Current:1);
1260 21D0 TSTindt; write(TestOut, 'Lng(ComLin)=', Length(CommandLine):1);
1261 21D0 TSTindt; TSTmem; TSTln;
1262 21D0 TSTindt; writeln(TestOut, 'ComLin=', CommandLine)
1263 21D0 END;
1264 21D0 #E#*)
1265 21D0 WHILE (Current < length(CommandLine)) and
1266 21E5 (CommandLine(.Current.) = '/') and
1267 2207 (Status = (..)) DO
1268 2223 BEGIN
1269 2228 Current := Current + 1;
1270 223E CASE CommandLine(.Current.) OF
1271 2259 'M','m':
1272 2259 BEGIN
1273 225E Current := Current + 1;
1274 2274 IF CommandLine(.Current.) = '=' THEN
1275 2290 BEGIN
1276 2295 Current := Current + 1;
1277 22AB DecodeFileName(Status, FileNametable(.-1.)
1278 22B7 , LogFileNameSuffix, (.' ', '/', ','.) );
1279 22DF IF Status = (..) THEN
1280 22F7 OptionTable.LogFileKind := Explicit
1281 22FC END
1282 2301 ELSE
1283 2303 OptionTable.LogFileKind := Implicit
1284 2308 END;
1285 2310 'O','o':
1286 2310 BEGIN
1287 2315 Current := Current + 1;
1288 232B IF CommandLine(.Current.) = '=' THEN
1289 2347 BEGIN
1290 234C Current := Current + 1;
1291 2362 DecodeFileName(Status, FileNameTable(.0.)
1292 236E , TargetFileNameSuffix, (.' ', '/', ','.) );
1293 2396 IF Status = (..) THEN
1294 23AE OptionTable.TargetFileKind := Explicit
1295 23B3 END
1296 23B8 ELSE
1297 23BA OptionTable.TargetFileKind := Implicit
1298 23BF END;
1299 23C6 OTHERWISE
1300 23C6 Status := Status + (.BadOption.)
1301 23DC END; (*CASE*)
1302 23FF (*#B#
1303 23FF IF test((.0,16,18.)) THEN
1304 23FF BEGIN
1305 23FF write(TestOut, 'Setup-2 '); TSTstat(Status);
1306 23FF TSTindt; writeln(TestOut, 'Curr=', Current:1);
1307 23FF TSTindt; TSTopt;
1308 23FF TSTindt; TSTfnt(-1);
1309 23FF TSTindt; TSTfnt(0)
1310 23FF END;
1311 23FF #E#*)
1312 23FF END; (*WHILE*)
1313 2402 IF Status = (..) THEN (*Interpret file list*)
1314 241B BEGIN
1315 2420 SkipBlanks;
1316 242C IF Current < length(CommandLine) THEN
1317 2444 Status := Status + (.NotFinished.);
1318 246C WHILE (Current < length(CommandLine)) and
1319 2481 (NotFinished IN Status) DO
1320 24A2 BEGIN
1321 24A7 DecodeFileName(Status, FileName
1322 24B3 , InputFileNameSuffix, (.' ', ','.) );
1323 24DF IF not (BadFileName IN Status) THEN
1324 24F9 BEGIN
1325 24FE (*#B#
1326 24FE IF test((.0,16,18.)) THEN
1327 24FE BEGIN
1328 24FE write(TestOut, 'Setup-3 '); TSTstat(Status); TSTindt;
1329 24FE write(TestOut, 'fstat(FileName)=');
1330 24FE TSTbool(fstat(FileName)); TSTln;
1331 24FE END;
1332 24FE #E#*)
1333 24FE IF fstat(FileName) THEN
1334 2513 FNTP(Status, FileName)
1335 252E ELSE
1336 2533 Status := Status + (.NoSuchFile.);
1337 2557 END;
1338 2557 IF NotFinished IN Status THEN
1339 2571 CASE CommandLine(.Current.) OF
1340 258F ' ':
1341 258F Status := Status - (.NotFinished.);
1342 25B9 ',':
1343 25B9 BEGIN
1344 25BE Current := Current + 1 (*Skip the comma*)
1345 25C3 END
1346 25D4 END (*CASE CommandLine(.Current.) OF*)
1347 25E3 END (* WHILE *** DO *)
1348 25E3 END; (* IF Status = (..) -- End interpret file list *)
1349 25E6 IF CurFileNo <= 0 THEN
1350 25F7 Status := Status + (.NoInputFiles.);
1351 261B IF Status = (..) THEN
1352 2634 BEGIN
1353 2639 FileName := copy(FileNameTable(.1.), 1, pos('.',FileNameTable(.1.)) );
1354 2665 IF OptionTable.LogFileKind = Implicit THEN
1355 2671 FileNameTable(.-1.) := concat(FileName, LogFileNameSuffix);
1356 2692 IF OptionTable.TargetFileKind = Implicit THEN
1357 269E FileNameTable(. 0.) := concat(FileName, TargetFileNameSuffix);
1358 26BF
1359 26BF IF (OptionTable.LogFileKind <> none) and
1360 26C9 ( (not checkfn(FileNameTable(.-1.) ) ) or
1361 26D8 (fstat(FileNameTable(.-1.) ) )
1362 26E2 ) THEN
1363 26EB Status := Status + (.badlogfilename.);
1364 270F IF (not checkfn(FileNameTable(.0.) ) ) or
1365 271F (fstat(FileNameTable(.0.) ) ) THEN
1366 272F Status := Status + (.badtargetfilename.);
1367 2753
1368 2753 (*#B#
1369 2753 IF test((.0,16,18.)) THEN
1370 2753 BEGIN
1371 2753 write(TestOut, 'Setup-4 '); TSTstat(Status); TSTln;
1372 2753 TSTindt; TSTopt;
1373 2753 TSTindt; TSTfnt(-1);
1374 2753 TSTindt; TSTfnt(0);
1375 2753 TSTindt; TSTfnt(1)
1376 2753 END;
1377 2753 #E#*)
1378 2753
1379 2753 IF Status = (..) THEN
1380 276B BEGIN
1381 2770 IF OptionTable.LogFileKind <> None THEN
1382 277C BEGIN
1383 2781 LogInit(LogFile, FileNameTable(.-1.) );
1384 279B LogCmd(LogFile, CommandLine);
1385 27B9 END;
1386 27B9 FilAsg(TargetFile, FileNameTable(.0.) );
1387 27D3 FilRwt(TargetFile);
1388 27E2 END
1389 27E2 ELSE
1390 27E4 Status := Status + (.NoTarget.);
1391 280C END
1392 280C ELSE
1393 280E BEGIN
1394 2813 Status := Status + (.Notarget.);
1395 283B writeln(out_file, CommandLine);
1396 2864 writeln(out_file, '^':Current);
1397 2887 END
1398 2887 END; (*SETUP*)
1399 288D
1400 288D (* *)
1401 288D (* *)
1402 288D (******************************************************************************)
1403 288D
1404 288D (*$I B:lnkp1.pas Procedure pass1 *)
1405 288D (******************************************************************************)
1406 288D (* *)
1407 288D (* Copyright (1985) by Metanic Aps., Denmark *)
1408 288D (* *)
1409 288D (* Author: Lars Gregers Jakobsen. *)
1410 288D (* *)
1411 288D (******************************************************************************)
1412 288D
1413 288D PROCEDURE Pass1(VAR Status: StatusType
1414 288D ;VAR TargetFile: FileType
1415 288D ;VAR LogFile: LogFileType
1416 288D );
1417 288D
1418 288D (* Pass1 of the linker performs the gathering of export and
1419 288D import information from the input files as well as calculation
1420 288D of final memory map and all operations on the symbol table
1421 288D including reporting to the log file.
1422 288D The following statusvalues may be returned:
1423 288D Success: ok. All other parameters meaningful.
1424 288D
1425 288D *)
1426 288D
1427 288D
1428 288D VAR
1429 288D SymbolTable: SymbolTableType;
1430 288D LatestInsert: SymbolTableIndexType; (*Points to SBT entry of latest insert*)
1431 288D CurrentSymbolCount: SymbolTableIndexType; (*Number of SBT entries currently used*)
1432 288D
1433 288D NameTable: NameTableType;
1434 288D CurrentNameTableIndex: NameTableIndexType; (*Least index vacant -
1435 288D NOT count of strings*)
1436 288D
1437 288D
1438 288D (* MISC. VARIABLES *)
1439 288D
1440 288D SBTSubInx: SymbolTableSubIndexType;
1441 288D
1442 288D (*#B#(*$I B:LnkDF3.pas Definitions of pass1 local test output primitives *)
1443 288D (*$I B:LnkDF4.pas Definitions of pass1 local access primitives *)
1444 288D (******************************************************************************)
1445 288D (* *)
1446 288D (* Copyright (1985) by Metanic Aps., Denmark *)
1447 288D (* *)
1448 288D (* Author: Lars Gregers Jakobsen. *)
1449 288D (* *)
1450 288D (******************************************************************************)
1451 288D
1452 288D
1453 288D PROCEDURE NMTP(VAR Status: StatusType
1454 288D ;VAR NameReference: NameTableIndexType
1455 288D ; SymbolName: SymbolNameType
1456 288D );
1457 288D
1458 288D VAR
1459 288D I: SymbolNameIndexType;
1460 288D
1461 288D BEGIN (*NMTP*)
1462 288D WITH SymbolName DO
1463 28AF BEGIN
1464 28B4 IF CurrentNameTableIndex + Length + 1 > MaxNameTableIndex THEN
1465 28E3 Status := Status + (.NameTableOverFlow.)
1466 28F9 ELSE
1467 290D BEGIN
1468 2912 Namereference := CurrentNameTableIndex + 1;
1469 2932 CurrentNameTableIndex := NameReference + Length;
1470 2959 NameTable(.NameReference.) := Length;
1471 297E FOR I := 1 TO Length DO
1472 2997 NameTable(.NameReference + I.) := Name(.I.);
1473 29E3 END;
1474 29E3 (*#B#
1475 29E3 IF test((.0,9.)) THEN
1476 29E3 BEGIN
1477 29E3 write(TestOut, 'NMTP '); TSTstat(Status); TSTindt;
1478 29E3 writeln(TestOut, 'Length=', Length:1);
1479 29E3 TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1480 29E3 END;
1481 29E3 #E#*)
1482 29E3 END
1483 29E3 END; (*NMTP*)
1484 29E9
1485 29E9 FUNCTION NMTfail( NameReference: NameTableIndexType
1486 29E9 ; SymbolName: SymbolNameType
1487 29E9 ): boolean;
1488 29E9
1489 29E9 (* NMTfail returns one of the following values:
1490 29E9 FALSE: If the exact same symbolname was found in NMT - i.e.
1491 29E9
1492 29E9 NameReference <> 0 AND
1493 29E9 NMT(.NameReference.) = SymbolName.Length AND
1494 29E9 FOR i = 1 TO length:
1495 29E9 NMT(.NameReference+i.) = SymbolName.Name(.i.)
1496 29E9
1497 29E9 OR If an empty entry was found in NMT - i.e.
1498 29E9
1499 29E9 NameReference = 0.
1500 29E9
1501 29E9
1502 29E9 TRUE: In all other cases.
1503 29E9 *)
1504 29E9
1505 29E9 LABEL
1506 29E9 99;
1507 29E9
1508 29E9 VAR
1509 29E9 I: SymbolNameIndexType;
1510 29E9
1511 29E9 BEGIN (*NMTFAIL*)
1512 29E9 NMTfail := false;
1513 2A0F WITH SymbolName DO
1514 2A14 BEGIN
1515 2A19 IF NameReference <> 0 THEN
1516 2A25 IF length <> NameTable(.NameReference.) THEN
1517 2A42 NMTfail := true
1518 2A47 ELSE
1519 2A4E BEGIN
1520 2A53 FOR I := 1 TO Length DO
1521 2A6C IF Name(.I.) <> NameTable(.NameReference + I.) THEN
1522 2AAC BEGIN
1523 2AB1 NMTfail := true;
1524 2ABA GOTO 99;
1525 2AC2 END;
1526 2ACC 99:; END;
1527 2ACC (*#B#
1528 2ACC IF test((.0,9.)) THEN
1529 2ACC BEGIN
1530 2ACC writeln(TestOut, 'NMTfail ', 'NameRef=', NameReference:1);
1531 2ACC TSTindt; TSTindt; TSTindt; TSTsymbol(SymbolName);
1532 2ACC TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1533 2ACC END;
1534 2ACC #E#*)
1535 2ACC END
1536 2ACC END; (*NMTFAIL*)
1537 2AD5
1538 2AD5 PROCEDURE NMTG( NameReference: NameTableIndexType
1539 2AD5 ;VAR SymbolName: SymbolNameType
1540 2AD5 );
1541 2AD5
1542 2AD5 VAR
1543 2AD5 I: SymbolNameIndexType;
1544 2AD5
1545 2AD5 BEGIN (*NMTG*)
1546 2AD5 WITH SymbolName DO
1547 2AEE BEGIN
1548 2AF3 Length := NameTable(.NameReference.);
1549 2B15 FOR I := 1 TO Length DO
1550 2B32 Name(.I.) := NameTable(. NameReference + I .);
1551 2B7B (*#B#
1552 2B7B IF test((.0,9,13.)) THEN
1553 2B7B BEGIN
1554 2B7B write(TestOut, 'NMTG '); TSTindt;
1555 2B7B write(TestOut, 'NameRef=', NameReference:1); TSTindt;
1556 2B7B TSTsymbol(SymbolName);
1557 2B7B END;
1558 2B7B #E#*)
1559 2B7B END
1560 2B7B END; (*NMTG*)
1561 2B81
1562 2B81 PROCEDURE Hash(VAR SymbolName: SymbolNameType
1563 2B81 ;VAR SBTInx: SymbolTableIndexType
1564 2B81 );
1565 2B81
1566 2B81 BEGIN (*HASH*)
1567 2B81 SBTInx := 1
1568 2B94 END; (*HASH*)
1569 2B9C
1570 2B9C PROCEDURE SBTS(VAR Status: StatusType
1571 2B9C ;VAR SBTInx: SymbolTableIndexType
1572 2B9C ; SymbolName: SymbolNameType
1573 2B9C );
1574 2B9C
1575 2B9C (* SBTS returns one of the following Status codes:
1576 2B9C Success: SymbolName found in SBT. SBTInx reflects
1577 2B9C SymbolName.
1578 2B9C NotFound: SymbolName NOT found in SBT. SBTInx
1579 2B9C indicates the entry into which Symbol should be
1580 2B9C registered.
1581 2B9C SymbolTableOverFlow: SymbolName NOT found in SBT.
1582 2B9C SBTInx is not valid. There
1583 2B9C is no room in SBT for further updates.
1584 2B9C
1585 2B9C Search SBT to find the Entry for SYMBOLNAME retaining the index
1586 2B9C of the first vacant record as SYMBOLTABLEENTRYNO if the search
1587 2B9C fails. Otherwise return found index. Set Status to Success or
1588 2B9C NotFound according to outcome. Set Status to SBTOverFlow if
1589 2B9C no vacant is available and symbol is not found.
1590 2B9C
1591 2B9C A SBT record is vacant if Namereference = 0.
1592 2B9C *)
1593 2B9C
1594 2B9C
1595 2B9C BEGIN (*SBTS*)
1596 2B9C (* Assume existence of entry in SBT with NameReference = 0 *)
1597 2B9C Hash(SymbolName, SBTInx);
1598 2BD0 (*#B#
1599 2BD0 IF test((.0,9.)) THEN
1600 2BD0 BEGIN
1601 2BD0 write(TestOut, 'SBTS-1 '); TSTstat(Status); TSTln;
1602 2BD0 TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1603 2BD0 END;
1604 2BD0 #E#*)
1605 2BD0 WHILE NMTfail(Symboltable(.SBTInx.).NameReference, SymbolName) DO
1606 2C09 BEGIN
1607 2C0E (* HASH NEXT TRY *)
1608 2C0E IF MaxNooSymbols <= SBTInx THEN
1609 2C25 SBTInx := 0;
1610 2C32 SBTInx := SBTInx + 1;
1611 2C52
1612 2C52 (*#B#
1613 2C52 IF test((.0,9.)) THEN
1614 2C52 BEGIN
1615 2C52 write(TestOut, 'SBTS-2 '); TSTstat(Status); TSTln;
1616 2C52 TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1617 2C52 END;
1618 2C52 #E#*)
1619 2C52
1620 2C52 END;
1621 2C54 IF SymbolTable(.SBTInx.).NameReference = 0 THEN
1622 2C7A IF CurrentSymbolCount >= MaxNooSymbols - 1 THEN
1623 2C8E Status := Status + (.SymbolTableOverFlow.)
1624 2CA4 ELSE
1625 2CB7 Status := Status + (.NotFound.);
1626 2CDF (*#B#
1627 2CDF IF test((.0,10.)) THEN
1628 2CDF BEGIN
1629 2CDF write(TestOut, 'SBTS-3 '); TSTstat(Status); TSTln;
1630 2CDF TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1631 2CDF END;
1632 2CDF #E#*)
1633 2CDF END; (*SBTS*)
1634 2CE5
1635 2CE5 PROCEDURE SBTEX(VAR Status: StatusType
1636 2CE5 ;VAR SymbolTableEntryNo: SymbolTableIndexType
1637 2CE5 ; SymbolName: SymbolNameType
1638 2CE5 ; P_ModuleNo: ModuleTableIndexType
1639 2CE5 ; P_SegmentNo: SegmentNoType
1640 2CE5 ; Item: i32
1641 2CE5 );
1642 2CE5
1643 2CE5 BEGIN (*SBTEX*)
1644 2CE5 SBTS(Status, SymbolTableEntryNo, SymbolName);
1645 2D24 IF not (SymbolTableOverFlow IN Status) THEN
1646 2D3F WITH SymbolTable(.SymbolTableEntryNo.)
1647 2D60 ,ValueTable(.SymbolTableEntryNo.) DO
1648 2D84 IF NotFound IN Status THEN
1649 2D9F BEGIN (*Symbol is NOT in SBT and thus not resolved*)
1650 2DA4 Status := Status - (.NotFound.);
1651 2DCC NMTP(Status, NameReference, SymbolName);
1652 2DEF IF not (NameTableOverFlow IN Status) THEN
1653 2E0A BEGIN
1654 2E0F CurrentSymbolCount := CurrentSymbolCount + 1;
1655 2E2D ModuleNo := P_ModuleNo;
1656 2E41 IF LatestInsert <> 0 THEN
1657 2E50 SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
1658 2E80 LatestInsert := SymbolTableEntryNo;
1659 2E96 SortLink := SymbolTableEntryNo;
1660 2EB0 SegmentNo := P_SegmentNo;
1661 2EC4 Value := Item
1662 2ECF END
1663 2ED8 END (*IF NotFound IN Status*)
1664 2ED8 ELSE (* SUCCESS: Symbol is in SBT*)
1665 2EDB BEGIN
1666 2EE0 IF SegmentNo > UnResolved THEN
1667 2EF7 Status := Status + (.DuplicateExportSymbol.)
1668 2F0D ELSE (*Symbol NOT previously resolved i.e. imported only*)
1669 2F20 BEGIN
1670 2F25 ModuleNo := P_ModuleNo;
1671 2F39 IF LatestInsert <> 0 THEN
1672 2F48 SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
1673 2F78 LatestInsert := SymbolTableEntryNo;
1674 2F8E SortLink := SymbolTableEntryNo;
1675 2FA8 SegmentNo := P_SegmentNo;
1676 2FBC Value := Item
1677 2FC7 END
1678 2FD0 END; (*ELSE (i.e. Success IN Status)*)
1679 2FD0 (*#B#
1680 2FD0 IF test((.0,10.)) THEN
1681 2FD0 BEGIN
1682 2FD0 write(TestOut, 'SBTEX '); TSTstat(Status);
1683 2FD0 TSTindt; TSTsymbol(SymbolName);
1684 2FD0 TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
1685 2FD0 TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
1686 2FD0 END;
1687 2FD0 #E#*)
1688 2FD0 END; (*SBTEX*)
1689 2FD6
1690 2FD6
1691 2FD6 PROCEDURE SBTIM(VAR Status: StatusType
1692 2FD6 ;VAR SymbolTableEntryNo: SymbolTableIndexType
1693 2FD6 ;VAR SymbolName: SymbolNameType
1694 2FD6 ; P_ModuleNo: ModuleTableIndexType
1695 2FD6 );
1696 2FD6
1697 2FD6 BEGIN (*SBTIM*)
1698 2FD6 SBTS(Status, SymbolTableEntryNo, SymbolName);
1699 2FFF IF Not (SymbolTableOverFlow IN Status) THEN
1700 301A BEGIN
1701 301F IF NotFound IN Status THEN
1702 303A WITH SymbolTable(.SymbolTableEntryNo.)
1703 305B ,ValueTable(.SymbolTableEntryNo.) DO
1704 307F BEGIN
1705 3084 Status := Status - (.NotFound.);
1706 30AC NMTP(Status, NameReference, SymbolName);
1707 30CE IF not (NameTableOverFlow IN Status) THEN
1708 30E8 BEGIN
1709 30ED CurrentSymbolCount := CurrentSymbolCount + 1;
1710 310B ModuleNo := P_ModuleNo;
1711 311F SortLink := 0;
1712 312E SegmentNo := UnResolved;
1713 313B Value := 0;
1714 3151 END
1715 3151 END;
1716 3151 EITP(Status,SymbolTableEntryNo)
1717 3168 END;
1718 316B (*#B#
1719 316B IF test((.0,10.)) THEN
1720 316B BEGIN
1721 316B write(TestOut, 'SBTIM '); TSTstat(Status); TSTln;
1722 316B TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
1723 316B TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
1724 316B END;
1725 316B #E#*)
1726 316B END; (*SBTIM*)
1727 3171
1728 3171 (* *)
1729 3171 (* *)
1730 3171 (******************************************************************************)
1731 3171
1732 3171
1733 3171 (*$I B:lnkp1-1.pas getinputfiles *)
1734 3171 (******************************************************************************)
1735 3171 (* *)
1736 3171 (* Copyright (1985) by Metanic Aps., Denmark *)
1737 3171 (* *)
1738 3171 (* Author: Lars Gregers Jakobsen. *)
1739 3171 (* *)
1740 3171 (******************************************************************************)
1741 3171
1742 3171 PROCEDURE GetInputFiles(VAR GStatus: StatusType
1743 3171 ;VAR LogFile: LogFileType
1744 3171 );
1745 3171
1746 3171 VAR
1747 3171 InputFile: FileType;
1748 3171 FileNo: FileNameTableIndexType;
1749 3171 Status: StatusType;
1750 3171
1751 3171 PROCEDURE ValidateFileFormat(VAR Status: StatusType
1752 3171 ;VAR F: FileType
1753 3171 ; Format: OF_FormatType
1754 3171 );
1755 3171
1756 3171 VAR
1757 3171 OFF_Format: OF_FormatType;
1758 3171
1759 3171 BEGIN (*VALIDATEFILEFORMAT*)
1760 3171 FGi32(Status, F, OFF_Format);
1761 3197 IF OFF_Format <> Format THEN
1762 31AB Status := Status + (.BadFileFormat.);
1763 31CF (*#B#
1764 31CF IF test((.0,16,19.)) THEN
1765 31CF BEGIN
1766 31CF write(TestOut, 'GetFFvalid '); TSTstat(Status); TSTindt;
1767 31CF writeln(TestOut, 'OFF_Format=', OFF_Format);
1768 31CF END;
1769 31CF #E#*)
1770 31CF END; (*VALIDATEFILEFORMAT*)
1771 31D5
1772 31D5 PROCEDURE GetModules(VAR GStatus: StatusType
1773 31D5 ;VAR LogFile: LogFileType
1774 31D5 ; FileNumber: FileNameTableIndexType
1775 31D5 ;VAR Fl: FileType
1776 31D5 ; StartAddressOfNextModule: FileAddressType
1777 31D5 );
1778 31D5
1779 31D5 VAR
1780 31D5 Status: StatusType;
1781 31D5
1782 31D5 PROCEDURE ValidateModuleFormat(VAR Status: StatusType
1783 31D5 ;VAR F: FileType
1784 31D5 ; Format: OM_FormatType
1785 31D5 );
1786 31D5
1787 31D5 VAR
1788 31D5 OMF_Format: OM_FormatType;
1789 31D5
1790 31D5 BEGIN (*VALIDATEMODULEFORMAT*)
1791 31D5 FGi32(Status, F, OMF_Format);
1792 31FB IF OMF_Format <> Format THEN
1793 320F Status := Status + (.BadModuleFormat.);
1794 3235 (*#B#
1795 3235 IF test((.0,16,19.)) THEN
1796 3235 BEGIN
1797 3235 write(TestOut, 'GetMFvalid '); TSTstat(Status); TSTindt;
1798 3235 writeln(TestOut, 'OMF_Format=',OMF_Format);
1799 3235 END;
1800 3235 #E#*)
1801 3235 END; (*VALIDATEMODULEFORMAT*)
1802 323B
1803 323B
1804 323B PROCEDURE GetModuleHeader(VAR GStatus: StatusType
1805 323B ;VAR LogFile: LogFileType
1806 323B ; FileNo:
1807 323B FileNameTableIndexType
1808 323B ;VAR Fl: FileType
1809 323B ;VAR StartAddressOfNextModule:
1810 323B FileAddressType
1811 323B );
1812 323B
1813 323B VAR
1814 323B Status: StatusType;
1815 323B SegmentNo: SegmentNoType;
1816 323B SymbolNo: SymbolTableIndexType;
1817 323B ModuleNo: ModuleTableIndexType;
1818 323B MdtRec: ModuleTableRecordType;
1819 323B NooExpSymbols: QuadImageUnitType;
1820 323B NooExiSymbols: QuadImageUnitType;
1821 323B
1822 323B PROCEDURE GetINX(VAR Status: StatusType
1823 323B ;VAR ModuleNo: ModuleTableIndexType
1824 323B ;VAR Fl: FileType
1825 323B ;VAR StartAddressOfNextModule:
1826 323B FileAddressType
1827 323B ;VAR NooExpSymbols: QuadImageUnitType
1828 323B ;VAR NooExiSymbols: QuadImageUnitType
1829 323B );
1830 323B
1831 323B VAR
1832 323B OMH_ModuleSize: QuadImageUnitType;
1833 323B OMH_NooSegments: QuadImageUnitType;
1834 323B OMH_ModuleName: ModuleNameType;
1835 323B
1836 323B BEGIN (*GETINX*)
1837 323B WITH ModuleTable(.ModuleNo.) DO
1838 3266 BEGIN
1839 326B FGi32(Status, Fl, OMH_ModuleSize);
1840 3289 FGi32(Status, Fl, OMH_NooSegments);
1841 32A7 FGi32(Status, Fl, NooExpSymbols);
1842 32C4 FGi32(Status, Fl, NooExiSymbols);
1843 32E1 StartAddressOfNextModule :=
1844 32EC StartAddressOfNextModule + abs(OMH_moduleSize);
1845 3308 IF (OMH_NooSegments > MaxNooSegments) or
1846 331C (Noo_ExiSymbols > MaxNooExternalImportSymbols) THEN
1847 333D Status := Status + (.RangeError.)
1848 3353 ELSE
1849 3366 BEGIN
1850 336B Referenced := false;
1851 337C NooSegments := OMH_NooSegments;
1852 339B IF NooSegments > CurSegmentCount THEN
1853 33B7 CurSegmentCount := NooSegments;
1854 33CD NooExternalImportSymbols := NooExiSymbols;
1855 33F1 LatestInsert := 0;
1856 33FE FGsym(Status, Fl, OMH_ModuleName);
1857 341C IF Status = (..) THEN
1858 3435 BEGIN
1859 343A SBTEX(Status
1860 343F ,ModuleNameReference
1861 3446 ,OMH_ModuleName
1862 344D ,ModuleNo
1863 3455 ,0,0);
1864 3472 IF not (SymbolTableOverFlow IN Status) THEN
1865 348C ValueTable(.ModuleNameReference.).SegmentNo := UnResolved;
1866 34AB IF DuplicateExportSymbol IN Status THEN
1867 34C5 Status := Status - (.DuplicateExportSymbol.) +
1868 34E4 (.DuplicateModuleName.);
1869 34F4 END
1870 34F4 END
1871 34F4 END
1872 34F4 END; (*GETINX*)
1873 34FA
1874 34FA
1875 34FA PROCEDURE GetSGDs(VAR Status: StatusType
1876 34FA ; SCTBase: SectionTableIndexType
1877 34FA ; NooSegments: SegmentNoType
1878 34FA ; P_ModuleNo: ModuleTableIndexType
1879 34FA ;VAR Fl: FileType
1880 34FA );
1881 34FA
1882 34FA LABEL
1883 34FA 99;
1884 34FA
1885 34FA VAR
1886 34FA SegmentInx: SegmentNoType;
1887 34FA Dummy32: QuadImageUnitType;
1888 34FA
1889 34FA BEGIN (*GETSEGMENTDESCRIPTORS*)
1890 34FA FOR SegmentInx := 1 TO NooSegments DO
1891 351C BEGIN
1892 3521 IF Status <> (..) THEN
1893 353A GOTO 99;
1894 3542 WITH SectionTable(.SCTbase + SegmentInx.) DO
1895 3570 BEGIN
1896 3575 SegmentNo := SegmentInx;
1897 3584 ModuleNo := P_ModuleNo;
1898 3598 FGi32(Status, Fl, Dummy32);
1899 35B6 ImageSize := abs(Dummy32);
1900 35D1 FGi32(Status, Fl, Dummy32);
1901 35EF OvrSize := abs(Dummy32);
1902 360C (*#B#
1903 360C IF test((.0,16,19.)) THEN
1904 360C BEGIN
1905 360C write(TestOut, 'GetSGDs '); TSTstat(Status);
1906 360C TSTindt; TSTsct(SCTbase + SegmentInx); TSTln
1907 360C END;
1908 360C #E#*)
1909 360C END;
1910 360C END;
1911 3616 99:; END; (*GETSEGMENTDESCRIPTORS*)
1912 361C
1913 361C PROCEDURE GetEXP(VAR GStatus: StatusType
1914 361C ;VAR LogFile: LogFileType
1915 361C ;VAR Fl: FileType
1916 361C ;VAR LinkHead: SymbolTableIndexType
1917 361C ; ModuleNo: ModuleTableIndexType
1918 361C ; NooExpSymbols: i32
1919 361C );
1920 361C
1921 361C VAR
1922 361C Status: StatusType;
1923 361C SymbolCount: i32;
1924 361C DuplicateCount: i32;
1925 361C RelocationIndicator: RelocationIndicatorType;
1926 361C EXP_RelocationIndicator: ImageUnitType;
1927 361C EXP_Item: QuadImageUnitType;
1928 361C EXP_SymbolName: SymbolNameType;
1929 361C SymbolTableEntryNo: SymbolTableIndexType; (*DUMMY*)
1930 361C ModuleName: ModuleNameType;
1931 361C
1932 361C BEGIN (*GETEXPORTLIST*)
1933 361C Status := (..);
1934 363C LinkHead := 0;
1935 3649 LatestInsert := 0;
1936 3656 SymbolCount := 0;
1937 3665 DuplicateCount := 0;
1938 3674 IF SymbolCount < NooExpSymbols THEN
1939 3689 BEGIN
1940 368E SymbolCount := SymbolCount + 1;
1941 369E FGi8( Status, Fl, EXP_RelocationIndicator);
1942 36BD IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
1943 36CF RelocationIndicator := EXP_RelocationIndicator
1944 36D4 ELSE
1945 36E3 Status := Status + (.RangeError.);
1946 370B FGi32(Status, Fl, EXP_Item);
1947 372A FGsym(Status, Fl, EXP_SymbolName);
1948 3749 IF Status = (..) THEN
1949 3763 BEGIN
1950 3768 SBTEX(Status
1951 376D ,LinkHead
1952 3775 ,EXP_SymbolName
1953 377C ,ModuleNo
1954 3784 ,EXP_RelocationIndicator
1955 378B ,EXP_Item
1956 3796 );
1957 37A3 IF DuplicateExportSymbol IN Status THEN
1958 37BC BEGIN
1959 37C1 DuplicateCount := DuplicateCount + 1;
1960 37D1 IF DuplicateCount <= 1 THEN
1961 37E4 LogHdds(LogFile);
1962 37F3 NMTG(SymbolTable(.
1963 37F8 ModuleTable(.ModuleNo
1964 37F8 .).ModuleNameReference
1965 380C .).NameReference
1966 3822 ,ModuleName
1967 3828 );
1968 3837 LogDDS(LogFile
1969 383C ,EXP_RelocationIndicator
1970 3843 ,EXP_Item
1971 384E ,EXP_SymbolName
1972 3854 ,ModuleName
1973 385C );
1974 3867 END
1975 3867 END;
1976 3867 GStatus := GStatus + Status;
1977 3892 END;
1978 3892 WHILE (GStatus <= (.DuplicateExportSymbol.)) and
1979 38AA (SymbolCount < NooExpSymbols) DO
1980 38C5 BEGIN
1981 38CA SymbolCount := SymbolCount + 1;
1982 38DA Status := (..);
1983 38F2 FGi8( Status, Fl, EXP_RelocationIndicator);
1984 3911 IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
1985 3923 RelocationIndicator := EXP_RelocationIndicator
1986 3928 ELSE
1987 3937 Status := Status + (.RangeError.);
1988 395F FGi32(Status, Fl, EXP_Item);
1989 397E FGsym(Status, Fl, EXP_SymbolName);
1990 399D IF Status = (..) THEN
1991 39B7 BEGIN
1992 39BC SBTEX(Status
1993 39C1 ,SymbolTableEntryNo
1994 39C9 ,EXP_SymbolName
1995 39D1 ,ModuleNo
1996 39D9 ,EXP_RelocationIndicator
1997 39E0 ,EXP_Item
1998 39EB );
1999 39F8 IF DuplicateExportSymbol IN Status THEN
2000 3A11 BEGIN
2001 3A16 DuplicateCount := DuplicateCount + 1;
2002 3A26 IF DuplicateCount <= 1 THEN
2003 3A39 LogHdds(LogFile);
2004 3A48 NMTG(SymbolTable(.
2005 3A4D ModuleTable(.ModuleNo
2006 3A4D .).ModuleNameReference
2007 3A61 .).NameReference
2008 3A77 ,ModuleName
2009 3A7D );
2010 3A8C LogDDS(LogFile
2011 3A91 ,EXP_RelocationIndicator
2012 3A98 ,EXP_Item
2013 3AA3 ,EXP_SymbolName
2014 3AA9 ,ModuleName
2015 3AB1 );
2016 3ABC END
2017 3ABC END;
2018 3ABC GStatus := GStatus + Status
2019 3AD2 END; (*WHILE ... DO*)
2020 3AEA END; (*GETEXPORTLIST*)
2021 3AF0
2022 3AF0 PROCEDURE GetEXI(VAR Status: StatusType
2023 3AF0 ;VAR Fl: FileType
2024 3AF0 ; ModuleNo: ModuleTableIndexType
2025 3AF0 ; NooExternalImportSymbols: i32
2026 3AF0 );
2027 3AF0
2028 3AF0 VAR
2029 3AF0 SymbolTableEntryNo: SymbolTableIndexType;
2030 3AF0 SymbolCount: i32;
2031 3AF0 EXI_SymbolName: SymbolNameType;
2032 3AF0
2033 3AF0 BEGIN (*GETEXTERNALIMPORTLIST*)
2034 3AF0 SymbolCount := 0;
2035 3B07 WHILE (Status = (..)) and
2036 3B1D (SymbolCount < NooExternalImportSymbols) DO
2037 3B37 BEGIN
2038 3B3C SymbolCount := SymbolCount + 1;
2039 3B4C FGsym(Status, Fl, EXI_SymbolName);
2040 3B6A IF Status = (..) THEN
2041 3B82 SBTIM(Status
2042 3B87 ,SymbolTableEntryNo
2043 3B8E ,EXI_SymbolName
2044 3B96 ,ModuleNo
2045 3B9E );
2046 3BAC END; (*WHILE ... DO*)
2047 3BAF END; (*GETEXTERNALIMPORTLIST*)
2048 3BB5
2049 3BB5
2050 3BB5
2051 3BB5 BEGIN (*GETMODULEHEADER*)
2052 3BB5 Status := (..);
2053 3BD5 MDTA(Status, ModuleNo, 1);
2054 3BF0 IF Status = (..) THEN
2055 3C0A BEGIN
2056 3C0F GetINX(Status, ModuleNo, Fl
2057 3C24 , StartAddressOfNextModule
2058 3C2B , NooExpSymbols
2059 3C32 , NooExiSymbols);
2060 3C49 IF Status = (..) THEN
2061 3C63 WITH ModuleTable(.ModuleNo.) DO
2062 3C82 BEGIN
2063 3C87 FileNameReference := FileNo;
2064 3C96 SCTA(Status, SCTBase, NooSegments);
2065 3CC0 IF Status = (..) THEN
2066 3CDA BEGIN
2067 3CDF GetSGDs(Status
2068 3CE4 ,SCTBase
2069 3CEC ,NooSegments
2070 3CFB ,ModuleNo
2071 3D0A ,Fl
2072 3D11 );
2073 3D1B IF Status = (..) THEN
2074 3D35 BEGIN
2075 3D3A SymbolTable(.ModuleNameReference
2076 3D3F .).ModuleNo := ModuleNo;
2077 3D64 GetEXP(Status
2078 3D69 ,LogFile
2079 3D71 ,Fl
2080 3D78 ,SBTLinkHead
2081 3D7F ,ModuleNo
2082 3D8A ,NooExpSymbols
2083 3D91 );
2084 3D9E IF Status <= (.DuplicateExportSymbol.) THEN
2085 3DBA BEGIN
2086 3DBF EITOffset := CurExternalImportSymbolNo;
2087 3DD7 GetEXI(Status
2088 3DDC ,Fl
2089 3DE4 ,ModuleNo
2090 3DEB ,NooExiSymbols
2091 3DF2 );
2092 3DFF CurrentFileAddress := Fl.P;
2093 3E1E END
2094 3E1E END
2095 3E1E END
2096 3E1E END;
2097 3E1E END;
2098 3E1E GStatus := GStatus + Status;
2099 3E49 (*#B#
2100 3E49 IF test((.0,6,16,19.)) THEN
2101 3E49 BEGIN
2102 3E49 write(TestOut, 'GetOMH '); TSTstat(Status); TSTln;
2103 3E49 TSTindt; TSTindt; TSTindt; TSTmdt(ModuleNo);
2104 3E49 END;
2105 3E49 #E#*)
2106 3E49 END; (*GETMODULEHEADER*)
2107 3E4F
2108 3E4F BEGIN (*GETMODULES*)
2109 3E4F REPEAT
2110 3E5C Status := (..);
2111 3E74 FilSeek(Status, InputFile, StartAddressOfNextModule);
2112 3E95 IF not (UnexpectedEof IN Status) THEN
2113 3EAE BEGIN
2114 3EB3 ValidateModuleFormat(Status, InputFile, OM_Format1);
2115 3ED3 IF UnexpectedEof IN Status THEN
2116 3EEB BEGIN
2117 3EF0 LogEOFerror(LogFile, FileNumber, InputFile.P)
2118 3F10 END
2119 3F13 ELSE IF (BadModuleFormat IN Status) THEN
2120 3F2D BEGIN
2121 3F32 LogOMFerror(LogFile, FileNumber, InputFile.P)
2122 3F52 END
2123 3F55 ELSE (* Status = (..) *)
2124 3F57 GetModuleHeader(Status
2125 3F5C ,LogFile
2126 3F64 ,FileNumber
2127 3F6B ,InputFile
2128 3F72 ,StartAddressOfNextModule
2129 3F7A );
2130 3F89 GStatus := GStatus + Status;
2131 3FB4 END
2132 3FB4 UNTIL Status - (.DuplicateExportSymbol, BadSymbolName.) <> (..);
2133 3FD2 END; (*GETMODULES*)
2134 3FD8
2135 3FD8 BEGIN (*GETINPUTFILES*)
2136 3FD8 FOR FileNo := 1 TO CurFileNo DO
2137 3FFA BEGIN
2138 3FFF Status := (..);
2139 4017 FilAsg(InputFile, FileNameTable(.FileNo.));
2140 4043 FilRst(Status, InputFile);
2141 405B IF Status = (..) THEN
2142 4075 BEGIN
2143 407A ValidateFileFormat (Status, InputFile, OF_Format1);
2144 409A IF Status = (..) THEN
2145 40B4 GetModules(Status, LogFile, FileNo, InputFile, 4)
2146 40DF ELSE IF BadFileFormat IN Status THEN
2147 4102 LogOFFerror(LogFile, FileNo);
2148 4118 END;
2149 4118 IF UnexpectedEof IN Status THEN
2150 4131 LogEOFerror(LogFile, FileNo, InputFile.P);
2151 4150 FilCls(InputFile);
2152 4160 GStatus := GStatus + Status;
2153 418B END;
2154 4195 IF CurModuleNo <= 0 THEN
2155 41A6 GStatus := GStatus + (.NoInput.);
2156 41CC END; (*GETINPUTFILES*)
2157 41D5
2158 41D5 (* *)
2159 41D5 (* *)
2160 41D5 (******************************************************************************)
2161 41D5
2162 41D5 (*$I B:lnkp1-2.pas putmodule *)
2163 41D5 (******************************************************************************)
2164 41D5 (* *)
2165 41D5 (* Copyright (1985) by Metanic Aps., Denmark *)
2166 41D5 (* *)
2167 41D5 (* Author: Lars Gregers Jakobsen. *)
2168 41D5 (* *)
2169 41D5 (******************************************************************************)
2170 41D5
2171 41D5 PROCEDURE PutTargetFile(VAR Status: StatusType
2172 41D5 ;VAR TargetFile: FileType
2173 41D5 ;VAR LogFile: LogFileType
2174 41D5 );
2175 41D5
2176 41D5 PROCEDURE PutFF(VAR Fl: FileType
2177 41D5 );
2178 41D5
2179 41D5 BEGIN (*PUTFF*)
2180 41D5 FPi32(Fl, OF_Format1);
2181 41F4 END; (*OUTFF*)
2182 41FA
2183 41FA PROCEDURE PutModule(VAR Status: StatusType
2184 41FA ;VAR TargetFile: FileType
2185 41FA ;VAR LogFile: LogFileType
2186 41FA );
2187 41FA
2188 41FA PROCEDURE PutMF(VAR Fl: FileType
2189 41FA );
2190 41FA
2191 41FA BEGIN (*PUTMF*)
2192 41FA FPi32(Fl, OM_Format1);
2193 4219 END; (*OUTMF*)
2194 421F
2195 421F PROCEDURE PutINX(VAR Status: StatusType
2196 421F ;VAR Fl: FileType
2197 421F ;VAR LogFile: LogFileType
2198 421F );
2199 421F
2200 421F VAR
2201 421F OMH_ModuleName: ModuleNameType;
2202 421F
2203 421F BEGIN (*PUTINX*)
2204 421F FPi32(Fl,0); (* OMH_Module *)
2205 423E FPi32(Fl,0); (* OMH_NooSegments *)
2206 4255 FPi32(Fl,0); (* OMH_NooExportSymbols *)
2207 426C FPi32(Fl,0); (* OMH_NooExtImportSymbols *)
2208 4283 NMTG(SymbolTable(.ModuleTable(.1.).ModuleNameReference
2209 4288 .).NameReference
2210 42A0 , OMH_ModuleName
2211 42A6 );
2212 42B5 FPsym(Fl, OMH_ModuleName);
2213 42CC END; (*PUTINX*)
2214 42D2
2215 42D2 PROCEDURE PutSGDs(VAR Status: StatusType
2216 42D2 ;VAR Fl: Filetype
2217 42D2 ;VAR LogFile: LogFileType
2218 42D2 );
2219 42D2
2220 42D2 VAR
2221 42D2 SRCinx: SectionTableIndexType;
2222 42D2 DSTinx: SectionTableIndexType;
2223 42D2 ModuleName: ModuleNameType;
2224 42D2
2225 42D2 PROCEDURE PutSGD(VAR TargetFile: FileType
2226 42D2 ; Section: SectionTableRecordType
2227 42D2 );
2228 42D2
2229 42D2 BEGIN (*PUTSGD*)
2230 42D2 WITH Section DO
2231 42F4 BEGIN
2232 42F9 FPi32(TargetFile, ImageSize);
2233 430E FPi32(TargetFile, OvrSize);
2234 4323 END;
2235 4323 END; (*PUTSGD*)
2236 4329
2237 4329 BEGIN (*PUTSGDS*)
2238 4329 Status := (..);
2239 4348 SCTA(Status, TargetSectionOffset, CurSegmentCount);
2240 4362 IF not (SectionTableOverFlow IN Status) THEN
2241 437D BEGIN
2242 4382 IF CurSegmentCount > 0 THEN
2243 4393 LogHSgd(LogFile);
2244 43A2 FOR DSTinx := 1 TO CurSegmentCount DO
2245 43BC WITH SectionTable(.TargetSectionOffset + DSTinx.) DO
2246 43EA BEGIN
2247 43EF ModuleNo := TargetModuleNo;
2248 43FD SegmentNo := DSTinx;
2249 4412 ImageSize := 0; (*TO BE UPDATED*)
2250 4429 OvrSize := 0;
2251 4442 RelocationConstant := 0;
2252 445B FOR SRCinx := 1 TO TargetSectionOffset DO
2253 4475 IF SectionTable(.SRCinx.).SegmentNo = DSTinx THEN
2254 4493 BEGIN
2255 4498 SectionTable(.SRCinx.).RelocationConstant :=
2256 44B1 ImageSize * ImageFactor;
2257 44D2 ImageSize := ImageSize +
2258 44EB SectionTable(.SRCinx.).ImageSize;
2259 450F WITH SectionTable(.SRCinx.) DO (*Log memory map element*)
2260 452E IF SectionTable(.SRCinx.).ImageSize > 0 THEN
2261 455A BEGIN
2262 455F NMTG(SymbolTable(.ModuleTable(.
2263 4564 ModuleNo.).ModuleNameReference
2264 457C .).Namereference
2265 4592 ,ModuleName
2266 4598 );
2267 45A7 LogSGD(LogFile
2268 45AC ,DSTinx
2269 45B3 ,RelocationConstant
2270 45BA ,ImageSize*ImageFactor
2271 45D7 ,ModuleName
2272 45E7 );
2273 45F2 END;
2274 45F2 (*#B#
2275 45F2 IF test((.0,6,16,19.)) THEN
2276 45F2 BEGIN
2277 45F2 write(TestOut, 'PutSGDs-1');
2278 45F2 TSTsct(SRCinx);
2279 45F2 END;
2280 45F2 #E#*)
2281 45F2 END; (* FOR SRCinx := ... *)
2282 45FC PutSGD(Fl, SectionTable(.TargetSectionOffset +
2283 4608 DSTinx.) );
2284 462F (*#B#
2285 462F IF test((.0,6,16,19.)) THEN
2286 462F BEGIN
2287 462F write(TestOut, 'PutSGDs-2');
2288 462F TSTsct(TargetSectionOffset + DSTinx);
2289 462F END;
2290 462F #E#*)
2291 462F END; (* FOR DSTinx := ... *)
2292 4639 END; (* allocation ok *)
2293 4639 END; (*PUTSGDS*)
2294 463F
2295 463F PROCEDURE PutEXP(VAR Status: StatusType
2296 463F ;VAR Target: FileType
2297 463F ;VAR LogFile: LogFileType
2298 463F );
2299 463F
2300 463F VAR
2301 463F MDTInx: ModuleTableIndexType;
2302 463F ModuleName: ModuleNameType;
2303 463F Heap: HeapType;
2304 463F HeapMax: HeapIndexType;
2305 463F Winner: SymboltableIndexType;
2306 463F SymbolNo: SymbolTableIndexType;
2307 463F EXP_RelocationIndicator: RelocationIndicatorType;
2308 463F EXP_Item: i32;
2309 463F EXP_SymbolName: SymbolNameType;
2310 463F SbtInx: SymbolTableIndexType;
2311 463F
2312 463F FUNCTION NameSwop(VAR A
2313 463F , B: SymbolNameType
2314 463F ): boolean;
2315 463F
2316 463F VAR
2317 463F I: integer;
2318 463F
2319 463F BEGIN (*NAMESWOP*)
2320 463F I := 1;
2321 4656 IF B.Length < A.Length THEN
2322 4672 BEGIN
2323 4677 WHILE (I <= B.Length) and (A.Name(.I.) >= B.Name(.I.)) DO
2324 46DE I := I + 1;
2325 46F1 NameSwop := (I > B.Length);
2326 4715 END
2327 4715 ELSE
2328 4718 BEGIN
2329 471D WHILE (I <= A.Length) and (A.Name(.I.) <= B.Name(.I.)) DO
2330 4787 I := I + 1;
2331 479A NameSwop := not (I > A.Length);
2332 47BE END;
2333 47BE (*#B#
2334 47BE IF test((.0,13.)) THEN
2335 47BE BEGIN
2336 47BE writeln(TestOut, 'NameSwop ', 'I=', I:1);
2337 47BE TSTindt; TSTindt; TSTindt;
2338 47BE write(TestOut, 'A='); TSTsymbol(A);
2339 47BE TSTindt; TSTindt; TSTindt;
2340 47BE write(TestOut, 'B='); TSTsymbol(B);
2341 47BE END
2342 47BE #E#*)
2343 47BE END; (*NAMESWOP*)
2344 47C7
2345 47C7 PROCEDURE InHeap( New: SymbolTableIndexType
2346 47C7 );
2347 47C7
2348 47C7 VAR
2349 47C7 I,J: integer;
2350 47C7 Z,V: SymbolNameType;
2351 47C7 Swop: boolean;
2352 47C7
2353 47C7 BEGIN (*INHEAP*)
2354 47C7 HeapMax := HeapMax + 1;
2355 47ED I := HeapMax;
2356 47FC NMTG(SymbolTable(.New.).NameReference, Z);
2357 482E IF I > 1 THEN
2358 4845 REPEAT
2359 484A J := I div 2;
2360 4862 NMTG(SymbolTable(. Heap(.J.) .).NameReference, V);
2361 48A7 Swop := NameSwop(V,Z);
2362 48C5 IF Swop THEN
2363 48CE BEGIN
2364 48D3 Heap(.I.) := Heap(.J.);
2365 4911 I := J
2366 4916 END
2367 491E UNTIL (I <= 1) or ( not Swop );
2368 493D Heap(.I.) := New;
2369 4964 (*#B#
2370 4964 IF test((.0,13.)) THEN
2371 4964 BEGIN
2372 4964 writeln(TestOut, 'InHeap New=', New:1);
2373 4964 TSTheap(Heap, HeapMax);
2374 4964 END;
2375 4964 #E#*)
2376 4964 END; (*INHEAP*)
2377 496A
2378 496A PROCEDURE SelectWinner(VAR Status: StatusType
2379 496A );
2380 496A
2381 496A VAR
2382 496A I,J: integer;
2383 496A Swop: boolean;
2384 496A V,W,Z: SymbolNameType;
2385 496A New: SymbolTableIndexType;
2386 496A
2387 496A BEGIN (*SELECTWINNER*)
2388 496A IF (0 < HeapMax) THEN
2389 4986 BEGIN
2390 498B Winner := Heap(.1.);
2391 49A1 WITH Symboltable(.Winner.) DO
2392 49C1 IF SortLink <> Winner THEN
2393 49D3 New := SortLink
2394 49D8 ELSE
2395 49EA BEGIN (* Chain exhausted - descrease size of heap *)
2396 49EF New := Heap(.HeapMax.);
2397 4A11 HeapMax := HeapMax - 1;
2398 4A2F END;
2399 4A2F I := 1;
2400 4A3E IF HeapMax >= 2 THEN
2401 4A52 BEGIN
2402 4A57 J := 2;
2403 4A66 Heap(.HeapMax + 1.) := New;
2404 4A92 NMTG(SymbolTable(.New.).NameReference, Z);
2405 4AC4 REPEAT
2406 4AC9 (* J <= HeapMax *)
2407 4AC9
2408 4AC9 NMTG(SymbolTable(.Heap(. J .).).NameReference, V);
2409 4B12 NMTG(SymbolTable(.Heap(.J+1.).).NameReference, W);
2410 4B5E IF NameSwop(V,W) THEN
2411 4B7A BEGIN
2412 4B7F V := W;
2413 4B99 J := J + 1
2414 4BA2 END;
2415 4BA9
2416 4BA9 Swop := NameSwop(Z,V);
2417 4BC7 IF Swop THEN
2418 4BD0 BEGIN
2419 4BD5 Heap(.I.) := Heap(.J.);
2420 4C13 I := J;
2421 4C20 J := I + I;
2422 4C32 END;
2423 4C32
2424 4C32 (*#B#
2425 4C32 IF test((.0,13.)) THEN
2426 4C32 BEGIN
2427 4C32 write(TestOut, 'SLCT-W-1 ', 'I=' , I:1
2428 4C32 , ' ':2 , 'J=' , J:1
2429 4C32 , ' ':2 , 'New=', New:1
2430 4C32 , ' ':2 , 'Swop='
2431 4C32 ); TSTbool(Swop); TSTln;
2432 4C32 TSTheap(Heap, HeapMax);
2433 4C32 END
2434 4C32 #E#*)
2435 4C32
2436 4C32 UNTIL (not Swop) or (J > HeapMax);
2437 4C58 END;
2438 4C58 Heap(.I.) := New;
2439 4C7F END
2440 4C7F ELSE
2441 4C82 Status := Status + (.HeapEmpty.);
2442 4CAA (*#B#
2443 4CAA IF test((.0,13,16,19.)) THEN
2444 4CAA BEGIN
2445 4CAA write(TestOut, 'SLCT-W-2 '); TSTstat(Status); TSTindt;
2446 4CAA writeln(TestOut, 'HeapMax=', HeapMax:1
2447 4CAA , ' ':2, 'Winner=', Winner:1
2448 4CAA );
2449 4CAA END;
2450 4CAA #E#*)
2451 4CAA END; (*SELECTWINNER*)
2452 4CB0
2453 4CB0
2454 4CB0 BEGIN (*PUTEXP*)
2455 4CB0
2456 4CB0 (*#B#
2457 4CB0 IF test((.0,13.)) THEN
2458 4CB0 BEGIN
2459 4CB0 writeln(TestOut, 'PUTEXP ');
2460 4CB0 FOR SbtInx := 1 TO MaxNooSymbols DO
2461 4CB0 WITH SymbolTable(.SbtInx.), ValueTable(.SbtInx.) DO
2462 4CB0 IF NameReference <> 0 THEN
2463 4CB0 BEGIN
2464 4CB0 TSTindt; TSTindt; TSTindt; TSTsbt(SbtInx);
2465 4CB0 TSTindt; TSTvlt(SbtInx); TSTln;
2466 4CB0 END;
2467 4CB0 END;
2468 4CB0 #E#*)
2469 4CB0
2470 4CB0 (*Initialize selection*)
2471 4CB0 HeapMax := 0;
2472 4CC1 FOR MDTInx := 1 TO TargetModuleNo - 1 DO
2473 4CE8 IF ModuleTable(.MDTInx
2474 4CED .).SBTLinkHead IN (.1..MaxNooSymbols.) THEN
2475 4D0E InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
2476 4D41
2477 4D41 IF HeapMax > 0 THEN
2478 4D51 LogHxpN(LogFile);
2479 4D60 NooExpSymbols := 0;
2480 4D72
2481 4D72 WHILE (Status = (..)) DO
2482 4D8B BEGIN
2483 4D90 SelectWinner(Status);
2484 4DA3 IF Status = (..) THEN
2485 4DBC WITH SymbolTable(.Winner.), ValueTable(.Winner.) DO
2486 4DF9 IF SegmentNo > UnResolved THEN
2487 4E0A BEGIN
2488 4E0F NooExpSymbols := NooExpSymbols + 1;
2489 4E25 IF (SegmentNo > 0) THEN (*relocatable*)
2490 4E3C WITH SectionTable(.ModuleTable(.ModuleNo
2491 4E41 .).SCTbase +
2492 4E59 SegmentNo
2493 4E59 .) DO
2494 4E8A BEGIN
2495 4E8F Value := Value + RelocationConstant;
2496 4EBB END;
2497 4EBB EXP_RelocationIndicator := SegmentNo;
2498 4ECD EXP_Item := Value;
2499 4EE0 NMTG(NameReference, EXP_SymbolName);
2500 4F00 FPi8(Target, EXP_RelocationIndicator);
2501 4F17 FPi32(Target, EXP_Item);
2502 4F2C FPsym(Target, EXP_SymbolName);
2503 4F43 IF (Status = (..)) and (OPTlfk <> none) THEN
2504 4F6C BEGIN
2505 4F71 NMTG(SymbolTable(.
2506 4F76 ModuleTable(.ModuleNo
2507 4F76 .).ModuleNameReference
2508 4F8E .).NameReference
2509 4FA4 ,ModuleName
2510 4FAA );
2511 4FB9 LogXP(LogFile
2512 4FBE ,EXP_RelocationIndicator
2513 4FC5 ,EXP_Item
2514 4FCC ,EXP_SymbolName
2515 4FD2 ,ModuleName
2516 4FDA )
2517 4FE2 END;
2518 4FE5 END;
2519 4FE5 END;
2520 4FE8 Status := Status - (.HeapEmpty.);
2521 5010 IF (HeapEmpty IN Status) and (OPTlfk <> none) THEN
2522 503B BEGIN (*sort sbt/vlt by value and log*)
2523 5040 END
2524 5040 END; (*PUTEXP*)
2525 5046
2526 5046
2527 5046 PROCEDURE PutEXI(VAR Status: StatusType
2528 5046 ;VAR Target: FileType
2529 5046 ;VAR LogFile: LogFileType
2530 5046 );
2531 5046
2532 5046 LABEL
2533 5046 1;
2534 5046
2535 5046 VAR
2536 5046 ModuleName: ModuleNameType;
2537 5046 SymbolName: SymbolNameType;
2538 5046 ExiInx1: ExternalImportTableIndexType;
2539 5046 ExiInx: ExternalImportTableIndexType;
2540 5046
2541 5046 (* TargetModuleNo is a global variable *)
2542 5046
2543 5046 BEGIN (*PUTEXI*)
2544 5046 NooExiSymbols := 0;
2545 5060
2546 5060 ExiInx1 := 1;
2547 5069 FOR ExiInx1 := 1 TO CurExternalImportSymbolNo DO
2548 5083 BEGIN
2549 5088 (*#B#
2550 5088 IF test((.0,7.)) THEN
2551 5088 BEGIN
2552 5088 write(TestOut, 'PUTEXI-1 ');
2553 5088 TSTeit(ExiInx1);
2554 5088 END;
2555 5088 #E#*)
2556 5088 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2557 5098 .).SegmentNo = UnResolved) THEN
2558 50B0 GOTO 1;
2559 50B8 END;
2560 50C2
2561 50C2 1: IF (CurExternalImportSymbolNo > 0) THEN
2562 50D3 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2563 50E6 .).SegmentNo = UnResolved) THEN
2564 50FE BEGIN
2565 5103 LogHurs(LogFile);
2566 5112 FOR ExiInx := ExiInx1 TO CurExternalImportSymbolNo DO
2567 512D BEGIN
2568 5132 (*#B#
2569 5132 IF test((.0,7.)) THEN
2570 5132 BEGIN
2571 5132 write(TestOut, 'PUTEXI-2 ');
2572 5132 TSTeit(ExiInx);
2573 5132 END;
2574 5132 #E#*)
2575 5132 WITH ExternalImportTable(.ExiInx.) DO
2576 5148 WITH ValueTable(.SymbolNo.),
2577 5165 SymbolTable(.SymbolNo.) DO
2578 5187 IF SegmentNo = UnResolved THEN
2579 5198 BEGIN
2580 519D NooExiSymbols := NooExiSymbols + 1;
2581 51B3 Value := NooExiSymbols;
2582 51CA NMTG(NameReference, SymbolName);
2583 51EA FPsym(Target, SymbolName);
2584 5201 NMTG(SymbolTable(.
2585 5206 ModuleTable(.ModuleNo
2586 5206 .).ModuleNameReference
2587 521E .).NameReference
2588 5234 ,ModuleName
2589 523A );
2590 5249 LogURS(LogFile, ModuleName, SymbolName);
2591 5268 (*#B#
2592 5268 IF test((.0,16,19.)) THEN
2593 5268 BEGIN
2594 5268 writeln(TestOut, 'PutEXI '
2595 5268 , 'SymbolNo=', SymbolNo:1
2596 5268 , ' ':2, 'Value=', Value:1);
2597 5268 END;
2598 5268 #E#*)
2599 5268 END;
2600 5268
2601 5268 END;
2602 5272 END;
2603 5272 END; (*PUTEXI*)
2604 5278
2605 5278 (* TargetModuleNo is a global variable *)
2606 5278
2607 5278 BEGIN (*PUTMODULE*)
2608 5278 MDTA(Status, TargetModuleNo, 1);
2609 5296 IF not (ModuleTableOverFlow IN Status) THEN
2610 52B1 BEGIN
2611 52B6 PutMF(TargetFile);
2612 52C5 PutINX(Status, TargetFile, LogFile);
2613 52E6 IF Status = (..) THEN
2614 52FF BEGIN (*Calculate memory map, write sgd, and log*)
2615 5304 PutSGDs(Status, TargetFile, LogFile);
2616 5325
2617 5325 IF not (SectionTableOverFlow IN Status) THEN
2618 5340 BEGIN (*Relocate symbol table, write export list, and log*)
2619 5345 PutEXP(Status, TargetFile, LogFile);
2620 5366 IF Status = (..) THEN
2621 537F BEGIN (*Write EXI while logging unresolved references*)
2622 5384 PutEXI(Status, TargetFile, LogFile);
2623 53A5 END;
2624 53A5 END;
2625 53A5 END;
2626 53A5 END;
2627 53A5 END; (*PUTMODULE*)
2628 53AB
2629 53AB BEGIN (*PUTTARGETFILE*)
2630 53AB PutFF(TargetFile);
2631 53C2 PutModule(Status, TargetFile, LogFile);
2632 53E3 END; (*PUTTARGETFILE*)
2633 53E9
2634 53E9 (* *)
2635 53E9 (* *)
2636 53E9 (******************************************************************************)
2637 53E9
2638 53E9
2639 53E9 BEGIN (*PASS1*)
2640 53E9
2641 53E9 (* Initialize local data structures *)
2642 53E9 FOR SBTSubInx := 1 TO MaxNooSymbols DO
2643 5402 SymbolTable(.SBTSubInx.).NameReference := 0;
2644 5429 LatestInsert := 0;
2645 5432 CurrentSymbolCount := 0;
2646 543B CurrentNameTableIndex := 0;
2647 5444
2648 5444 GetInputFiles(Status, LogFile);
2649 545E IF Status = (..) THEN
2650 5477 BEGIN
2651 547C PutTargetFile(Status, TargetFile, LogFile);
2652 549D END;
2653 549D END; (*PASS1*)
2654 54A3
2655 54A3 (* *)
2656 54A3 (* *)
2657 54A3 (******************************************************************************)
2658 54A3
2659 54A3 (*$I B:lnkp2.pas Procedure pass2 *)
2660 54A3 (******************************************************************************)
2661 54A3 (* *)
2662 54A3 (* Copyright (1985) by Metanic Aps., Denmark *)
2663 54A3 (* *)
2664 54A3 (* Author: Lars Gregers Jakobsen. *)
2665 54A3 (* *)
2666 54A3 (******************************************************************************)
2667 54A3
2668 54A3 PROCEDURE Pass2(VAR Status: StatusType
2669 54A3 ;VAR TargetFile: FileType
2670 54A3 ;VAR LogFile: LogFileType
2671 54A3 );
2672 54A3
2673 54A3 LABEL
2674 54A3 999;
2675 54A3
2676 54A3 VAR
2677 54A3 SegmentInx: SegmentNoType;
2678 54A3 ModuleInx: ModuleTableIndexType;
2679 54A3 Crid: BitMappedFileType; (*Composite relocation import directory*)
2680 54A3 Covr: FileType; (*Composite overrun store*)
2681 54A3
2682 54A3 (*#B#(*$I B:LNKDF5.PAS Bit Map Buffer Test Output *)
2683 54A3 (*$I B:LNKDF6.PAS Bit Map Access Primitives *)
2684 54A3 (******************************************************************************)
2685 54A3 (* *)
2686 54A3 (* Copyright (1985) by Metanic Aps., Denmark *)
2687 54A3 (* *)
2688 54A3 (* Author: Lars Gregers Jakobsen. *)
2689 54A3 (* *)
2690 54A3 (******************************************************************************)
2691 54A3
2692 54A3 PROCEDURE BMG2(VAR BM: BitMappedFileType
2693 54A3 ;VAR Relocatable: boolean
2694 54A3 ;VAR Importable: boolean
2695 54A3 );
2696 54A3
2697 54A3 BEGIN (*BMG2*)
2698 54A3 WITH BM, BM.B DO
2699 54CA BEGIN
2700 54CF IF P <= 8 THEN
2701 54E0 BEGIN
2702 54E5 read(F, Y1);
2703 5510 P := P + 8;
2704 5533 END;
2705 5533 P := P - 1;
2706 5553 Relocatable := P IN I;
2707 5581 P := P - 1;
2708 55A1 Importable := P IN I;
2709 55CF (*#B#
2710 55CF IF test((.0,4.)) THEN
2711 55CF BEGIN
2712 55CF write(TestOut, 'BMG2 '); TSTbmb(BM.B);
2713 55CF write(TestOut, 'R,I= ');
2714 55CF TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
2715 55CF END;
2716 55CF #E#*)
2717 55CF
2718 55CF END;
2719 55CF END; (*BMG2*)
2720 55D5
2721 55D5 PROCEDURE BMG6(VAR BM: BitMappedFileType
2722 55D5 ;VAR Index:i8
2723 55D5 );
2724 55D5
2725 55D5 VAR
2726 55D5 J: 1..6;
2727 55D5
2728 55D5 BEGIN (*BMG6*)
2729 55D5 Index := 0;
2730 55EA WITH BM, BM.B DO
2731 5609 BEGIN
2732 560E IF P < 14 THEN
2733 561C BEGIN
2734 5621 read(F, Y0);
2735 564B FOR J := 1 TO 6 DO
2736 565C Index := Index + Index + ord( (P-J) IN I );
2737 56C7 Y1 := Y0;
2738 56DF P := P + 2; (* = P - 6 + 8 *)
2739 5702 END
2740 5702 ELSE
2741 5705 BEGIN
2742 570A FOR J := 1 TO 6 DO
2743 571B Index := Index + Index + ord( (P-J) IN I );
2744 5786 P := P - 6;
2745 57A9 END;
2746 57A9 (*#B#
2747 57A9 IF test((.0,4.)) THEN
2748 57A9 BEGIN
2749 57A9 write(TestOut, 'BMG6 '); TSTbmb(BM.B);
2750 57A9 writeln(TestOut, 'Index= ',Index:1);
2751 57A9 END;
2752 57A9 #E#*)
2753 57A9 END;
2754 57A9 END; (*BMG6*)
2755 57AF
2756 57AF PROCEDURE BMP2(VAR BM: BitMappedFileType
2757 57AF ; Relocatable: boolean
2758 57AF ; Importable: boolean
2759 57AF );
2760 57AF
2761 57AF BEGIN (*BMP2*)
2762 57AF WITH BM, BM.B DO
2763 57D6 BEGIN
2764 57DB P := P - 1;
2765 57F5 IF Relocatable THEN
2766 5801 I := I + (.P.);
2767 5839 P := P - 1;
2768 5859 IF Importable THEN
2769 5865 I := I + (.P.);
2770 589D IF P <= 8 THEN (* always >= 8 *)
2771 58B4 BEGIN
2772 58B9 write(F, Y1);
2773 58E4 Y1 := 0;
2774 58F3 P := 16 (* = P + 8 *)
2775 58FE END;
2776 5900 (*#B#
2777 5900 IF test((.0,4.)) THEN
2778 5900 BEGIN
2779 5900 write(TestOut, 'BMP2 '); TSTbmb(BM.B);
2780 5900 write(TestOut, 'R,I= ');
2781 5900 TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
2782 5900 END;
2783 5900 #E#*)
2784 5900 END
2785 5900 END; (*BMP2*)
2786 5906
2787 5906 PROCEDURE BMP6(VAR BM: BitMappedFileType
2788 5906 ; Index:i8
2789 5906 );
2790 5906
2791 5906 VAR
2792 5906 J: 0..5;
2793 5906
2794 5906 BEGIN (*BMP6*)
2795 5906 WITH BM, BM.B DO
2796 592D BEGIN
2797 5932 P := P - 6;
2798 594F FOR J := 0 TO 5 DO
2799 5960 BEGIN
2800 5965 IF odd(Index) THEN
2801 5973 I := I + (.P+J.);
2802 59B5 Index := Index div 2
2803 59BA END;
2804 59CC (*#B#
2805 59CC IF test((.0,4.)) THEN
2806 59CC BEGIN
2807 59CC write(TestOut, 'BMP6 '); TSTbmb(BM.B);
2808 59CC writeln(TestOut, 'Index= ', Index:1);
2809 59CC END;
2810 59CC #E#*)
2811 59CC IF P <= 8 THEN
2812 59E3 BEGIN
2813 59E8 write(F, Y1);
2814 5A13 Y1 := Y0;
2815 5A2B Y0 := 0;
2816 5A39 P := P + 8;
2817 5A5C END;
2818 5A5C END;
2819 5A5C END; (*BMP6*)
2820 5A62
2821 5A62 (* *)
2822 5A62 (* *)
2823 5A62 (******************************************************************************)
2824 5A62
2825 5A62
2826 5A62 PROCEDURE LinkSection(VAR Status: StatusType
2827 5A62 ;VAR TargetFile: FileType
2828 5A62 ;VAR LogFile: LogFileType
2829 5A62 ;VAR Crid: BitMappedFileType
2830 5A62 ;VAR Covr: FileType
2831 5A62 ;VAR SCTrec: SectionTableRecordType
2832 5A62 ;VAR MDTrec: ModuleTableRecordType
2833 5A62 );
2834 5A62
2835 5A62 LABEL
2836 5A62 99;
2837 5A62
2838 5A62 VAR
2839 5A62 Oimg: FileType;
2840 5A62 Orid: BitMappedFileType;
2841 5A62 Oovr: FileType;
2842 5A62 ImageUnit: ImageUnitType;
2843 5A62 QuadImageUnit: QuadImageUnitType;
2844 5A62 Relocatable: boolean;
2845 5A62 Importable: boolean;
2846 5A62 Index: i8;
2847 5A62 Address: FileAddressType; (*relative to current obj. section*)
2848 5A62 LocalImageSize: FileAddressType;
2849 5A62 OvrIndex: QuadImageUnitType;
2850 5A62
2851 5A62
2852 5A62 BEGIN (*LINKSECTION*)
2853 5A62 WITH MDTrec, SCTrec DO
2854 5A87 BEGIN
2855 5A8C IF ImageSize > 0 THEN
2856 5AA4 BEGIN
2857 5AA9 FilAsg(Oimg, FileNameTable(.FileNameReference.));
2858 5ADA FilRst(Status, Oimg);
2859 5AF1 FilSeek(Status, Oimg, CurrentFileAddress);
2860 5B18 CurrentFileAddress := CurrentFileAddress + ImageSize * ImageFactor;
2861 5B52
2862 5B52 WITH Orid DO
2863 5B57 BEGIN
2864 5B5C assign(F, FileNameTable(.FileNameReference.));
2865 5B8C reset(F);
2866 5BA0 seek(F, CurrentFileAddress);
2867 5BBC WITH B DO
2868 5BCE BEGIN
2869 5BD3 P := 16;
2870 5BDA I := (..);
2871 5BF2 read(F, Y1);
2872 5C19 END;
2873 5C19 END;
2874 5C19 CurrentFileAddress := CurrentFileAddress + ImageSize;
2875 5C48
2876 5C48 IF OvrSize > 0 THEN
2877 5C68 BEGIN
2878 5C6D FilAsg(Oovr, FileNameTable(.FileNameReference.));
2879 5C9E FilRst(Status, Oovr);
2880 5CB5 FilSeek(Status, Oovr, CurrentFileAddress);
2881 5CDC CurrentFileAddress := CurrentFileAddress + OvrSize;
2882 5D0D END
2883 5D0D ELSE
2884 5D10 Oovr.P := CurrentFileAddress;
2885 5D27
2886 5D27 (*CurrentFileAddress now reflects starting position of
2887 5D27 next section in file if any*)
2888 5D27
2889 5D27 Address := 0;
2890 5D36 LocalImageSize := (ImageSize - 1) * ImageFactor;
2891 5D5B WHILE (Address <= LocalImageSize) and (Status = (..)) DO
2892 5D8C BEGIN
2893 5D91 BMG2(Orid, Relocatable, Importable);
2894 5DB1 IF Relocatable <> Importable THEN
2895 5DBF BEGIN
2896 5DC4 BMG6(Orid, Index);
2897 5DDC FGi32(Status, Oimg, QuadImageUnit);
2898 5DFB IF Relocatable THEN
2899 5E07 (* Relocate *)
2900 5E07 IF Index IN (.1..NooSegments.) THEN
2901 5E35 WITH SectionTable(.SCTBase + Index.) DO
2902 5E6C QuadImageUnit := QuadImageUnit + RelocationConstant
2903 5E75 ELSE
2904 5E8E Status := Status + (.BadRelocationCode.)
2905 5EA4 ELSE
2906 5EB8 (* Import *)
2907 5EB8 BEGIN (*IMPORT*)
2908 5EBD IF Index = OvrCode THEN
2909 5EC9 IF Oovr.P < CurrentFileAddress - 3 THEN
2910 5EF0 FGi32(Status, Oovr, OvrIndex)
2911 5F0C ELSE
2912 5F12 Status := Status + (.UnexpectedEof.)
2913 5F28 ELSE
2914 5F3B OvrIndex := Index;
2915 5F4B IF OvrIndex IN (.1..NooExternalImportSymbols.) THEN
2916 5F7B WITH ValueTable(.ExternalImportTable(.EITOffset + OvrIndex
2917 5F86 .).SymbolNo
2918 5FAC .) DO
2919 5FC4 IF SegmentNo > UnResolved THEN
2920 5FD5 BEGIN
2921 5FDA QuadImageUnit := QuadImageUnit + Value; (*?* + ? *)
2922 5FF6 Importable := false;
2923 5FFF Relocatable := SegmentNo > 0;
2924 601C Index := SegmentNo;
2925 602F END
2926 602F ELSE
2927 6032 IF Value IN (.0..63.) THEN
2928 6055 Index := Value
2929 605A ELSE
2930 6071 BEGIN
2931 6076 Index := OvrCode;
2932 607F FPi32(Covr, Value);
2933 609A END
2934 609A ELSE
2935 609D Status := Status + (.BadImportCode.)
2936 60B3 END; (*IMPORT*)
2937 60C4 FPi32(TargetFile, QuadImageUnit);
2938 60D9 BMP2(Crid, Relocatable, Importable);
2939 60F6 BMP6(Crid, Index);
2940 6109 Address := Address + ImageFactor;
2941 6124 END
2942 6124 ELSE
2943 6127 IF Relocatable THEN
2944 6133 BEGIN
2945 6138 Status := Status + (.Baddibit.);
2946 615E GOTO 99; (*EXIT procedure*)
2947 6166 END
2948 6166 ELSE
2949 6169 BEGIN
2950 616E FGi8(Status, Oimg, ImageUnit);
2951 618D FPi8(TargetFile, ImageUnit);
2952 61A0 BMP2(Crid, Relocatable, Importable);
2953 61BD Address := Address + 1;
2954 61D0 END;
2955 61D0 END;
2956 61D3 LocalImageSize := ImageSize * ImageFactor;
2957 61F5 WHILE (Address < LocalImageSize) and (Status = (..)) DO
2958 6226 BEGIN
2959 622B BMG2(Orid, Relocatable, Importable);
2960 624B IF Relocatable or Importable THEN
2961 625A BEGIN
2962 625F Status := Status + (.Baddibit.);
2963 6285 GOTO 99; (*EXIT procedure*)
2964 628D END
2965 628D ELSE
2966 6290 BEGIN
2967 6295 FGi8(Status, Oimg, ImageUnit);
2968 62B4 FPi8(TargetFile, ImageUnit);
2969 62C7 BMP2(Crid, Relocatable, Importable);
2970 62E4 Address := Address + 1;
2971 62F7 END;
2972 62F7 END;
2973 62FA END; (* IF ImageSize > 0 THEN *)
2974 62FA 99: END; (* WITH MDTrec, SCTrec DO *)
2975 62FA END; (*LINKSECTION*)
2976 6303
2977 6303 PROCEDURE CopyBuffer(VAR Status: StatusType
2978 6303 ;VAR Buffer: BasicFileType
2979 6303 ;VAR TargetFile: FileType
2980 6303 ;VAR Size: FileAddressType
2981 6303 );
2982 6303
2983 6303 VAR
2984 6303 Item: i8;
2985 6303 Start: FileAddressType;
2986 6303
2987 6303 BEGIN (*COPYBUFFER*)
2988 6303 reset(Buffer);
2989 631E Start := TargetFile.P;
2990 6335 WHILE not eof(Buffer) DO
2991 634E BEGIN
2992 6353 read(Buffer, Item);
2993 6376 FPi8(TargetFile, Item); (*Advancing TargetFile.P*)
2994 6389 END;
2995 638C Size := TargetFile.P - Start;
2996 63B2 (*#B#
2997 63B2 IF test((.0,20.)) THEN
2998 63B2 BEGIN
2999 63B2 writeln(TestOut, 'CPYBUF ', 'Start= ', Start:1
3000 63B2 , ' End= ', TargetFile.P:1
3001 63B2 , ' Size= ', Size:1
3002 63B2 );
3003 63B2 END;
3004 63B2 #E#*)
3005 63B2 END; (*COPYBUFFER*)
3006 63B8
3007 63B8 PROCEDURE UPDINX(VAR Status: StatusType
3008 63B8 VAR TargetFile: FileType
3009 63B8 );
3010 63B8
3011 63B8 VAR
3012 63B8 ModuleSize: i32;
3013 63B8 ModuleName: ModuleNameType;
3014 63B8 SegmentInx: SegmentNoType;
3015 63B8
3016 63B8 BEGIN (*UPDINX*)
3017 63B8 ModuleSize := TargetFile.P - OMF_Address;
3018 63DF update(TargetFile.F);
3019 63F2 FilSeek(Status, TargetFile, OMH_Address);
3020 6410 IF Status = (..) THEN
3021 6429 BEGIN
3022 642E FPi32(TargetFile, ModuleSize);
3023 6443 FPi32(TargetFile, CurSegmentCount);
3024 645D FPi32(TargetFile, NooExpSymbols);
3025 6475 FPi32(TargetFile, NooExiSymbols);
3026 648D FGsym(Status, TargetFile, ModuleName); (*skip past name*)
3027 64AB IF Status = (..) THEN
3028 64C4 FOR SegmentInx := 1 TO CurSegmentCount DO
3029 64DE WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3030 650C BEGIN
3031 6511 FPi32(TargetFile, ImageSize);
3032 652D FPi32(TargetFile, OvrSize);
3033 654B END;
3034 6555 END;
3035 6555 END; (*UPDINX*)
3036 655B
3037 655B BEGIN (*PASS2*)
3038 655B FOR SegmentInx := 1 TO CurSegmentCount DO
3039 657D BEGIN
3040 6582 WITH Crid DO
3041 6587 BEGIN
3042 658C rewrite(F);
3043 65A0 WITH B DO
3044 65B2 BEGIN
3045 65B7 P := 16;
3046 65BE I := (..)
3047 65CB END
3048 65D6 END;
3049 65D6 FilRwt(Covr);
3050 65E6 FOR ModuleInx := 1 TO TargetModuleNo - 1 DO
3051 660D BEGIN
3052 6612 (*#B#
3053 6612 IF test((.0,20.)) THEN
3054 6612 BEGIN
3055 6612 write(TestOut, 'Pass-2 '); TSTstat(Status); TSTindt;
3056 6612 writeln(TestOut, 'SgmInx= ', SegmentInx:1
3057 6612 , ' MdlInx= ', ModuleInx:1
3058 6612 );
3059 6612 TSTindt; TSTindt; TSTindt;
3060 6612 TSTmdt(ModuleInx);
3061 6612 TSTindt; TSTindt; TSTindt;
3062 6612 TSTsct(ModuleTable(.ModuleInx.).SCTBase + SegmentInx);
3063 6612 END;
3064 6612 #E#*)
3065 6612 IF (SectionTable(.ModuleTable(.ModuleInx
3066 6617 .).SCTBase + SegmentInx
3067 6628 .).ModuleNo = ModuleInx) THEN
3068 6656 BEGIN
3069 665B LinkSection(Status, TargetFile, LogFile, Crid, Covr
3070 667D ,SectionTable(.ModuleTable(.ModuleInx
3071 6685 .).SCTBase + SegmentInx
3072 6699 .)
3073 66C0 ,ModuleTable(.ModuleInx.)
3074 66D5 );
3075 66D9 IF Status <> (..) THEN
3076 66F2 GOTO 999; (************* EXIT BOTH FOR LOOPS **************)
3077 66FA END;
3078 66FA END;
3079 6704 WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3080 6732 BEGIN
3081 6737 CopyBuffer(Status, Crid.F, TargetFile, ImageSize);
3082 675E CopyBuffer(Status, Covr.F, TargetFile, OvrSize);
3083 6787 END;
3084 6787 END;
3085 6791 999:
3086 6791 (*backpatch info to target.inx*)
3087 6791 UPDINX(Status, TargetFile);
3088 67A7
3089 67A7 END; (*PASS2*)
3090 67B0
3091 67B0 (* *)
3092 67B0 (* *)
3093 67B0 (******************************************************************************)
3094 67B0
3095 67B0
3096 67B0
3097 67B0 BEGIN (*LINK*)
3098 67B0 (*#B#
3099 67B0 TestInit(Input,Output);
3100 67B0 #E#*)
3101 67B0 Status := (..);
3102 67CD Optiontable.LogFileKind := None;
3103 67D7 OptionTable.TargetFileKind := Implicit;
3104 67E1 CurFileNo := 0;
3105 67EB CurModuleNo := 0;
3106 67F5 FOR SCTSubInx := 1 TO MaxNooSections DO
3107 6807 SectionTable(.SCTSubInx.).SegmentNo := 0;
3108 682B SCTOffset := 0;
3109 6835 CurSegmentCount := 0;
3110 683F CurExternalImportSymbolNo := 0;
3111 6849
3112 6849 SetUp(Status, TargetFile, LogFile, Output);
3113 6861 (*#B#
3114 6861 IF test((.0,16,17.)) THEN
3115 6861 BEGIN
3116 6861 write(TestOut, 'Link-MAIN-1 '); TSTstat(Status); TSTindt; TSTmem; TSTln
3117 6861 END;
3118 6861 #E#*)
3119 6861 IF Status = (..) THEN
3120 6877 Pass1(Status, TargetFile, LogFile);
3121 688B (*#B#
3122 688B IF test((.0,16,17.)) THEN
3123 688B BEGIN
3124 688B write(TestOut, 'Link-MAIN-2 '); TSTstat(Status); TSTln
3125 688B END;
3126 688B #E#*)
3127 688B IF Status = (..) THEN
3128 68A1 Pass2(Status, TargetFile, LogFile);
3129 68B5 (*#B#
3130 68B5 IF test((.0,16,17.)) THEN
3131 68B5 BEGIN
3132 68B5 write(TestOut, 'Link-MAIN-3 '); TSTstat(Status); TSTln
3133 68B5 END;
3134 68B5 #E#*)
3135 68B5 IF Status = (..) THEN
3136 68CB BEGIN
3137 68D0 writeln(output, 'LINK -- Normal termination')
3138 6906 END
3139 6909 ELSE
3140 690C BEGIN
3141 6911 writeln(output, 'LINK -- Abnormal termination.');
3142 694D FOR StatusInx := Success TO Error DO
3143 695F IF StatusInx IN Status THEN
3144 6972 writeln(output, ' #Error: ', ord(StatusInx):3 );
3145 69B6 IF not (NoTarget IN Status) THEN
3146 69CB erase(TargetFile.F);
3147 69D7 END
3148 69D7 END.
«eof»