|
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: 14848 (0x3a00)
Types: TextFile
Names: »LNKP2.PAS«
└─⟦3d1e6965e⟧ Bits:30009789/_.ft.Ibm2.50007347.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP2.PAS«
(******************************************************************************)
(* *)
(* Copyright (1985) by Metanic Aps., Denmark *)
(* *)
(* Author: Lars Gregers Jakobsen. *)
(* *)
(******************************************************************************)
PROCEDURE Pass2(VAR Status: StatusType
;VAR TargetFile: FileType
;VAR LogFile: LogFileType
);
LABEL
999;
TYPE
BitMapBufferTagType = (bit, byt);
BitMapBufferType = RECORD
P: 0..16;
CASE BitMapBufferTagType OF
bit: (I: SET OF 0..15);
byt: (Y0: i8;
Y1: i8
)
END;
BitMappedFileType = RECORD
F: BasicFileType;
B: BitMapBufferType
END;
VAR
SegmentInx: SegmentNoType;
ModuleInx: ModuleTableIndexType;
Crid: BitMappedFileType; (*Composite relocation import directory*)
Covr: FileType; (*Composite overrun store*)
PROCEDURE TSTbmb(Bmb: BitMapBufferType
);
VAR
I: 0..15;
BEGIN (*TSTBMB*)
write(TestOut, 'Y1,Y0,I,P= ', Bmb.Y1:3, ' ', Bmb.Y0:3, ' ');
FOR I := 15 DOWNTO 8 DO
IF I IN Bmb.I THEN
write(TestOut, '1')
ELSE
write(TestOut, '0');
write(TestOut, ' ');
FOR I := 7 DOWNTO 0 DO
IF I IN Bmb.I THEN
write(TestOut, '1')
ELSE
write(TestOut, '0');
write(TestOut, ' ', Bmb.P:3, ' ');
END; (*TSTBMB*)
PROCEDURE BMG2(VAR BM: BitMappedFileType
;VAR Relocatable: boolean
;VAR Importable: boolean
);
BEGIN (*BMG2*)
WITH BM, BM.B DO
BEGIN
IF P <= 8 THEN
BEGIN
read(F, Y1);
P := P + 8;
END;
P := P - 1;
Relocatable := P IN I;
P := P - 1;
Importable := P IN I;
IF test((.0,4.)) THEN
BEGIN
write(TestOut, 'BMG2 '); TSTbmb(BM.B);
write(TestOut, 'R,I= ');
TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
END;
END;
END; (*BMG2*)
PROCEDURE BMG6(VAR BM: BitMappedFileType
;VAR Index:i8
);
VAR
J: 1..6;
BEGIN (*BMG6*)
Index := 0;
WITH BM, BM.B DO
BEGIN
IF P < 14 THEN
BEGIN
read(F, Y0);
FOR J := 1 TO 6 DO
Index := Index + Index + ord( (P-J) IN I );
Y1 := Y0;
P := P + 2; (* = P - 6 + 8 *)
END
ELSE
BEGIN
FOR J := 1 TO 6 DO
Index := Index + Index + ord( (P-J) IN I );
P := P - 6;
END;
IF test((.0,4.)) THEN
BEGIN
write(TestOut, 'BMG6 '); TSTbmb(BM.B);
writeln(TestOut, 'Index= ',Index:1);
END;
END;
END; (*BMG6*)
PROCEDURE BMP2(VAR BM: BitMappedFileType
; Relocatable: boolean
; Importable: boolean
);
BEGIN (*BMP2*)
WITH BM, BM.B DO
BEGIN
P := P - 1;
IF Relocatable THEN
I := I + (.P.);
P := P - 1;
IF Importable THEN
I := I + (.P.);
IF P <= 8 THEN (* always >= 8 *)
BEGIN
write(F, Y1);
P := 16 (* = P + 8 *)
END;
IF test((.0,4.)) THEN
BEGIN
write(TestOut, 'BMP2 '); TSTbmb(BM.B);
write(TestOut, 'R,I= ');
TSTbool(Relocatable); TSTindt; TSTbool(Importable); TSTln;
END;
END
END; (*BMP2*)
PROCEDURE BMP6(VAR BM: BitMappedFileType
; Index:i8
);
VAR
J: 0..5;
BEGIN (*BMP6*)
WITH BM, BM.B DO
BEGIN
P := P - 6;
FOR J := 0 TO 5 DO
BEGIN
IF odd(Index) THEN
I := I + (.P+J.);
Index := Index div 2
END;
IF test((.0,4.)) THEN
BEGIN
write(TestOut, 'BMP6 '); TSTbmb(BM.B);
writeln(TestOut, 'Index= ', Index:1);
END;
IF P <= 8 THEN
BEGIN
write(F, Y1);
Y1 := Y0;
P := P + 8;
END;
END;
END; (*BMP6*)
PROCEDURE LinkSection(VAR Status: StatusType
;VAR TargetFile: FileType
;VAR LogFile: LogFileType
;VAR Crid: BitMappedFileType
;VAR Covr: FileType
;VAR SCTrec: SectionTableRecordType
;VAR MDTrec: ModuleTableRecordType
);
LABEL
99;
CONST
OvrCode = 0;
AllAbsCode = 0;
VAR
Oimg: FileType;
Orid: BitMappedFileType;
Oovr: FileType;
ImageUnit: ImageUnitType;
QuadImageUnit: QuadImageUnitType;
Relocatable: boolean;
Importable: boolean;
Index: i8;
Address: FileAddressType; (*relative to current obj. section*)
LocalImageSize: FileAddressType;
OvrIndex: QuadImageUnitType;
BEGIN (*LINKSECTION*)
WITH MDTrec, SCTrec DO
BEGIN
IF ImageSize > 0 THEN
BEGIN
FilAsg(Oimg, FileNameTable(.FileNameReference.));
FilRst(Status, Oimg);
FilSeek(Status, Oimg, CurrentFileAddress);
CurrentFileAddress := CurrentFileAddress + ImageSize * 4;
WITH Orid DO
BEGIN
assign(F, FileNameTable(.FileNameReference.));
reset(F);
seek(F, CurrentFileAddress);
WITH B DO
BEGIN
P := 16;
I := (..);
read(F, Y1);
END;
END;
CurrentFileAddress := CurrentFileAddress + ImageSize;
IF OvrSize > 0 THEN
BEGIN
FilAsg(Oovr, FileNameTable(.FileNameReference.));
FilRst(Status, Oovr);
FilSeek(Status, Oovr, CurrentFileAddress);
CurrentFileAddress := CurrentFileAddress + OvrSize;
END
ELSE
Oovr.P := CurrentFileAddress;
(*CurrentFileAddress now reflects starting position of
next section in file if any*)
Address := 0;
LocalImageSize := (ImageSize - 1) * 4;
WHILE (Address <= LocalImageSize) and (Status = (..)) DO
BEGIN
BMG2(Orid, Relocatable, Importable);
IF Relocatable <> Importable THEN
BEGIN
BMG6(Orid, Index);
FGi32(Status, Oimg, QuadImageUnit);
IF Relocatable THEN
(* Relocate *)
IF Index IN (.1..NooSegments.) THEN
WITH SectionTable(.SCTBase + Index.) DO
QuadImageUnit := QuadImageUnit + RelocationConstant
ELSE
Status := Status + (.BadRelocationCode.)
ELSE
(* Import *)
BEGIN (*IMPORT*)
IF Index = OvrCode THEN
IF Oovr.P < CurrentFileAddress - 3 THEN
FGi32(Status, Oovr, OvrIndex)
ELSE
Status := Status + (.UnexpectedEof.)
ELSE
OvrIndex := Index;
IF OvrIndex IN (.1..NooExternalImportSymbols.) THEN
WITH ValueTable(.ExternalImportTable(.EITOffset + OvrIndex
.).SymbolNo
.) DO
IF resolved THEN
BEGIN
QuadImageUnit := QuadImageUnit + Value; (*?* + ? *)
Importable := false;
Index := AllAbsCode;
END
ELSE
IF Value IN (.0..63.) THEN
Index := Value
ELSE
BEGIN
Index := OvrCode;
FPi32(Covr, Value);
END
ELSE
Status := Status + (.BadImportCode.)
END; (*IMPORT*)
FPi32(TargetFile, QuadImageUnit);
BMP2(Crid, Relocatable, Importable);
BMP6(Crid, Index);
Address := Address + 4;
END
ELSE
IF Relocatable THEN
BEGIN
Status := Status + (.Baddibit.);
GOTO 99; (*EXIT procedure*)
END
ELSE
BEGIN
FGi8(Status, Oimg, ImageUnit);
FPi8(TargetFile, ImageUnit);
BMP2(Crid, Relocatable, Importable);
Address := Address + 1;
END;
END;
LocalImageSize := ImageSize * 4;
WHILE (Address < LocalImageSize) and (Status = (..)) DO
BEGIN
BMG2(Orid, Relocatable, Importable);
IF Relocatable or Importable THEN
BEGIN
Status := Status + (.Baddibit.);
GOTO 99; (*EXIT procedure*)
END
ELSE
BEGIN
FGi8(Status, Oimg, ImageUnit);
FPi8(TargetFile, ImageUnit);
BMP2(Crid, Relocatable, Importable);
Address := Address + 1;
END;
END;
END; (* IF ImageSize > 0 THEN *)
99: END; (* WITH MDTrec, SCTrec DO *)
END; (*LINKSECTION*)
PROCEDURE CopyBuffer(VAR Status: StatusType
;VAR Buffer: BasicFileType
;VAR TargetFile: FileType
;VAR Size: SizeType
);
VAR
Item: i8;
Start: FileAddressType;
BEGIN (*COPYBUFFER*)
reset(Buffer);
Start := TargetFile.P;
WHILE not eof(Buffer) DO
BEGIN
read(Buffer, Item);
FPi8(TargetFile, Item); (*Advancing TargetFile.P*)
END;
Size := TargetFile.P - Start;
IF test((.0,20.)) THEN
BEGIN
writeln(TestOut, 'CPYBUF ', 'Start= ', Start:1
, ' End= ', TargetFile.P:1
, ' Size= ', Size:1
);
END;
END; (*COPYBUFFER*)
PROCEDURE UPDINX(VAR Status: StatusType
);
BEGIN (*UPDINX*)
(* Backpatch both inx and sgd *)
END; (*UPDINX*)
BEGIN (*PASS2*)
FOR SegmentInx := 1 TO CurSegmentCount DO
BEGIN
WITH Crid DO
BEGIN
rewrite(F);
WITH B DO
BEGIN
P := 16;
I := (..)
END
END;
FilRwt(Covr);
FOR ModuleInx := 1 TO TargetModuleNo - 1 DO
BEGIN
IF test((.0,20.)) THEN
BEGIN
write(TestOut, 'Pass-2 '); TSTstat(Status); TSTindt;
writeln(TestOut, 'SgmInx= ', SegmentInx:1
, ' MdlInx= ', ModuleInx:1
);
TSTindt; TSTindt; TSTindt;
TSTmdt(ModuleInx);
TSTindt; TSTindt; TSTindt;
TSTsct(ModuleTable(.ModuleInx.).SCTBase + SegmentInx);
END;
IF (SectionTable(.ModuleTable(.ModuleInx
.).SCTBase + SegmentInx
.).ModuleNo = ModuleInx) THEN
BEGIN
LinkSection(Status, TargetFile, LogFile, Crid, Covr
,SectionTable(.ModuleTable(.ModuleInx
.).SCTBase + SegmentInx
.)
,ModuleTable(.ModuleInx.)
);
IF Status <> (..) THEN
GOTO 999; (************* EXIT BOTH FOR LOOPS **************)
END;
END;
WITH SectionTable(.TargetSectionOffset + SegmentInx - 1.) DO
BEGIN
CopyBuffer(Status, Crid.F, TargetFile, ImageSize);
CopyBuffer(Status, Covr.F, TargetFile, OvrSize);
END;
END;
999:
(*backpatch info to target.inx*)
UPDINX(Status
);
END; (*PASS2*)
«eof»