|
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: 188160 (0x2df00)
Types: TextFile
Names: »LNK.PRN«
└─⟦2079929d2⟧ Bits:30009789/_.ft.Ibm2.50006583.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNK.PRN«
Pro Pascal Compiler - Version zz 2.1
Compilation of: B:LNK.PAS
Options: LNIAG
1 0000 (******************************************************************************)
2 0000 (* *)
3 0000 (* Copyright (1985) by Metanic Aps., Denmark *)
4 0000 (* *)
5 0000 (* Author: Lars Gregers Jakobsen. *)
6 0000 (* *)
7 0000 (******************************************************************************)
8 0000
9 0000 PROGRAM Link;
10 0000
11 0000 (*$I B:lnkDC0.pas Declarations of global constants, types, and commons *)
12 0000 (******************************************************************************)
13 0000 (* *)
14 0000 (* Copyright (1985) by Metanic Aps., Denmark *)
15 0000 (* *)
16 0000 (* Author: Lars Gregers Jakobsen. *)
17 0000 (* *)
18 0000 (******************************************************************************)
19 0000
20 0000 CONST
21 0000
22 0000 (*$I B:LNKDC0-0.pas Configuration Constants *)
23 0000 (******************************************************************************)
24 0000 (* *)
25 0000 (* Copyright (1985) by Metanic Aps., Denmark *)
26 0000 (* *)
27 0000 (* Author: Lars Gregers Jakobsen. *)
28 0000 (* *)
29 0000 (******************************************************************************)
30 0000
31 0000 (* $I B:LNKDC0-0.pas Configuration Constants *)
32 0000
33 0000 ConfigurationNo = 'C0B CP/M';
34 0008
35 0008 CommandLineLength = 127;
36 0008 FileNameLength = 14;
37 0008 MaxSymbolNameIndex = 32; (*?*)
38 0008 MaxNooInputFiles = 5; (*?*)
39 0008 MaxNooModules = 10; (*?*)
40 0008 MaxNooSections = 40; (*?*)
41 0008 MaxNooSegments = 5; (*?*)
42 0008 MaxNooSymbols = 100; (*?*)
43 0008 MaxNooExternalImportSymbols = 100; (*?*)
44 0008 MaxNameTableIndex = 300; (*?*)
45 0008 MaxHeapIndex = 11; (* >= MaxNooModules + 1 *)
46 0008 OM_Format1 = 1;
47 0008 OF_Format1 = 1;
48 0008 LogFilePageSize = 65; (*First line is #1. Last line is #65*)
49 0008
50 0008 (* *)
51 0008 (* *)
52 0008 (******************************************************************************)
53 0008
54 0008 (*#B#*)
55 0008 (*$I A:PrTstCon.pas Declarations of constants for PrTst package *)
56 0008 (* $I A:PrTstCon.pas Declarations of constants for PrTst package *)
57 0008
58 0008 (* This file is part of the ProPascal test option package. Se file
59 0008 PrTst.pas for further explanations of usage
60 0008 *)
61 0008
62 0008 max_test_option_number = 31;
63 0008
64 0008
65 0008
66 0008 (* Other constants *)
67 0008
68 0008 VersionNo = 'V0.03';
69 000D UnResolved = -1; (* Value of field segmentno in VLT *)
70 000D OvrCode = 0; (* For index in bit map *)
71 000D ImageFactor = 4; (* 2 bits in bit map per 8 bits in image *)
72 000D OMF_Address = 4; (* Address of OMF in target file *)
73 000D OMH_Address = 8; (* Address of OMH in target file *)
74 000D LogMargin = 10; (* Size of blank left margin in log file *)
75 000D
76 000D TYPE (*LINK*)
77 000D
78 000D (* General Types *)
79 000D
80 000D i8 = 0..255;
81 000D i16 = 0..65535;
82 000D i32 = integer;
83 000D i32IndexType = (bs0, bs1, bs2, bs3);
84 000D i32ArrayType = ARRAY (.i32IndexType.) OF i8;
85 000D CharSetType = SET OF char;
86 000D
87 000D (* Basic Types *)
88 000D
89 000D StatusBaseType =
90 000D (Success
91 000D ,BadOption
92 000D ,BadLogFileName
93 000D ,BadTargetFileName
94 000D ,BadFileName
95 000D ,NoSuchFile
96 000D ,NoInputFiles
97 000D ,ExtraText
98 000D ,BadFileFormat
99 000D ,BadModuleFormat
100 000D ,UnexpectedEof
101 000D ,RangeError
102 000D ,BadSymbolName
103 000D ,DuplicateModuleName
104 000D ,DuplicateExportSymbol
105 000D ,NoInput
106 000D ,Baddibit
107 000D ,BadRelocationCode
108 000D ,BadImportCode
109 000D ,NameTableOverFlow
110 000D ,ModuleTableOverFlow
111 000D ,SectionTableOverFlow
112 000D ,FileNameTableOverFlow
113 000D ,SymbolTableOverFlow
114 000D ,ExternalImportTableOverFlow
115 000D ,NotFound
116 000D ,NotFinished
117 000D ,HeapEmpty
118 000D ,NoTarget
119 000D ,Error
120 000D );
121 000D
122 000D StatusType = SET OF StatusBaseType;
123 000D
124 000D OF_FormatType = i32;
125 000D OM_FormatType = i32;
126 000D FileKindBaseType = (explicit, implicit, none);
127 000D LogFileKindType = explicit..none;
128 000D TargetFileKindType = explicit..implicit;
129 000D
130 000D SegmentNoType = UnResolved..MaxNooSegments;
131 000D RelocationIndicatorType = SegmentNoType;
132 000D FileAddressType = 0..MaxInt;
133 000D
134 000D CommandLineIndexType = 0..CommandLineLength;
135 000D CommandLineType = String(.CommandLineLength.);
136 000D
137 000D SymbolNameIndexType = 0..MaxSymbolNameIndex;
138 000D SymbolNameSubIndexType = 1..MaxSymbolNameIndex;
139 000D SymbolNameType = RECORD
140 000D Length: SymbolNameIndexType;
141 000D Name: ARRAY (.SymbolNameSubIndexType.) OF i8;
142 000D END;
143 000D ModuleNameType = SymbolNameType;
144 000D FileNameType = STRING(.FileNameLength.);
145 000D
146 000D ImageUnitType = i8;
147 000D QuadImageUnitType = i32;
148 000D BasicFileType = file OF ImageUnitType;
149 000D FileType = RECORD
150 000D F: BasicFileType; (* File systeme file *)
151 000D P: FileAddressType (* Current file address.
152 000D NOT defined when eof(F) = true *)
153 000D END;
154 000D
155 000D PageNoType = i32;
156 000D LineNoType = 0..255;
157 000D LogFileType = RECORD
158 000D F: text; (* File system file *)
159 000D P: PageNoType; (* No of page started upon *)
160 000D L: LineNoType; (* No of line just printed within current page *)
161 000D END;
162 000D
163 000D (* Table Index Types *)
164 000D
165 000D ExternalImportTableIndexType = 0..MaxNooExternalImportSymbols;
166 000D FileNameTableIndexType = -1..MaxNooInputFiles;
167 000D ModuleTableIndexType = 0..MaxNooModules;
168 000D NameTableIndexType = 0..MaxNameTableIndex;
169 000D SectionTableIndexType = 0..MaxNooSections;
170 000D SymbolTableIndexType = 0..MaxNooSymbols;
171 000D HeapIndexType = 0..MaxHeapIndex;
172 000D
173 000D (* Table Sub Index Types *)
174 000D
175 000D ExternalImportTableSubIndexType = 1..MaxNooExternalImportSymbols;
176 000D ModuleTableSubIndexType = 1..MaxNooModules;
177 000D NameTableSubIndexType = 1..MaxNameTableIndex;
178 000D SectionTableSubIndexType = 1..MaxNooSections;
179 000D SymbolTableSubIndexType = 1..MaxNooSymbols;
180 000D
181 000D
182 000D
183 000D (* Table Record Types *)
184 000D
185 000D ExternalImportTableRecordType = RECORD
186 000D SymbolNo: SymbolTableIndexType
187 000D (* Points to VLT entry holding value *)
188 000D END;
189 000D
190 000D FileNameTableRecordType = FileNameType;
191 000D
192 000D ModuleTableRecordType = RECORD
193 000D ModuleNameReference: SymbolTableIndexType;
194 000D (* Points to SBT entry holding module name *)
195 000D FileNameReference: FileNameTableIndexType;
196 000D (* Points to FNT entry holding name of file *)
197 000D CurrentFileAddress: FileAddressType;
198 000D (* Offset (in octets) relative to start of file. First octet
199 000D in file is # 0 *)
200 000D Referenced: Boolean;
201 000D (* True if module referenced. Not used. *)
202 000D NooSegments: SegmentNoType;
203 000D (* Noo Segments in module *)
204 000D SCTBase: SectionTableIndexType;
205 000D (* Points to SCT entry just below the entries of this module.
206 000D Used by putEXP during relocation of exported symbols *)
207 000D NooExternalImportSymbols: ExternalImportTableIndexType;
208 000D (* Noo External import symbols in module *)
209 000D EITOffset: ExternalImportTableIndexType;
210 000D (* Points to EIT entry just below the entries of this module.
211 000D Used during pass 2 *)
212 000D SBTLinkHead: SymbolTableIndexType
213 000D (* Points to first SBT entry in ordered linked list using
214 000D sortlink as link field *)
215 000D END;
216 000D
217 000D OptionTableRecordType = RECORD
218 000D LogFileKind: LogFileKindType;
219 000D TargetFileKind: TargetFileKindType
220 000D END;
221 000D
222 000D SectionTableRecordType = RECORD
223 000D ModuleNo: ModuleTableIndexType;
224 000D (* Points to MDT entry holding module description *)
225 000D SegmentNo: SegmentNoType;
226 000D (* *)
227 000D ImageSize: FileAddressType;
228 000D (* Size of image in quadimageunits.
229 000D Size of bitmap rid in imageunits *)
230 000D OvrSize: FileAddressType;
231 000D (* Size of overrun store in octets *)
232 000D RelocationConstant: FileAddressType;
233 000D (* Amount (in octets) to offset section during relocation *)
234 000D END;
235 000D
236 000D SymbolTableRecordType = RECORD
237 000D ModuleNo: ModuleTableIndexType;
238 000D (* if symbol resolved: Points to MDT entry of exporting module.
239 000D if not : Points to MDT entry of importing module *)
240 000D NameReference: NameTableIndexType;
241 000D (* Points to first octet of name (length field) in NMT *)
242 000D SortLink: SymbolTableIndexType
243 000D (* Points to SBT entry of next symbol according to
244 000D some ordering (e.g. alphabetically) *)
245 000D END;
246 000D
247 000D ValueTableRecordType = RECORD
248 000D SegmentNo: SegmentNoType;
249 000D (* < 0 : Symbol has not been resolved.
250 000D = 0 : Symbol is absolute.
251 000D 0 < s <= MDT(SBT.ModuleNo).NooSegments:Symbol is relocatable
252 000D and field indicates number of segment. *)
253 000D Value: i32
254 000D (* if symbol resolved: Value of symbol.
255 000D if not : Points to EIT entry of the symbol in the
256 000D reduced EIT written to targetmodule *)
257 000D END;
258 000D
259 000D (* Table Types *)
260 000D
261 000D
262 000D ExternalImportTableType = ARRAY (.ExternalImportTableSubIndexType.) OF
263 000D ExternalImportTableRecordType;
264 000D
265 000D FileNameTableType = ARRAY (.FileNameTableIndexType.) OF
266 000D FileNameTableRecordType;
267 000D
268 000D ModuleTableType = ARRAY (.ModuleTableSubIndexType.) OF
269 000D ModuleTableRecordType;
270 000D
271 000D OptionTableType = OptionTableRecordType;
272 000D
273 000D NameTableType = ARRAY (.NameTableSubIndexType.) OF i8;
274 000D
275 000D SectionTableType = ARRAY (.SectionTableSubIndexType.) OF
276 000D SectionTableRecordType;
277 000D
278 000D SymbolTableType = ARRAY (.SymbolTableSubIndexType.) OF
279 000D SymbolTableRecordType;
280 000D
281 000D ValueTableType = ARRAY (.SymbolTableSubIndexType.) OF
282 000D ValueTableRecordType;
283 000D
284 000D
285 000D (* Other major data structures *)
286 000D
287 000D HeapType = ARRAY (.ModuleTableIndexType.) OF SymbolTableIndexType;
288 000D
289 000D BitMapBufferTagType = (bit, byt);
290 000D BitMapBufferType = RECORD
291 000D P: 0..16;
292 000D CASE BitMapBufferTagType OF
293 000D bit: (I: SET OF 0..15);
294 000D byt: (Y0: i8;
295 000D Y1: i8
296 000D )
297 000D END;
298 000D
299 000D BitMappedFileType = RECORD
300 000D F: BasicFileType;
301 000D B: BitMapBufferType
302 000D END;
303 000D
304 000D (*#B#*)
305 000D (*$I A:PrTstTyp.pas Declarations of types for PrTst package *)
306 000D (* $I A:PrTstTyp.pas Declarations of types for PrTst package *)
307 000D
308 000D (* This file is part of the ProPascal test option package. Se file
309 000D PrTst.pas for further explanations of usage
310 000D *)
311 000D
312 000D test_option_type = 0..max_test_option_number;
313 000D test_option_set_type = SET OF test_option_type;
314 000D
315 000D
316 000D
317 000D
318 000D COMMON (*LINK*)
319 000D
320 000D (* Permanent Tables *)
321 000D
322 000D OptionTable: OptionTableType;
323 000D
324 000D FileNameTable: FilenameTableType;
325 000D CurFileNo: FileNameTableIndexType;
326 000D (* Points to highest entry used *)
327 000D
328 000D ModuleTable: ModuleTableType;
329 000D CurModuleNo: ModuleTableIndexType;
330 000D (* Points to highest entry used *)
331 000D TargetModuleNo: ModuleTableIndexType;
332 000D (* Points to entry of target module *)
333 000D
334 000D SectionTable: SectionTableType;
335 000D SCTOffset: SectionTableIndexType;
336 000D (* Points to highest entry used *)
337 000D TargetSectionOffset: SectionTableIndexType;
338 000D (* Points to entry just below target sections *)
339 000D CurSegmentCount: SegmentNoType;
340 000D (* Number of segments in target module *)
341 000D
342 000D ValueTable: ValueTableType;
343 000D NooExpSymbols: i32;
344 000D (* Number of EXP symbols in target module *)
345 000D
346 000D ExternalImportTable: ExternalImportTableType;
347 000D CurExternalImportSymbolNo: ExternalImportTableIndexType;
348 000D (* Points to highest entry used *)
349 000D NooExiSymbols: i32;
350 000D (* Number of EXI symbols in target module *)
351 000D
352 000D (*#B#*)
353 000D (*$I A:PrTstCom.pas Declarations of global variables for PrTst package *)
354 000D (* $I A:PrTstCom.pas Declarations of global variables for PrTst package *)
355 000D
356 000D (* This file is part of the ProPascal test option package. Se file
357 000D PrTst.pas for further explanations of usage
358 000D *)
359 000D
360 000D test_options: test_option_set_type;
361 000D test_out: text;
362 000D test_global: boolean;
363 000D
364 000D
365 000D
366 000D (* *)
367 000D (* *)
368 000D (******************************************************************************)
369 000D
370 000D
371 000D VAR (*LINK*)
372 000D
373 000D (* Misc. Variables *)
374 000D
375 000D Status: StatusType;
376 000D TargetFile: FileType;
377 000D LogFile: LogFileType;
378 000D SCTSubInx: SectionTableSubIndexType;
379 000D
380 000D (*#B#*)
381 000D (*$I A:PrTstExt.pas External Decl. of standard test procedures *)
382 000D (* $I A:ProTstExt.pas Declarations of external procedures for ProTst package *)
383 000D
384 000D (* This file is part of the ProPascal test option package. Se file
385 000D ProTst.pas for further explanations of usage
386 000D *)
387 000D
388 000D FUNCTION test(list: test_option_set_type
389 000D ): boolean; EXTERNAL;
390 000D
391 000D PROCEDURE test_init(VAR in_file,
392 000D out_file: text
393 000D ); EXTERNAL;
394 000D
395 000D
396 000D (*#B#*)
397 000D (*$I B:LnkDF1.pas Global test output primitives *)
398 000D (******************************************************************************)
399 000D (* *)
400 000D (* Copyright (1985) by Metanic Aps., Denmark *)
401 000D (* *)
402 000D (* Author: Lars Gregers Jakobsen. *)
403 000D (* *)
404 000D (******************************************************************************)
405 000D
406 000D (* File LnkDF1 defines the test output primitives used for debugging
407 000D program link and its associated subroutines and functions.
408 000D *)
409 000D
410 000D FUNCTION memavail: integer; EXTERNAL;
411 000D
412 000D PROCEDURE TSTasc(N: i8
413 000D );
414 000D
415 000D BEGIN (*TSTASC*)
416 000D IF (31 < N) and (N < 127) THEN
417 0031 write(TestOut, chr(N) )
418 004A ELSE
419 004F write(TestOut, '+')
420 0067 END; (*TSTASC*)
421 0070
422 0070 PROCEDURE TSThex(N: i8
423 0070 );
424 0070
425 0070 VAR
426 0070 Nibble: i8;
427 0070
428 0070 BEGIN (*TSTHEX*)
429 0070 Nibble := N div 16;
430 008F IF Nibble < 10 THEN
431 0098 write(TestOut, chr( ord('0') + Nibble ) )
432 00B8 ELSE
433 00BD write(TestOut, chr( ord('A') - 10 + Nibble ) );
434 00E0 Nibble := N mod 16;
435 00F1 IF Nibble < 10 THEN
436 00FA write(TestOut, chr( ord('0') + Nibble ) )
437 011A ELSE
438 011F write(TestOut, chr( ord('A') - 10 + Nibble ) )
439 013F END; (*TSTHEX*)
440 0148
441 0148 PROCEDURE TSTbool(A: boolean
442 0148 );
443 0148
444 0148 BEGIN (*TSTBOOL*)
445 0148 IF A THEN
446 015B write(TestOut, 'T')
447 0173 ELSE
448 0178 write(TestOut, 'F')
449 0190 END; (*TSTBOOL*)
450 0199
451 0199 PROCEDURE TSTindt;
452 0199
453 0199 BEGIN (*TSTindt*)
454 0199 write(TestOut, ' ':3)
455 01B9 END; (*TSTindt*)
456 01C2
457 01C2 PROCEDURE TSTln;
458 01C2
459 01C2 BEGIN (*TSTln*)
460 01C2 writeln(TestOut)
461 01D9 END; (*TSTln*)
462 01E2
463 01E2 PROCEDURE TSTsymbol(S: SymbolNameType
464 01E2 );
465 01E2
466 01E2 VAR
467 01E2 I: SymbolNameIndexType;
468 01E2
469 01E2 BEGIN (*TSTSYMBOL*)
470 01E2 WITH S DO
471 0204 BEGIN
472 0209 write(TestOut, 'SYMBOLÆ', Length:1, 'Å=');
473 024F FOR I := 1 TO Length DO
474 0268 TSTasc(Name(.I.));
475 028E TSTln;
476 0296 END
477 0296 END; (*TSTSYMBOL*)
478 029C
479 029C PROCEDURE TSTstat(Status: StatusType
480 029C );
481 029C
482 029C VAR
483 029C Inx: StatusBaseType;
484 029C
485 029C BEGIN (*TSTstat*)
486 029C write(TestOut, 'STAT=(');
487 02C9 IF Status = (..) THEN
488 02E2 write(TestOut, 'SUCCESS)' )
489 0306 ELSE
490 030C BEGIN
491 0311 FOR Inx := succ(Success) TO Error DO
492 0322 IF Inx IN Status THEN
493 0339 write(TestOut, ' ', ord(Inx):1);
494 036D write(TestOut, ' )');
495 038E END
496 038E END; (*TSTstat*)
497 0394
498 0394 PROCEDURE TSTmem;
499 0394
500 0394 BEGIN (*TSTmem*)
501 0394 write(TestOut, 'MEMAVAIL=', memavail:1)
502 03CC END; (*TSTmem*)
503 03D5
504 03D5 PROCEDURE TSTeit(Inx: ExternalImportTableIndexType
505 03D5 );
506 03D5
507 03D5 BEGIN (*TSTeit*)
508 03D5 WITH ExternalImportTable(.Inx.) DO
509 03F6 writeln(TestOut, 'EITÆ', Inx:1, '/', CurExternalImportSymbolNo:1,
510 0441 'Å=(SblNo=', SymbolNo:1, ')' )
511 0475 END; (*TSTeit*)
512 047E
513 047E PROCEDURE TSTfnt(Inx: FileNameTableIndexType
514 047E );
515 047E
516 047E BEGIN (*TSTfnt*)
517 047E writeln(TestOut, 'FNTÆ', Inx:1, '/', CurFileNo:1,
518 04D1 'Å=(FlNm=', FileNameTable(.inx.), ')' )
519 050C END; (*TSTfnt*)
520 0515
521 0515 PROCEDURE TSTheap(Heap: HeapType
522 0515 ;HeapMax: ModuleTableIndexType
523 0515 );
524 0515
525 0515 VAR
526 0515 I: ModuleTableIndexType;
527 0515
528 0515 BEGIN (*TSTHEAP*)
529 0515 TSTindt; TSTindt; TSTindt;
530 0540 write(TestOut, 'HeapÆ',HeapMax:2,'Å=(' );
531 0585 FOR I := 1 TO HeapMax DO
532 059E write(TestOut, Heap(.I.):2, ' ':1);
533 05E4 writeln(TestOut, ')');
534 05FF END; (*TSTHEAP*)
535 0605
536 0605 PROCEDURE TSTmdt(Inx: ModuleTableIndexType
537 0605 );
538 0605
539 0605 BEGIN (*TST*)
540 0605 WITH moduleTable(.Inx.) DO
541 062C BEGIN
542 0631 write(TestOut, 'MDTÆ', Inx:1, '/', CurModuleNo:1,
543 067C 'Å=(MdNm#=', ModuleNameReference:1, ' ':2
544 06AA ,'Fn#=', FileNameReference:1, ' ':2
545 06DA ,'CurFlAddr=', CurrentFileAddress:1, ' ':2
546 070D ,'Refd='
547 071B );
548 0728 TSTbool(Referenced);
549 073F TSTln;
550 0747 TSTindt; TSTindt; TSTindt;
551 0755 writeln(TestOut ,'SCTbase=', SCTbase:1, ' ':2
552 0795 ,'#Sgm=', NooSegments:1, ' ':2
553 07C9 ,'EIT#=', EITOffset:1, ' ':2
554 07FD ,'#EIsbl=', NooExternalImportSymbols:1, ' ':2
555 0833 ,'SBTLH=', SBTlinkHead:1
556 085F ,')'
557 0865 );
558 0871 END
559 0871 END; (*TST*)
560 0877
561 0877 PROCEDURE TSTopt;
562 0877
563 0877 BEGIN (*TSTopt*)
564 0877 writeln(TestOut, 'OPT=(LogKind=', ord(OptionTable.LogFileKind):1, ' ':2
565 08BA ,'TargetKind=', ord(OptionTable.TargetFileKind):1
566 08E1 ,')' )
567 08F0 END; (*TSTopt*)
568 08F9
569 08F9 PROCEDURE TSTsct(Inx: SectionTableIndexType
570 08F9 );
571 08F9
572 08F9 BEGIN (*TSTsct*)
573 08F9 WITH SectionTable(.Inx.) DO
574 0920 BEGIN
575 0925 writeln(TestOut, 'SCT=Æ', Inx:1, '/', SCTOffset:1, '/', CurSegmentCount:1
576 0985 ,'Å=(Mdl#=', ModuleNo:1, ' ':2
577 09B8 ,'Sgm#=', SegmentNo:1
578 09E0 );
579 09E9 writeln(TestOut, ' ImgSz=', ImageSize, ' ':2
580 0A2A ,'OvrSz=', OvrSize, ' ':2
581 0A5B ,'RlConst=', RelocationConstant
582 0A76 ,')'
583 0A8B );
584 0A97 END
585 0A97 END; (*TSTsct*)
586 0A9D
587 0A9D PROCEDURE TSTvlt(Inx: SymbolTableIndexType
588 0A9D );
589 0A9D
590 0A9D BEGIN (*TSTvlt*)
591 0A9D WITH ValueTable(.Inx.) DO
592 0AC4 BEGIN
593 0AC9 write(TestOut, 'VLTÆ',Inx:1,'Å=(Segm#=', SegmentNo:1
594 0B1F , ' Value=', Value:1, ')' )
595 0B55 END
596 0B58 END; (*TSTvlt*)
597 0B5E
598 0B5E (* *)
599 0B5E (* *)
600 0B5E (******************************************************************************)
601 0B5E
602 0B5E (*$I B:LnkDF2.pas Global access primitives *)
603 0B5E (******************************************************************************)
604 0B5E (* *)
605 0B5E (* Copyright (1985) by Metanic Aps., Denmark *)
606 0B5E (* *)
607 0B5E (* Author: Lars Gregers Jakobsen. *)
608 0B5E (* *)
609 0B5E (******************************************************************************)
610 0B5E
611 0B5E (* File LnkDF2X holds the access primitives used by the
612 0B5E linker to access input and output files. *)
613 0B5E
614 0B5E FUNCTION OPTLFK: LogFileKindType;
615 0B5E
616 0B5E BEGIN (*OPTLFK*)
617 0B5E optlfk := OptionTable.LogFileKind;
618 0B74 END; (*OPTLFK*)
619 0B7A
620 0B7A PROCEDURE FNTP(VAR Status: StatusType
621 0B7A ; FileName: FileNameType
622 0B7A );
623 0B7A
624 0B7A BEGIN (*FNTP*)
625 0B7A IF CurFileNo < MaxNooInputFiles THEN
626 0B92 BEGIN
627 0B97 CurFileNo := CurFileNo + 1;
628 0BAD FileNameTable(.CurFileNo.) := FileName;
629 0BD7 END
630 0BD7 ELSE
631 0BD9 Status := Status + (.FileNameTableOverFlow.);
632 0C00 (*#B#*)
633 0C00 IF test((.0,6.)) THEN
634 0C16 BEGIN
635 0C1B write(TestOut, 'FNTP '); TSTstat(Status); TSTindt;
636 0C5A TSTfnt(CurFileNo); TSTln
637 0C69 END
638 0C6C (*#E#*)
639 0C6C END; (*FNTP*)
640 0C72
641 0C72 PROCEDURE EITP(VAR Status: StatusType
642 0C72 ; SymbolTableEntryNo: SymbolTableIndexType
643 0C72 );
644 0C72
645 0C72 BEGIN (*EITP*)
646 0C72 IF CurExternalImportSymbolNo < MaxNooExternalImportSymbols THEN
647 0C8A BEGIN
648 0C8F CurExternalImportSymbolNo := CurExternalImportSymbolNo + 1;
649 0CA5 ExternalImportTable(.CurExternalImportSymbolNo
650 0CAA .).SymbolNo := SymbolTableEntryNo
651 0CB5 END
652 0CBE ELSE
653 0CC0 Status := Status + (.ExternalImportTableOverFlow.);
654 0CE8 (*#B#*)
655 0CE8 IF test((.0,7.)) THEN
656 0CFE BEGIN
657 0D03 write(TestOut, 'EITP '); TSTstat(Status); TSTln;
658 0D42 TSTeit(CurExternalImportSymbolNo)
659 0D4E END
660 0D51 (*#E#*)
661 0D51 END; (*EITP*)
662 0D57
663 0D57 (* ModuleTable *)
664 0D57
665 0D57 PROCEDURE MDTA(VAR Status: StatusType
666 0D57 ;VAR ModuleNo: ModuleTableIndexType (*Points to least, vacant entry in MDT*)
667 0D57 ; ModuleCount: ModuleTableIndexType
668 0D57 );
669 0D57
670 0D57 BEGIN (*MDTA*)
671 0D57 ModuleNo := CurModuleNo;
672 0D73 IF CurModuleNo > MaxNooModules - ModuleCount THEN
673 0D9A Status := Status + (.ModuleTableOverFlow.)
674 0DB0 ELSE
675 0DC3 BEGIN
676 0DC8 ModuleNo := CurModuleNo + 1;
677 0DE4 CurModuleNo := CurModuleNo + ModuleCount;
678 0E01 END;
679 0E01 (*#B#*)
680 0E01 IF test((.0,6.)) THEN
681 0E18 BEGIN
682 0E1D write(TestOut, 'MDTA '); TSTstat(Status); TSTindt;
683 0E5C writeln(TestOut, 'ModuleNo, Count, CurModuleNo= ',
684 0E96 ModuleNo:1, ' ',
685 0EB4 ModuleCount:1, ' ', CurModuleNo:1
686 0ED9 );
687 0EE2 END;
688 0EE2 (*#E#*)
689 0EE2 END; (*MDTA*)
690 0EE8
691 0EE8 (* SectionTable *)
692 0EE8
693 0EE8 PROCEDURE SCTA(VAR Status: StatusType
694 0EE8 ;VAR SectionNo: SectionTableIndexType (*Points to highest, used entry in SCT*)
695 0EE8 ; SectionCount: SegmentNoType
696 0EE8 );
697 0EE8
698 0EE8 BEGIN (*SCTA*)
699 0EE8 SectionNo := SCTOffset;
700 0F04 IF SCTOffset > MaxNooSections - SectionCount THEN
701 0F2B Status := Status + (.SectionTableOverFlow.)
702 0F41 ELSE
703 0F54 BEGIN
704 0F59 SCTOffset := SCTOffset + SectionCount;
705 0F76 END;
706 0F76 (*#B#*)
707 0F76 IF test((.0,6.)) THEN
708 0F8D BEGIN
709 0F92 write(TestOut, 'SCTA '); TSTstat(Status); TSTindt;
710 0FD1 writeln(TestOut, 'SectionNo, Count, SCTOffset= ',
711 100A SectionNo:11, ' ', SectionCount:1, ' ',
712 1042 SCTOffset:1
713 104D );
714 1056 END;
715 1056 (*#E#*)
716 1056 END; (*SCTA*)
717 105C
718 105C (* *)
719 105C (* *)
720 105C (******************************************************************************)
721 105C
722 105C
723 105C
724 105C (*$I B:LnkDF7.pas Log File access primitives *)
725 105C (******************************************************************************)
726 105C (* *)
727 105C (* Copyright (1985) by Metanic Aps., Denmark *)
728 105C (* *)
729 105C (* Author: Lars Gregers Jakobsen. *)
730 105C (* *)
731 105C (******************************************************************************)
732 105C
733 105C
734 105C PROCEDURE WriteSymbolName(VAR F: text
735 105C ; SymbolName: SymbolNameType
736 105C ; FieldSize: i8
737 105C );
738 105C
739 105C VAR
740 105C I: i8;
741 105C N: i8;
742 105C
743 105C BEGIN (*WRITESYMBOLNAME*)
744 105C WITH SymbolName DO
745 107E BEGIN
746 1083 IF Length < FieldSize THEN
747 109B N := Length
748 10A0 ELSE
749 10AC N := FieldSize;
750 10B7 FOR I := 1 TO N DO
751 10CD IF Name(.I.) in (.32..127.) THEN
752 1104 write(F, chr(Name(.I.)) );
753 1145 FOR I := N+1 TO FieldSize DO
754 1167 write(F, ' ');
755 1193 END
756 1193 END; (*WRITESYMBOLNAME*)
757 1199
758 1199 PROCEDURE LogInit(VAR LogFile: LogFileType
759 1199 ; FileName: FileNameType
760 1199 );
761 1199
762 1199 BEGIN (*LOGINIT*)
763 1199 WITH LogFile DO
764 11B2 BEGIN
765 11B7 assign(F, FileName);
766 11CE rewrite(F);
767 11E1 P := 0;
768 11F8 L := LogFilePageSize;
769 1209 END
770 1209 END; (*LOGINIT*)
771 120F
772 120F PROCEDURE LogTerm(VAR LogFile: LogFileType
773 120F );
774 120F
775 120F BEGIN (*LOGTERM*)
776 120F WITH LogFile DO
777 1228 BEGIN
778 122D close(F);
779 123A END
780 123A END; (*LOGTERM*)
781 1240
782 1240 FUNCTION LogFF(VAR LogFile: LogFileType
783 1240 ; Delta: LineNoType
784 1240 ): boolean;
785 1240
786 1240 CONST
787 1240 LogFFDelta = 5;
788 1240
789 1240 BEGIN (*LOGFF*)
790 1240 WITH LogFile DO
791 1259 IF L >= LogFilePageSize - Delta THEN
792 127F BEGIN
793 1284 LogFF := true;
794 128D P := P + 1;
795 12AC L := LogFFDelta;
796 12BD page(F);
797 12D0 writeln(F);
798 12E9 writeln(F);
799 1302 writeln(F, ' ':LogMargin, 'LINKER '
800 132B , VersionNo, ' '
801 1342 , ConfigurationNo
802 134B , ' ':30
803 135B , 'SIDE # ', P:2);
804 138B writeln(F);
805 13A4 writeln(F);
806 13BD END
807 13BD ELSE
808 13BF LogFF := false;
809 13C8 END; (*LOGFF*)
810 13D1
811 13D1 PROCEDURE LogCmd(VAR LogFile: LogFileType
812 13D1 ; CommandLine: CommandLineType
813 13D1 );
814 13D1
815 13D1 CONST Delta = 5;
816 13D1
817 13D1 BEGIN (*LOGCMD*)
818 13D1 IF OptionTable.LogFileKind <> none THEN
819 13E6 BEGIN
820 13EB IF LogFF(LogFile, Delta) THEN BEGIN END;
821 1400 WITH LogFile DO
822 1411 BEGIN
823 1416 writeln(F);
824 142F writeln(F, ' ':LogMargin, 'AKTIVERINGSKOMMANDO: ');
825 1473 writeln(F);
826 148C writeln(F, ' ':LogMargin, CommandLine);
827 14BE writeln(F);
828 14D7 END
829 14D7 END
830 14D7 END; (*LOGCMD*)
831 14DD
832 14DD PROCEDURE LogHSsgd(VAR LogFile: LogFileType
833 14DD );
834 14DD
835 14DD BEGIN (*LOGHSSGD*)
836 14DD IF OptionTable.LogFileKind <> none THEN
837 14F2 WITH LogFile DO
838 1503 BEGIN
839 1508 L := L + 2;
840 1529 writeln(F, ' ':LogMargin, 'SGM'
841 154E , ' ':2, 'ADRESSE':9
842 156F , ' ':2, 'STØRRELSE'
843 158A , ' ':2, 'MODUL'
844 15A5 );
845 15B2 writeln(F);
846 15CB END
847 15CB END; (*LOGHSSGD*)
848 15D1
849 15D1 PROCEDURE LogHsgd(VAR LogFile: LogFileType
850 15D1 );
851 15D1
852 15D1 BEGIN (*LOGHSGD*)
853 15D1 IF OptionTable.LogFileKind <> none THEN
854 15E6 BEGIN
855 15EB IF LogFF(LogFile, 6) THEN BEGIN END;
856 1600 WITH LogFile DO
857 1611 BEGIN
858 1616 L := L + 3;
859 1637 writeln(F);
860 1650 writeln(F, ' ':LogMargin, 'LOKALISERINGSPLAN:');
861 1691 writeln(F);
862 16AA END;
863 16AA LogHSsgd(LogFile);
864 16B9 END;
865 16B9 END; (*LOGHSGD*)
866 16BF
867 16BF PROCEDURE LogSGD(VAR LogFile: LogFileType
868 16BF ; SegmentNo: RelocationIndicatorType
869 16BF ; StartAddress: FileAddressType
870 16BF ; Size: FileAddressType
871 16BF ; ModuleName: SymbolNameType
872 16BF );
873 16BF
874 16BF BEGIN (*LOGSGD*)
875 16BF IF OptionTable.LogFileKind <> none THEN
876 16E9 BEGIN
877 16EE IF LogFF(LogFile, 1) THEN
878 1703 LogHSsgd(LogFile);
879 1712 WITH LogFile DO
880 1723 BEGIN
881 1728 L := L + 1;
882 1746 write(F, ' ':LogMargin, SegmentNo:3
883 1770 , ' ':2, StartAddress:9
884 1785 , ' ':2, Size:9
885 179A , ' ':2
886 17A3 );
887 17AC WriteSymbolName(F, ModuleName, 20);
888 17C6 writeln(F);
889 17DF END;
890 17DF END
891 17DF END; (*LOGSGD*)
892 17E5
893 17E5 PROCEDURE LogHSxp(VAR LogFile: LogFileType
894 17E5 );
895 17E5
896 17E5 BEGIN (*LOGHSXP*)
897 17E5 IF OptionTable.LogFileKind <> none THEN
898 17FA WITH LogFile DO
899 180B BEGIN
900 1810 L := L + 2;
901 1831 writeln(F, ' ':LogMargin, 'SGM'
902 1856 , ' ':2, 'VÆRDI':9
903 1875 , ' ':2, 'SYMBOL', ' ':14
904 189A , ' ':2, 'MODUL'
905 18B1 );
906 18BE writeln(F);
907 18D7 END
908 18D7 END; (*LOGHSXP*)
909 18DD
910 18DD PROCEDURE LogHxpN(VAR LogFile: LogFileType
911 18DD );
912 18DD
913 18DD BEGIN (*LOGHXPN*)
914 18DD IF OptionTable.LogFileKind <> none THEN
915 18F2 BEGIN
916 18F7 IF LogFF(LogFile, 6) THEN BEGIN END;
917 190C WITH LogFile DO
918 191D BEGIN
919 1922 L := L + 3;
920 1943 writeln(F);
921 195C writeln(F, ' ':LogMargin, 'EXPORTEREDE SYMBOLER (NAVNEORDEN):');
922 19AD writeln(F);
923 19C6 END;
924 19C6 LogHSxp(LogFile);
925 19D5 END
926 19D5 END; (*LOGHXPN*)
927 19DB
928 19DB PROCEDURE LogHxpV(VAR LogFile: LogFileType
929 19DB );
930 19DB
931 19DB BEGIN (*LOGHXPV*)
932 19DB IF OptionTable.LogFileKind <> none THEN
933 19F0 BEGIN
934 19F5 IF LogFF(LogFile, 6) THEN BEGIN END;
935 1A0A WITH LogFile DO
936 1A1B BEGIN
937 1A20 L := L + 3;
938 1A41 writeln(F);
939 1A5A writeln(F, ' ':LogMargin, 'EXPORTEREDE SYMBOLER (VÆRDIORDEN):');
940 1AAB writeln(F);
941 1AC4 END;
942 1AC4 LogHSxp(LogFile);
943 1AD3 END
944 1AD3 END; (*LOGHXPV*)
945 1AD9
946 1AD9 PROCEDURE LogXP(VAR LogFile: LogFileType
947 1AD9 ; SegmentNo: RelocationIndicatorType
948 1AD9 ; Value: i32
949 1AD9 ; SymbolName: SymbolNameType
950 1AD9 ; ModuleName: ModuleNameType
951 1AD9 );
952 1AD9
953 1AD9 BEGIN (*LOGXP*)
954 1AD9 IF OptionTable.LogFileKind <> none THEN
955 1B18 BEGIN
956 1B1D IF LogFF(LogFile,1) THEN
957 1B32 LogHSxp(LogFile);
958 1B41 WITH LogFile DO
959 1B52 BEGIN
960 1B57 L := L + 1;
961 1B75 write(F, ' ':LogMargin, SegmentNo:3
962 1B9F , ' ':2, Value:9
963 1BB4 , ' ':2
964 1BBD );
965 1BC6 WriteSymbolName(F, SymbolName, 20);
966 1BE0 write(F, ' ':2);
967 1C02 WriteSymbolName(F, ModuleName, 20);
968 1C1C writeln(F);
969 1C35 END
970 1C35 END
971 1C35 END; (*LOGXP*)
972 1C3B
973 1C3B PROCEDURE LogHSurs(VAR LogFile: LogFileType
974 1C3B );
975 1C3B
976 1C3B BEGIN (*LOGHSURS*)
977 1C3B IF OptionTable.LogFileKind <> none THEN
978 1C50 BEGIN
979 1C55 WITH LogFile DO
980 1C66 BEGIN
981 1C6B L := L + 2;
982 1C8C writeln(F, ' ':LogMargin
983 1CA5 , ' ':16, 'SYMBOL', ' ':14
984 1CCA , ' ':2, 'MODUL');
985 1CEE writeln(F);
986 1D07 END
987 1D07 END
988 1D07 END; (*LOGHSURS*)
989 1D0D
990 1D0D PROCEDURE LogHurs(VAR LogFile: LogFileType
991 1D0D );
992 1D0D
993 1D0D BEGIN (*LOGHURS*)
994 1D0D IF OptionTable.LogFileKind <> none THEN
995 1D22 BEGIN
996 1D27 IF LogFF(LogFile, 6)THEN BEGIN END;
997 1D3C WITH LogFile DO
998 1D4D BEGIN
999 1D52 L := L + 3;
1000 1D73 writeln(F);
1001 1D8C writeln(F, ' ':LogMargin, 'UTILFREDSSTILLEDE REFERENCER:');
1002 1DD8 writeln(F);
1003 1DF1 END;
1004 1DF1 LogHSurs(LogFile);
1005 1E00 END
1006 1E00 END; (*LOGHURS*)
1007 1E06
1008 1E06 PROCEDURE LogURS(VAR LogFile: LogFileType
1009 1E06 ; ModuleName: ModuleNameType
1010 1E06 ; SymbolName: SymbolNameType
1011 1E06 );
1012 1E06
1013 1E06 BEGIN (*LOGURS*)
1014 1E06 IF OptionTable.LogFileKind <> none THEN
1015 1E45 BEGIN
1016 1E4A IF LogFF(LogFile, 1) THEN
1017 1E5F LogHSurs(LogFile);
1018 1E6E WITH LogFile DO
1019 1E7F BEGIN
1020 1E84 L := L + 1;
1021 1EA2 write(F, ' ':LogMargin
1022 1EBB , ' ':16
1023 1EC4 );
1024 1ECD WriteSymbolName(F, SymbolName, 20);
1025 1EE7 write(F, ' ':2);
1026 1F09 WriteSymbolName(F, ModuleName, 20);
1027 1F23 writeln(F);
1028 1F3C END
1029 1F3C END
1030 1F3C END; (*LOGURS*)
1031 1F42
1032 1F42 PROCEDURE LogHSdds(VAR LogFile: LogFileType
1033 1F42 );
1034 1F42
1035 1F42 BEGIN (*LOGHSDDS*)
1036 1F42 IF OptionTable.LogFileKind <> none THEN
1037 1F57 WITH LogFile DO
1038 1F68 BEGIN
1039 1F6D L := L + 2;
1040 1F8E writeln(F, ' ':LogMargin, 'SGM'
1041 1FB3 , ' ':2, 'VÆRDI':9
1042 1FD2 , ' ':2, 'SYMBOL', ' ':14
1043 1FF7 , ' ':2, 'MODUL'
1044 200E );
1045 201B writeln(F);
1046 2034 END;
1047 2034 END; (*LOGHSDDS*)
1048 203A
1049 203A PROCEDURE LogHdds(VAR LogFile: LogFileType
1050 203A );
1051 203A
1052 203A BEGIN (*LOGHDDS*)
1053 203A IF OptionTable.LogFileKind <> none THEN
1054 204F BEGIN
1055 2054 IF LogFF(LogFile, 6) THEN BEGIN END;
1056 2069 WITH LogFile DO
1057 207A BEGIN
1058 207F L := L + 2;
1059 20A0 writeln(F);
1060 20B9 writeln(F, ' ':LogMargin, 'DOBBELTDEFINEREDE SYMBOLER:');
1061 2103 writeln(F);
1062 211C END;
1063 211C LogHSdds(LogFile);
1064 212B END
1065 212B END; (*LOGHDDS*)
1066 2131
1067 2131 PROCEDURE LogDDS(VAR LogFile: LogFileType
1068 2131 ; RelocationIndicator: RelocationIndicatorType
1069 2131 ; Value: i32
1070 2131 ; SymbolName: SymbolNameType
1071 2131 ; ModuleName: ModuleNameType
1072 2131 );
1073 2131
1074 2131 BEGIN (*LOGDDS*)
1075 2131 IF OptionTable.LogFileKind <> none THEN
1076 2170 BEGIN
1077 2175 IF LogFF(LogFile, 1) THEN
1078 218A LogHSdds(LogFile);
1079 2199 WITH LogFile DO
1080 21AA BEGIN
1081 21AF L := L + 1;
1082 21CD write(F, ' ':LogMargin, ord(RelocationIndicator):3
1083 21F7 , ' ':2, Value:9
1084 220C , ' ':2
1085 2215 );
1086 221E WriteSymbolName(F, SymbolName, 20);
1087 2238 write(F, ' ':2);
1088 225A WriteSymbolName(F, ModuleName, 20);
1089 2274 writeln(F);
1090 228D END
1091 228D END
1092 228D END; (*LOGDDS*)
1093 2293
1094 2293 PROCEDURE LogOFFerror(VAR LogFile: LogFileType
1095 2293 ; FileNo: FileNameTableIndexType
1096 2293 );
1097 2293
1098 2293 BEGIN (*LOGOFFERROR*)
1099 2293 IF OptionTable.LogFileKind <> none THEN
1100 22A8 BEGIN
1101 22AD IF LogFF(LogFile, 2) THEN BEGIN END;
1102 22C2 WITH LogFile DO
1103 22D3 BEGIN
1104 22D8 L := L + 2;
1105 22F9 writeln(F, ' ':LogMargin, '*** FILFORMATFEJL *** FIL # ', FileNo:1
1106 234C , ' ***'
1107 2359 );
1108 2366 END;
1109 2366 END
1110 2366 END; (*LOGOFFERROR*)
1111 236C
1112 236C
1113 236C PROCEDURE LogOMFerror(VAR LogFile: LogFileType
1114 236C ; FileNo: FileNameTableIndexType
1115 236C ; Position: FileAddressType
1116 236C );
1117 236C
1118 236C BEGIN (*LOGOMFERROR*)
1119 236C IF OptionTable.LogFileKind <> none THEN
1120 2381 BEGIN
1121 2386 IF LogFF(LogFile, 2) THEN BEGIN END;
1122 239B WITH LogFile DO
1123 23AC BEGIN
1124 23B1 L := L + 2;
1125 23D2 writeln(F, ' ':LogMargin, '*** MODULFORMATFEJL *** FIL # ', FileNo:1
1126 2427 , ' *** POSITION # ', Position:1
1127 2450 , ' ***'
1128 245D );
1129 246A END;
1130 246A END
1131 246A END; (*LOGOMFERROR*)
1132 2470
1133 2470 PROCEDURE LogEOFerror(VAR LogFile: LogFileType
1134 2470 ; FileNo: FileNameTableIndexType
1135 2470 ; Position: FileAddressType
1136 2470 );
1137 2470
1138 2470 BEGIN (*LOGEOFERROR*)
1139 2470 IF OptionTable.LogFileKind <> none THEN
1140 2485 BEGIN
1141 248A IF LogFF(LogFile, 2) THEN BEGIN END;
1142 249F WITH LogFile DO
1143 24B0 BEGIN
1144 24B5 L := L + 2;
1145 24D6 writeln(F, ' ':LogMargin, '*** FILLÆNGDEFEJL *** FIL # ', FileNo:1
1146 2529 , ' *** POSITION # ', Position:1
1147 2552 , ' ***'
1148 255F );
1149 256C END;
1150 256C END
1151 256C END; (*LOGEOFERROR*)
1152 2572
1153 2572 (* *)
1154 2572 (* *)
1155 2572 (******************************************************************************)
1156 2572
1157 2572
1158 2572 (*$I B:LnkDF8.pas Object File access primitives *)
1159 2572 (******************************************************************************)
1160 2572 (* *)
1161 2572 (* Copyright (1985) by Metanic Aps., Denmark *)
1162 2572 (* *)
1163 2572 (* Author: Lars Gregers Jakobsen. *)
1164 2572 (* *)
1165 2572 (******************************************************************************)
1166 2572
1167 2572 PROCEDURE FilAsg(VAR Fl: FileType
1168 2572 ;Fn: FileNameType
1169 2572 );
1170 2572
1171 2572 BEGIN (*FILASG*)
1172 2572 (*#B#*)
1173 2572 IF test((.0,1.)) THEN
1174 2590 writeln(TestOut, 'FILasg FlNm=', Fn);
1175 25CD (*#E#*)
1176 25CD assign(Fl.F, Fn)
1177 25EA END; (*FILASG*)
1178 25F0
1179 25F0 PROCEDURE FilRst(VAR Status: StatusType
1180 25F0 ;VAR Fl: FileType
1181 25F0 );
1182 25F0
1183 25F0 BEGIN (*FILRST*)
1184 25F0 WITH Fl DO
1185 2609 BEGIN
1186 260E P := 0;
1187 261F reset(F);
1188 2632 IF eof(F) THEN
1189 2648 Status := Status + (.UnExpectedEof.);
1190 266E (*#B#*)
1191 266E IF test((.0,1.)) THEN
1192 2684 BEGIN
1193 2689 write(TestOut, 'FILrst'); TSTstat(Status); TSTln;
1194 26C5 END;
1195 26C5 (*#E#*)
1196 26C5 END
1197 26C5 END; (*FILRST*)
1198 26CB
1199 26CB PROCEDURE FilRwt(VAR Fl: FileType
1200 26CB );
1201 26CB
1202 26CB BEGIN (*FILRWT*)
1203 26CB (*#B#*)
1204 26CB IF test((.0,1.)) THEN
1205 26E9 writeln(TestOut, 'FILrwt');
1206 270E (*#E#*)
1207 270E WITH Fl DO
1208 271F BEGIN
1209 2724 rewrite(F);
1210 2731 P := 0;
1211 2748 END
1212 2748 END; (*FILRWT*)
1213 274E
1214 274E PROCEDURE FilCls(VAR Fl: FileType
1215 274E );
1216 274E
1217 274E BEGIN (*FILCLS*)
1218 274E close(Fl.F);
1219 2769 END; (*FILCLS*)
1220 276F
1221 276F PROCEDURE FilSeek(VAR Status: StatusType
1222 276F ;VAR Fl: FileType
1223 276F ; Position: FileAddressType
1224 276F );
1225 276F
1226 276F BEGIN (*FILSEEK*)
1227 276F WITH Fl DO
1228 2788 BEGIN
1229 278D P := Position;
1230 279F seek(F, Position);
1231 27B8 IF eof(F) THEN
1232 27CE Status := Status + (.UnExpectedEof.);
1233 27F4 (*#B#*)
1234 27F4 IF test((.0,1,2.)) THEN
1235 280B BEGIN
1236 2810 write(TestOut, 'FILSEEK '); TSTstat(Status); TSTindt;
1237 284F write(TestOut, 'P=', P:1
1238 287A , ' EOF='); TSTbool(eof(F));
1239 28B0 TSTln;
1240 28B8 END;
1241 28B8 (*#E#*)
1242 28B8 END
1243 28B8 END; (*FILSEEK*)
1244 28BE
1245 28BE PROCEDURE FGi8(VAR Status: StatusType
1246 28BE ;VAR Fl: FileType
1247 28BE ;VAR V: i8
1248 28BE );
1249 28BE
1250 28BE BEGIN (*FGI8*)
1251 28BE WITH Fl DO
1252 28D7 BEGIN
1253 28DC IF not eof(F) THEN
1254 28EE BEGIN
1255 28F3 read(F,V);
1256 291C P := P + 1;
1257 293E END
1258 293E ELSE
1259 2940 BEGIN
1260 2945 Status := Status + (.UnexpectedEof.);
1261 296B V := 0
1262 2976 END;
1263 2978 (*#B#*)
1264 2978 IF test((.0,2.)) THEN
1265 298F BEGIN
1266 2994 write(TestOut, 'FGI8 '); TSTstat(Status); TSTindt;
1267 29D3 write(TestOut, 'P=', P:1,' V=', V:1, ' EOF='); TSTbool(eof(F));
1268 2A51 TSTln;
1269 2A59 END;
1270 2A59 (*#E#*)
1271 2A59 END;
1272 2A59 END; (*FGI8*)
1273 2A5F
1274 2A5F PROCEDURE FGi32(VAR Status: StatusType
1275 2A5F ;VAR Fl: FileType
1276 2A5F ;VAR V: i32
1277 2A5F );
1278 2A5F
1279 2A5F VAR
1280 2A5F I: I32IndexType;
1281 2A5F N: I32ArrayType;
1282 2A5F
1283 2A5F BEGIN (*FGI32*)
1284 2A5F WITH Fl DO
1285 2A78 BEGIN
1286 2A7D P := P + 4;
1287 2AA1 FOR I := bs3 DOWNTO bs0 DO
1288 2AB2 IF not eof(f) THEN
1289 2ACB read(F, N(.I.) )
1290 2AFC ELSE
1291 2B02 BEGIN
1292 2B07 Status := Status + (.UnexpectedEof.);
1293 2B2D N(.I.) := 0
1294 2B43 END;
1295 2B4F move(N, V, 4);
1296 2B68 (*#B#*)
1297 2B68 IF test((.0,2.)) THEN
1298 2B7F BEGIN
1299 2B84 write(TestOut, 'FGI32 '); TSTstat(Status); TSTindt;
1300 2BC3 write(TestOut, 'P=', P:1,' V=', V:1,
1301 2C15 ' N=(',N(.bs3.):3,'/',N(.bs2.):3
1302 2C47 ,'/',N(.bs1.):3,'/',N(.bs0.):3,') EOF=');
1303 2C93 TSTbool(eof(F)); TSTln;
1304 2CB0 END;
1305 2CB0 (*#E#*)
1306 2CB0 END;
1307 2CB0 END; (*FGI32*)
1308 2CB6
1309 2CB6 PROCEDURE FGSym(VAR Status: StatusType
1310 2CB6 ;VAR Fl: FileType
1311 2CB6 ;VAR SymbolName: SymbolNameType
1312 2CB6 );
1313 2CB6
1314 2CB6 VAR
1315 2CB6 I: i8;
1316 2CB6 N: i8;
1317 2CB6
1318 2CB6 BEGIN (*FGSYM*)
1319 2CB6 WITH Fl, SymbolName DO
1320 2CDB BEGIN
1321 2CE0 (*#B#*)
1322 2CE0 IF test((.0,2.)) THEN
1323 2CF7 BEGIN
1324 2CFC write(TestOut, 'FGSYM-1 '); TSTstat(Status); TSTindt;
1325 2D3B write(TestOut, 'P=', P:1, ' F^=',F^:3, ' EOF=');
1326 2DAF TSTbool(eof(F)); TSTln
1327 2DC9 END;
1328 2DCC (*#E#*)
1329 2DCC IF not eof(F) THEN
1330 2DE5 BEGIN
1331 2DEA read(F, N);
1332 2E0D P := P + 1 + N;
1333 2E3C IF (0 < N) and (N <= MaxSymbolNameIndex) THEN
1334 2E5A BEGIN
1335 2E5F Length := N;
1336 2E77 FOR I := 1 TO N DO
1337 2E8E IF not eof(F) THEN
1338 2EA7 read(F, Name(.I.) )
1339 2EE0 ELSE
1340 2EE6 BEGIN
1341 2EEB Length := 0;
1342 2EF8 Status := Status + (.UnexpectedEof.)
1343 2F0E END
1344 2F1E END
1345 2F28 ELSE
1346 2F2B BEGIN
1347 2F30 Length := 0;
1348 2F3D Status := Status + (.BadSymbolName.);
1349 2F63 FOR I := 1 TO N DO
1350 2F79 IF not eof(F) THEN
1351 2F92 read(F, Name(.1.) )
1352 2FB9 ELSE
1353 2FBF Status := Status + (.UnexpectedEof.)
1354 2FD5 END
1355 2FEF END
1356 2FEF ELSE
1357 2FF1 BEGIN
1358 2FF6 Length := 0;
1359 3003 Status := Status + (.UnexpectedEof.)
1360 3019 END;
1361 3029 (*#B#*)
1362 3029 IF test((.0,2.)) THEN
1363 303F BEGIN
1364 3044 write(TestOut, 'FGSYM-2 '); TSTstat(Status); TSTindt;
1365 3083 TSTsymbol(SymbolName);
1366 3092 END;
1367 3092 (*#E#*)
1368 3092 END
1369 3092 END; (*FGSYM*)
1370 3098
1371 3098 PROCEDURE FPi8(VAR Fl: FileType
1372 3098 ; V: i8
1373 3098 );
1374 3098
1375 3098 BEGIN (*FPI8*)
1376 3098 WITH Fl DO
1377 30B1 BEGIN
1378 30B6 (*#B#*)
1379 30B6 IF test((.0,3.)) THEN
1380 30CC BEGIN
1381 30D1 writeln(TestOut, 'FPI8 ', 'P=', P:1,' V=', V:1);
1382 313A END;
1383 313A (*#E#*)
1384 313A write(F,V);
1385 315F P := P + 1
1386 3178 END
1387 3181 END; (*FPI8*)
1388 3187
1389 3187 PROCEDURE FPi32(VAR Fl: FileType
1390 3187 ; V: i32
1391 3187 );
1392 3187
1393 3187 VAR
1394 3187 I: I32IndexType;
1395 3187 N: I32ArrayType;
1396 3187
1397 3187 BEGIN (*FPI32*)
1398 3187 move(V, N, 4);
1399 31A9 WITH Fl DO
1400 31BA BEGIN
1401 31BF (*#B#*)
1402 31BF IF test((.0,3.)) THEN
1403 31D6 BEGIN
1404 31DB writeln(TestOut, 'FPI32 ', 'P=', P:1,' V=', V:1,
1405 323E ' N=(',N(.bs3.):3,'/',N(.bs2.):3
1406 3270 ,'/',N(.bs1.):3,'/',N(.bs0.):3,')');
1407 32B2 END;
1408 32B2 (*#E#*)
1409 32B2 P := P + 4;
1410 32DC FOR I := bs3 DOWNTO bs0 DO
1411 32ED write(F, N(.I.) )
1412 331E END
1413 332B END; (*FPI32*)
1414 3331
1415 3331 PROCEDURE FPSym(VAR Fl: FileType
1416 3331 ; SymbolName: SymbolNameType
1417 3331 );
1418 3331
1419 3331 VAR
1420 3331 I: SymbolNameIndexType;
1421 3331
1422 3331 BEGIN (*FPSYM*)
1423 3331 WITH Fl, SymbolName DO
1424 335F BEGIN
1425 3364 (*#B#*)
1426 3364 IF test((.0,3.)) THEN
1427 337B BEGIN
1428 3380 write(TestOut, 'FPSYM-2 '); TSTstat(Status); TSTindt;
1429 33BD write(TestOut, 'P=', P:1); TSTindt; TSTsymbol(SymbolName);
1430 33FF END;
1431 33FF (*#E#*)
1432 33FF P := P + 1 + Length;
1433 342F write(F, Length);
1434 3458 FOR I := 1 TO Length DO
1435 3471 write(F, Name(.I.) )
1436 34A3 END
1437 34B0 END; (*FPSYM*)
1438 34B6
1439 34B6 (* *)
1440 34B6 (* *)
1441 34B6 (******************************************************************************)
1442 34B6
1443 34B6 (*$I B:lnkp0.pas Procedure setup *)
1444 34B6 (******************************************************************************)
1445 34B6 (* *)
1446 34B6 (* Copyright (1985) by Metanic Aps., Denmark *)
1447 34B6 (* *)
1448 34B6 (* Author: Lars Gregers Jakobsen. *)
1449 34B6 (* *)
1450 34B6 (******************************************************************************)
1451 34B6
1452 34B6
1453 34B6 PROCEDURE SetUp(VAR Status: StatusType
1454 34B6 ;VAR TargetFile: FileType
1455 34B6 ;VAR LogFile: LogFileType
1456 34B6 ;VAR Out_file: text
1457 34B6 );
1458 34B6
1459 34B6 CONST
1460 34B6 InputFileNameSuffix = 'OBJ';
1461 34B9 TargetFileNameSuffix = 'OUT';
1462 34BC LogFileNameSuffix = 'MAP';
1463 34BF
1464 34BF VAR
1465 34BF CommandLine: CommandLineType;
1466 34BF Current: CommandLineIndexType;
1467 34BF FileName: FileNameType;
1468 34BF
1469 34BF PROCEDURE SkipBlanks;
1470 34BF
1471 34BF BEGIN (*SKIPBLANKS*)
1472 34BF WHILE (CommandLine(.Current.) = ' ') and
1473 34E8 (Current < length(CommandLine)) DO
1474 350D Current := Current + 1;
1475 352D END; (*SKIPBLANKS*)
1476 3533
1477 3533 PROCEDURE DecodeFileName(VAR Status: StatusType
1478 3533 ;VAR FileName: FileNameType
1479 3533 ; Suffix: FileNameType
1480 3533 ; Terminators: CharSetType
1481 3533 );
1482 3533
1483 3533 VAR
1484 3533 I: CommandLineIndexType;
1485 3533
1486 3533 BEGIN (*DECODEFILENAME*)
1487 3533 I := 0;
1488 3544 WHILE (Current + I < length(CommandLine) ) and
1489 356E not ( CommandLine(.Current + I.) in Terminators ) DO
1490 35AF I := I + 1;
1491 35C7 IF (0 < I) and (I <= FileNameLength) THEN
1492 35EA BEGIN
1493 35EF FileName := Copy(CommandLine, Current, I);
1494 361D Current := Current + I;
1495 3642 IF (pos('.', FileName) = 0) THEN
1496 365D IF (length(FileName) <= FileNameLength - 4) THEN
1497 3670 FileName := concat(FileName, '.', Suffix)
1498 3699 ELSE
1499 36A4 Status := Status + (.BadFileName.)
1500 36BA END
1501 36C8 ELSE
1502 36CA Status := Status + (.BadFileName.);
1503 36EE (*#B#*)
1504 36EE IF test((.0,16,18.)) THEN
1505 3708 BEGIN
1506 370D write(TestOut, 'DecodeFileName '); TSTstat(Status);
1507 3751 TSTindt; write(TestOut, 'Curr=', Current:1);
1508 378D TSTindt; write(TestOut, 'I=', I:1);
1509 37C2 TSTindt; writeln(TestOut, 'FileName=', FileName)
1510 37F9 END
1511 37FC (*#E#*)
1512 37FC END; (*DECODEFILENAME*)
1513 3802
1514 3802
1515 3802 BEGIN (*SETUP*)
1516 3802 Getcomm(CommandLine);
1517 381D CommandLine := concat(CommandLine, ' ');
1518 383F Current := 1;
1519 3848 Status := (..);
1520 385F SkipBlanks; (*Leaving current pointing at next non blank*)
1521 386B (*Interpret option list*)
1522 386B (*#B#*)
1523 386B IF test((.0,16,18.)) THEN
1524 3885 BEGIN
1525 388A write(TestOut, 'Setup-1 '); write(TestOut, 'Curr=', Current:1);
1526 38E3 TSTindt; write(TestOut, 'Lng(ComLin)=', Length(CommandLine):1);
1527 3920 TSTindt; TSTmem; TSTln;
1528 392E TSTindt; writeln(TestOut, 'ComLin=', CommandLine)
1529 3964 END;
1530 3967 (*#E#*)
1531 3967 WHILE (Current < length(CommandLine)) and
1532 397C (CommandLine(.Current.) = '/') and
1533 399E (Status = (..)) DO
1534 39BA BEGIN
1535 39BF Current := Current + 1;
1536 39D5 CASE CommandLine(.Current.) OF
1537 39F0 'M','m':
1538 39F0 BEGIN
1539 39F5 Current := Current + 1;
1540 3A0B IF CommandLine(.Current.) = '=' THEN
1541 3A27 BEGIN
1542 3A2C Current := Current + 1;
1543 3A42 DecodeFileName(Status, FileNametable(.-1.)
1544 3A4E , LogFileNameSuffix, (.' ', '/', ','.) );
1545 3A76 IF Status = (..) THEN
1546 3A8E OptionTable.LogFileKind := Explicit
1547 3A93 END
1548 3A98 ELSE
1549 3A9A OptionTable.LogFileKind := Implicit
1550 3A9F END;
1551 3AA7 'O','o':
1552 3AA7 BEGIN
1553 3AAC Current := Current + 1;
1554 3AC2 IF CommandLine(.Current.) = '=' THEN
1555 3ADE BEGIN
1556 3AE3 Current := Current + 1;
1557 3AF9 DecodeFileName(Status, FileNameTable(.0.)
1558 3B05 , TargetFileNameSuffix, (.' ', '/', ','.) );
1559 3B2D IF Status = (..) THEN
1560 3B45 OptionTable.TargetFileKind := Explicit
1561 3B4A END
1562 3B4F ELSE
1563 3B51 OptionTable.TargetFileKind := Implicit
1564 3B56 END;
1565 3B5D OTHERWISE
1566 3B5D Status := Status + (.BadOption.)
1567 3B73 END; (*CASE*)
1568 3B96 (*#B#*)
1569 3B96 IF test((.0,16,18.)) THEN
1570 3BB0 BEGIN
1571 3BB5 write(TestOut, 'Setup-2 '); TSTstat(Status);
1572 3BF2 TSTindt; writeln(TestOut, 'Curr=', Current:1);
1573 3C2A TSTindt; TSTopt;
1574 3C35 TSTindt; TSTfnt(-1);
1575 3C43 TSTindt; TSTfnt(0)
1576 3C4E END;
1577 3C51 (*#E#*)
1578 3C51 END; (*WHILE*)
1579 3C54 IF Status = (..) THEN (*Interpret file list*)
1580 3C6D BEGIN
1581 3C72 SkipBlanks;
1582 3C7E IF Current < length(CommandLine) THEN
1583 3C96 Status := Status + (.NotFinished.);
1584 3CBE WHILE (Current < length(CommandLine)) and
1585 3CD3 (NotFinished IN Status) DO
1586 3CF4 BEGIN
1587 3CF9 DecodeFileName(Status, FileName
1588 3D05 , InputFileNameSuffix, (.' ', ','.) );
1589 3D31 IF not (BadFileName IN Status) THEN
1590 3D4C BEGIN
1591 3D51 (*#B#*)
1592 3D51 IF test((.0,16,18.)) THEN
1593 3D6B BEGIN
1594 3D70 write(TestOut, 'Setup-3 '); TSTstat(Status); TSTindt;
1595 3DB0 write(TestOut, 'fstat(FileName)=');
1596 3DDF TSTbool(fstat(FileName)); TSTln;
1597 3DFB END;
1598 3DFB (*#E#*)
1599 3DFB IF fstat(FileName) THEN
1600 3E10 FNTP(Status, FileName)
1601 3E2B ELSE
1602 3E30 Status := Status + (.NoSuchFile.);
1603 3E54 END;
1604 3E54 IF NotFinished IN Status THEN
1605 3E6E CASE CommandLine(.Current.) OF
1606 3E8C ' ':
1607 3E8C Status := Status - (.NotFinished.);
1608 3EB6 ',':
1609 3EB6 BEGIN
1610 3EBB Current := Current + 1 (*Skip the comma*)
1611 3EC0 END
1612 3ED1 END (*CASE CommandLine(.Current.) OF*)
1613 3EE0 END (* WHILE *** DO *)
1614 3EE0 END; (* IF Status = (..) -- End interpret file list *)
1615 3EE3 IF CurFileNo <= 0 THEN
1616 3EF4 Status := Status + (.NoInputFiles.);
1617 3F18 IF Current < length(CommandLine) THEN
1618 3F30 Status := Status + (.ExtraText.);
1619 3F54 IF Status = (..) THEN
1620 3F6D BEGIN
1621 3F72 FileName := copy(FileNameTable(.1.), 1, pos('.',FileNameTable(.1.)) );
1622 3F9E IF OptionTable.LogFileKind = Implicit THEN
1623 3FAA FileNameTable(.-1.) := concat(FileName, LogFileNameSuffix);
1624 3FCB IF OptionTable.TargetFileKind = Implicit THEN
1625 3FD7 FileNameTable(. 0.) := concat(FileName, TargetFileNameSuffix);
1626 3FF8
1627 3FF8 IF (OptionTable.LogFileKind <> none) and
1628 4002 ( (not checkfn(FileNameTable(.-1.) ) ) or
1629 4011 (fstat(FileNameTable(.-1.) ) )
1630 401B ) THEN
1631 4024 Status := Status + (.badlogfilename.);
1632 4048 IF (not checkfn(FileNameTable(.0.) ) ) or
1633 4058 (fstat(FileNameTable(.0.) ) ) THEN
1634 4068 Status := Status + (.badtargetfilename.);
1635 408C
1636 408C (*#B#*)
1637 408C IF test((.0,16,18.)) THEN
1638 40A5 BEGIN
1639 40AA write(TestOut, 'Setup-4 '); TSTstat(Status); TSTln;
1640 40EA TSTindt; TSTopt;
1641 40F5 TSTindt; TSTfnt(-1);
1642 4103 TSTindt; TSTfnt(0);
1643 4111 TSTindt; TSTfnt(1)
1644 411C END;
1645 411F (*#E#*)
1646 411F
1647 411F IF Status = (..) THEN
1648 4137 BEGIN
1649 413C IF OptionTable.LogFileKind <> None THEN
1650 4148 BEGIN
1651 414D LogInit(LogFile, FileNameTable(.-1.) );
1652 4167 LogCmd(LogFile, CommandLine);
1653 4185 END;
1654 4185 FilAsg(TargetFile, FileNameTable(.0.) );
1655 419F FilRwt(TargetFile);
1656 41AE END
1657 41AE ELSE
1658 41B0 Status := Status + (.NoTarget.);
1659 41D8 END
1660 41D8 ELSE
1661 41DA BEGIN
1662 41DF Status := Status + (.Notarget.);
1663 4207 writeln(out_file, CommandLine);
1664 4230 writeln(out_file, '^':Current);
1665 4253 END
1666 4253 END; (*SETUP*)
1667 4259
1668 4259 (* *)
1669 4259 (* *)
1670 4259 (******************************************************************************)
1671 4259
1672 4259 (*$I B:lnkp1.pas Procedure pass1 *)
1673 4259 (******************************************************************************)
1674 4259 (* *)
1675 4259 (* Copyright (1985) by Metanic Aps., Denmark *)
1676 4259 (* *)
1677 4259 (* Author: Lars Gregers Jakobsen. *)
1678 4259 (* *)
1679 4259 (******************************************************************************)
1680 4259
1681 4259 PROCEDURE Pass1(VAR Status: StatusType
1682 4259 ;VAR TargetFile: FileType
1683 4259 ;VAR LogFile: LogFileType
1684 4259 );
1685 4259
1686 4259 (* Pass1 of the linker performs the gathering of export and
1687 4259 import information from the input files as well as calculation
1688 4259 of final memory map and all operations on the symbol table
1689 4259 including reporting to the log file.
1690 4259 The following statusvalues may be returned:
1691 4259 Success: ok. All other parameters meaningful.
1692 4259
1693 4259 *)
1694 4259
1695 4259
1696 4259 VAR
1697 4259 SymbolTable: SymbolTableType;
1698 4259 LatestInsert: SymbolTableIndexType; (*Points to SBT entry of latest insert*)
1699 4259 CurrentSymbolCount: SymbolTableIndexType; (*Number of SBT entries currently used*)
1700 4259
1701 4259 NameTable: NameTableType;
1702 4259 CurrentNameTableIndex: NameTableIndexType; (*Least index vacant -
1703 4259 NOT count of strings*)
1704 4259
1705 4259
1706 4259 (* MISC. VARIABLES *)
1707 4259
1708 4259 SBTSubInx: SymbolTableSubIndexType;
1709 4259
1710 4259 (*#B#*)
1711 4259 (*$I B:LnkDF3.pas Definitions of pass1 local test output primitives *)
1712 4259 (******************************************************************************)
1713 4259 (* *)
1714 4259 (* Copyright (1985) by Metanic Aps., Denmark *)
1715 4259 (* *)
1716 4259 (* Author: Lars Gregers Jakobsen. *)
1717 4259 (* *)
1718 4259 (******************************************************************************)
1719 4259
1720 4259 PROCEDURE TSTnmt(Inx: NameTableIndexType
1721 4259 );
1722 4259
1723 4259 VAR
1724 4259 i : 0..9;
1725 4259
1726 4259 BEGIN (*TSTnmt*)
1727 4259 write(TestOut, 'NMTÆ', inx:1
1728 428F , ';../', CurrentNameTableIndex:1,'Å=(' );
1729 42D1 FOR i := 0 TO 7 DO
1730 42E2 IF (Inx + i) IN (.1..CurrentNameTableIndex.) THEN
1731 4323 TSTasc( NameTable(. Inx+i .) )
1732 4352 ELSE
1733 4358 write(TestOut, '-');
1734 437D write(TestOut, '/');
1735 4398 IF Inx IN (.1..CurrentNameTableIndex.) THEN
1736 43C3 TSThex( NameTable(. Inx .) )
1737 43DB ELSE
1738 43E0 write(TestOut, '--');
1739 4401 FOR i := 1 TO 7 DO
1740 4412 BEGIN
1741 4417 write(TestOut, '-');
1742 4432 IF (Inx + i) IN (.1..CurrentNameTableIndex.) THEN
1743 4473 TSThex( NameTable(. Inx+i .) )
1744 44A2 ELSE
1745 44A8 write(TestOut, '--');
1746 44C9 END;
1747 44D3 writeln(TestOut, ')' )
1748 44EB END; (*TSTnmt*)
1749 44F4
1750 44F4 PROCEDURE TSTsbt(Inx: SymbolTableIndexType
1751 44F4 );
1752 44F4
1753 44F4 BEGIN (*TSTsbt*)
1754 44F4 WITH SymbolTable(.Inx.) DO
1755 451B BEGIN
1756 4520 IF NameReference <> 0 THEN
1757 452F write(TestOut, 'SBTÆ', Inx:1
1758 455A , '/', LatestInsert:1
1759 457D , '/', CurrentSymbolCount:1
1760 45A0 , 'Å=(Module#=', ModuleNo:1, ' '
1761 45D3 , 'NameRef=', NameReference:1, ' '
1762 460A , 'SortLink=', SortLink:1, ')'
1763 4642 )
1764 464B ELSE
1765 4651 write(TestOut, 'SBTÆ', Inx:1
1766 467C , '/', LatestInsert:1
1767 469F , '/', CurrentSymbolCount:1
1768 46C2 , 'Å=(Module#=--', ' '
1769 46E2 , 'NameRef=', NameReference:1, ' '
1770 4719 , 'SortLink=--', ')'
1771 473A )
1772 4743 END
1773 4746 END; (*TSTsbt*)
1774 474C
1775 474C (* *)
1776 474C (* *)
1777 474C (******************************************************************************)
1778 474C
1779 474C (*$I B:LnkDF4.pas Definitions of pass1 local access primitives *)
1780 474C (******************************************************************************)
1781 474C (* *)
1782 474C (* Copyright (1985) by Metanic Aps., Denmark *)
1783 474C (* *)
1784 474C (* Author: Lars Gregers Jakobsen. *)
1785 474C (* *)
1786 474C (******************************************************************************)
1787 474C
1788 474C
1789 474C PROCEDURE NMTP(VAR Status: StatusType
1790 474C ;VAR NameReference: NameTableIndexType
1791 474C ; SymbolName: SymbolNameType
1792 474C );
1793 474C
1794 474C VAR
1795 474C I: SymbolNameIndexType;
1796 474C
1797 474C BEGIN (*NMTP*)
1798 474C WITH SymbolName DO
1799 476E BEGIN
1800 4773 IF CurrentNameTableIndex + Length + 1 > MaxNameTableIndex THEN
1801 47A7 Status := Status + (.NameTableOverFlow.)
1802 47BD ELSE
1803 47D1 BEGIN
1804 47D6 Namereference := CurrentNameTableIndex + 1;
1805 4800 CurrentNameTableIndex := NameReference + Length;
1806 4833 NameTable(.NameReference.) := Length;
1807 4857 FOR I := 1 TO Length DO
1808 4870 NameTable(.NameReference + I.) := Name(.I.);
1809 48C1 END;
1810 48C1 (*#B#*)
1811 48C1 IF test((.0,9.)) THEN
1812 48DA BEGIN
1813 48DF write(TestOut, 'NMTP '); TSTstat(Status); TSTindt;
1814 491E writeln(TestOut, 'Length=', Length:1);
1815 4955 TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1816 4978 END;
1817 4978 (*#E#*)
1818 4978 END
1819 4978 END; (*NMTP*)
1820 497E
1821 497E FUNCTION NMTfail( NameReference: NameTableIndexType
1822 497E ; SymbolName: SymbolNameType
1823 497E ): boolean;
1824 497E
1825 497E (* NMTfail returns one of the following values:
1826 497E FALSE: If the exact same symbolname was found in NMT - i.e.
1827 497E
1828 497E NameReference <> 0 AND
1829 497E NMT(.NameReference.) = SymbolName.Length AND
1830 497E FOR i = 1 TO length:
1831 497E NMT(.NameReference+i.) = SymbolName.Name(.i.)
1832 497E
1833 497E OR If an empty entry was found in NMT - i.e.
1834 497E
1835 497E NameReference = 0.
1836 497E
1837 497E
1838 497E TRUE: In all other cases.
1839 497E *)
1840 497E
1841 497E LABEL
1842 497E 99;
1843 497E
1844 497E VAR
1845 497E I: SymbolNameIndexType;
1846 497E
1847 497E BEGIN (*NMTFAIL*)
1848 497E NMTfail := false;
1849 49A4 WITH SymbolName DO
1850 49A9 BEGIN
1851 49AE IF NameReference <> 0 THEN
1852 49BE IF length <> NameTable(.NameReference.) THEN
1853 49DA NMTfail := true
1854 49DF ELSE
1855 49E6 BEGIN
1856 49EB FOR I := 1 TO Length DO
1857 4A04 IF Name(.I.) <> NameTable(.NameReference + I.) THEN
1858 4A4B BEGIN
1859 4A50 NMTfail := true;
1860 4A59 GOTO 99;
1861 4A61 END;
1862 4A6B 99:; END;
1863 4A6B (*#B#*)
1864 4A6B IF test((.0,9.)) THEN
1865 4A84 BEGIN
1866 4A89 writeln(TestOut, 'NMTfail ', 'NameRef=', NameReference:1);
1867 4ADA TSTindt; TSTindt; TSTindt; TSTsymbol(SymbolName);
1868 4AF3 TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
1869 4B12 END;
1870 4B12 (*#E#*)
1871 4B12 END
1872 4B12 END; (*NMTFAIL*)
1873 4B1B
1874 4B1B PROCEDURE NMTG( NameReference: NameTableIndexType
1875 4B1B ;VAR SymbolName: SymbolNameType
1876 4B1B );
1877 4B1B
1878 4B1B VAR
1879 4B1B I: SymbolNameIndexType;
1880 4B1B
1881 4B1B BEGIN (*NMTG*)
1882 4B1B WITH SymbolName DO
1883 4B34 BEGIN
1884 4B39 Length := NameTable(.NameReference.);
1885 4B5A FOR I := 1 TO Length DO
1886 4B77 Name(.I.) := NameTable(. NameReference + I .);
1887 4BC7 (*#B#*)
1888 4BC7 IF test((.0,9,13.)) THEN
1889 4BDF BEGIN
1890 4BE4 write(TestOut, 'NMTG '); TSTindt;
1891 4C0F write(TestOut, 'NameRef=', NameReference:1); TSTindt;
1892 4C4D TSTsymbol(SymbolName);
1893 4C5C END;
1894 4C5C (*#E#*)
1895 4C5C END
1896 4C5C END; (*NMTG*)
1897 4C62
1898 4C62 PROCEDURE Hash(VAR SymbolName: SymbolNameType
1899 4C62 ;VAR SBTInx: SymbolTableIndexType
1900 4C62 );
1901 4C62
1902 4C62 BEGIN (*HASH*)
1903 4C62 SBTInx := 1
1904 4C75 END; (*HASH*)
1905 4C7D
1906 4C7D PROCEDURE SBTS(VAR Status: StatusType
1907 4C7D ;VAR SBTInx: SymbolTableIndexType
1908 4C7D ; SymbolName: SymbolNameType
1909 4C7D );
1910 4C7D
1911 4C7D (* SBTS returns one of the following Status codes:
1912 4C7D Success: SymbolName found in SBT. SBTInx reflects
1913 4C7D SymbolName.
1914 4C7D NotFound: SymbolName NOT found in SBT. SBTInx
1915 4C7D indicates the entry into which Symbol should be
1916 4C7D registered.
1917 4C7D SymbolTableOverFlow: SymbolName NOT found in SBT.
1918 4C7D SBTInx is not valid. There
1919 4C7D is no room in SBT for further updates.
1920 4C7D
1921 4C7D Search SBT to find the Entry for SYMBOLNAME retaining the index
1922 4C7D of the first vacant record as SYMBOLTABLEENTRYNO if the search
1923 4C7D fails. Otherwise return found index. Set Status to Success or
1924 4C7D NotFound according to outcome. Set Status to SBTOverFlow if
1925 4C7D no vacant is available and symbol is not found.
1926 4C7D
1927 4C7D A SBT record is vacant if Namereference = 0.
1928 4C7D *)
1929 4C7D
1930 4C7D
1931 4C7D BEGIN (*SBTS*)
1932 4C7D (* Assume existence of entry in SBT with NameReference = 0 *)
1933 4C7D Hash(SymbolName, SBTInx);
1934 4CB1 (*#B#*)
1935 4CB1 IF test((.0,9.)) THEN
1936 4CC9 BEGIN
1937 4CCE write(TestOut, 'SBTS-1 '); TSTstat(Status); TSTln;
1938 4D0D TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1939 4D30 END;
1940 4D30 (*#E#*)
1941 4D30 WHILE NMTfail(Symboltable(.SBTInx.).NameReference, SymbolName) DO
1942 4D69 BEGIN
1943 4D6E (* HASH NEXT TRY *)
1944 4D6E IF MaxNooSymbols <= SBTInx THEN
1945 4D85 SBTInx := 0;
1946 4D92 SBTInx := SBTInx + 1;
1947 4DB2
1948 4DB2 (*#B#*)
1949 4DB2 IF test((.0,9.)) THEN
1950 4DCA BEGIN
1951 4DCF write(TestOut, 'SBTS-2 '); TSTstat(Status); TSTln;
1952 4E0E TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1953 4E31 END;
1954 4E31 (*#E#*)
1955 4E31
1956 4E31 END;
1957 4E34 IF SymbolTable(.SBTInx.).NameReference = 0 THEN
1958 4E5A IF CurrentSymbolCount >= MaxNooSymbols - 1 THEN
1959 4E73 Status := Status + (.SymbolTableOverFlow.)
1960 4E89 ELSE
1961 4E9C Status := Status + (.NotFound.);
1962 4EC4 (*#B#*)
1963 4EC4 IF test((.0,10.)) THEN
1964 4EDC BEGIN
1965 4EE1 write(TestOut, 'SBTS-3 '); TSTstat(Status); TSTln;
1966 4F20 TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
1967 4F43 END;
1968 4F43 (*#E#*)
1969 4F43 END; (*SBTS*)
1970 4F49
1971 4F49 PROCEDURE SBTEX(VAR Status: StatusType
1972 4F49 ;VAR SymbolTableEntryNo: SymbolTableIndexType
1973 4F49 ; SymbolName: SymbolNameType
1974 4F49 ; P_ModuleNo: ModuleTableIndexType
1975 4F49 ; P_SegmentNo: SegmentNoType
1976 4F49 ; Item: i32
1977 4F49 );
1978 4F49
1979 4F49 BEGIN (*SBTEX*)
1980 4F49 SBTS(Status, SymbolTableEntryNo, SymbolName);
1981 4F88 IF not (SymbolTableOverFlow IN Status) THEN
1982 4FA3 WITH SymbolTable(.SymbolTableEntryNo.)
1983 4FC0 ,ValueTable(.SymbolTableEntryNo.) DO
1984 4FE4 IF NotFound IN Status THEN
1985 4FFF BEGIN (*Symbol is NOT in SBT and thus not resolved*)
1986 5004 Status := Status - (.NotFound.);
1987 502C NMTP(Status, NameReference, SymbolName);
1988 504F IF not (NameTableOverFlow IN Status) THEN
1989 506A BEGIN
1990 506F CurrentSymbolCount := CurrentSymbolCount + 1;
1991 5097 ModuleNo := P_ModuleNo;
1992 50AB IF LatestInsert <> 0 THEN
1993 50BF SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
1994 50F2 LatestInsert := SymbolTableEntryNo;
1995 510D SortLink := SymbolTableEntryNo;
1996 5129 SegmentNo := P_SegmentNo;
1997 513D Value := Item
1998 5148 END
1999 5151 END (*IF NotFound IN Status*)
2000 5151 ELSE (* SUCCESS: Symbol is in SBT*)
2001 5154 BEGIN
2002 5159 IF SegmentNo > UnResolved THEN
2003 5170 Status := Status + (.DuplicateExportSymbol.)
2004 5186 ELSE (*Symbol NOT previously resolved i.e. imported only*)
2005 5199 BEGIN
2006 519E ModuleNo := P_ModuleNo;
2007 51B2 IF LatestInsert <> 0 THEN
2008 51C6 SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
2009 51F9 LatestInsert := SymbolTableEntryNo;
2010 5214 SortLink := SymbolTableEntryNo;
2011 5230 SegmentNo := P_SegmentNo;
2012 5244 Value := Item
2013 524F END
2014 5258 END; (*ELSE (i.e. Success IN Status)*)
2015 5258 (*#B#*)
2016 5258 IF test((.0,10.)) THEN
2017 5271 BEGIN
2018 5276 write(TestOut, 'SBTEX '); TSTstat(Status);
2019 52B2 TSTindt; TSTsymbol(SymbolName);
2020 52C5 TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
2021 52E8 TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
2022 5307 END;
2023 5307 (*#E#*)
2024 5307 END; (*SBTEX*)
2025 530D
2026 530D
2027 530D PROCEDURE SBTIM(VAR Status: StatusType
2028 530D ;VAR SymbolTableEntryNo: SymbolTableIndexType
2029 530D ;VAR SymbolName: SymbolNameType
2030 530D ; P_ModuleNo: ModuleTableIndexType
2031 530D );
2032 530D
2033 530D BEGIN (*SBTIM*)
2034 530D SBTS(Status, SymbolTableEntryNo, SymbolName);
2035 5336 IF Not (SymbolTableOverFlow IN Status) THEN
2036 5351 BEGIN
2037 5356 IF NotFound IN Status THEN
2038 5371 WITH SymbolTable(.SymbolTableEntryNo.)
2039 538E ,ValueTable(.SymbolTableEntryNo.) DO
2040 53B2 BEGIN
2041 53B7 Status := Status - (.NotFound.);
2042 53DF NMTP(Status, NameReference, SymbolName);
2043 5401 IF not (NameTableOverFlow IN Status) THEN
2044 541B BEGIN
2045 5420 CurrentSymbolCount := CurrentSymbolCount + 1;
2046 5448 ModuleNo := P_ModuleNo;
2047 545C SortLink := 0;
2048 546D SegmentNo := UnResolved;
2049 547A Value := 0;
2050 5490 END
2051 5490 END;
2052 5490 EITP(Status,SymbolTableEntryNo)
2053 54A7 END;
2054 54AA (*#B#*)
2055 54AA IF test((.0,10.)) THEN
2056 54C3 BEGIN
2057 54C8 write(TestOut, 'SBTIM '); TSTstat(Status); TSTln;
2058 5507 TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
2059 552A TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
2060 5549 END;
2061 5549 (*#E#*)
2062 5549 END; (*SBTIM*)
2063 554F
2064 554F (* *)
2065 554F (* *)
2066 554F (******************************************************************************)
2067 554F
2068 554F
2069 554F (*$I B:lnkp1-1.pas getinputfiles *)
2070 554F (******************************************************************************)
2071 554F (* *)
2072 554F (* Copyright (1985) by Metanic Aps., Denmark *)
2073 554F (* *)
2074 554F (* Author: Lars Gregers Jakobsen. *)
2075 554F (* *)
2076 554F (******************************************************************************)
2077 554F
2078 554F PROCEDURE GetInputFiles(VAR GStatus: StatusType
2079 554F ;VAR LogFile: LogFileType
2080 554F );
2081 554F
2082 554F VAR
2083 554F InputFile: FileType;
2084 554F FileNo: FileNameTableIndexType;
2085 554F Status: StatusType;
2086 554F
2087 554F PROCEDURE ValidateFileFormat(VAR Status: StatusType
2088 554F ;VAR F: FileType
2089 554F ; Format: OF_FormatType
2090 554F );
2091 554F
2092 554F VAR
2093 554F OFF_Format: OF_FormatType;
2094 554F
2095 554F BEGIN (*VALIDATEFILEFORMAT*)
2096 554F FGi32(Status, F, OFF_Format);
2097 5575 IF OFF_Format <> Format THEN
2098 5589 Status := Status + (.BadFileFormat.);
2099 55AF (*#B#*)
2100 55AF IF test((.0,16,19.)) THEN
2101 55C9 BEGIN
2102 55CE write(TestOut, 'GetFFvalid '); TSTstat(Status); TSTindt;
2103 5611 writeln(TestOut, 'OFF_Format=', OFF_Format);
2104 5647 END;
2105 5647 (*#E#*)
2106 5647 END; (*VALIDATEFILEFORMAT*)
2107 564D
2108 564D PROCEDURE GetModules(VAR GStatus: StatusType
2109 564D ;VAR LogFile: LogFileType
2110 564D ; FileNumber: FileNameTableIndexType
2111 564D ;VAR Fl: FileType
2112 564D ; StartAddressOfNextModule: FileAddressType
2113 564D );
2114 564D
2115 564D VAR
2116 564D Status: StatusType;
2117 564D
2118 564D PROCEDURE ValidateModuleFormat(VAR Status: StatusType
2119 564D ;VAR F: FileType
2120 564D ; Format: OM_FormatType
2121 564D );
2122 564D
2123 564D VAR
2124 564D OMF_Format: OM_FormatType;
2125 564D
2126 564D BEGIN (*VALIDATEMODULEFORMAT*)
2127 564D FGi32(Status, F, OMF_Format);
2128 5673 IF OMF_Format <> Format THEN
2129 5687 Status := Status + (.BadModuleFormat.);
2130 56AD (*#B#*)
2131 56AD IF test((.0,16,19.)) THEN
2132 56C7 BEGIN
2133 56CC write(TestOut, 'GetMFvalid '); TSTstat(Status); TSTindt;
2134 570F writeln(TestOut, 'OMF_Format=',OMF_Format);
2135 5745 END;
2136 5745 (*#E#*)
2137 5745 END; (*VALIDATEMODULEFORMAT*)
2138 574B
2139 574B
2140 574B PROCEDURE GetModuleHeader(VAR GStatus: StatusType
2141 574B ;VAR LogFile: LogFileType
2142 574B ; FileNo:
2143 574B FileNameTableIndexType
2144 574B ;VAR Fl: FileType
2145 574B ;VAR StartAddressOfNextModule:
2146 574B FileAddressType
2147 574B );
2148 574B
2149 574B VAR
2150 574B Status: StatusType;
2151 574B SegmentNo: SegmentNoType;
2152 574B SymbolNo: SymbolTableIndexType;
2153 574B ModuleNo: ModuleTableIndexType;
2154 574B MdtRec: ModuleTableRecordType;
2155 574B NooExpSymbols: QuadImageUnitType;
2156 574B NooExiSymbols: QuadImageUnitType;
2157 574B
2158 574B PROCEDURE GetINX(VAR Status: StatusType
2159 574B ;VAR ModuleNo: ModuleTableIndexType
2160 574B ;VAR Fl: FileType
2161 574B ;VAR StartAddressOfNextModule:
2162 574B FileAddressType
2163 574B ;VAR NooExpSymbols: QuadImageUnitType
2164 574B ;VAR NooExiSymbols: QuadImageUnitType
2165 574B );
2166 574B
2167 574B VAR
2168 574B OMH_ModuleSize: QuadImageUnitType;
2169 574B OMH_NooSegments: QuadImageUnitType;
2170 574B OMH_ModuleName: ModuleNameType;
2171 574B
2172 574B BEGIN (*GETINX*)
2173 574B WITH ModuleTable(.ModuleNo.) DO
2174 5776 BEGIN
2175 577B FGi32(Status, Fl, OMH_ModuleSize);
2176 5799 FGi32(Status, Fl, OMH_NooSegments);
2177 57B7 FGi32(Status, Fl, NooExpSymbols);
2178 57D4 FGi32(Status, Fl, NooExiSymbols);
2179 57F1 StartAddressOfNextModule :=
2180 57FC StartAddressOfNextModule + abs(OMH_moduleSize);
2181 5818 IF (OMH_NooSegments > MaxNooSegments) or
2182 582C (Noo_ExiSymbols > MaxNooExternalImportSymbols) THEN
2183 584D Status := Status + (.RangeError.)
2184 5863 ELSE
2185 5876 BEGIN
2186 587B Referenced := false;
2187 588C NooSegments := OMH_NooSegments;
2188 58AB IF NooSegments > CurSegmentCount THEN
2189 58C7 CurSegmentCount := NooSegments;
2190 58DD NooExternalImportSymbols := NooExiSymbols;
2191 5901 LatestInsert := 0;
2192 5913 FGsym(Status, Fl, OMH_ModuleName);
2193 5931 IF Status = (..) THEN
2194 594A BEGIN
2195 594F SBTEX(Status
2196 5954 ,ModuleNameReference
2197 595B ,OMH_ModuleName
2198 5962 ,ModuleNo
2199 596A ,0,0);
2200 5987 IF not (SymbolTableOverFlow IN Status) THEN
2201 59A1 ValueTable(.ModuleNameReference.).SegmentNo := UnResolved;
2202 59C0 IF DuplicateExportSymbol IN Status THEN
2203 59DA Status := Status - (.DuplicateExportSymbol.) +
2204 59F9 (.DuplicateModuleName.);
2205 5A09 END
2206 5A09 END
2207 5A09 END
2208 5A09 END; (*GETINX*)
2209 5A0F
2210 5A0F
2211 5A0F PROCEDURE GetSGDs(VAR Status: StatusType
2212 5A0F ; SCTBase: SectionTableIndexType
2213 5A0F ; NooSegments: SegmentNoType
2214 5A0F ; P_ModuleNo: ModuleTableIndexType
2215 5A0F ;VAR Fl: FileType
2216 5A0F );
2217 5A0F
2218 5A0F LABEL
2219 5A0F 99;
2220 5A0F
2221 5A0F VAR
2222 5A0F SegmentInx: SegmentNoType;
2223 5A0F Dummy32: QuadImageUnitType;
2224 5A0F
2225 5A0F BEGIN (*GETSEGMENTDESCRIPTORS*)
2226 5A0F FOR SegmentInx := 1 TO NooSegments DO
2227 5A31 BEGIN
2228 5A36 IF Status <> (..) THEN
2229 5A4F GOTO 99;
2230 5A57 WITH SectionTable(.SCTbase + SegmentInx.) DO
2231 5A85 BEGIN
2232 5A8A SegmentNo := SegmentInx;
2233 5A99 ModuleNo := P_ModuleNo;
2234 5AAD FGi32(Status, Fl, Dummy32);
2235 5ACB ImageSize := abs(Dummy32);
2236 5AE6 FGi32(Status, Fl, Dummy32);
2237 5B04 OvrSize := abs(Dummy32);
2238 5B21 (*#B#*)
2239 5B21 IF test((.0,16,19.)) THEN
2240 5B3B BEGIN
2241 5B40 write(TestOut, 'GetSGDs '); TSTstat(Status);
2242 5B7C TSTindt; TSTsct(SCTbase + SegmentInx); TSTln
2243 5B9D END;
2244 5BA0 (*#E#*)
2245 5BA0 END;
2246 5BA0 END;
2247 5BAA 99:; END; (*GETSEGMENTDESCRIPTORS*)
2248 5BB0
2249 5BB0 PROCEDURE GetEXP(VAR GStatus: StatusType
2250 5BB0 ;VAR LogFile: LogFileType
2251 5BB0 ;VAR Fl: FileType
2252 5BB0 ;VAR LinkHead: SymbolTableIndexType
2253 5BB0 ; ModuleNo: ModuleTableIndexType
2254 5BB0 ; NooExpSymbols: i32
2255 5BB0 );
2256 5BB0
2257 5BB0 VAR
2258 5BB0 Status: StatusType;
2259 5BB0 SymbolCount: i32;
2260 5BB0 DuplicateCount: i32;
2261 5BB0 RelocationIndicator: RelocationIndicatorType;
2262 5BB0 EXP_RelocationIndicator: ImageUnitType;
2263 5BB0 EXP_Item: QuadImageUnitType;
2264 5BB0 EXP_SymbolName: SymbolNameType;
2265 5BB0 SymbolTableEntryNo: SymbolTableIndexType; (*DUMMY*)
2266 5BB0 ModuleName: ModuleNameType;
2267 5BB0
2268 5BB0 BEGIN (*GETEXPORTLIST*)
2269 5BB0 Status := (..);
2270 5BD0 LinkHead := 0;
2271 5BDD LatestInsert := 0;
2272 5BEF SymbolCount := 0;
2273 5BFE DuplicateCount := 0;
2274 5C0D IF SymbolCount < NooExpSymbols THEN
2275 5C22 BEGIN
2276 5C27 SymbolCount := SymbolCount + 1;
2277 5C37 FGi8( Status, Fl, EXP_RelocationIndicator);
2278 5C56 IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
2279 5C68 RelocationIndicator := EXP_RelocationIndicator
2280 5C6D ELSE
2281 5C7C Status := Status + (.RangeError.);
2282 5CA4 FGi32(Status, Fl, EXP_Item);
2283 5CC3 FGsym(Status, Fl, EXP_SymbolName);
2284 5CE2 IF Status = (..) THEN
2285 5CFC BEGIN
2286 5D01 SBTEX(Status
2287 5D06 ,LinkHead
2288 5D0E ,EXP_SymbolName
2289 5D15 ,ModuleNo
2290 5D1D ,EXP_RelocationIndicator
2291 5D24 ,EXP_Item
2292 5D2F );
2293 5D3C IF DuplicateExportSymbol IN Status THEN
2294 5D55 BEGIN
2295 5D5A DuplicateCount := DuplicateCount + 1;
2296 5D6A IF DuplicateCount <= 1 THEN
2297 5D7D LogHdds(LogFile);
2298 5D8C NMTG(SymbolTable(.
2299 5D91 ModuleTable(.ModuleNo
2300 5D91 .).ModuleNameReference
2301 5DA5 .).NameReference
2302 5DB7 ,ModuleName
2303 5DC0 );
2304 5DCF LogDDS(LogFile
2305 5DD4 ,EXP_RelocationIndicator
2306 5DDB ,EXP_Item
2307 5DE6 ,EXP_SymbolName
2308 5DEC ,ModuleName
2309 5DF4 );
2310 5DFF END
2311 5DFF END;
2312 5DFF GStatus := GStatus + Status;
2313 5E2A END;
2314 5E2A WHILE (GStatus <= (.DuplicateExportSymbol.)) and
2315 5E42 (SymbolCount < NooExpSymbols) DO
2316 5E5D BEGIN
2317 5E62 SymbolCount := SymbolCount + 1;
2318 5E72 Status := (..);
2319 5E8A FGi8( Status, Fl, EXP_RelocationIndicator);
2320 5EA9 IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
2321 5EBB RelocationIndicator := EXP_RelocationIndicator
2322 5EC0 ELSE
2323 5ECF Status := Status + (.RangeError.);
2324 5EF7 FGi32(Status, Fl, EXP_Item);
2325 5F16 FGsym(Status, Fl, EXP_SymbolName);
2326 5F35 IF Status = (..) THEN
2327 5F4F BEGIN
2328 5F54 SBTEX(Status
2329 5F59 ,SymbolTableEntryNo
2330 5F61 ,EXP_SymbolName
2331 5F69 ,ModuleNo
2332 5F71 ,EXP_RelocationIndicator
2333 5F78 ,EXP_Item
2334 5F83 );
2335 5F90 IF DuplicateExportSymbol IN Status THEN
2336 5FA9 BEGIN
2337 5FAE DuplicateCount := DuplicateCount + 1;
2338 5FBE IF DuplicateCount <= 1 THEN
2339 5FD1 LogHdds(LogFile);
2340 5FE0 NMTG(SymbolTable(.
2341 5FE5 ModuleTable(.ModuleNo
2342 5FE5 .).ModuleNameReference
2343 5FF9 .).NameReference
2344 600B ,ModuleName
2345 6014 );
2346 6023 LogDDS(LogFile
2347 6028 ,EXP_RelocationIndicator
2348 602F ,EXP_Item
2349 603A ,EXP_SymbolName
2350 6040 ,ModuleName
2351 6048 );
2352 6053 END
2353 6053 END;
2354 6053 GStatus := GStatus + Status
2355 6069 END; (*WHILE ... DO*)
2356 6081 END; (*GETEXPORTLIST*)
2357 6087
2358 6087 PROCEDURE GetEXI(VAR Status: StatusType
2359 6087 ;VAR Fl: FileType
2360 6087 ; ModuleNo: ModuleTableIndexType
2361 6087 ; NooExternalImportSymbols: i32
2362 6087 );
2363 6087
2364 6087 VAR
2365 6087 SymbolTableEntryNo: SymbolTableIndexType;
2366 6087 SymbolCount: i32;
2367 6087 EXI_SymbolName: SymbolNameType;
2368 6087
2369 6087 BEGIN (*GETEXTERNALIMPORTLIST*)
2370 6087 SymbolCount := 0;
2371 609E WHILE (Status = (..)) and
2372 60B4 (SymbolCount < NooExternalImportSymbols) DO
2373 60CE BEGIN
2374 60D3 SymbolCount := SymbolCount + 1;
2375 60E3 FGsym(Status, Fl, EXI_SymbolName);
2376 6101 IF Status = (..) THEN
2377 6119 SBTIM(Status
2378 611E ,SymbolTableEntryNo
2379 6125 ,EXI_SymbolName
2380 612D ,ModuleNo
2381 6135 );
2382 6143 END; (*WHILE ... DO*)
2383 6146 END; (*GETEXTERNALIMPORTLIST*)
2384 614C
2385 614C
2386 614C
2387 614C BEGIN (*GETMODULEHEADER*)
2388 614C Status := (..);
2389 616C MDTA(Status, ModuleNo, 1);
2390 6187 IF Status = (..) THEN
2391 61A1 BEGIN
2392 61A6 GetINX(Status, ModuleNo, Fl
2393 61BB , StartAddressOfNextModule
2394 61C2 , NooExpSymbols
2395 61C9 , NooExiSymbols);
2396 61E0 IF Status = (..) THEN
2397 61FA WITH ModuleTable(.ModuleNo.) DO
2398 6219 BEGIN
2399 621E FileNameReference := FileNo;
2400 622D SCTA(Status, SCTBase, NooSegments);
2401 6257 IF Status = (..) THEN
2402 6271 BEGIN
2403 6276 GetSGDs(Status
2404 627B ,SCTBase
2405 6283 ,NooSegments
2406 6292 ,ModuleNo
2407 62A1 ,Fl
2408 62A8 );
2409 62B2 IF Status = (..) THEN
2410 62CC BEGIN
2411 62D1 SymbolTable(.ModuleNameReference
2412 62D6 .).ModuleNo := ModuleNo;
2413 62F7 GetEXP(Status
2414 62FC ,LogFile
2415 6304 ,Fl
2416 630B ,SBTLinkHead
2417 6312 ,ModuleNo
2418 631D ,NooExpSymbols
2419 6324 );
2420 6331 IF Status <= (.DuplicateExportSymbol.) THEN
2421 634D BEGIN
2422 6352 EITOffset := CurExternalImportSymbolNo;
2423 636A GetEXI(Status
2424 636F ,Fl
2425 6377 ,ModuleNo
2426 637E ,NooExiSymbols
2427 6385 );
2428 6392 CurrentFileAddress := Fl.P;
2429 63B1 END
2430 63B1 END
2431 63B1 END
2432 63B1 END;
2433 63B1 END;
2434 63B1 GStatus := GStatus + Status;
2435 63DC (*#B#*)
2436 63DC IF test((.0,6,16,19.)) THEN
2437 63F5 BEGIN
2438 63FA write(TestOut, 'GetOMH '); TSTstat(Status); TSTln;
2439 643A TSTindt; TSTindt; TSTindt; TSTmdt(ModuleNo);
2440 6452 END;
2441 6452 (*#E#*)
2442 6452 END; (*GETMODULEHEADER*)
2443 6458
2444 6458 BEGIN (*GETMODULES*)
2445 6458 REPEAT
2446 6465 Status := (..);
2447 647D FilSeek(Status, InputFile, StartAddressOfNextModule);
2448 649E IF not (UnexpectedEof IN Status) THEN
2449 64B7 BEGIN
2450 64BC ValidateModuleFormat(Status, InputFile, OM_Format1);
2451 64DC IF UnexpectedEof IN Status THEN
2452 64F4 BEGIN
2453 64F9 LogEOFerror(LogFile, FileNumber, InputFile.P)
2454 6519 END
2455 651C ELSE IF (BadModuleFormat IN Status) THEN
2456 6536 BEGIN
2457 653B LogOMFerror(LogFile, FileNumber, InputFile.P)
2458 655B END
2459 655E ELSE (* Status = (..) *)
2460 6560 GetModuleHeader(Status
2461 6565 ,LogFile
2462 656D ,FileNumber
2463 6574 ,InputFile
2464 657B ,StartAddressOfNextModule
2465 6583 );
2466 6592 GStatus := GStatus + Status;
2467 65BD END
2468 65BD UNTIL Status - (.DuplicateExportSymbol, BadSymbolName.) <> (..);
2469 65DB END; (*GETMODULES*)
2470 65E1
2471 65E1 BEGIN (*GETINPUTFILES*)
2472 65E1 FOR FileNo := 1 TO CurFileNo DO
2473 6603 BEGIN
2474 6608 Status := (..);
2475 6620 FilAsg(InputFile, FileNameTable(.FileNo.));
2476 664C FilRst(Status, InputFile);
2477 6664 IF Status = (..) THEN
2478 667E BEGIN
2479 6683 ValidateFileFormat (Status, InputFile, OF_Format1);
2480 66A3 IF Status = (..) THEN
2481 66BD GetModules(Status, LogFile, FileNo, InputFile, 4)
2482 66E8 ELSE IF BadFileFormat IN Status THEN
2483 670B LogOFFerror(LogFile, FileNo);
2484 6721 END;
2485 6721 IF UnexpectedEof IN Status THEN
2486 673A LogEOFerror(LogFile, FileNo, InputFile.P);
2487 6759 FilCls(InputFile);
2488 6769 GStatus := GStatus + Status;
2489 6794 END;
2490 679E IF CurModuleNo <= 0 THEN
2491 67AF GStatus := GStatus + (.NoInput.);
2492 67D5 END; (*GETINPUTFILES*)
2493 67DE
2494 67DE (* *)
2495 67DE (* *)
2496 67DE (******************************************************************************)
2497 67DE
2498 67DE (*$I B:lnkp1-2.pas putmodule *)
2499 67DE (******************************************************************************)
2500 67DE (* *)
2501 67DE (* Copyright (1985) by Metanic Aps., Denmark *)
2502 67DE (* *)
2503 67DE (* Author: Lars Gregers Jakobsen. *)
2504 67DE (* *)
2505 67DE (******************************************************************************)
2506 67DE
2507 67DE PROCEDURE PutTargetFile(VAR Status: StatusType
2508 67DE ;VAR TargetFile: FileType
2509 67DE ;VAR LogFile: LogFileType
2510 67DE );
2511 67DE
2512 67DE PROCEDURE PutFF(VAR Fl: FileType
2513 67DE );
2514 67DE
2515 67DE BEGIN (*PUTFF*)
2516 67DE FPi32(Fl, OF_Format1);
2517 67FD END; (*OUTFF*)
2518 6803
2519 6803 PROCEDURE PutModule(VAR Status: StatusType
2520 6803 ;VAR TargetFile: FileType
2521 6803 ;VAR LogFile: LogFileType
2522 6803 );
2523 6803
2524 6803 PROCEDURE PutMF(VAR Fl: FileType
2525 6803 );
2526 6803
2527 6803 BEGIN (*PUTMF*)
2528 6803 FPi32(Fl, OM_Format1);
2529 6822 END; (*OUTMF*)
2530 6828
2531 6828 PROCEDURE PutINX(VAR Status: StatusType
2532 6828 ;VAR Fl: FileType
2533 6828 ;VAR LogFile: LogFileType
2534 6828 );
2535 6828
2536 6828 VAR
2537 6828 OMH_ModuleName: ModuleNameType;
2538 6828
2539 6828 BEGIN (*PUTINX*)
2540 6828 FPi32(Fl,0); (* OMH_Module *)
2541 6847 FPi32(Fl,0); (* OMH_NooSegments *)
2542 685E FPi32(Fl,0); (* OMH_NooExportSymbols *)
2543 6875 FPi32(Fl,0); (* OMH_NooExtImportSymbols *)
2544 688C NMTG(SymbolTable(.ModuleTable(.1.).ModuleNameReference
2545 6891 .).NameReference
2546 68A5 , OMH_ModuleName
2547 68AE );
2548 68BD FPsym(Fl, OMH_ModuleName);
2549 68D4 END; (*PUTINX*)
2550 68DA
2551 68DA PROCEDURE PutSGDs(VAR Status: StatusType
2552 68DA ;VAR Fl: Filetype
2553 68DA ;VAR LogFile: LogFileType
2554 68DA );
2555 68DA
2556 68DA VAR
2557 68DA SRCinx: SectionTableIndexType;
2558 68DA DSTinx: SectionTableIndexType;
2559 68DA ModuleName: ModuleNameType;
2560 68DA
2561 68DA PROCEDURE PutSGD(VAR TargetFile: FileType
2562 68DA ; Section: SectionTableRecordType
2563 68DA );
2564 68DA
2565 68DA BEGIN (*PUTSGD*)
2566 68DA WITH Section DO
2567 68FC BEGIN
2568 6901 FPi32(TargetFile, ImageSize);
2569 6916 FPi32(TargetFile, OvrSize);
2570 692B END;
2571 692B END; (*PUTSGD*)
2572 6931
2573 6931 BEGIN (*PUTSGDS*)
2574 6931 Status := (..);
2575 6950 SCTA(Status, TargetSectionOffset, CurSegmentCount);
2576 696A IF not (SectionTableOverFlow IN Status) THEN
2577 6985 BEGIN
2578 698A IF CurSegmentCount > 0 THEN
2579 699B LogHSgd(LogFile);
2580 69AA FOR DSTinx := 1 TO CurSegmentCount DO
2581 69C4 WITH SectionTable(.TargetSectionOffset + DSTinx.) DO
2582 69F2 BEGIN
2583 69F7 ModuleNo := TargetModuleNo;
2584 6A05 SegmentNo := DSTinx;
2585 6A1A ImageSize := 0; (*TO BE UPDATED*)
2586 6A31 OvrSize := 0;
2587 6A4A RelocationConstant := 0;
2588 6A63 FOR SRCinx := 1 TO TargetSectionOffset DO
2589 6A7D IF SectionTable(.SRCinx.).SegmentNo = DSTinx THEN
2590 6A9B BEGIN
2591 6AA0 SectionTable(.SRCinx.).RelocationConstant :=
2592 6AB9 ImageSize * ImageFactor;
2593 6ADA ImageSize := ImageSize +
2594 6AF3 SectionTable(.SRCinx.).ImageSize;
2595 6B17 WITH SectionTable(.SRCinx.) DO (*Log memory map element*)
2596 6B36 IF SectionTable(.SRCinx.).ImageSize > 0 THEN
2597 6B62 BEGIN
2598 6B67 NMTG(SymbolTable(.ModuleTable(.
2599 6B6C ModuleNo.).ModuleNameReference
2600 6B84 .).Namereference
2601 6B96 ,ModuleName
2602 6B9F );
2603 6BAE LogSGD(LogFile
2604 6BB3 ,DSTinx
2605 6BBA ,RelocationConstant
2606 6BC1 ,ImageSize*ImageFactor
2607 6BDE ,ModuleName
2608 6BEE );
2609 6BF9 END;
2610 6BF9 (*#B#*)
2611 6BF9 IF test((.0,6,16,19.)) THEN
2612 6C13 BEGIN
2613 6C18 write(TestOut, 'PutSGDs-1');
2614 6C40 TSTsct(SRCinx);
2615 6C4F END;
2616 6C4F (*#E#*)
2617 6C4F END; (* FOR SRCinx := ... *)
2618 6C59 PutSGD(Fl, SectionTable(.TargetSectionOffset +
2619 6C65 DSTinx.) );
2620 6C8C (*#B#*)
2621 6C8C IF test((.0,6,16,19.)) THEN
2622 6CA6 BEGIN
2623 6CAB write(TestOut, 'PutSGDs-2');
2624 6CD3 TSTsct(TargetSectionOffset + DSTinx);
2625 6CF1 END;
2626 6CF1 (*#E#*)
2627 6CF1 END; (* FOR DSTinx := ... *)
2628 6CFB END; (* allocation ok *)
2629 6CFB END; (*PUTSGDS*)
2630 6D01
2631 6D01 PROCEDURE PutEXP(VAR Status: StatusType
2632 6D01 ;VAR Target: FileType
2633 6D01 ;VAR LogFile: LogFileType
2634 6D01 );
2635 6D01
2636 6D01 VAR
2637 6D01 MDTInx: ModuleTableIndexType;
2638 6D01 ModuleName: ModuleNameType;
2639 6D01 Heap: HeapType;
2640 6D01 HeapMax: HeapIndexType;
2641 6D01 Winner: SymboltableIndexType;
2642 6D01 SymbolNo: SymbolTableIndexType;
2643 6D01 EXP_RelocationIndicator: RelocationIndicatorType;
2644 6D01 EXP_Item: i32;
2645 6D01 EXP_SymbolName: SymbolNameType;
2646 6D01 SbtInx: SymbolTableIndexType;
2647 6D01
2648 6D01 FUNCTION NameSwop(VAR A
2649 6D01 , B: SymbolNameType
2650 6D01 ): boolean;
2651 6D01
2652 6D01 VAR
2653 6D01 I: integer;
2654 6D01
2655 6D01 BEGIN (*NAMESWOP*)
2656 6D01 I := 1;
2657 6D18 IF B.Length < A.Length THEN
2658 6D34 BEGIN
2659 6D39 WHILE (I <= B.Length) and (A.Name(.I.) >= B.Name(.I.)) DO
2660 6DA0 I := I + 1;
2661 6DB3 NameSwop := (I > B.Length);
2662 6DD7 END
2663 6DD7 ELSE
2664 6DDA BEGIN
2665 6DDF WHILE (I <= A.Length) and (A.Name(.I.) <= B.Name(.I.)) DO
2666 6E49 I := I + 1;
2667 6E5C NameSwop := not (I > A.Length);
2668 6E80 END;
2669 6E80 (*#B#*)
2670 6E80 IF test((.0,13.)) THEN
2671 6E99 BEGIN
2672 6E9E writeln(TestOut, 'NameSwop ', 'I=', I:1);
2673 6EE1 TSTindt; TSTindt; TSTindt;
2674 6EEF write(TestOut, 'A='); TSTsymbol(A);
2675 6F1A TSTindt; TSTindt; TSTindt;
2676 6F28 write(TestOut, 'B='); TSTsymbol(B);
2677 6F53 END
2678 6F53 (*#E#*)
2679 6F53 END; (*NAMESWOP*)
2680 6F5C
2681 6F5C PROCEDURE InHeap( New: SymbolTableIndexType
2682 6F5C );
2683 6F5C
2684 6F5C VAR
2685 6F5C I,J: integer;
2686 6F5C Z,V: SymbolNameType;
2687 6F5C Swop: boolean;
2688 6F5C
2689 6F5C BEGIN (*INHEAP*)
2690 6F5C HeapMax := HeapMax + 1;
2691 6F82 I := HeapMax;
2692 6F91 NMTG(SymbolTable(.New.).NameReference, Z);
2693 6FC2 IF I > 1 THEN
2694 6FD9 REPEAT
2695 6FDE J := I div 2;
2696 6FF6 NMTG(SymbolTable(. Heap(.J.) .).NameReference, V);
2697 703A Swop := NameSwop(V,Z);
2698 7058 IF Swop THEN
2699 7061 BEGIN
2700 7066 Heap(.I.) := Heap(.J.);
2701 70A4 I := J
2702 70A9 END
2703 70B1 UNTIL (I <= 1) or ( not Swop );
2704 70D0 Heap(.I.) := New;
2705 70F7 (*#B#*)
2706 70F7 IF test((.0,13.)) THEN
2707 7110 BEGIN
2708 7115 writeln(TestOut, 'InHeap New=', New:1);
2709 7152 TSTheap(Heap, HeapMax);
2710 716D END;
2711 716D (*#E#*)
2712 716D END; (*INHEAP*)
2713 7173
2714 7173 PROCEDURE SelectWinner(VAR Status: StatusType
2715 7173 );
2716 7173
2717 7173 VAR
2718 7173 I,J: integer;
2719 7173 Swop: boolean;
2720 7173 V,W,Z: SymbolNameType;
2721 7173 New: SymbolTableIndexType;
2722 7173
2723 7173 BEGIN (*SELECTWINNER*)
2724 7173 IF (0 < HeapMax) THEN
2725 718F BEGIN
2726 7194 Winner := Heap(.1.);
2727 71AA WITH Symboltable(.Winner.) DO
2728 71C6 IF SortLink <> Winner THEN
2729 71DA New := SortLink
2730 71DF ELSE
2731 71F3 BEGIN (* Chain exhausted - descrease size of heap *)
2732 71F8 New := Heap(.HeapMax.);
2733 721A HeapMax := HeapMax - 1;
2734 7238 END;
2735 7238 I := 1;
2736 7247 IF HeapMax >= 2 THEN
2737 725B BEGIN
2738 7260 J := 2;
2739 726F Heap(.HeapMax + 1.) := New;
2740 729B NMTG(SymbolTable(.New.).NameReference, Z);
2741 72CC REPEAT
2742 72D1 (* J <= HeapMax *)
2743 72D1
2744 72D1 NMTG(SymbolTable(.Heap(. J .).).NameReference, V);
2745 7319 NMTG(SymbolTable(.Heap(.J+1.).).NameReference, W);
2746 7364 IF NameSwop(V,W) THEN
2747 7380 BEGIN
2748 7385 V := W;
2749 739F J := J + 1
2750 73A8 END;
2751 73AF
2752 73AF Swop := NameSwop(Z,V);
2753 73CD IF Swop THEN
2754 73D6 BEGIN
2755 73DB Heap(.I.) := Heap(.J.);
2756 7419 I := J;
2757 7426 J := I + I;
2758 7438 END;
2759 7438
2760 7438 (*#B#*)
2761 7438 IF test((.0,13.)) THEN
2762 7451 BEGIN
2763 7456 write(TestOut, 'SLCT-W-1 ', 'I=' , I:1
2764 7490 , ' ':2 , 'J=' , J:1
2765 74B4 , ' ':2 , 'New=', New:1
2766 74DF , ' ':2 , 'Swop='
2767 74F6 ); TSTbool(Swop); TSTln;
2768 7515 TSTheap(Heap, HeapMax);
2769 7530 END
2770 7530 (*#E#*)
2771 7530
2772 7530 UNTIL (not Swop) or (J > HeapMax);
2773 7556 END;
2774 7556 Heap(.I.) := New;
2775 757D END
2776 757D ELSE
2777 7580 Status := Status + (.HeapEmpty.);
2778 75A8 (*#B#*)
2779 75A8 IF test((.0,13,16,19.)) THEN
2780 75C2 BEGIN
2781 75C7 write(TestOut, 'SLCT-W-2 '); TSTstat(Status); TSTindt;
2782 7606 writeln(TestOut, 'HeapMax=', HeapMax:1
2783 7639 , ' ':2, 'Winner=', Winner:1
2784 766B );
2785 7674 END;
2786 7674 (*#E#*)
2787 7674 END; (*SELECTWINNER*)
2788 767A
2789 767A
2790 767A BEGIN (*PUTEXP*)
2791 767A
2792 767A (*#B#*)
2793 767A IF test((.0,13.)) THEN
2794 769B BEGIN
2795 76A0 writeln(TestOut, 'PUTEXP ');
2796 76C8 FOR SbtInx := 1 TO MaxNooSymbols DO
2797 76D9 WITH SymbolTable(.SbtInx.), ValueTable(.SbtInx.) DO
2798 770F IF NameReference <> 0 THEN
2799 7724 BEGIN
2800 7729 TSTindt; TSTindt; TSTindt; TSTsbt(SbtInx);
2801 7745 TSTindt; TSTvlt(SbtInx); TSTln;
2802 775A END;
2803 7764 END;
2804 7764 (*#E#*)
2805 7764
2806 7764 (*Initialize selection*)
2807 7764 HeapMax := 0;
2808 776D FOR MDTInx := 1 TO TargetModuleNo - 1 DO
2809 7794 IF ModuleTable(.MDTInx
2810 7799 .).SBTLinkHead IN (.1..MaxNooSymbols.) THEN
2811 77C7 InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
2812 77FA
2813 77FA IF HeapMax > 0 THEN
2814 780A LogHxpN(LogFile);
2815 7819 NooExpSymbols := 0;
2816 782B
2817 782B WHILE (Status = (..)) DO
2818 7844 BEGIN
2819 7849 SelectWinner(Status);
2820 785C IF Status = (..) THEN
2821 7875 WITH SymbolTable(.Winner.), ValueTable(.Winner.) DO
2822 78AE IF SegmentNo > UnResolved THEN
2823 78BF BEGIN
2824 78C4 NooExpSymbols := NooExpSymbols + 1;
2825 78DA IF (SegmentNo > 0) THEN (*relocatable*)
2826 78F1 WITH SectionTable(.ModuleTable(.ModuleNo
2827 78F6 .).SCTbase +
2828 790E SegmentNo
2829 790E .) DO
2830 793F BEGIN
2831 7944 Value := Value + RelocationConstant;
2832 7970 END;
2833 7970 EXP_RelocationIndicator := SegmentNo;
2834 7982 EXP_Item := Value;
2835 7995 NMTG(NameReference, EXP_SymbolName);
2836 79B8 FPi8(Target, EXP_RelocationIndicator);
2837 79CF FPi32(Target, EXP_Item);
2838 79E4 FPsym(Target, EXP_SymbolName);
2839 79FB IF (Status = (..)) and (OPTlfk <> none) THEN
2840 7A24 BEGIN
2841 7A29 NMTG(SymbolTable(.
2842 7A2E ModuleTable(.ModuleNo
2843 7A2E .).ModuleNameReference
2844 7A46 .).NameReference
2845 7A58 ,ModuleName
2846 7A61 );
2847 7A70 LogXP(LogFile
2848 7A75 ,EXP_RelocationIndicator
2849 7A7C ,EXP_Item
2850 7A83 ,EXP_SymbolName
2851 7A89 ,ModuleName
2852 7A91 )
2853 7A99 END;
2854 7A9C END;
2855 7A9C END;
2856 7A9F Status := Status - (.HeapEmpty.);
2857 7AC7 IF (HeapEmpty IN Status) and (OPTlfk <> none) THEN
2858 7AF2 BEGIN (*sort sbt/vlt by value and log*)
2859 7AF7 END
2860 7AF7 END; (*PUTEXP*)
2861 7AFD
2862 7AFD
2863 7AFD PROCEDURE PutEXI(VAR Status: StatusType
2864 7AFD ;VAR Target: FileType
2865 7AFD ;VAR LogFile: LogFileType
2866 7AFD );
2867 7AFD
2868 7AFD LABEL
2869 7AFD 1;
2870 7AFD
2871 7AFD VAR
2872 7AFD ModuleName: ModuleNameType;
2873 7AFD SymbolName: SymbolNameType;
2874 7AFD ExiInx1: ExternalImportTableIndexType;
2875 7AFD ExiInx: ExternalImportTableIndexType;
2876 7AFD
2877 7AFD (* TargetModuleNo is a global variable *)
2878 7AFD
2879 7AFD BEGIN (*PUTEXI*)
2880 7AFD NooExiSymbols := 0;
2881 7B17
2882 7B17 ExiInx1 := 1;
2883 7B20 FOR ExiInx1 := 1 TO CurExternalImportSymbolNo DO
2884 7B3A BEGIN
2885 7B3F (*#B#*)
2886 7B3F IF test((.0,7.)) THEN
2887 7B56 BEGIN
2888 7B5B write(TestOut, 'PUTEXI-1 ');
2889 7B83 TSTeit(ExiInx1);
2890 7B92 END;
2891 7B92 (*#E#*)
2892 7B92 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2893 7BA5 .).SegmentNo = UnResolved) THEN
2894 7BBD GOTO 1;
2895 7BC5 END;
2896 7BCF
2897 7BCF 1: IF (CurExternalImportSymbolNo > 0) THEN
2898 7BE0 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2899 7BF3 .).SegmentNo = UnResolved) THEN
2900 7C0B BEGIN
2901 7C10 LogHurs(LogFile);
2902 7C1F FOR ExiInx := ExiInx1 TO CurExternalImportSymbolNo DO
2903 7C3A BEGIN
2904 7C3F (*#B#*)
2905 7C3F IF test((.0,7.)) THEN
2906 7C56 BEGIN
2907 7C5B write(TestOut, 'PUTEXI-2 ');
2908 7C83 TSTeit(ExiInx);
2909 7C92 END;
2910 7C92 (*#E#*)
2911 7C92 WITH ExternalImportTable(.ExiInx.) DO
2912 7CAB WITH ValueTable(.SymbolNo.),
2913 7CC8 SymbolTable(.SymbolNo.) DO
2914 7CE6 IF SegmentNo = UnResolved THEN
2915 7CF7 BEGIN
2916 7CFC NooExiSymbols := NooExiSymbols + 1;
2917 7D12 Value := NooExiSymbols;
2918 7D29 NMTG(NameReference, SymbolName);
2919 7D4C FPsym(Target, SymbolName);
2920 7D63 NMTG(SymbolTable(.
2921 7D68 ModuleTable(.ModuleNo
2922 7D68 .).ModuleNameReference
2923 7D80 .).NameReference
2924 7D92 ,ModuleName
2925 7D9B );
2926 7DAA LogURS(LogFile, ModuleName, SymbolName);
2927 7DC9 (*#B#*)
2928 7DC9 IF test((.0,16,19.)) THEN
2929 7DE3 BEGIN
2930 7DE8 writeln(TestOut, 'PutEXI '
2931 7E03 , 'SymbolNo=', SymbolNo:1
2932 7E32 , ' ':2, 'Value=', Value:1);
2933 7E69 END;
2934 7E69 (*#E#*)
2935 7E69 END;
2936 7E69
2937 7E69 END;
2938 7E73 END;
2939 7E73 END; (*PUTEXI*)
2940 7E79
2941 7E79 (* TargetModuleNo is a global variable *)
2942 7E79
2943 7E79 BEGIN (*PUTMODULE*)
2944 7E79 MDTA(Status, TargetModuleNo, 1);
2945 7E97 IF not (ModuleTableOverFlow IN Status) THEN
2946 7EB2 BEGIN
2947 7EB7 PutMF(TargetFile);
2948 7EC6 PutINX(Status, TargetFile, LogFile);
2949 7EE7 IF Status = (..) THEN
2950 7F00 BEGIN (*Calculate memory map, write sgd, and log*)
2951 7F05 PutSGDs(Status, TargetFile, LogFile);
2952 7F26
2953 7F26 IF not (SectionTableOverFlow IN Status) THEN
2954 7F41 BEGIN (*Relocate symbol table, write export list, and log*)
2955 7F46 PutEXP(Status, TargetFile, LogFile);
2956 7F67 IF Status = (..) THEN
2957 7F80 BEGIN (*Write EXI while logging unresolved references*)
2958 7F85 PutEXI(Status, TargetFile, LogFile);
2959 7FA6 END;
2960 7FA6 END;
2961 7FA6 END;
2962 7FA6 END;
2963 7FA6 END; (*PUTMODULE*)
2964 7FAC
2965 7FAC BEGIN (*PUTTARGETFILE*)
2966 7FAC PutFF(TargetFile);
2967 7FC3 PutModule(Status, TargetFile, LogFile);
2968 7FE4 END; (*PUTTARGETFILE*)
2969 7FEA
2970 7FEA (* *)
2971 7FEA (* *)
2972 7FEA (******************************************************************************)
2973 7FEA
2974 7FEA
2975 7FEA BEGIN (*PASS1*)
2976 7FEA
2977 7FEA (* Initialize local data structures *)
2978 7FEA FOR SBTSubInx := 1 TO MaxNooSymbols DO
2979 8005 SymbolTable(.SBTSubInx.).NameReference := 0;
2980 802B LatestInsert := 0;
2981 803D CurrentSymbolCount := 0;
2982 804F CurrentNameTableIndex := 0;
2983 805D
2984 805D GetInputFiles(Status, LogFile);
2985 8089 IF Status = (..) THEN
2986 80AB BEGIN
2987 80B0 PutTargetFile(Status, TargetFile, LogFile);
2988 80EC END;
2989 80EC END; (*PASS1*)
2990 80F2
2991 80F2 (* *)
2992 80F2 (* *)
2993 80F2 (******************************************************************************)
2994 80F2
2995 80F2 (*$I B:lnkp2.pas Procedure pass2 *)
2996 80F2 (******************************************************************************)
2997 80F2 (* *)
2998 80F2 (* Copyright (1985) by Metanic Aps., Denmark *)
2999 80F2 (* *)
3000 80F2 (* Author: Lars Gregers Jakobsen. *)
3001 80F2 (* *)
3002 80F2 (******************************************************************************)
3003 80F2
3004 80F2 PROCEDURE Pass2(VAR Status: StatusType
3005 80F2 ;VAR TargetFile: FileType
3006 80F2 ;VAR LogFile: LogFileType
3007 80F2 );
3008 80F2
3009 80F2 LABEL
3010 80F2 999;
3011 80F2
3012 80F2 VAR
3013 80F2 SegmentInx: SegmentNoType;
3014 80F2 ModuleInx: ModuleTableIndexType;
3015 80F2 Crid: BitMappedFileType; (*Composite relocation import directory*)
3016 80F2 Covr: FileType; (*Composite overrun store*)
3017 80F2
3018 80F2 (*#B#*)
3019 80F2 (*$I B:LNKDF5.PAS Bit Map Buffer Test Output *)
3020 80F2 (******************************************************************************)
3021 80F2 (* *)
3022 80F2 (* Copyright (1985) by Metanic Aps., Denmark *)
3023 80F2 (* *)
3024 80F2 (* Author: Lars Gregers Jakobsen. *)
3025 80F2 (* *)
3026 80F2 (******************************************************************************)
3027 80F2
3028 80F2 PROCEDURE TSTbmb(Bmb: BitMapBufferType
3029 80F2 );
3030 80F2
3031 80F2 VAR
3032 80F2 I: 0..15;
3033 80F2
3034 80F2 BEGIN (*TSTBMB*)
3035 80F2 write(TestOut, 'Y1,Y0,I,P= ', Bmb.Y1:3, ' ', Bmb.Y0:3, ' ');
3036 8169 FOR I := 15 DOWNTO 8 DO
3037 817A IF I IN Bmb.I THEN
3038 8191 write(TestOut, '1')
3039 81A9 ELSE
3040 81AF write(TestOut, '0');
3041 81D4 write(TestOut, ' ');
3042 81EF FOR I := 7 DOWNTO 0 DO
3043 8200 IF I IN Bmb.I THEN
3044 8217 write(TestOut, '1')
3045 822F ELSE
3046 8235 write(TestOut, '0');
3047 825A write(TestOut, ' ', Bmb.P:3, ' ');
3048 8296 END; (*TSTBMB*)
3049 829C
3050 829C (* *)
3051 829C (* *)
3052 829C (******************************************************************************)
3053 829C
3054 829C (*$I B:LNKDF6.PAS Bit Map Access Primitives *)
3055 829C (******************************************************************************)
3056 829C (* *)
3057 829C (* Copyright (1985) by Metanic Aps., Denmark *)
3058 829C (* *)
3059 829C (* Author: Lars Gregers Jakobsen. *)
3060 829C (* *)
3061 829C (******************************************************************************)
3062 829C
3063 829C PROCEDURE BMG2(VAR BM: BitMappedFileType
3064 829C ;VAR Relocatable: boolean
3065 829C ;VAR Importable: boolean
3066 829C );
3067 829C
3068 829C BEGIN (*BMG2*)
3069 829C WITH BM, BM.B DO
3070 82C3 BEGIN
3071 82C8 IF P <= 8 THEN
3072 82D9 BEGIN
3073 82DE read(F, Y1);
3074 8309 P := P + 8;
3075 832C END;
3076 832C P := P - 1;
3077 834C Relocatable := P IN I;
3078 837A P := P - 1;
3079 839A Importable := P IN I;
3080 83C8 (*#B#*)
3081 83C8 IF test((.0,4.)) THEN
3082 83DF BEGIN
3083 83E4 write(TestOut, 'BMG2 '); TSTbmb(BM.B);
3084 8418 write(TestOut, 'R,I= ');
3085 843C TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
3086 8463 END;
3087 8463 (*#E#*)
3088 8463
3089 8463 END;
3090 8463 END; (*BMG2*)
3091 8469
3092 8469 PROCEDURE BMG6(VAR BM: BitMappedFileType
3093 8469 ;VAR Index:i8
3094 8469 );
3095 8469
3096 8469 VAR
3097 8469 J: 1..6;
3098 8469
3099 8469 BEGIN (*BMG6*)
3100 8469 Index := 0;
3101 847E WITH BM, BM.B DO
3102 849D BEGIN
3103 84A2 IF P < 14 THEN
3104 84B0 BEGIN
3105 84B5 read(F, Y0);
3106 84DF FOR J := 1 TO 6 DO
3107 84F0 Index := Index + Index + ord( (P-J) IN I );
3108 855B Y1 := Y0;
3109 8573 P := P + 2; (* = P - 6 + 8 *)
3110 8596 END
3111 8596 ELSE
3112 8599 BEGIN
3113 859E FOR J := 1 TO 6 DO
3114 85AF Index := Index + Index + ord( (P-J) IN I );
3115 861A P := P - 6;
3116 863D END;
3117 863D (*#B#*)
3118 863D IF test((.0,4.)) THEN
3119 8654 BEGIN
3120 8659 write(TestOut, 'BMG6 '); TSTbmb(BM.B);
3121 868D writeln(TestOut, 'Index= ',Index:1);
3122 86C6 END;
3123 86C6 (*#E#*)
3124 86C6 END;
3125 86C6 END; (*BMG6*)
3126 86CC
3127 86CC PROCEDURE BMP2(VAR BM: BitMappedFileType
3128 86CC ; Relocatable: boolean
3129 86CC ; Importable: boolean
3130 86CC );
3131 86CC
3132 86CC BEGIN (*BMP2*)
3133 86CC WITH BM, BM.B DO
3134 86F3 BEGIN
3135 86F8 P := P - 1;
3136 8712 IF Relocatable THEN
3137 871E I := I + (.P.);
3138 8756 P := P - 1;
3139 8776 IF Importable THEN
3140 8782 I := I + (.P.);
3141 87BA IF P <= 8 THEN (* always >= 8 *)
3142 87D1 BEGIN
3143 87D6 write(F, Y1);
3144 8801 Y1 := 0;
3145 8810 P := 16 (* = P + 8 *)
3146 881B END;
3147 881D (*#B#*)
3148 881D IF test((.0,4.)) THEN
3149 8834 BEGIN
3150 8839 write(TestOut, 'BMP2 '); TSTbmb(BM.B);
3151 886D write(TestOut, 'R,I= ');
3152 8891 TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
3153 88B0 END;
3154 88B0 (*#E#*)
3155 88B0 END
3156 88B0 END; (*BMP2*)
3157 88B6
3158 88B6 PROCEDURE BMP6(VAR BM: BitMappedFileType
3159 88B6 ; Index:i8
3160 88B6 );
3161 88B6
3162 88B6 VAR
3163 88B6 J: 0..5;
3164 88B6
3165 88B6 BEGIN (*BMP6*)
3166 88B6 WITH BM, BM.B DO
3167 88DD BEGIN
3168 88E2 P := P - 6;
3169 88FF FOR J := 0 TO 5 DO
3170 8910 BEGIN
3171 8915 IF odd(Index) THEN
3172 8923 I := I + (.P+J.);
3173 8965 Index := Index div 2
3174 896A END;
3175 897C (*#B#*)
3176 897C IF test((.0,4.)) THEN
3177 8993 BEGIN
3178 8998 write(TestOut, 'BMP6 '); TSTbmb(BM.B);
3179 89CC writeln(TestOut, 'Index= ', Index:1);
3180 8A01 END;
3181 8A01 (*#E#*)
3182 8A01 IF P <= 8 THEN
3183 8A18 BEGIN
3184 8A1D write(F, Y1);
3185 8A48 Y1 := Y0;
3186 8A60 Y0 := 0;
3187 8A6E P := P + 8;
3188 8A91 END;
3189 8A91 END;
3190 8A91 END; (*BMP6*)
3191 8A97
3192 8A97 (* *)
3193 8A97 (* *)
3194 8A97 (******************************************************************************)
3195 8A97
3196 8A97
3197 8A97 PROCEDURE LinkSection(VAR Status: StatusType
3198 8A97 ;VAR TargetFile: FileType
3199 8A97 ;VAR LogFile: LogFileType
3200 8A97 ;VAR Crid: BitMappedFileType
3201 8A97 ;VAR Covr: FileType
3202 8A97 ;VAR SCTrec: SectionTableRecordType
3203 8A97 ;VAR MDTrec: ModuleTableRecordType
3204 8A97 );
3205 8A97
3206 8A97 LABEL
3207 8A97 99;
3208 8A97
3209 8A97 VAR
3210 8A97 Oimg: FileType;
3211 8A97 Orid: BitMappedFileType;
3212 8A97 Oovr: FileType;
3213 8A97 ImageUnit: ImageUnitType;
3214 8A97 QuadImageUnit: QuadImageUnitType;
3215 8A97 Relocatable: boolean;
3216 8A97 Importable: boolean;
3217 8A97 Index: i8;
3218 8A97 Address: FileAddressType; (*relative to current obj. section*)
3219 8A97 LocalImageSize: FileAddressType;
3220 8A97 OvrIndex: QuadImageUnitType;
3221 8A97
3222 8A97
3223 8A97 BEGIN (*LINKSECTION*)
3224 8A97 WITH MDTrec, SCTrec DO
3225 8ABC BEGIN
3226 8AC1 IF ImageSize > 0 THEN
3227 8AD9 BEGIN
3228 8ADE FilAsg(Oimg, FileNameTable(.FileNameReference.));
3229 8B0F FilRst(Status, Oimg);
3230 8B26 FilSeek(Status, Oimg, CurrentFileAddress);
3231 8B4D CurrentFileAddress := CurrentFileAddress + ImageSize * ImageFactor;
3232 8B87
3233 8B87 WITH Orid DO
3234 8B8C BEGIN
3235 8B91 assign(F, FileNameTable(.FileNameReference.));
3236 8BC1 reset(F);
3237 8BD5 seek(F, CurrentFileAddress);
3238 8BF1 WITH B DO
3239 8C03 BEGIN
3240 8C08 P := 16;
3241 8C0F I := (..);
3242 8C27 read(F, Y1);
3243 8C4E END;
3244 8C4E END;
3245 8C4E CurrentFileAddress := CurrentFileAddress + ImageSize;
3246 8C7D
3247 8C7D IF OvrSize > 0 THEN
3248 8C9D BEGIN
3249 8CA2 FilAsg(Oovr, FileNameTable(.FileNameReference.));
3250 8CD3 FilRst(Status, Oovr);
3251 8CEA FilSeek(Status, Oovr, CurrentFileAddress);
3252 8D11 CurrentFileAddress := CurrentFileAddress + OvrSize;
3253 8D42 END
3254 8D42 ELSE
3255 8D45 Oovr.P := CurrentFileAddress;
3256 8D5C
3257 8D5C (*CurrentFileAddress now reflects starting position of
3258 8D5C next section in file if any*)
3259 8D5C
3260 8D5C Address := 0;
3261 8D6B LocalImageSize := (ImageSize - 1) * ImageFactor;
3262 8D90 WHILE (Address <= LocalImageSize) and (Status = (..)) DO
3263 8DC1 BEGIN
3264 8DC6 BMG2(Orid, Relocatable, Importable);
3265 8DE6 IF Relocatable <> Importable THEN
3266 8DF4 BEGIN
3267 8DF9 BMG6(Orid, Index);
3268 8E11 FGi32(Status, Oimg, QuadImageUnit);
3269 8E30 IF Relocatable THEN
3270 8E3C (* Relocate *)
3271 8E3C IF Index IN (.1..NooSegments.) THEN
3272 8E6A WITH SectionTable(.SCTBase + Index.) DO
3273 8EA1 QuadImageUnit := QuadImageUnit + RelocationConstant
3274 8EAA ELSE
3275 8EC3 Status := Status + (.BadRelocationCode.)
3276 8ED9 ELSE
3277 8EED (* Import *)
3278 8EED BEGIN (*IMPORT*)
3279 8EF2 IF Index = OvrCode THEN
3280 8EFE IF Oovr.P < CurrentFileAddress - 3 THEN
3281 8F25 FGi32(Status, Oovr, OvrIndex)
3282 8F41 ELSE
3283 8F47 Status := Status + (.UnexpectedEof.)
3284 8F5D ELSE
3285 8F70 OvrIndex := Index;
3286 8F80 IF OvrIndex IN (.1..NooExternalImportSymbols.) THEN
3287 8FB0 WITH ValueTable(.ExternalImportTable(.EITOffset + OvrIndex
3288 8FBB .).SymbolNo
3289 8FE1 .) DO
3290 8FF9 IF SegmentNo > UnResolved THEN
3291 900A BEGIN
3292 900F QuadImageUnit := QuadImageUnit + Value; (*?* + ? *)
3293 902B Importable := false;
3294 9034 Relocatable := SegmentNo > 0;
3295 9051 Index := SegmentNo;
3296 9064 END
3297 9064 ELSE
3298 9067 IF Value IN (.0..63.) THEN
3299 908A Index := Value
3300 908F ELSE
3301 90A6 BEGIN
3302 90AB Index := OvrCode;
3303 90B4 FPi32(Covr, Value);
3304 90CF END
3305 90CF ELSE
3306 90D2 Status := Status + (.BadImportCode.)
3307 90E8 END; (*IMPORT*)
3308 90F9 FPi32(TargetFile, QuadImageUnit);
3309 910E BMP2(Crid, Relocatable, Importable);
3310 912B BMP6(Crid, Index);
3311 913E Address := Address + ImageFactor;
3312 9159 END
3313 9159 ELSE
3314 915C IF Relocatable THEN
3315 9168 BEGIN
3316 916D Status := Status + (.Baddibit.);
3317 9194 GOTO 99; (*EXIT procedure*)
3318 919C END
3319 919C ELSE
3320 919F BEGIN
3321 91A4 FGi8(Status, Oimg, ImageUnit);
3322 91C3 FPi8(TargetFile, ImageUnit);
3323 91D6 BMP2(Crid, Relocatable, Importable);
3324 91F3 Address := Address + 1;
3325 9206 END;
3326 9206 END;
3327 9209 LocalImageSize := ImageSize * ImageFactor;
3328 922B WHILE (Address < LocalImageSize) and (Status = (..)) DO
3329 925C BEGIN
3330 9261 BMG2(Orid, Relocatable, Importable);
3331 9281 IF Relocatable or Importable THEN
3332 9290 BEGIN
3333 9295 Status := Status + (.Baddibit.);
3334 92BC GOTO 99; (*EXIT procedure*)
3335 92C4 END
3336 92C4 ELSE
3337 92C7 BEGIN
3338 92CC FGi8(Status, Oimg, ImageUnit);
3339 92EB FPi8(TargetFile, ImageUnit);
3340 92FE BMP2(Crid, Relocatable, Importable);
3341 931B Address := Address + 1;
3342 932E END;
3343 932E END;
3344 9331 END; (* IF ImageSize > 0 THEN *)
3345 9331 99: END; (* WITH MDTrec, SCTrec DO *)
3346 9331 END; (*LINKSECTION*)
3347 933A
3348 933A PROCEDURE CopyBuffer(VAR Status: StatusType
3349 933A ;VAR Buffer: BasicFileType
3350 933A ;VAR TargetFile: FileType
3351 933A ;VAR Size: FileAddressType
3352 933A );
3353 933A
3354 933A VAR
3355 933A Item: i8;
3356 933A Start: FileAddressType;
3357 933A
3358 933A BEGIN (*COPYBUFFER*)
3359 933A reset(Buffer);
3360 9355 Start := TargetFile.P;
3361 936C WHILE not eof(Buffer) DO
3362 9385 BEGIN
3363 938A read(Buffer, Item);
3364 93AD FPi8(TargetFile, Item); (*Advancing TargetFile.P*)
3365 93C0 END;
3366 93C3 Size := TargetFile.P - Start;
3367 93E9 (*#B#*)
3368 93E9 IF test((.0,20.)) THEN
3369 9403 BEGIN
3370 9408 writeln(TestOut, 'CPYBUF ', 'Start= ', Start:1
3371 9447 , ' End= ', TargetFile.P:1
3372 946D , ' Size= ', Size:1
3373 9492 );
3374 949B END;
3375 949B (*#E#*)
3376 949B END; (*COPYBUFFER*)
3377 94A1
3378 94A1 PROCEDURE UPDINX(VAR Status: StatusType
3379 94A1 VAR TargetFile: FileType
3380 94A1 );
3381 94A1
3382 94A1 VAR
3383 94A1 ModuleSize: i32;
3384 94A1 ModuleName: ModuleNameType;
3385 94A1 SegmentInx: SegmentNoType;
3386 94A1
3387 94A1 BEGIN (*UPDINX*)
3388 94A1 ModuleSize := TargetFile.P - OMF_Address;
3389 94C8 update(TargetFile.F);
3390 94DB FilSeek(Status, TargetFile, OMH_Address);
3391 94F9 IF Status = (..) THEN
3392 9512 BEGIN
3393 9517 FPi32(TargetFile, ModuleSize);
3394 952C FPi32(TargetFile, CurSegmentCount);
3395 9546 FPi32(TargetFile, NooExpSymbols);
3396 955E FPi32(TargetFile, NooExiSymbols);
3397 9576 FGsym(Status, TargetFile, ModuleName); (*skip past name*)
3398 9594 IF Status = (..) THEN
3399 95AD FOR SegmentInx := 1 TO CurSegmentCount DO
3400 95C7 WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3401 95F5 BEGIN
3402 95FA FPi32(TargetFile, ImageSize);
3403 9616 FPi32(TargetFile, OvrSize);
3404 9634 END;
3405 963E END;
3406 963E END; (*UPDINX*)
3407 9644
3408 9644 BEGIN (*PASS2*)
3409 9644 FOR SegmentInx := 1 TO CurSegmentCount DO
3410 9666 BEGIN
3411 966B WITH Crid DO
3412 9670 BEGIN
3413 9675 rewrite(F);
3414 9689 WITH B DO
3415 969B BEGIN
3416 96A0 P := 16;
3417 96A7 I := (..)
3418 96B4 END
3419 96BF END;
3420 96BF FilRwt(Covr);
3421 96CF FOR ModuleInx := 1 TO TargetModuleNo - 1 DO
3422 96F6 BEGIN
3423 96FB (*#B#*)
3424 96FB IF test((.0,20.)) THEN
3425 9715 BEGIN
3426 971A write(TestOut, 'Pass-2 '); TSTstat(Status); TSTindt;
3427 9759 writeln(TestOut, 'SgmInx= ', SegmentInx:1
3428 9788 , ' MdlInx= ', ModuleInx:1
3429 97AF );
3430 97B8 TSTindt; TSTindt; TSTindt;
3431 97C6 TSTmdt(ModuleInx);
3432 97D5 TSTindt; TSTindt; TSTindt;
3433 97E3 TSTsct(ModuleTable(.ModuleInx.).SCTBase + SegmentInx);
3434 9819 END;
3435 9819 (*#E#*)
3436 9819 IF (SectionTable(.ModuleTable(.ModuleInx
3437 981E .).SCTBase + SegmentInx
3438 9832 .).ModuleNo = ModuleInx) THEN
3439 9860 BEGIN
3440 9865 LinkSection(Status, TargetFile, LogFile, Crid, Covr
3441 9887 ,SectionTable(.ModuleTable(.ModuleInx
3442 988F .).SCTBase + SegmentInx
3443 98A3 .)
3444 98CA ,ModuleTable(.ModuleInx.)
3445 98DF );
3446 98E3 IF Status <> (..) THEN
3447 98FC GOTO 999; (************* EXIT BOTH FOR LOOPS **************)
3448 9904 END;
3449 9904 END;
3450 990E WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3451 993C BEGIN
3452 9941 CopyBuffer(Status, Crid.F, TargetFile, ImageSize);
3453 9968 CopyBuffer(Status, Covr.F, TargetFile, OvrSize);
3454 9991 END;
3455 9991 END;
3456 999B 999:
3457 999B (*backpatch info to target.inx*)
3458 999B UPDINX(Status, TargetFile);
3459 99B1
3460 99B1 END; (*PASS2*)
3461 99BA
3462 99BA (* *)
3463 99BA (* *)
3464 99BA (******************************************************************************)
3465 99BA
3466 99BA
3467 99BA
3468 99BA BEGIN (*LINK*)
3469 99BA (*#B#*)
3470 99BA TestInit(Input,Output);
3471 99D3 (*#E#*)
3472 99D3 Status := (..);
3473 99E7 Optiontable.LogFileKind := None;
3474 99F1 OptionTable.TargetFileKind := Implicit;
3475 99FB CurFileNo := 0;
3476 9A05 CurModuleNo := 0;
3477 9A0F FOR SCTSubInx := 1 TO MaxNooSections DO
3478 9A21 SectionTable(.SCTSubInx.).SegmentNo := 0;
3479 9A45 SCTOffset := 0;
3480 9A4F CurSegmentCount := 0;
3481 9A59 CurExternalImportSymbolNo := 0;
3482 9A63
3483 9A63 SetUp(Status, TargetFile, LogFile, Output);
3484 9A7B (*#B#*)
3485 9A7B IF test((.0,16,17.)) THEN
3486 9A95 BEGIN
3487 9A9A write(TestOut, 'Link-MAIN-1 '); TSTstat(Status); TSTindt; TSTmem; TSTln
3488 9ADE END;
3489 9AE1 (*#E#*)
3490 9AE1 IF Status = (..) THEN
3491 9AF7 Pass1(Status, TargetFile, LogFile);
3492 9B0B (*#B#*)
3493 9B0B IF test((.0,16,17.)) THEN
3494 9B25 BEGIN
3495 9B2A write(TestOut, 'Link-MAIN-2 '); TSTstat(Status); TSTln
3496 9B68 END;
3497 9B6B (*#E#*)
3498 9B6B IF Status = (..) THEN
3499 9B81 Pass2(Status, TargetFile, LogFile);
3500 9B95 (*#B#*)
3501 9B95 IF test((.0,16,17.)) THEN
3502 9BAF BEGIN
3503 9BB4 write(TestOut, 'Link-MAIN-3 '); TSTstat(Status); TSTln
3504 9BF2 END;
3505 9BF5 (*#E#*)
3506 9BF5 IF Status = (..) THEN
3507 9C0B BEGIN
3508 9C10 writeln(output, 'LINK -- Normal termination')
3509 9C46 END
3510 9C49 ELSE
3511 9C4C BEGIN
3512 9C51 writeln(output, 'LINK -- Abnormal termination.');
3513 9C8D
3514 9C8D IF BadOption IN Status THEN
3515 9CA2 writeln(output, 'Bad option');
3516 9CCB IF BadLogFileName IN Status THEN
3517 9CE0 writeln(output, 'Bad log file name');
3518 9D10 IF BadTargetFileName IN Status THEN
3519 9D25 writeln(output, 'Bad target file name');
3520 9D58 IF BadFileName IN Status THEN
3521 9D6D writeln(output, 'Bad file name');
3522 9D99 IF NoSuchFile IN Status THEN
3523 9DAE writeln(output, 'No such file');
3524 9DD9 IF NoInputFiles IN Status THEN
3525 9DEE writeln(output, 'No input files');
3526 9E1B IF ExtraText IN Status THEN
3527 9E30 writeln(output, 'Extra text');
3528 9E59 IF BadFileFormat IN Status THEN
3529 9E6E writeln(output, 'Bad file format');
3530 9E9C IF BadModuleFormat IN Status THEN
3531 9EB1 writeln(output, 'Bad module format');
3532 9EE1 IF UnexpectedEof IN Status THEN
3533 9EF6 writeln(output, 'Unexpected EOF');
3534 9F23 IF RangeError IN Status THEN
3535 9F38 writeln(output, 'Range error');
3536 9F62 IF BadSymbolName IN Status THEN
3537 9F77 writeln(output, 'Bad symbol name');
3538 9FA5 IF DuplicateModuleName IN Status THEN
3539 9FBA writeln(output, 'Duplicate module name');
3540 9FEE IF DuplicateExportSymbol IN Status THEN
3541 A003 writeln(output, 'Duplicate export symbol');
3542 A039 IF NoInput IN Status THEN
3543 A04E writeln(output, 'No input');
3544 A075 IF Baddibit IN Status THEN
3545 A08A writeln(output, 'Bad dibit');
3546 A0B2 IF BadRelocationCode IN Status THEN
3547 A0C7 writeln(output, 'Bad relocation code');
3548 A0F9 IF BadImportCode IN Status THEN
3549 A10E writeln(output, 'Bad import code');
3550 A13C IF NameTableOverFlow IN Status THEN
3551 A151 writeln(output, 'Name table overflow');
3552 A183 IF ModuleTableOverFlow IN Status THEN
3553 A198 writeln(output, 'Module table overflow');
3554 A1CC IF SectionTableOverFlow IN Status THEN
3555 A1E1 writeln(output, 'Section table overflow');
3556 A216 IF FileNameTableOverFlow IN Status THEN
3557 A22B writeln(output, 'File name table overflow');
3558 A262 IF SymbolTableOverFlow IN Status THEN
3559 A277 writeln(output, 'Symbol table overflow');
3560 A2AB IF ExternalImportTableOverFlow IN Status THEN
3561 A2C0 writeln(output, 'External import table overflow');
3562 A2FD
3563 A2FD IF not (NoTarget IN Status) THEN
3564 A312 erase(TargetFile.F);
3565 A31E END
3566 A31E END.
«eof»