|
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: 12288 (0x3000)
Types: TextFile
Names: »LNKP1-2.PIS«
└─⟦91467e717⟧ Bits:30009789/_.ft.Ibm2.50007348.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP1-2.PIS«
PROCEDURE PutTargetFile(VAR Status: StatusType
;VAR TargetFile: FileType
;VAR LogFile: LogFileType
);
PROCEDURE PutFF(VAR Status: StatusType
;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 Status: StatusType
;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_NooExtImprtSymbols *)
NMTG(SymbolTable(.ModuleTable(.1.).ModuleNameReference
.).NameReference
, OMH_ModuleName
);
FPsym(Fl, OMH_ModuleName);
END; (*PUTINX*)
PROCEDURE PutSGDs(VAR Status: StatusType
;VAR Fl: Filetype
;VAR Log: LogFileType
);
VAR
SegmentNoIndex: SegmentNoType;
TargetSection: SectionTableRecordType;
SectionNoIndex: SectionTableIndexType;
ObjectSection: SectionTableRecordType;
PROCEDURE PutSGD(VAR Status: StatusType
;VAR TargetFile: FileType
; Section: SectionTableRecordType
);
BEGIN (*PUTSGD*)
WITH Section DO
BEGIN
FPi32(TargetFile, ImageSize);
FPi32(TargetFile, RldSize);
FPi32(TargetFile, RldSize); (***** IntImportSize !!!!!!*)
FPi32(TargetFile, NooInternalImportSymbols);
END
END; (*PUTSGD*)
BEGIN (*PUTSGDS*)
Status := Success;
FOR SegmentNoIndex := 1 TO CurSegmentCount DO
BEGIN
WITH TargetSection DO
BEGIN
ModuleNo := 0;
SegmentNo := SegmentNoIndex;
ImageSize := 0; (*TO BE UPDATED*)
RldSize := 0; (*TO BE UPDATED*)
NooInternalImportSymbols := 0; (*TO BE UPDATED AFTER PASS 2*)
RelocationConstant := 0;
FOR SectionNoIndex := 1 TO SCTOffset DO
IF Status = Success THEN
BEGIN
SCTG(Status, SectionNoIndex, ObjectSection);
IF (Status = Success) and
(ObjectSection.SegmentNo = SegmentNoIndex) THEN
BEGIN
ObjectSection.RelocationConstant := ImageSize;
ImageSize := ImageSize + ObjectSection.ImageSize;
RldSize := RldSize + ObjectSection.RldSize;
(*Log memory map element*)
SCTWB(Status, SectionNoIndex, ObjectSection);
END
END;
IF Status = Success THEN
BEGIN
PutSGD(Status, Fl, TargetSection);
END;
END;
END;
END; (*PUTSGDS*)
PROCEDURE PutEXP(VAR Status: StatusType
;VAR Target: FileType
;VAR LogFile: LogFileType
);
VAR
MDTInx: ModuleTableIndexType;
Heap: ARRAY (.ModuleTableIndexType.) OF SymbolTableIndexType;
HeapMax: ModuleTableIndexType;
Winner: SymboltableIndexType;
SymbolNo: SymbolTableIndexType;
EXP_Record: ObjectRecordType;
FUNCTION NameOrder(VAR V
, W: SymbolNameType
): boolean;
VAR
I: SymbolNameIndexType;
BEGIN (*NAMEORDER*)
IF V.Length <> W.Length THEN
NameOrder := false
ELSE
BEGIN
I := 0;
REPEAT
I := I + 1;
UNTIL ( V.Name(.I.) <> W.Name(.I.) ) or ( V.Length <= I );
IF I = V.Length THEN
NameOrder := true
ELSE
NameOrder := false;
END
END; (*NAMEORDER*)
PROCEDURE InHeap( New: SymbolTableIndexType
);
VAR
I,J: ModuleTableIndexType;
Z,V: SymbolNameType;
BEGIN (*INHEAP*)
HeapMax := HeapMax + 1;
I := HeapMax;
NMTG(SymbolTable(.I.).NameReference, Z);
WHILE I > 1 DO
BEGIN
J := i div 2;
NMTG(SymbolTable(.J.).NameReference, V);
IF NameOrder(Z,V) THEN
BEGIN
Heap(.I.) := Heap(.J.);
I := J;
END;
END;
Heap(.I.) := New;
END; (*INHEAP*)
PROCEDURE SelectWinner(VAR Status: StatusType
);
VAR
I,J: ModuleTableIndexType;
V,W,Z: SymbolNameType;
New: SymbolTableIndexType;
PROCEDURE SelectJ;
BEGIN (*SELECTJ*)
NMTG(SymbolTable(.Heap(. J .).).NameReference, V);
NMTG(SymbolTable(.Heap(.J+1.).).NameReference, W);
IF NameOrder(W, V) THEN
BEGIN
V := W;
J := J + 1
END
END; (*SELECTJ*)
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 := HeapMax;
HeapMax := HeapMax - 1;
END;
NMTG(New, Z);
IF Status = Success THEN
BEGIN
I := 1;
J := 2;
SelectJ;
WHILE (J <= HeapMax) and NameOrder(V, Z) DO
BEGIN
Heap(.I.) := Heap(.J.);
I := J;
J := J + J;
SelectJ;
END
END
END
ELSE
Status := HeapEmpty;
END; (*SELECTWINNER*)
BEGIN (*PUTEXP*)
LogHxpN(LogFile);
LogHSxp(LogFile);
(*Initialize selection*)
HeapMax := 0;
FOR MDTInx := 1 TO CurModuleNo DO
InHeap(ModuleTable(.MDTInx.).SBTLinkHead);
WHILE (Status = Success) DO
BEGIN
SelectWinner(Status);
IF Status = Success THEN
WITH SymbolTable(.Winner.), ValueTable(.Winner.), EXP_Record DO
BEGIN
IF (Section <> 0) THEN (*relocatable*)
BEGIN
Value := Value + SCTGRC(Section);
EXP_RelocationIndicator := SCTGSG(Section);
END
ELSE (*absolute*)
EXP_RelocationIndicator := 0;
EXP_Item := Value;
NMTG(NameReference, EXP_SymbolName);
FPi8(Target, EXP_Record.EXP_RelocationIndicator);
FPsym(Target, EXP_record.EXP_SymbolName);
IF (Status = Success) and (OPTlfk <> none) THEN
LogXP(LogFile
,EXP_RelocationIndicator
,EXP_Item
,EXP_SymbolName
)
END;
END;
IF (Status = HeapEmpty) and (OPTlfk <> none) THEN
BEGIN (*sort sbt/vlt by value and log*)
Status := Success;
LogHxpV(LogFile);
LogHSxp(LogFile);
(*sort*)
WHILE Status = Success DO
BEGIN
(*GET NEXT IN LINKED LIST*)
IF Status = Success THEN
(***********Something is wrong here!!! V V *)
WITH SymbolTable(.winner.), ValueTable(.winner.), EXP_Record DO
LogXP(LogFile
,EXP_RelocationIndicator
,EXP_Item
,EXP_SymbolName
)
END
END
END; (*PUTEXP*)
PROCEDURE PutEXI(VAR Status: StatusType
;VAR Target: FileType
;VAR LogFile: LogFileType
);
BEGIN (*PUTEXI*)
END; (*PUTEXI*)
BEGIN (*PUTMODULE*)
PutMF(Status, TargetFile);
IF Status = Success THEN
BEGIN
PutINX(Status, TargetFile, LogFile);
IF Status = Success THEN
BEGIN (*Calculate memory map, write sgd, and log*)
PutSGDs(Status, TargetFile, LogFile);
IF Status = Success THEN
BEGIN (*Relocate symbol table, write export list, and log*)
PutEXP(Status, TargetFile, LogFile);
IF Status = Success THEN
BEGIN (*Write EXI while logging unresolved references*)
PutEXI(Status, TargetFile, LogFile);
END;
END;
END;
END;
END; (*PUTMODULE*)
BEGIN (*PUTTARGETFILE*)
PutFF(Status, TargetFile);
IF Status = Success THEN
PutModule(Status, TargetFile, LogFile);
END; (*PUTTARGETFILE*)
«eof»