|
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: 10368 (0x2880)
Types: TextFile
Names: »LNKDF4.PAS«
└─⟦2079929d2⟧ Bits:30009789/_.ft.Ibm2.50006583.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKDF4.PAS«
└─⟦243948191⟧ Bits:30009789/_.ft.Ibm2.50007349.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKDF4.PAS«
└─⟦94d85ef43⟧ Bits:30009789/_.ft.Ibm2.50006584.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKDF4.PAS«
(******************************************************************************)
(* *)
(* Copyright (1985) by Metanic Aps., Denmark *)
(* *)
(* Author: Lars Gregers Jakobsen. *)
(* *)
(******************************************************************************)
PROCEDURE NMTP(VAR Status: StatusType
;VAR NameReference: NameTableIndexType
; SymbolName: SymbolNameType
);
VAR
I: SymbolNameIndexType;
BEGIN (*NMTP*)
WITH SymbolName DO
BEGIN
IF CurrentNameTableIndex + Length + 1 > MaxNameTableIndex THEN
Status := Status + (.NameTableOverFlow.)
ELSE
BEGIN
Namereference := CurrentNameTableIndex + 1;
CurrentNameTableIndex := NameReference + Length;
NameTable(.NameReference.) := Length;
FOR I := 1 TO Length DO
NameTable(.NameReference + I.) := Name(.I.);
END;
(*#B#*)
IF test((.0,9.)) THEN
BEGIN
write(TestOut, 'NMTP '); TSTstat(Status); TSTindt;
writeln(TestOut, 'Length=', Length:1);
TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
END;
(*#E#*)
END
END; (*NMTP*)
FUNCTION NMTfail( NameReference: NameTableIndexType
; SymbolName: SymbolNameType
): boolean;
(* NMTfail returns one of the following values:
FALSE: If the exact same symbolname was found in NMT - i.e.
NameReference <> 0 AND
NMT(.NameReference.) = SymbolName.Length AND
FOR i = 1 TO length:
NMT(.NameReference+i.) = SymbolName.Name(.i.)
OR If an empty entry was found in NMT - i.e.
NameReference = 0.
TRUE: In all other cases.
*)
LABEL
99;
VAR
I: SymbolNameIndexType;
BEGIN (*NMTFAIL*)
NMTfail := false;
WITH SymbolName DO
BEGIN
IF NameReference <> 0 THEN
IF length <> NameTable(.NameReference.) THEN
NMTfail := true
ELSE
BEGIN
FOR I := 1 TO Length DO
IF Name(.I.) <> NameTable(.NameReference + I.) THEN
BEGIN
NMTfail := true;
GOTO 99;
END;
99:; END;
(*#B#*)
IF test((.0,9.)) THEN
BEGIN
writeln(TestOut, 'NMTfail ', 'NameRef=', NameReference:1);
TSTindt; TSTindt; TSTindt; TSTsymbol(SymbolName);
TSTindt; TSTindt; TSTindt; TSTnmt(NameReference);
END;
(*#E#*)
END
END; (*NMTFAIL*)
PROCEDURE NMTG( NameReference: NameTableIndexType
;VAR SymbolName: SymbolNameType
);
VAR
I: SymbolNameIndexType;
BEGIN (*NMTG*)
WITH SymbolName DO
BEGIN
Length := NameTable(.NameReference.);
FOR I := 1 TO Length DO
Name(.I.) := NameTable(. NameReference + I .);
(*#B#*)
IF test((.0,9,13.)) THEN
BEGIN
write(TestOut, 'NMTG '); TSTindt;
write(TestOut, 'NameRef=', NameReference:1); TSTindt;
TSTsymbol(SymbolName);
END;
(*#E#*)
END
END; (*NMTG*)
PROCEDURE Hash(VAR SymbolName: SymbolNameType
;VAR SBTInx: SymbolTableIndexType
);
BEGIN (*HASH*)
SBTInx := 1
END; (*HASH*)
PROCEDURE SBTS(VAR Status: StatusType
;VAR SBTInx: SymbolTableIndexType
; SymbolName: SymbolNameType
);
(* SBTS returns one of the following Status codes:
Success: SymbolName found in SBT. SBTInx reflects
SymbolName.
NotFound: SymbolName NOT found in SBT. SBTInx
indicates the entry into which Symbol should be
registered.
SymbolTableOverFlow: SymbolName NOT found in SBT.
SBTInx is not valid. There
is no room in SBT for further updates.
Search SBT to find the Entry for SYMBOLNAME retaining the index
of the first vacant record as SYMBOLTABLEENTRYNO if the search
fails. Otherwise return found index. Set Status to Success or
NotFound according to outcome. Set Status to SBTOverFlow if
no vacant is available and symbol is not found.
A SBT record is vacant if Namereference = 0.
*)
BEGIN (*SBTS*)
(* Assume existence of entry in SBT with NameReference = 0 *)
Hash(SymbolName, SBTInx);
(*#B#*)
IF test((.0,9.)) THEN
BEGIN
write(TestOut, 'SBTS-1 '); TSTstat(Status); TSTln;
TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
END;
(*#E#*)
WHILE NMTfail(Symboltable(.SBTInx.).NameReference, SymbolName) DO
BEGIN
(* HASH NEXT TRY *)
IF MaxNooSymbols <= SBTInx THEN
SBTInx := 0;
SBTInx := SBTInx + 1;
(*#B#*)
IF test((.0,9.)) THEN
BEGIN
write(TestOut, 'SBTS-2 '); TSTstat(Status); TSTln;
TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
END;
(*#E#*)
END;
IF SymbolTable(.SBTInx.).NameReference = 0 THEN
IF CurrentSymbolCount >= MaxNooSymbols - 1 THEN
Status := Status + (.SymbolTableOverFlow.)
ELSE
Status := Status + (.NotFound.);
(*#B#*)
IF test((.0,10.)) THEN
BEGIN
write(TestOut, 'SBTS-3 '); TSTstat(Status); TSTln;
TSTindt; TSTindt; TSTindt; TSTsbt(SBTInx); TSTln;
END;
(*#E#*)
END; (*SBTS*)
PROCEDURE SBTEX(VAR Status: StatusType
;VAR SymbolTableEntryNo: SymbolTableIndexType
; SymbolName: SymbolNameType
; P_ModuleNo: ModuleTableIndexType
; P_SegmentNo: SegmentNoType
; Item: i32
);
BEGIN (*SBTEX*)
SBTS(Status, SymbolTableEntryNo, SymbolName);
IF not (SymbolTableOverFlow IN Status) THEN
WITH SymbolTable(.SymbolTableEntryNo.)
,ValueTable(.SymbolTableEntryNo.) DO
IF NotFound IN Status THEN
BEGIN (*Symbol is NOT in SBT and thus not resolved*)
Status := Status - (.NotFound.);
NMTP(Status, NameReference, SymbolName);
IF not (NameTableOverFlow IN Status) THEN
BEGIN
CurrentSymbolCount := CurrentSymbolCount + 1;
ModuleNo := P_ModuleNo;
IF LatestInsert <> 0 THEN
SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
LatestInsert := SymbolTableEntryNo;
SortLink := SymbolTableEntryNo;
SegmentNo := P_SegmentNo;
Value := Item
END
END (*IF NotFound IN Status*)
ELSE (* SUCCESS: Symbol is in SBT*)
BEGIN
IF SegmentNo > UnResolved THEN
Status := Status + (.DuplicateExportSymbol.)
ELSE (*Symbol NOT previously resolved i.e. imported only*)
BEGIN
ModuleNo := P_ModuleNo;
IF LatestInsert <> 0 THEN
SymbolTable(.LatestInsert.).SortLink := SymbolTableEntryNo;
LatestInsert := SymbolTableEntryNo;
SortLink := SymbolTableEntryNo;
SegmentNo := P_SegmentNo;
Value := Item
END
END; (*ELSE (i.e. Success IN Status)*)
(*#B#*)
IF test((.0,10.)) THEN
BEGIN
write(TestOut, 'SBTEX '); TSTstat(Status);
TSTindt; TSTsymbol(SymbolName);
TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
END;
(*#E#*)
END; (*SBTEX*)
PROCEDURE SBTIM(VAR Status: StatusType
;VAR SymbolTableEntryNo: SymbolTableIndexType
;VAR SymbolName: SymbolNameType
; P_ModuleNo: ModuleTableIndexType
);
BEGIN (*SBTIM*)
SBTS(Status, SymbolTableEntryNo, SymbolName);
IF Not (SymbolTableOverFlow IN Status) THEN
BEGIN
IF NotFound IN Status THEN
WITH SymbolTable(.SymbolTableEntryNo.)
,ValueTable(.SymbolTableEntryNo.) DO
BEGIN
Status := Status - (.NotFound.);
NMTP(Status, NameReference, SymbolName);
IF not (NameTableOverFlow IN Status) THEN
BEGIN
CurrentSymbolCount := CurrentSymbolCount + 1;
ModuleNo := P_ModuleNo;
SortLink := 0;
SegmentNo := UnResolved;
Value := 0;
END
END;
EITP(Status,SymbolTableEntryNo)
END;
(*#B#*)
IF test((.0,10.)) THEN
BEGIN
write(TestOut, 'SBTIM '); TSTstat(Status); TSTln;
TSTindt; TSTindt; TSTindt; TSTsbt(SymbolTableEntryNo); TSTln;
TSTindt; TSTindt; TSTindt; TSTvlt(SymbolTableEntryNo); TSTln;
END;
(*#E#*)
END; (*SBTIM*)
(* *)
(* *)
(******************************************************************************)
«eof»