|
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: 19712 (0x4d00)
Types: TextFile
Names: »LNKP1-2.BAK«
└─⟦dbb5cfece⟧ Bits:30009789/_.ft.Ibm2.50007354.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP1-2.BAK«
(******************************************************************************)
(* *)
(* Copyright (1985) by Metanic Aps., Denmark *)
(* *)
(* Author: Lars Gregers Jakobsen. *)
(* *)
(******************************************************************************)
PROCEDURE PutTargetFile(VAR Status: StatusType
;VAR TargetFile: FileType
;VAR LogFile: LogFileType
);
PROCEDURE PutFF(VAR Fl: FileType
);
BEGIN (*PUTFF*)
FPi32(Fl, OF_Format1);
END; (*OUTFF*)
PROCEDURE PutModule(VAR Status: StatusType
;VAR TargetFile: FileType
;VAR LogFile: LogFileType
);
PROCEDURE PutMF(VAR Fl: FileType
);
BEGIN (*PUTMF*)
FPi32(Fl, OM_Format1);
END; (*OUTMF*)
PROCEDURE PutINX(VAR Status: StatusType
;VAR Fl: FileType
;VAR LogFile: LogFileType
);
VAR
OMH_ModuleName: ModuleNameType;
BEGIN (*PUTINX*)
FPi32(Fl,0); (* OMH_Module *)
FPi32(Fl,0); (* OMH_NooSegments *)
FPi32(Fl,0); (* OMH_NooExportSymbols *)
FPi32(Fl,0); (* OMH_NooExtImportSymbols *)
NMTG(SymbolTable(.ModuleTable(.1.).ModuleNameReference
.).NameReference
, OMH_ModuleName
);
FPsym(Fl, OMH_ModuleName);
END; (*PUTINX*)
PROCEDURE PutSGDs(VAR Status: StatusType
;VAR Fl: Filetype
;VAR LogFile: LogFileType
);
VAR
SRCinx: SectionTableIndexType;
DSTinx: SectionTableIndexType;
ModuleName: ModuleNameType;
PROCEDURE PutSGD(VAR TargetFile: FileType
; Section: SectionTableRecordType
);
BEGIN (*PUTSGD*)
WITH Section DO
BEGIN
FPi32(TargetFile, ImageSize);
FPi32(TargetFile, OvrSize);
END;
END; (*PUTSGD*)
BEGIN (*PUTSGDS*)
Status := (..);
SCTA(Status, TargetSectionOffset, CurSegmentCount);
IF not (SectionTableOverFlow IN Status) THEN
BEGIN
IF CurSegmentCount > 0 THEN
LogHSgd(LogFile);
FOR DSTinx := 1 TO CurSegmentCount DO
WITH SectionTable(.TargetSectionOffset + DSTinx.) DO
BEGIN
ModuleNo := TargetModuleNo;
SegmentNo := DSTinx;
ImageSize := 0; (*TO BE UPDATED*)
OvrSize := 0;
RelocationConstant := 0;
FOR SRCinx := 1 TO TargetSectionOffset DO
IF SectionTable(.SRCinx.).SegmentNo = DSTinx THEN
BEGIN
SectionTable(.SRCinx.).RelocationConstant :=
ImageSize * ImageFactor;
ImageSize := ImageSize +
SectionTable(.SRCinx.).ImageSize;
WITH SectionTable(.SRCinx.) DO (*Log memory map element*)
IF SectionTable(.SRCinx.).ImageSize > 0 THEN
BEGIN
NMTG(SymbolTable(.ModuleTable(.
ModuleNo.).ModuleNameReference
.).Namereference
,ModuleName
);
LogSGD(LogFile
,DSTinx
,RelocationConstant
,ImageSize*ImageFactor
,ModuleName
);
END;
IF test((.0,6,16,19.)) THEN
BEGIN
write(TestOut, 'PutSGDs-1');
TSTsct(SRCinx);
END;
END; (* FOR SRCinx := ... *)
PutSGD(Fl, SectionTable(.TargetSectionOffset +
DSTinx.) );
IF test((.0,6,16,19.)) THEN
BEGIN
write(TestOut, 'PutSGDs-2');
TSTsct(TargetSectionOffset + DSTinx);
END;
END; (* FOR DSTinx := ... *)
END; (* allocation ok *)
END; (*PUTSGDS*)
PROCEDURE PutEXP(VAR Status: StatusType
;VAR Target: FileType
;VAR LogFile: LogFileType
);
VAR
MDTInx: ModuleTableIndexType;
ModuleName: ModuleNameType;
Heap: HeapType;
HeapMax: HeapIndexType;
Winner: SymboltableIndexType;
SymbolNo: SymbolTableIndexType;
EXP_RelocationIndicator: RelocationIndicatorType;
EXP_Item: i32;
EXP_SymbolName: SymbolNameType;
SbtInx: SymbolTableIndexType;
FUNCTION NameSwop(VAR A
, B: SymbolNameType
): boolean;
VAR
I: integer;
BEGIN (*NAMESWOP*)
I := 1;
IF B.Length < A.Length THEN
BEGIN
WHILE (I <= B.Length) and (A.Name(.I.) >= B.Name(.I.)) DO
I := I + 1;
NameSwop := (I > B.Length);
END
ELSE
BEGIN
WHILE (I <= A.Length) and (A.Name(.I.) <= B.Name(.I.)) DO
I := I + 1;
NameSwop := not (I > A.Length);
END;
IF test((.0,13.)) THEN
BEGIN
writeln(TestOut, 'NameSwop ', 'I=', I:1);
TSTindt; TSTindt; TSTindt;
write(TestOut, 'A='); TSTsymbol(A);
TSTindt; TSTindt; TSTindt;
write(TestOut, 'B='); TSTsymbol(B);
END
END; (*NAMESWOP*)
PROCEDURE InHeap( New: SymbolTableIndexType
);
VAR
I,J: integer;
Z,V: SymbolNameType;
Swop: boolean;
BEGIN (*INHEAP*)
HeapMax := HeapMax + 1;
I := HeapMax;
NMTG(SymbolTable(.New.).NameReference, Z);
IF I > 1 THEN
REPEAT
J := I div 2;
NMTG(SymbolTable(. Heap(.J.) .).NameReference, V);
Swop := NameSwop(V,Z);
IF Swop THEN
BEGIN
Heap(.I.) := Heap(.J.);
I := J
END
UNTIL (I <= 1) or ( not Swop );
Heap(.I.) := New;
IF test((.0,13.)) THEN
BEGIN
writeln(TestOut, 'InHeap New=', New:1);
TSTheap(Heap, HeapMax);
END;
END; (*INHEAP*)
PROCEDURE SelectWinner(VAR Status: StatusType
);
VAR
I,J: integer;
Swop: boolean;
V,W,Z: SymbolNameType;
New: SymbolTableIndexType;
BEGIN (*SELECTWINNER*)
IF (0 < HeapMax) THEN
BEGIN
Winner := Heap(.1.);
WITH Symboltable(.Winner.) DO
IF SortLink <> Winner THEN
New := SortLink
ELSE
BEGIN (* Chain exhausted - descrease size of heap *)
New := Heap(.HeapMax.);
HeapMax := HeapMax - 1;
END;
I := 1;
IF HeapMax >= 2 THEN
BEGIN
J := 2;
Heap(.HeapMax + 1.) := New;
NMTG(SymbolTable(.New.).NameReference, Z);
REPEAT
(* J <= HeapMax *)
NMTG(SymbolTable(.Heap(. J .).).NameReference, V);
NMTG(SymbolTable(.Heap(.J+1.).).NameReference, W);
IF NameSwop(V,W) THEN
BEGIN
V := W;
J := J + 1
END;
Swop := NameSwop(Z,V);
IF Swop THEN
BEGIN
Heap(.I.) := Heap(.J.);
I := J;
J := I + I;
END;
IF test((.0,13.)) THEN
BEGIN
write(TestOut, 'SLCT-W-1 ', 'I=' , I:1
, ' ':2 , 'J=' , J:1
, ' ':2 , 'New=', New:1
, ' ':2 , 'Swop='
); TSTbool(Swop); TSTln;
TSTheap(Heap, HeapMax);
END
UNTIL (not Swop) or (J > HeapMax);
END;
Heap(.I.) := New;
END
ELSE
Status := Status + (.HeapEmpty.);
IF test((.0,13,16,19.)) THEN
BEGIN
write(TestOut, 'SLCT-W-2 '); TSTstat(Status); TSTindt;
writeln(TestOut, 'HeapMax=', HeapMax:1
, ' ':2, 'Winner=', Winner:1
);
END;
END; (*SELECTWINNER*)
BEGIN (*PUTEXP*)
IF test((.0,13.)) THEN
BEGIN
writeln(TestOut, 'PUTEXP ');
FOR SbtInx := 1 TO MaxNooSymbols DO
WITH SymbolTable(.SbtInx.), ValueTable(.SbtInx.) DO
IF NameReference <> 0 THEN
BEGIN
TSTindt; TSTindt; TSTindt; TSTsbt(SbtInx);
TSTindt; TSTvlt(SbtInx); TSTln;
END;
END;
(*Initialize selection*)
HeapMax := 0;
FOR MDTInx := 1 TO TargetModuleNo - 1 DO
IF ModuleTable(.MDTInx
.).SBTLinkHead IN (.1..MaxNooSymbols.) THEN
InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
IF HeapMax > 0 THEN
LogHxpN(LogFile);
NooExpSymbols := 0;
WHILE (Status = (..)) DO
BEGIN
SelectWinner(Status);
IF Status = (..) THEN
WITH SymbolTable(.Winner.), ValueTable(.Winner.) DO
IF SegmentNo > UnResolved THEN
BEGIN
NooExpSymbols := NooExpSymbols + 1;
IF (SegmentNo > 0) THEN (*relocatable*)
WITH SectionTable(.ModuleTable(.ModuleNo
.).SCTbase +
SegmentNo
.) DO
BEGIN
Value := Value + RelocationConstant;
END;
EXP_RelocationIndicator := SegmentNo;
EXP_Item := Value;
NMTG(NameReference, EXP_SymbolName);
FPi8(Target, EXP_RelocationIndicator);
FPi32(Target, EXP_Item);
FPsym(Target, EXP_SymbolName);
IF (Status = (..)) and (OPTlfk <> none) THEN
BEGIN
NMTG(SymbolTable(.
ModuleTable(.ModuleNo
.).ModuleNameReference
.).NameReference
,ModuleName
);
LogXP(LogFile
,EXP_RelocationIndicator
,EXP_Item
,EXP_SymbolName
,ModuleName
)
END;
END;
END;
Status := Status - (.HeapEmpty.);
IF (HeapEmpty IN Status) and (OPTlfk <> none) THEN
BEGIN (*sort sbt/vlt by value and log*)
END
END; (*PUTEXP*)
PROCEDURE PutEXI(VAR Status: StatusType
;VAR Target: FileType
;VAR LogFile: LogFileType
);
LABEL
1;
VAR
ModuleName: ModuleNameType;
SymbolName: SymbolNameType;
ExiInx1: ExternalImportTableIndexType;
ExiInx: ExternalImportTableIndexType;
(* TargetModuleNo is a global variable *)
BEGIN (*PUTEXI*)
NooExiSymbols := 0;
ExiInx1 := 1;
FOR ExiInx1 := 1 TO CurExternalImportSymbolNo DO
BEGIN
IF test((.0,7.)) THEN
BEGIN
write(TestOut, 'PUTEXI-1 ');
TSTeit(ExiInx1);
END;
IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
.).SegmentNo = UnResolved) THEN
GOTO 1;
END;
1: IF (CurExternalImportSymbolNo > 0) THEN
IF (ValueTable(.ExternalImportTable(.ExiInx1.).SymbolNo
.).SegmentNo = UnResolved) THEN
BEGIN
LogHurs(LogFile);
FOR ExiInx := ExiInx1 TO CurExternalImportSymbolNo DO
BEGIN
IF test((.0,7.)) THEN
BEGIN
write(TestOut, 'PUTEXI-2 ');
TSTeit(ExiInx);
END;
WITH ExternalImportTable(.ExiInx.) DO
WITH ValueTable(.SymbolNo.),
SymbolTable(.SymbolNo.) DO
IF SegmentNo = UnResolved THEN
BEGIN
NooExiSymbols := NooExiSymbols + 1;
Value := NooExiSymbols;
NMTG(NameReference, SymbolName);
FPsym(Target, SymbolName);
NMTG(SymbolTable(.
ModuleTable(.ModuleNo
.).ModuleNameReference
.).NameReference
,ModuleName
);
LogURS(LogFile, ModuleName, SymbolName);
IF test((.0,16,19.)) THEN
BEGIN
writeln(TestOut, 'PutEXI '
, 'SymbolNo=', SymbolNo:1
, ' ':2, 'Value=', Value:1);
END;
END;
END;
END;
END; (*PUTEXI*)
(* TargetModuleNo is a global variable *)
BEGIN (*PUTMODULE*)
MDTA(Status, TargetModuleNo, 1);
IF not (ModuleTableOverFlow IN Status) THEN
BEGIN
PutMF(TargetFile);
PutINX(Status, TargetFile, LogFile);
IF Status = (..) THEN
BEGIN (*Calculate memory map, write sgd, and log*)
PutSGDs(Status, TargetFile, LogFile);
IF not (SectionTableOverFlow IN Status) THEN
BEGIN (*Relocate symbol table, write export list, and log*)
PutEXP(Status, TargetFile, LogFile);
IF Status = (..) THEN
BEGIN (*Write EXI while logging unresolved references*)
PutEXI(Status, TargetFile, LogFile);
END;
END;
END;
END;
END; (*PUTMODULE*)
BEGIN (*PUTTARGETFILE*)
PutFF(TargetFile);
PutModule(Status, TargetFile, LogFile);
END; (*PUTTARGETFILE*)
(* *)
(* *)
(******************************************************************************)
«eof»