|
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: 188288 (0x2df80)
Types: TextFile
Names: »LNK.PRN«
└─⟦243948191⟧ Bits:30009789/_.ft.Ibm2.50007349.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.04';
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 write(TestOut, 'HeapMax=', HeapMax:1, ' ':2);
2783 764B IF 0 < HeapMax THEN
2784 765F writeln(TestOut, 'Winner=', Winner:1)
2785 7697 ELSE
2786 769D writeln(TestOut, 'Winner=--');
2787 76C5 END;
2788 76C5 (*#E#*)
2789 76C5 END; (*SELECTWINNER*)
2790 76CB
2791 76CB
2792 76CB BEGIN (*PUTEXP*)
2793 76CB
2794 76CB (*#B#*)
2795 76CB IF test((.0,13.)) THEN
2796 76EC BEGIN
2797 76F1 writeln(TestOut, 'PUTEXP ');
2798 7719 FOR SbtInx := 1 TO MaxNooSymbols DO
2799 772A WITH SymbolTable(.SbtInx.), ValueTable(.SbtInx.) DO
2800 7760 IF NameReference <> 0 THEN
2801 7775 BEGIN
2802 777A TSTindt; TSTindt; TSTindt; TSTsbt(SbtInx);
2803 7796 TSTindt; TSTvlt(SbtInx); TSTln;
2804 77AB END;
2805 77B5 END;
2806 77B5 (*#E#*)
2807 77B5
2808 77B5 (*Initialize selection*)
2809 77B5 HeapMax := 0;
2810 77BE FOR MDTInx := 1 TO TargetModuleNo - 1 DO
2811 77E5 IF ModuleTable(.MDTInx
2812 77EA .).SBTLinkHead IN (.1..MaxNooSymbols.) THEN
2813 7818 InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
2814 784B
2815 784B IF HeapMax > 0 THEN
2816 785B LogHxpN(LogFile);
2817 786A NooExpSymbols := 0;
2818 787C
2819 787C WHILE (Status = (..)) DO
2820 7895 BEGIN
2821 789A SelectWinner(Status);
2822 78AD IF Status = (..) THEN
2823 78C6 WITH SymbolTable(.Winner.), ValueTable(.Winner.) DO
2824 78FF IF SegmentNo > UnResolved THEN
2825 7910 BEGIN
2826 7915 NooExpSymbols := NooExpSymbols + 1;
2827 792B IF (SegmentNo > 0) THEN (*relocatable*)
2828 7942 WITH SectionTable(.ModuleTable(.ModuleNo
2829 7947 .).SCTbase +
2830 795F SegmentNo
2831 795F .) DO
2832 7990 BEGIN
2833 7995 Value := Value + RelocationConstant;
2834 79C1 END;
2835 79C1 EXP_RelocationIndicator := SegmentNo;
2836 79D3 EXP_Item := Value;
2837 79E6 NMTG(NameReference, EXP_SymbolName);
2838 7A09 FPi8(Target, EXP_RelocationIndicator);
2839 7A20 FPi32(Target, EXP_Item);
2840 7A35 FPsym(Target, EXP_SymbolName);
2841 7A4C IF (Status = (..)) and (OPTlfk <> none) THEN
2842 7A75 BEGIN
2843 7A7A NMTG(SymbolTable(.
2844 7A7F ModuleTable(.ModuleNo
2845 7A7F .).ModuleNameReference
2846 7A97 .).NameReference
2847 7AA9 ,ModuleName
2848 7AB2 );
2849 7AC1 LogXP(LogFile
2850 7AC6 ,EXP_RelocationIndicator
2851 7ACD ,EXP_Item
2852 7AD4 ,EXP_SymbolName
2853 7ADA ,ModuleName
2854 7AE2 )
2855 7AEA END;
2856 7AED END;
2857 7AED END;
2858 7AF0 Status := Status - (.HeapEmpty.);
2859 7B18 IF (HeapEmpty IN Status) and (OPTlfk <> none) THEN
2860 7B43 BEGIN (*sort sbt/vlt by value and log*)
2861 7B48 END
2862 7B48 END; (*PUTEXP*)
2863 7B4E
2864 7B4E
2865 7B4E PROCEDURE PutEXI(VAR Status: StatusType
2866 7B4E ;VAR Target: FileType
2867 7B4E ;VAR LogFile: LogFileType
2868 7B4E );
2869 7B4E
2870 7B4E LABEL
2871 7B4E 1;
2872 7B4E
2873 7B4E VAR
2874 7B4E ModuleName: ModuleNameType;
2875 7B4E SymbolName: SymbolNameType;
2876 7B4E ExiInx1: ExternalImportTableIndexType;
2877 7B4E ExiInx: ExternalImportTableIndexType;
2878 7B4E
2879 7B4E (* TargetModuleNo is a global variable *)
2880 7B4E
2881 7B4E BEGIN (*PUTEXI*)
2882 7B4E NooExiSymbols := 0;
2883 7B68
2884 7B68 ExiInx1 := 1;
2885 7B71 FOR ExiInx1 := 1 TO CurExternalImportSymbolNo DO
2886 7B8B BEGIN
2887 7B90 (*#B#*)
2888 7B90 IF test((.0,7.)) THEN
2889 7BA7 BEGIN
2890 7BAC write(TestOut, 'PUTEXI-1 ');
2891 7BD4 TSTeit(ExiInx1);
2892 7BE3 END;
2893 7BE3 (*#E#*)
2894 7BE3 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2895 7BF6 .).SegmentNo = UnResolved) THEN
2896 7C0E GOTO 1;
2897 7C16 END;
2898 7C20
2899 7C20 1: IF (CurExternalImportSymbolNo > 0) THEN
2900 7C31 IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
2901 7C44 .).SegmentNo = UnResolved) THEN
2902 7C5C BEGIN
2903 7C61 LogHurs(LogFile);
2904 7C70 FOR ExiInx := ExiInx1 TO CurExternalImportSymbolNo DO
2905 7C8B BEGIN
2906 7C90 (*#B#*)
2907 7C90 IF test((.0,7.)) THEN
2908 7CA7 BEGIN
2909 7CAC write(TestOut, 'PUTEXI-2 ');
2910 7CD4 TSTeit(ExiInx);
2911 7CE3 END;
2912 7CE3 (*#E#*)
2913 7CE3 WITH ExternalImportTable(.ExiInx.) DO
2914 7CFC WITH ValueTable(.SymbolNo.),
2915 7D19 SymbolTable(.SymbolNo.) DO
2916 7D37 IF SegmentNo = UnResolved THEN
2917 7D48 BEGIN
2918 7D4D NooExiSymbols := NooExiSymbols + 1;
2919 7D63 Value := NooExiSymbols;
2920 7D7A NMTG(NameReference, SymbolName);
2921 7D9D FPsym(Target, SymbolName);
2922 7DB4 NMTG(SymbolTable(.
2923 7DB9 ModuleTable(.ModuleNo
2924 7DB9 .).ModuleNameReference
2925 7DD1 .).NameReference
2926 7DE3 ,ModuleName
2927 7DEC );
2928 7DFB LogURS(LogFile, ModuleName, SymbolName);
2929 7E1A (*#B#*)
2930 7E1A IF test((.0,16,19.)) THEN
2931 7E34 BEGIN
2932 7E39 writeln(TestOut, 'PutEXI '
2933 7E54 , 'SymbolNo=', SymbolNo:1
2934 7E83 , ' ':2, 'Value=', Value:1);
2935 7EBA END;
2936 7EBA (*#E#*)
2937 7EBA END;
2938 7EBA
2939 7EBA END;
2940 7EC4 END;
2941 7EC4 END; (*PUTEXI*)
2942 7ECA
2943 7ECA (* TargetModuleNo is a global variable *)
2944 7ECA
2945 7ECA BEGIN (*PUTMODULE*)
2946 7ECA MDTA(Status, TargetModuleNo, 1);
2947 7EE8 IF not (ModuleTableOverFlow IN Status) THEN
2948 7F03 BEGIN
2949 7F08 PutMF(TargetFile);
2950 7F17 PutINX(Status, TargetFile, LogFile);
2951 7F38 IF Status = (..) THEN
2952 7F51 BEGIN (*Calculate memory map, write sgd, and log*)
2953 7F56 PutSGDs(Status, TargetFile, LogFile);
2954 7F77
2955 7F77 IF not (SectionTableOverFlow IN Status) THEN
2956 7F92 BEGIN (*Relocate symbol table, write export list, and log*)
2957 7F97 PutEXP(Status, TargetFile, LogFile);
2958 7FB8 IF Status = (..) THEN
2959 7FD1 BEGIN (*Write EXI while logging unresolved references*)
2960 7FD6 PutEXI(Status, TargetFile, LogFile);
2961 7FF7 END;
2962 7FF7 END;
2963 7FF7 END;
2964 7FF7 END;
2965 7FF7 END; (*PUTMODULE*)
2966 7FFD
2967 7FFD BEGIN (*PUTTARGETFILE*)
2968 7FFD PutFF(TargetFile);
2969 8014 PutModule(Status, TargetFile, LogFile);
2970 8035 END; (*PUTTARGETFILE*)
2971 803B
2972 803B (* *)
2973 803B (* *)
2974 803B (******************************************************************************)
2975 803B
2976 803B
2977 803B BEGIN (*PASS1*)
2978 803B
2979 803B (* Initialize local data structures *)
2980 803B FOR SBTSubInx := 1 TO MaxNooSymbols DO
2981 8056 SymbolTable(.SBTSubInx.).NameReference := 0;
2982 807C LatestInsert := 0;
2983 808E CurrentSymbolCount := 0;
2984 80A0 CurrentNameTableIndex := 0;
2985 80AE
2986 80AE GetInputFiles(Status, LogFile);
2987 80DA IF Status = (..) THEN
2988 80FC BEGIN
2989 8101 PutTargetFile(Status, TargetFile, LogFile);
2990 813D END;
2991 813D END; (*PASS1*)
2992 8143
2993 8143 (* *)
2994 8143 (* *)
2995 8143 (******************************************************************************)
2996 8143
2997 8143 (*$I B:lnkp2.pas Procedure pass2 *)
2998 8143 (******************************************************************************)
2999 8143 (* *)
3000 8143 (* Copyright (1985) by Metanic Aps., Denmark *)
3001 8143 (* *)
3002 8143 (* Author: Lars Gregers Jakobsen. *)
3003 8143 (* *)
3004 8143 (******************************************************************************)
3005 8143
3006 8143 PROCEDURE Pass2(VAR Status: StatusType
3007 8143 ;VAR TargetFile: FileType
3008 8143 ;VAR LogFile: LogFileType
3009 8143 );
3010 8143
3011 8143 LABEL
3012 8143 999;
3013 8143
3014 8143 VAR
3015 8143 SegmentInx: SegmentNoType;
3016 8143 ModuleInx: ModuleTableIndexType;
3017 8143 Crid: BitMappedFileType; (*Composite relocation import directory*)
3018 8143 Covr: FileType; (*Composite overrun store*)
3019 8143
3020 8143 (*#B#*)
3021 8143 (*$I B:LNKDF5.PAS Bit Map Buffer Test Output *)
3022 8143 (******************************************************************************)
3023 8143 (* *)
3024 8143 (* Copyright (1985) by Metanic Aps., Denmark *)
3025 8143 (* *)
3026 8143 (* Author: Lars Gregers Jakobsen. *)
3027 8143 (* *)
3028 8143 (******************************************************************************)
3029 8143
3030 8143 PROCEDURE TSTbmb(Bmb: BitMapBufferType
3031 8143 );
3032 8143
3033 8143 VAR
3034 8143 I: 0..15;
3035 8143
3036 8143 BEGIN (*TSTBMB*)
3037 8143 write(TestOut, 'Y1,Y0,I,P= ', Bmb.Y1:3, ' ', Bmb.Y0:3, ' ');
3038 81BA FOR I := 15 DOWNTO 8 DO
3039 81CB IF I IN Bmb.I THEN
3040 81E2 write(TestOut, '1')
3041 81FA ELSE
3042 8200 write(TestOut, '0');
3043 8225 write(TestOut, ' ');
3044 8240 FOR I := 7 DOWNTO 0 DO
3045 8251 IF I IN Bmb.I THEN
3046 8268 write(TestOut, '1')
3047 8280 ELSE
3048 8286 write(TestOut, '0');
3049 82AB write(TestOut, ' ', Bmb.P:3, ' ');
3050 82E7 END; (*TSTBMB*)
3051 82ED
3052 82ED (* *)
3053 82ED (* *)
3054 82ED (******************************************************************************)
3055 82ED
3056 82ED (*$I B:LNKDF6.PAS Bit Map Access Primitives *)
3057 82ED (******************************************************************************)
3058 82ED (* *)
3059 82ED (* Copyright (1985) by Metanic Aps., Denmark *)
3060 82ED (* *)
3061 82ED (* Author: Lars Gregers Jakobsen. *)
3062 82ED (* *)
3063 82ED (******************************************************************************)
3064 82ED
3065 82ED PROCEDURE BMG2(VAR BM: BitMappedFileType
3066 82ED ;VAR Relocatable: boolean
3067 82ED ;VAR Importable: boolean
3068 82ED );
3069 82ED
3070 82ED BEGIN (*BMG2*)
3071 82ED WITH BM, BM.B DO
3072 8314 BEGIN
3073 8319 IF P <= 8 THEN
3074 832A BEGIN
3075 832F read(F, Y1);
3076 835A P := P + 8;
3077 837D END;
3078 837D P := P - 1;
3079 839D Relocatable := P IN I;
3080 83CB P := P - 1;
3081 83EB Importable := P IN I;
3082 8419 (*#B#*)
3083 8419 IF test((.0,4.)) THEN
3084 8430 BEGIN
3085 8435 write(TestOut, 'BMG2 '); TSTbmb(BM.B);
3086 8469 write(TestOut, 'R,I= ');
3087 848D TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
3088 84B4 END;
3089 84B4 (*#E#*)
3090 84B4
3091 84B4 END;
3092 84B4 END; (*BMG2*)
3093 84BA
3094 84BA PROCEDURE BMG6(VAR BM: BitMappedFileType
3095 84BA ;VAR Index:i8
3096 84BA );
3097 84BA
3098 84BA VAR
3099 84BA J: 1..6;
3100 84BA
3101 84BA BEGIN (*BMG6*)
3102 84BA Index := 0;
3103 84CF WITH BM, BM.B DO
3104 84EE BEGIN
3105 84F3 IF P < 14 THEN
3106 8501 BEGIN
3107 8506 read(F, Y0);
3108 8530 FOR J := 1 TO 6 DO
3109 8541 Index := Index + Index + ord( (P-J) IN I );
3110 85AC Y1 := Y0;
3111 85C4 P := P + 2; (* = P - 6 + 8 *)
3112 85E7 END
3113 85E7 ELSE
3114 85EA BEGIN
3115 85EF FOR J := 1 TO 6 DO
3116 8600 Index := Index + Index + ord( (P-J) IN I );
3117 866B P := P - 6;
3118 868E END;
3119 868E (*#B#*)
3120 868E IF test((.0,4.)) THEN
3121 86A5 BEGIN
3122 86AA write(TestOut, 'BMG6 '); TSTbmb(BM.B);
3123 86DE writeln(TestOut, 'Index= ',Index:1);
3124 8717 END;
3125 8717 (*#E#*)
3126 8717 END;
3127 8717 END; (*BMG6*)
3128 871D
3129 871D PROCEDURE BMP2(VAR BM: BitMappedFileType
3130 871D ; Relocatable: boolean
3131 871D ; Importable: boolean
3132 871D );
3133 871D
3134 871D BEGIN (*BMP2*)
3135 871D WITH BM, BM.B DO
3136 8744 BEGIN
3137 8749 P := P - 1;
3138 8763 IF Relocatable THEN
3139 876F I := I + (.P.);
3140 87A7 P := P - 1;
3141 87C7 IF Importable THEN
3142 87D3 I := I + (.P.);
3143 880B IF P <= 8 THEN (* always >= 8 *)
3144 8822 BEGIN
3145 8827 write(F, Y1);
3146 8852 Y1 := 0;
3147 8861 P := 16 (* = P + 8 *)
3148 886C END;
3149 886E (*#B#*)
3150 886E IF test((.0,4.)) THEN
3151 8885 BEGIN
3152 888A write(TestOut, 'BMP2 '); TSTbmb(BM.B);
3153 88BE write(TestOut, 'R,I= ');
3154 88E2 TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
3155 8901 END;
3156 8901 (*#E#*)
3157 8901 END
3158 8901 END; (*BMP2*)
3159 8907
3160 8907 PROCEDURE BMP6(VAR BM: BitMappedFileType
3161 8907 ; Index:i8
3162 8907 );
3163 8907
3164 8907 VAR
3165 8907 J: 0..5;
3166 8907
3167 8907 BEGIN (*BMP6*)
3168 8907 WITH BM, BM.B DO
3169 892E BEGIN
3170 8933 P := P - 6;
3171 8950 FOR J := 0 TO 5 DO
3172 8961 BEGIN
3173 8966 IF odd(Index) THEN
3174 8974 I := I + (.P+J.);
3175 89B6 Index := Index div 2
3176 89BB END;
3177 89CD (*#B#*)
3178 89CD IF test((.0,4.)) THEN
3179 89E4 BEGIN
3180 89E9 write(TestOut, 'BMP6 '); TSTbmb(BM.B);
3181 8A1D writeln(TestOut, 'Index= ', Index:1);
3182 8A52 END;
3183 8A52 (*#E#*)
3184 8A52 IF P <= 8 THEN
3185 8A69 BEGIN
3186 8A6E write(F, Y1);
3187 8A99 Y1 := Y0;
3188 8AB1 Y0 := 0;
3189 8ABF P := P + 8;
3190 8AE2 END;
3191 8AE2 END;
3192 8AE2 END; (*BMP6*)
3193 8AE8
3194 8AE8 (* *)
3195 8AE8 (* *)
3196 8AE8 (******************************************************************************)
3197 8AE8
3198 8AE8
3199 8AE8 PROCEDURE LinkSection(VAR Status: StatusType
3200 8AE8 ;VAR TargetFile: FileType
3201 8AE8 ;VAR LogFile: LogFileType
3202 8AE8 ;VAR Crid: BitMappedFileType
3203 8AE8 ;VAR Covr: FileType
3204 8AE8 ;VAR SCTrec: SectionTableRecordType
3205 8AE8 ;VAR MDTrec: ModuleTableRecordType
3206 8AE8 );
3207 8AE8
3208 8AE8 LABEL
3209 8AE8 99;
3210 8AE8
3211 8AE8 VAR
3212 8AE8 Oimg: FileType;
3213 8AE8 Orid: BitMappedFileType;
3214 8AE8 Oovr: FileType;
3215 8AE8 ImageUnit: ImageUnitType;
3216 8AE8 QuadImageUnit: QuadImageUnitType;
3217 8AE8 Relocatable: boolean;
3218 8AE8 Importable: boolean;
3219 8AE8 Index: i8;
3220 8AE8 Address: FileAddressType; (*relative to current obj. section*)
3221 8AE8 LocalImageSize: FileAddressType;
3222 8AE8 OvrIndex: QuadImageUnitType;
3223 8AE8
3224 8AE8
3225 8AE8 BEGIN (*LINKSECTION*)
3226 8AE8 WITH MDTrec, SCTrec DO
3227 8B0D BEGIN
3228 8B12 IF ImageSize > 0 THEN
3229 8B2A BEGIN
3230 8B2F FilAsg(Oimg, FileNameTable(.FileNameReference.));
3231 8B60 FilRst(Status, Oimg);
3232 8B77 FilSeek(Status, Oimg, CurrentFileAddress);
3233 8B9E CurrentFileAddress := CurrentFileAddress + ImageSize * ImageFactor;
3234 8BD8
3235 8BD8 WITH Orid DO
3236 8BDD BEGIN
3237 8BE2 assign(F, FileNameTable(.FileNameReference.));
3238 8C12 reset(F);
3239 8C26 seek(F, CurrentFileAddress);
3240 8C42 WITH B DO
3241 8C54 BEGIN
3242 8C59 P := 16;
3243 8C60 I := (..);
3244 8C78 read(F, Y1);
3245 8C9F END;
3246 8C9F END;
3247 8C9F CurrentFileAddress := CurrentFileAddress + ImageSize;
3248 8CCE
3249 8CCE IF OvrSize > 0 THEN
3250 8CEE BEGIN
3251 8CF3 FilAsg(Oovr, FileNameTable(.FileNameReference.));
3252 8D24 FilRst(Status, Oovr);
3253 8D3B FilSeek(Status, Oovr, CurrentFileAddress);
3254 8D62 CurrentFileAddress := CurrentFileAddress + OvrSize;
3255 8D93 END
3256 8D93 ELSE
3257 8D96 Oovr.P := CurrentFileAddress;
3258 8DAD
3259 8DAD (*CurrentFileAddress now reflects starting position of
3260 8DAD next section in file if any*)
3261 8DAD
3262 8DAD Address := 0;
3263 8DBC LocalImageSize := (ImageSize - 1) * ImageFactor;
3264 8DE1 WHILE (Address <= LocalImageSize) and (Status = (..)) DO
3265 8E12 BEGIN
3266 8E17 BMG2(Orid, Relocatable, Importable);
3267 8E37 IF Relocatable <> Importable THEN
3268 8E45 BEGIN
3269 8E4A BMG6(Orid, Index);
3270 8E62 FGi32(Status, Oimg, QuadImageUnit);
3271 8E81 IF Relocatable THEN
3272 8E8D (* Relocate *)
3273 8E8D IF Index IN (.1..NooSegments.) THEN
3274 8EBB WITH SectionTable(.SCTBase + Index.) DO
3275 8EF2 QuadImageUnit := QuadImageUnit + RelocationConstant
3276 8EFB ELSE
3277 8F14 Status := Status + (.BadRelocationCode.)
3278 8F2A ELSE
3279 8F3E (* Import *)
3280 8F3E BEGIN (*IMPORT*)
3281 8F43 IF Index = OvrCode THEN
3282 8F4F IF Oovr.P < CurrentFileAddress - 3 THEN
3283 8F76 FGi32(Status, Oovr, OvrIndex)
3284 8F92 ELSE
3285 8F98 Status := Status + (.UnexpectedEof.)
3286 8FAE ELSE
3287 8FC1 OvrIndex := Index;
3288 8FD1 IF OvrIndex IN (.1..NooExternalImportSymbols.) THEN
3289 9001 WITH ValueTable(.ExternalImportTable(.EITOffset + OvrIndex
3290 900C .).SymbolNo
3291 9032 .) DO
3292 904A IF SegmentNo > UnResolved THEN
3293 905B BEGIN
3294 9060 QuadImageUnit := QuadImageUnit + Value; (*?* + ? *)
3295 907C Importable := false;
3296 9085 Relocatable := SegmentNo > 0;
3297 90A2 Index := SegmentNo;
3298 90B5 END
3299 90B5 ELSE
3300 90B8 IF Value IN (.0..63.) THEN
3301 90DB Index := Value
3302 90E0 ELSE
3303 90F7 BEGIN
3304 90FC Index := OvrCode;
3305 9105 FPi32(Covr, Value);
3306 9120 END
3307 9120 ELSE
3308 9123 Status := Status + (.BadImportCode.)
3309 9139 END; (*IMPORT*)
3310 914A FPi32(TargetFile, QuadImageUnit);
3311 915F BMP2(Crid, Relocatable, Importable);
3312 917C BMP6(Crid, Index);
3313 918F Address := Address + ImageFactor;
3314 91AA END
3315 91AA ELSE
3316 91AD IF Relocatable THEN
3317 91B9 BEGIN
3318 91BE Status := Status + (.Baddibit.);
3319 91E5 GOTO 99; (*EXIT procedure*)
3320 91ED END
3321 91ED ELSE
3322 91F0 BEGIN
3323 91F5 FGi8(Status, Oimg, ImageUnit);
3324 9214 FPi8(TargetFile, ImageUnit);
3325 9227 BMP2(Crid, Relocatable, Importable);
3326 9244 Address := Address + 1;
3327 9257 END;
3328 9257 END;
3329 925A LocalImageSize := ImageSize * ImageFactor;
3330 927C WHILE (Address < LocalImageSize) and (Status = (..)) DO
3331 92AD BEGIN
3332 92B2 BMG2(Orid, Relocatable, Importable);
3333 92D2 IF Relocatable or Importable THEN
3334 92E1 BEGIN
3335 92E6 Status := Status + (.Baddibit.);
3336 930D GOTO 99; (*EXIT procedure*)
3337 9315 END
3338 9315 ELSE
3339 9318 BEGIN
3340 931D FGi8(Status, Oimg, ImageUnit);
3341 933C FPi8(TargetFile, ImageUnit);
3342 934F BMP2(Crid, Relocatable, Importable);
3343 936C Address := Address + 1;
3344 937F END;
3345 937F END;
3346 9382 END; (* IF ImageSize > 0 THEN *)
3347 9382 99: END; (* WITH MDTrec, SCTrec DO *)
3348 9382 END; (*LINKSECTION*)
3349 938B
3350 938B PROCEDURE CopyBuffer(VAR Status: StatusType
3351 938B ;VAR Buffer: BasicFileType
3352 938B ;VAR TargetFile: FileType
3353 938B ;VAR Size: FileAddressType
3354 938B );
3355 938B
3356 938B VAR
3357 938B Item: i8;
3358 938B Start: FileAddressType;
3359 938B
3360 938B BEGIN (*COPYBUFFER*)
3361 938B reset(Buffer);
3362 93A6 Start := TargetFile.P;
3363 93BD WHILE not eof(Buffer) DO
3364 93D6 BEGIN
3365 93DB read(Buffer, Item);
3366 93FE FPi8(TargetFile, Item); (*Advancing TargetFile.P*)
3367 9411 END;
3368 9414 Size := TargetFile.P - Start;
3369 943A (*#B#*)
3370 943A IF test((.0,20.)) THEN
3371 9454 BEGIN
3372 9459 writeln(TestOut, 'CPYBUF ', 'Start= ', Start:1
3373 9498 , ' End= ', TargetFile.P:1
3374 94BE , ' Size= ', Size:1
3375 94E3 );
3376 94EC END;
3377 94EC (*#E#*)
3378 94EC END; (*COPYBUFFER*)
3379 94F2
3380 94F2 PROCEDURE UPDINX(VAR Status: StatusType
3381 94F2 VAR TargetFile: FileType
3382 94F2 );
3383 94F2
3384 94F2 VAR
3385 94F2 ModuleSize: i32;
3386 94F2 ModuleName: ModuleNameType;
3387 94F2 SegmentInx: SegmentNoType;
3388 94F2
3389 94F2 BEGIN (*UPDINX*)
3390 94F2 ModuleSize := TargetFile.P - OMF_Address;
3391 9519 update(TargetFile.F);
3392 952C FilSeek(Status, TargetFile, OMH_Address);
3393 954A IF Status = (..) THEN
3394 9563 BEGIN
3395 9568 FPi32(TargetFile, ModuleSize);
3396 957D FPi32(TargetFile, CurSegmentCount);
3397 9597 FPi32(TargetFile, NooExpSymbols);
3398 95AF FPi32(TargetFile, NooExiSymbols);
3399 95C7 FGsym(Status, TargetFile, ModuleName); (*skip past name*)
3400 95E5 IF Status = (..) THEN
3401 95FE FOR SegmentInx := 1 TO CurSegmentCount DO
3402 9618 WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3403 9646 BEGIN
3404 964B FPi32(TargetFile, ImageSize);
3405 9667 FPi32(TargetFile, OvrSize);
3406 9685 END;
3407 968F END;
3408 968F END; (*UPDINX*)
3409 9695
3410 9695 BEGIN (*PASS2*)
3411 9695 FOR SegmentInx := 1 TO CurSegmentCount DO
3412 96B7 BEGIN
3413 96BC WITH Crid DO
3414 96C1 BEGIN
3415 96C6 rewrite(F);
3416 96DA WITH B DO
3417 96EC BEGIN
3418 96F1 P := 16;
3419 96F8 I := (..)
3420 9705 END
3421 9710 END;
3422 9710 FilRwt(Covr);
3423 9720 FOR ModuleInx := 1 TO TargetModuleNo - 1 DO
3424 9747 BEGIN
3425 974C (*#B#*)
3426 974C IF test((.0,20.)) THEN
3427 9766 BEGIN
3428 976B write(TestOut, 'Pass-2 '); TSTstat(Status); TSTindt;
3429 97AA writeln(TestOut, 'SgmInx= ', SegmentInx:1
3430 97D9 , ' MdlInx= ', ModuleInx:1
3431 9800 );
3432 9809 TSTindt; TSTindt; TSTindt;
3433 9817 TSTmdt(ModuleInx);
3434 9826 TSTindt; TSTindt; TSTindt;
3435 9834 TSTsct(ModuleTable(.ModuleInx.).SCTBase + SegmentInx);
3436 986A END;
3437 986A (*#E#*)
3438 986A IF (SectionTable(.ModuleTable(.ModuleInx
3439 986F .).SCTBase + SegmentInx
3440 9883 .).ModuleNo = ModuleInx) THEN
3441 98B1 BEGIN
3442 98B6 LinkSection(Status, TargetFile, LogFile, Crid, Covr
3443 98D8 ,SectionTable(.ModuleTable(.ModuleInx
3444 98E0 .).SCTBase + SegmentInx
3445 98F4 .)
3446 991B ,ModuleTable(.ModuleInx.)
3447 9930 );
3448 9934 IF Status <> (..) THEN
3449 994D GOTO 999; (************* EXIT BOTH FOR LOOPS **************)
3450 9955 END;
3451 9955 END;
3452 995F WITH SectionTable(.TargetSectionOffset + SegmentInx.) DO
3453 998D BEGIN
3454 9992 CopyBuffer(Status, Crid.F, TargetFile, ImageSize);
3455 99B9 CopyBuffer(Status, Covr.F, TargetFile, OvrSize);
3456 99E2 END;
3457 99E2 END;
3458 99EC 999:
3459 99EC (*backpatch info to target.inx*)
3460 99EC UPDINX(Status, TargetFile);
3461 9A02
3462 9A02 END; (*PASS2*)
3463 9A0B
3464 9A0B (* *)
3465 9A0B (* *)
3466 9A0B (******************************************************************************)
3467 9A0B
3468 9A0B
3469 9A0B
3470 9A0B BEGIN (*LINK*)
3471 9A0B (*#B#*)
3472 9A0B TestInit(Input,Output);
3473 9A24 (*#E#*)
3474 9A24 Status := (..);
3475 9A38 Optiontable.LogFileKind := None;
3476 9A42 OptionTable.TargetFileKind := Implicit;
3477 9A4C CurFileNo := 0;
3478 9A56 CurModuleNo := 0;
3479 9A60 FOR SCTSubInx := 1 TO MaxNooSections DO
3480 9A72 SectionTable(.SCTSubInx.).SegmentNo := 0;
3481 9A96 SCTOffset := 0;
3482 9AA0 CurSegmentCount := 0;
3483 9AAA CurExternalImportSymbolNo := 0;
3484 9AB4
3485 9AB4 SetUp(Status, TargetFile, LogFile, Output);
3486 9ACC (*#B#*)
3487 9ACC IF test((.0,16,17.)) THEN
3488 9AE6 BEGIN
3489 9AEB write(TestOut, 'Link-MAIN-1 '); TSTstat(Status); TSTindt; TSTmem; TSTln
3490 9B2F END;
3491 9B32 (*#E#*)
3492 9B32 IF Status = (..) THEN
3493 9B48 Pass1(Status, TargetFile, LogFile);
3494 9B5C (*#B#*)
3495 9B5C IF test((.0,16,17.)) THEN
3496 9B76 BEGIN
3497 9B7B write(TestOut, 'Link-MAIN-2 '); TSTstat(Status); TSTln
3498 9BB9 END;
3499 9BBC (*#E#*)
3500 9BBC IF Status = (..) THEN
3501 9BD2 Pass2(Status, TargetFile, LogFile);
3502 9BE6 (*#B#*)
3503 9BE6 IF test((.0,16,17.)) THEN
3504 9C00 BEGIN
3505 9C05 write(TestOut, 'Link-MAIN-3 '); TSTstat(Status); TSTln
3506 9C43 END;
3507 9C46 (*#E#*)
3508 9C46 IF Status = (..) THEN
3509 9C5C BEGIN
3510 9C61 writeln(output, 'LINK -- Normal termination')
3511 9C97 END
3512 9C9A ELSE
3513 9C9D BEGIN
3514 9CA2 writeln(output, 'LINK -- Abnormal termination.');
3515 9CDE
3516 9CDE IF BadOption IN Status THEN
3517 9CF3 writeln(output, 'Bad option');
3518 9D1C IF BadLogFileName IN Status THEN
3519 9D31 writeln(output, 'Bad log file name');
3520 9D61 IF BadTargetFileName IN Status THEN
3521 9D76 writeln(output, 'Bad target file name');
3522 9DA9 IF BadFileName IN Status THEN
3523 9DBE writeln(output, 'Bad file name');
3524 9DEA IF NoSuchFile IN Status THEN
3525 9DFF writeln(output, 'No such file');
3526 9E2A IF NoInputFiles IN Status THEN
3527 9E3F writeln(output, 'No input files');
3528 9E6C IF ExtraText IN Status THEN
3529 9E81 writeln(output, 'Extra text');
3530 9EAA IF BadFileFormat IN Status THEN
3531 9EBF writeln(output, 'Bad file format');
3532 9EED IF BadModuleFormat IN Status THEN
3533 9F02 writeln(output, 'Bad module format');
3534 9F32 IF UnexpectedEof IN Status THEN
3535 9F47 writeln(output, 'Unexpected EOF');
3536 9F74 IF RangeError IN Status THEN
3537 9F89 writeln(output, 'Range error');
3538 9FB3 IF BadSymbolName IN Status THEN
3539 9FC8 writeln(output, 'Bad symbol name');
3540 9FF6 IF DuplicateModuleName IN Status THEN
3541 A00B writeln(output, 'Duplicate module name');
3542 A03F IF DuplicateExportSymbol IN Status THEN
3543 A054 writeln(output, 'Duplicate export symbol');
3544 A08A IF NoInput IN Status THEN
3545 A09F writeln(output, 'No input');
3546 A0C6 IF Baddibit IN Status THEN
3547 A0DB writeln(output, 'Bad dibit');
3548 A103 IF BadRelocationCode IN Status THEN
3549 A118 writeln(output, 'Bad relocation code');
3550 A14A IF BadImportCode IN Status THEN
3551 A15F writeln(output, 'Bad import code');
3552 A18D IF NameTableOverFlow IN Status THEN
3553 A1A2 writeln(output, 'Name table overflow');
3554 A1D4 IF ModuleTableOverFlow IN Status THEN
3555 A1E9 writeln(output, 'Module table overflow');
3556 A21D IF SectionTableOverFlow IN Status THEN
3557 A232 writeln(output, 'Section table overflow');
3558 A267 IF FileNameTableOverFlow IN Status THEN
3559 A27C writeln(output, 'File name table overflow');
3560 A2B3 IF SymbolTableOverFlow IN Status THEN
3561 A2C8 writeln(output, 'Symbol table overflow');
3562 A2FC IF ExternalImportTableOverFlow IN Status THEN
3563 A311 writeln(output, 'External import table overflow');
3564 A34E
3565 A34E IF not (NoTarget IN Status) THEN
3566 A363 erase(TargetFile.F);
3567 A36F END
3568 A36F END.
«eof»