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