|
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: 14080 (0x3700)
Types: TextFile
Names: »LNKP1-1.PIS«
└─⟦91467e717⟧ Bits:30009789/_.ft.Ibm2.50007348.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP1-1.PIS«
PROCEDURE GetInputFiles(VAR Status:StatusType
);
VAR
InputFile: FileType;
FileNo: FileNameTableIndexType;
StatusSet: SET OF 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 (Status = Success) and (OFF_Format <> Format) THEN
Status := BadFileFormat;
IF test((.0,16,19.)) THEN
BEGIN
write(TestOut, 'GetFFvalid '); TSTstat(Status); TSTindt;
writeln(TestOut, 'OFF_Format=', OFF_Format);
END;
END; (*VALIDATEFILEFORMAT*)
PROCEDURE GetModules(VAR Status: StatusType
; FileNumber: FileNameTableIndexType
;VAR Fl: FileType
; StartAddressOfNextModule: FileAddressType
);
VAR
StatusSet: SET OF 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 (Status = Success) and (OMF_Format <> Format) THEN
Status := BadModuleFormat;
IF test((.0,16,19.)) THEN
BEGIN
write(TestOut, 'GetMFvalid '); TSTstat(Status); TSTindt;
writeln(TestOut, 'OMF_Format=',OMF_Format);
END;
END; (*VALIDATEMODULEFORMAT*)
PROCEDURE GetModuleHeader(VAR Status: StatusType
; FileNo:
FileNameTableIndexType
;VAR Fl: FileType
;VAR StartAddressOfNextModule:
FileAddressType
);
VAR
StatusSet: SET OF StatusType;
SegmentNo: SegmentNoType;
SymbolNo: SymbolTableIndexType;
ModuleNo: ModuleTableIndexType;
MdtRec: ModuleTableRecordType;
NooExportSymbols: i32;
PROCEDURE GetINX(VAR Status: StatusType
;VAR MdtRec: ModuleTableRecordType
;VAR Fl: FileType
;VAR StartAddressOfNextModule:
FileAddressType
;VAR NooExportSymbols: i32
);
VAR
OMH_ModuleSize: i32;
OMH_ModuleName: ModuleNameType;
Dummy32: i32;
BEGIN (*GETINX*)
WITH MdtRec DO
BEGIN
FGi32(Status, Fl, OMH_ModuleSize);
StartAddressOfNextModule :=
StartAddressOfNextModule + OMH_moduleSize;
CurrentFileAddress := StartAddressOfNextModule;
Referenced := false;
FGi32(Status, Fl, Dummy32);
NooSegments := Dummy32;
FGi32(Status, Fl, NooExportSymbols);
FGi32(Status, Fl, Dummy32);
NooExternalImportSymbols := Dummy32;
FGsym(Status, Fl, OMH_ModuleName);
IF Status = Success THEN
SBTEX(Status, ModuleNameReference, OMH_ModuleName,0,0);
END
END; (*GETINX*)
PROCEDURE GetSGDs(VAR Status: StatusType
; NooSegments: SegmentNoType
; ModuleNo: ModuleTableIndexType
;VAR Fl: FileType
);
VAR
SegmentNo: SegmentNoType;
SGD_Record: ObjectRecordType;
BEGIN (*GETSEGMENTDESCRIPTORS*)
SegmentNo := 0;
WITH SGD_Record DO
WHILE (SegmentNo < NooSegments) and (Status = Success) DO
BEGIN
SegmentNo := SegmentNo + 1;
FGi32(Status, Fl, SGD_Image);
FGi32(Status, Fl, SGD_Rld);
FGi32(Status, Fl, SGD_IntImport);
FGi32(Status, Fl, SGD_NooIntImportSymbols);
IF Status = Success THEN
SCTP(Status, ModuleNo, SegmentNo, SGD_Record);
IF test((.0,16,19.)) THEN
BEGIN
write(TestOut, 'GetSGDs '); TSTstat(Status); TSTln
END;
END
END; (*GETSEGMENTDESCRIPTORS*)
PROCEDURE GetEXP(VAR Status: StatusType
;VAR Fl: FileType
;VAR LinkHead: SymbolTableIndexType
; NooExportSymbols: i32
);
VAR
StatusSet: SET OF StatusType;
SymbolCountMax: i32;
EXP_Record: ObjectRecordType;
SymbolTableEntryNo: SymbolTableIndexType; (*DUMMY*)
Dummy8: i8;
Dummy32: i32;
BEGIN (*GETEXPORTLIST*)
StatusSet := (..);
LatestInsert := 0;
SymbolCountMax := CurrentSymbolCount + NooExportSymbols;
IF CurrentSymbolCount < SymbolCountMax THEN
WITH EXP_Record DO
BEGIN
FGi8( Status, Fl, Dummy8);
EXP_Record.EXP_RelocationIndicator := Dummy8;
FGi32(Status, Fl, EXP_Record.EXP_Item);
FGsym(Status, Fl, EXP_Record.EXP_SymbolName);
IF Status = Success THEN
BEGIN
SBTEX(Status
,LinkHead
,EXP_SymbolName
,EXP_RelocationIndicator
,EXP_Item
);
IF Status = DuplicateExportSymbol THEN
BEGIN
(*LOG*)
END;
END;
StatusSet := StatusSet + (.Status.);
END;
WHILE (Status in (.Success, DuplicateExportSymbol.)) and
(CurrentSymbolCount < SymbolCountMax) DO
BEGIN
FGi8( Status, Fl, Dummy8);
EXP_Record.EXP_RelocationIndicator := Dummy8;
FGi32(Status, Fl, EXP_Record.EXP_Item);
FGsym(Status, Fl, EXP_Record.EXP_SymbolName);
IF Status = Success THEN
WITH EXP_Record DO
BEGIN
SBTEX(Status
,SymbolTableEntryNo
,EXP_SymbolName
,EXP_RelocationIndicator
,EXP_Item
);
IF Status = DuplicateExportSymbol THEN
BEGIN
(*LOG*)
END;
END;
StatusSet := StatusSet + (.Status.)
END; (*WHILE ... DO*)
IF (Status = Success) and
(DuplicateExportSymbol in StatusSet) THEN
Status := DuplicateExportSymbol
END; (*GETEXPORTLIST*)
PROCEDURE GetEXI(VAR Status: StatusType
;VAR Fl: FileType
; ModuleNo: ModuleTableIndexType
; NooExternalImportSymbols:
ExternalImportTableIndexType
);
VAR
SymbolTableEntryNo: SymbolTableIndexType;
SymbolCountMax: i32;
EXI_SymbolName: SymbolNameType;
BEGIN (*GETEXTERNALIMPORTLIST*)
SymbolCountMax := CurExternalImportSymbolNo +
NooExternalImportSymbols;
WHILE (Status in (.Success.)) and
(CurExternalImportSymbolNo < SymbolCountMax) DO
BEGIN
FGsym(Status, Fl, EXI_SymbolName);
IF Status = Success THEN
SBTIM(Status
,SymbolTableEntryNo
,EXI_SymbolName
);
END; (*WHILE ... DO*)
END; (*GETEXTERNALIMPORTLIST*)
BEGIN (*GETMODULEHEADER*)
StatusSet := (..);
MDTA(Status, ModuleNo, 1);
IF Status = Success THEN
BEGIN
GetINX(Status, ModuleTable(.ModuleNo.), Fl
, StartAddressOfNextModule
, NooExportSymbols);
IF Status = Success THEN
WITH ModuleTable(.ModuleNo.) DO
BEGIN
FileNameReference := FileNo;
GetSGDs(Status
,NooSegments
,ModuleNo
,Fl
);
IF Status = Success THEN
BEGIN
GetEXP(Status
,Fl
,SBTLinkHead
,NooExportSymbols
);
IF Status in (.Success, DuplicateExportSymbol.) THEN
BEGIN
StatusSet := StatusSet + (.Status.);
EITOffset := CurExternalImportSymbolNo;
GetEXI(Status
,Fl
,ModuleNo
,NooExternalImportSymbols
);
END
END
END;
END;
IF (Status = Success) and
(DuplicateExportSymbol in StatusSet) THEN
Status := DuplicateExportSymbol;
IF test((.0,6,16,19.)) THEN
BEGIN
write(TestOut, 'GetOMH '); TSTstat(Status); TSTln;
TSTindt; TSTmdt(ModuleNo);
END;
END; (*GETMODULEHEADER*)
BEGIN (*GETMODULES*)
StatusSet := (..);
WHILE (Status in (.Success
, DuplicateExportSymbol
, BadSymbolName
.)
) DO
BEGIN
ValidateModuleFormat(Status, InputFile, OM_Format1);
CASE Status OF
Success:
GetModuleHeader(Status
,FileNumber
,InputFile
,StartAddressOfNextModule
);
BadModuleFormat:
BEGIN
(*Log error*)
END;
OTHERWISE (*UnexpectedEof*)
BEGIN END;
END; (*CASE*)
StatusSet := StatusSet + (.Status.)
END; (*WHILE ... DO*)
IF (Status = Success) and
(DuplicateExportSymbol in StatusSet) THEN
Status := DuplicateExportSymbol
END; (*GETMODULES*)
BEGIN (*GETINPUTFILE*)
StatusSet := (..);
FOR FileNo := 1 TO CurFileNo DO
BEGIN
FilAsg(InputFile, FileNameTable(.FileNo.));
FilRst(Status, InputFile);
IF Status = Success THEN
BEGIN
ValidateFileFormat (Status, InputFile, OF_Format1);
IF Status = Success THEN
GetModules(Status, FileNo, InputFile, 4)
ELSE
BEGIN (*Log error*)
END;
END
ELSE
BEGIN (*log error*)
END;
FilCLS(InputFile);
StatusSet := StatusSet + (.Status.);
END;
IF StatusSet - (.Success.) <> (..) THEN
Status := error;
END; (*GETINPUTFILE*)
«eof»