|
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: 18816 (0x4980)
Types: TextFile
Names: »LNKP1-1.BAK«, »LNKP1-1.PAS«
└─⟦94d85ef43⟧ Bits:30009789/_.ft.Ibm2.50006584.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP1-1.BAK«
└─⟦da8d53b95⟧ Bits:30009789/_.ft.Ibm2.50006585.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP1-1.PAS«
└─⟦dbb5cfece⟧ Bits:30009789/_.ft.Ibm2.50007354.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP1-1.PAS«
(******************************************************************************)
(* *)
(* Copyright (1985) by Metanic Aps., Denmark *)
(* *)
(* Author: Lars Gregers Jakobsen. *)
(* *)
(******************************************************************************)
PROCEDURE GetInputFiles(VAR GStatus: StatusType
;VAR LogFile: LogFileType
);
VAR
InputFile: FileType;
FileNo: FileNameTableIndexType;
Status: StatusType;
PROCEDURE ValidateFileFormat(VAR Status: StatusType
;VAR F: FileType
; Format: OF_FormatType
);
VAR
OFF_Format: OF_FormatType;
BEGIN (*VALIDATEFILEFORMAT*)
FGi32(Status, F, OFF_Format);
IF OFF_Format <> Format THEN
Status := Status + (.BadFileFormat.);
(*#B#
IF test((.0,16,19.)) THEN
BEGIN
write(TestOut, 'GetFFvalid '); TSTstat(Status); TSTindt;
writeln(TestOut, 'OFF_Format=', OFF_Format);
END;
#E#*)
END; (*VALIDATEFILEFORMAT*)
PROCEDURE GetModules(VAR GStatus: StatusType
;VAR LogFile: LogFileType
; FileNumber: FileNameTableIndexType
;VAR Fl: FileType
; StartAddressOfNextModule: FileAddressType
);
VAR
Status: StatusType;
PROCEDURE ValidateModuleFormat(VAR Status: StatusType
;VAR F: FileType
; Format: OM_FormatType
);
VAR
OMF_Format: OM_FormatType;
BEGIN (*VALIDATEMODULEFORMAT*)
FGi32(Status, F, OMF_Format);
IF OMF_Format <> Format THEN
Status := Status + (.BadModuleFormat.);
(*#B#
IF test((.0,16,19.)) THEN
BEGIN
write(TestOut, 'GetMFvalid '); TSTstat(Status); TSTindt;
writeln(TestOut, 'OMF_Format=',OMF_Format);
END;
#E#*)
END; (*VALIDATEMODULEFORMAT*)
PROCEDURE GetModuleHeader(VAR GStatus: StatusType
;VAR LogFile: LogFileType
; FileNo:
FileNameTableIndexType
;VAR Fl: FileType
;VAR StartAddressOfNextModule:
FileAddressType
);
VAR
Status: StatusType;
SegmentNo: SegmentNoType;
SymbolNo: SymbolTableIndexType;
ModuleNo: ModuleTableIndexType;
MdtRec: ModuleTableRecordType;
NooExpSymbols: QuadImageUnitType;
NooExiSymbols: QuadImageUnitType;
PROCEDURE GetINX(VAR Status: StatusType
;VAR ModuleNo: ModuleTableIndexType
;VAR Fl: FileType
;VAR StartAddressOfNextModule:
FileAddressType
;VAR NooExpSymbols: QuadImageUnitType
;VAR NooExiSymbols: QuadImageUnitType
);
VAR
OMH_ModuleSize: QuadImageUnitType;
OMH_NooSegments: QuadImageUnitType;
OMH_ModuleName: ModuleNameType;
BEGIN (*GETINX*)
WITH ModuleTable(.ModuleNo.) DO
BEGIN
FGi32(Status, Fl, OMH_ModuleSize);
FGi32(Status, Fl, OMH_NooSegments);
FGi32(Status, Fl, NooExpSymbols);
FGi32(Status, Fl, NooExiSymbols);
StartAddressOfNextModule :=
StartAddressOfNextModule + abs(OMH_moduleSize);
IF (OMH_NooSegments > MaxNooSegments) or
(Noo_ExiSymbols > MaxNooExternalImportSymbols) THEN
Status := Status + (.RangeError.)
ELSE
BEGIN
Referenced := false;
NooSegments := OMH_NooSegments;
IF NooSegments > CurSegmentCount THEN
CurSegmentCount := NooSegments;
NooExternalImportSymbols := NooExiSymbols;
LatestInsert := 0;
FGsym(Status, Fl, OMH_ModuleName);
IF Status = (..) THEN
BEGIN
SBTEX(Status
,ModuleNameReference
,OMH_ModuleName
,ModuleNo
,0,0);
IF not (SymbolTableOverFlow IN Status) THEN
ValueTable(.ModuleNameReference.).SegmentNo := UnResolved;
IF DuplicateExportSymbol IN Status THEN
Status := Status - (.DuplicateExportSymbol.) +
(.DuplicateModuleName.);
END
END
END
END; (*GETINX*)
PROCEDURE GetSGDs(VAR Status: StatusType
; SCTBase: SectionTableIndexType
; NooSegments: SegmentNoType
; P_ModuleNo: ModuleTableIndexType
;VAR Fl: FileType
);
LABEL
99;
VAR
SegmentInx: SegmentNoType;
Dummy32: QuadImageUnitType;
BEGIN (*GETSEGMENTDESCRIPTORS*)
FOR SegmentInx := 1 TO NooSegments DO
BEGIN
IF Status <> (..) THEN
GOTO 99;
WITH SectionTable(.SCTbase + SegmentInx.) DO
BEGIN
SegmentNo := SegmentInx;
ModuleNo := P_ModuleNo;
FGi32(Status, Fl, Dummy32);
ImageSize := abs(Dummy32);
FGi32(Status, Fl, Dummy32);
OvrSize := abs(Dummy32);
(*#B#
IF test((.0,16,19.)) THEN
BEGIN
write(TestOut, 'GetSGDs '); TSTstat(Status);
TSTindt; TSTsct(SCTbase + SegmentInx); TSTln
END;
#E#*)
END;
END;
99:; END; (*GETSEGMENTDESCRIPTORS*)
PROCEDURE GetEXP(VAR GStatus: StatusType
;VAR LogFile: LogFileType
;VAR Fl: FileType
;VAR LinkHead: SymbolTableIndexType
; ModuleNo: ModuleTableIndexType
; NooExpSymbols: i32
);
VAR
Status: StatusType;
SymbolCount: i32;
DuplicateCount: i32;
RelocationIndicator: RelocationIndicatorType;
EXP_RelocationIndicator: ImageUnitType;
EXP_Item: QuadImageUnitType;
EXP_SymbolName: SymbolNameType;
SymbolTableEntryNo: SymbolTableIndexType; (*DUMMY*)
ModuleName: ModuleNameType;
BEGIN (*GETEXPORTLIST*)
Status := (..);
LinkHead := 0;
LatestInsert := 0;
SymbolCount := 0;
DuplicateCount := 0;
IF SymbolCount < NooExpSymbols THEN
BEGIN
SymbolCount := SymbolCount + 1;
FGi8( Status, Fl, EXP_RelocationIndicator);
IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
RelocationIndicator := EXP_RelocationIndicator
ELSE
Status := Status + (.RangeError.);
FGi32(Status, Fl, EXP_Item);
FGsym(Status, Fl, EXP_SymbolName);
IF Status = (..) THEN
BEGIN
SBTEX(Status
,LinkHead
,EXP_SymbolName
,ModuleNo
,EXP_RelocationIndicator
,EXP_Item
);
IF DuplicateExportSymbol IN Status THEN
BEGIN
DuplicateCount := DuplicateCount + 1;
IF DuplicateCount <= 1 THEN
LogHdds(LogFile);
NMTG(SymbolTable(.
ModuleTable(.ModuleNo
.).ModuleNameReference
.).NameReference
,ModuleName
);
LogDDS(LogFile
,EXP_RelocationIndicator
,EXP_Item
,EXP_SymbolName
,ModuleName
);
END
END;
GStatus := GStatus + Status;
END;
WHILE (GStatus <= (.DuplicateExportSymbol.)) and
(SymbolCount < NooExpSymbols) DO
BEGIN
SymbolCount := SymbolCount + 1;
Status := (..);
FGi8( Status, Fl, EXP_RelocationIndicator);
IF EXP_RelocationIndicator IN (.0..MaxNooSegments.) THEN
RelocationIndicator := EXP_RelocationIndicator
ELSE
Status := Status + (.RangeError.);
FGi32(Status, Fl, EXP_Item);
FGsym(Status, Fl, EXP_SymbolName);
IF Status = (..) THEN
BEGIN
SBTEX(Status
,SymbolTableEntryNo
,EXP_SymbolName
,ModuleNo
,EXP_RelocationIndicator
,EXP_Item
);
IF DuplicateExportSymbol IN Status THEN
BEGIN
DuplicateCount := DuplicateCount + 1;
IF DuplicateCount <= 1 THEN
LogHdds(LogFile);
NMTG(SymbolTable(.
ModuleTable(.ModuleNo
.).ModuleNameReference
.).NameReference
,ModuleName
);
LogDDS(LogFile
,EXP_RelocationIndicator
,EXP_Item
,EXP_SymbolName
,ModuleName
);
END
END;
GStatus := GStatus + Status
END; (*WHILE ... DO*)
END; (*GETEXPORTLIST*)
PROCEDURE GetEXI(VAR Status: StatusType
;VAR Fl: FileType
; ModuleNo: ModuleTableIndexType
; NooExternalImportSymbols: i32
);
VAR
SymbolTableEntryNo: SymbolTableIndexType;
SymbolCount: i32;
EXI_SymbolName: SymbolNameType;
BEGIN (*GETEXTERNALIMPORTLIST*)
SymbolCount := 0;
WHILE (Status = (..)) and
(SymbolCount < NooExternalImportSymbols) DO
BEGIN
SymbolCount := SymbolCount + 1;
FGsym(Status, Fl, EXI_SymbolName);
IF Status = (..) THEN
SBTIM(Status
,SymbolTableEntryNo
,EXI_SymbolName
,ModuleNo
);
END; (*WHILE ... DO*)
END; (*GETEXTERNALIMPORTLIST*)
BEGIN (*GETMODULEHEADER*)
Status := (..);
MDTA(Status, ModuleNo, 1);
IF Status = (..) THEN
BEGIN
GetINX(Status, ModuleNo, Fl
, StartAddressOfNextModule
, NooExpSymbols
, NooExiSymbols);
IF Status = (..) THEN
WITH ModuleTable(.ModuleNo.) DO
BEGIN
FileNameReference := FileNo;
SCTA(Status, SCTBase, NooSegments);
IF Status = (..) THEN
BEGIN
GetSGDs(Status
,SCTBase
,NooSegments
,ModuleNo
,Fl
);
IF Status = (..) THEN
BEGIN
SymbolTable(.ModuleNameReference
.).ModuleNo := ModuleNo;
GetEXP(Status
,LogFile
,Fl
,SBTLinkHead
,ModuleNo
,NooExpSymbols
);
IF Status <= (.DuplicateExportSymbol.) THEN
BEGIN
EITOffset := CurExternalImportSymbolNo;
GetEXI(Status
,Fl
,ModuleNo
,NooExiSymbols
);
CurrentFileAddress := Fl.P;
END
END
END
END;
END;
GStatus := GStatus + Status;
(*#B#
IF test((.0,6,16,19.)) THEN
BEGIN
write(TestOut, 'GetOMH '); TSTstat(Status); TSTln;
TSTindt; TSTindt; TSTindt; TSTmdt(ModuleNo);
END;
#E#*)
END; (*GETMODULEHEADER*)
BEGIN (*GETMODULES*)
REPEAT
Status := (..);
FilSeek(Status, InputFile, StartAddressOfNextModule);
IF not (UnexpectedEof IN Status) THEN
BEGIN
ValidateModuleFormat(Status, InputFile, OM_Format1);
IF UnexpectedEof IN Status THEN
BEGIN
LogEOFerror(LogFile, FileNumber, InputFile.P)
END
ELSE IF (BadModuleFormat IN Status) THEN
BEGIN
LogOMFerror(LogFile, FileNumber, InputFile.P)
END
ELSE (* Status = (..) *)
GetModuleHeader(Status
,LogFile
,FileNumber
,InputFile
,StartAddressOfNextModule
);
GStatus := GStatus + Status;
END
UNTIL Status - (.DuplicateExportSymbol, BadSymbolName.) <> (..);
END; (*GETMODULES*)
BEGIN (*GETINPUTFILES*)
FOR FileNo := 1 TO CurFileNo DO
BEGIN
Status := (..);
FilAsg(InputFile, FileNameTable(.FileNo.));
FilRst(Status, InputFile);
IF Status = (..) THEN
BEGIN
ValidateFileFormat (Status, InputFile, OF_Format1);
IF Status = (..) THEN
GetModules(Status, LogFile, FileNo, InputFile, 4)
ELSE IF BadFileFormat IN Status THEN
LogOFFerror(LogFile, FileNo);
END;
IF UnexpectedEof IN Status THEN
LogEOFerror(LogFile, FileNo, InputFile.P);
FilCls(InputFile);
GStatus := GStatus + Status;
END;
IF CurModuleNo <= 0 THEN
GStatus := GStatus + (.NoInput.);
END; (*GETINPUTFILES*)
(* *)
(* *)
(******************************************************************************)
«eof»