|
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: 16000 (0x3e80)
Types: TextFile
Names: »LNKDF2X.PAS«
└─⟦91467e717⟧ Bits:30009789/_.ft.Ibm2.50007348.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKDF2X.PAS«
(******************************************************************************)
(* *)
(* Copyright (1985) by Metanic Aps., Denmark *)
(* *)
(* Author: Lars Gregers Jakobsen. *)
(* *)
(******************************************************************************)
SEGMENT LnkDF2X;
(* Segment LnkDF2X holds the access primitives used by the
linker to access input and output files. *)
(* On resetting (FILRST) the File sector number 0 (zero) is brought
into F^ and sector number (S) is initialized to 0 (zero). The file
pointer (P) is initialized to 0 too and it always points to the next
byte to be read. If a read operation causes the file pointer to
exceed maxsectorindex and no end of file condition exists a new
sector will be fetched (renew) and P will be updated accordingly.
If an end of file condition exists it will persist throughout
(thus identifiable) and P will be set to 0 (zero). *)
(*$I B:lnkDC0.pas Declarations of global constants, types, and commons *)
(*$I A:PrTstExt.pas External Decl. of standard test procedures *)
(*$I B:LnkDC1.pas External Decl. of global test output primitives *)
PROCEDURE FilAsg(VAR Fl: FileType
;Fn: FileNameType
);
BEGIN (*FILASG*)
IF test((.0,1.)) THEN
writeln(TestOut, 'FILasg FlNm=', Fn);
assign(Fl.F, Fn)
END; (*FILASG*)
PROCEDURE FilRst(VAR Status: StatusType
;VAR Fl: FileType
);
BEGIN (*FILRST*)
WITH Fl DO
BEGIN
reset(F);
IF eof(F) THEN
Status := UnExpectedEof
ELSE
BEGIN
S := 0;
P := 0;
Status := Success
END;
IF test((.0,1.)) THEN
BEGIN
write(TestOut, 'FILrst '); TSTstat(Status); TSTln;
END;
END
END; (*FILRST*)
PROCEDURE FilRwt(VAR Fl: FileType
);
BEGIN (*FILRWT*)
IF test((.0,1.)) THEN
writeln(TestOut, 'FILrwt');
WITH Fl DO
BEGIN
rewrite(F);
S := 0;
P := 0;
END
END; (*FILRWT*)
PROCEDURE FilCls(VAR Fl: FileType
);
BEGIN (*FILCLS*)
close(Fl.F);
END; (*FILCLS*)
PROCEDURE FGF(VAR Status: StatusType
;VAR Fl: FileType
;VAR R: ObjectRecordType
; Size: ObjectRecordIndexType
);
BEGIN (*FGF*)
Status := Success;
WITH Fl DO
BEGIN
IF P + Size > MaxSectorIndex THEN
BEGIN
get(F);
IF eof(F) THEN
Status := unexpectedeof
ELSE
BEGIN
S := S + 1;
P := 0
END;
END;
IF Status = Success THEN
BEGIN
move(F^(.P.), R.N(.0.), Size);
P := P + Size
END;
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FGF '); TSTstat(Status); TSTindt;
write(TestOut, 'SZ=', Size:1, ' S=', S:1, ' P=', P:1
, ' EOF='); TSTbool(eof(F)); TSTln
END
END
END; (*FGF*)
PROCEDURE FGFV(VAR Status: StatusType
;VAR Fl: FileType
;VAR R: ObjectRecordType
; Size: ObjectRecordIndexType
);
BEGIN (*FGFV*)
Status := Success;
WITH Fl DO
BEGIN
IF P + Size + 1 > MaxSectorIndex THEN
BEGIN
get(F);
IF eof(F) THEN
Status := unexpectedeof
ELSE
BEGIN
S := S + 1;
P := 0
END;
END;
IF Status = Success THEN
BEGIN
move(F^(.P.), R.N(.0.), Size);
P := P + Size
END;
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FGFV '); TSTstat(Status); TSTindt;
write(TestOut, 'SZ=', Size:1, ' S=', S:1, ' P=', P:1
, ' EOF='); TSTbool(eof(F)); TSTln
END
END
END; (*FGFV*)
PROCEDURE FGV(VAR Status: StatusType
;VAR Fl: FileType
;VAR R: SymbolNameType
);
(* NOTE that if no errors occur FGV will NOT change the value
of the parameter Status no matter what the vaue may be. *)
BEGIN (*FGV*)
WITH Fl DO
BEGIN
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FGV-1 F^(.P.)=', F^(.P.):1
,' S=', S:1, ' P=', P:1
, ' EOF='); TSTbool(eof(F)); TSTln
END;
IF P + F^(.P.) > MaxSectorIndex THEN
BEGIN
get(F);
IF eof(F) THEN
Status := unexpectedeof
ELSE
BEGIN
S := S + 1;
P := 0
END;
END;
IF Status = Success THEN
BEGIN
IF F^(.P.) < MaxSymbolNameIndex THEN
WITH R DO
BEGIN
Length := F^(.P.);
move(F^(.P.), R.Name(.1.), Length);
P := P + Length
END
ELSE
Status := badsymbolname
END;
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FGV-2 '); TSTstat(Status); TSTindt;
write(TestOut, 'F^(.P.)=', F^(.P.):1, ' S=', S:1, ' P=', P:1
, ' EOF='); TSTbool(eof(F)); TSTln
END
END
END; (*FGV*)
PROCEDURE FPF(VAR Status: StatusType
;VAR Fl: Filetype
;VAR R: ObjectRecordType
; Size: i16
);
BEGIN (*FPF*)
WITH Fl DO
BEGIN
IF P + Size > MaxSectorIndex THEN
BEGIN
put(F);
P := 0;
S := S + 1;
END;
move(R.N(.0.), F^(.P.), Size);
P := P + Size;
Status := Success;
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FPF '); TSTstat(Status); TSTindt;
writeln(TestOut, 'SZ=', Size:1, ' S=', S:1, ' P=', P:1);
END
END (*WITH Fl DO*)
END; (*FPF*)
PROCEDURE FPFV(VAR Status: StatusType
;VAR Fl: Filetype
;VAR R: ObjectRecordType
; Size: i16
);
BEGIN (*FPFV*)
WITH Fl DO
BEGIN
IF P + Size + 1 > MaxSectorIndex THEN
BEGIN
put(F);
P := 0;
S := S + 1;
END;
move(R.N(.0.), F^(.P.), Size);
P := P + Size;
Status := Success;
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FPFV '); TSTstat(Status); TSTindt;
writeln(TestOut, 'SZ=', Size:1, ' S=', S:1, ' P=', P:1);
END
END (*WITH Fl DO*)
END; (*FPFV*)
PROCEDURE FPV(VAR Status: StatusType
;VAR Fl: FileType
;VAR R: SymbolNameType
);
(* NOTE that if no errors occur FPV will NOT change the value
of the parameter Status no matter what the value may be. *)
BEGIN (*FPV*)
WITH Fl, R DO
BEGIN
IF test((.0,2.)) THEN
BEGIN
writeln(TestOut, 'FPV-1 F^(.P.)=', F^(.P.):1
, ' S=', S:1, ' P=', P:1);
END;
IF P + Length + 1 > MaxSectorIndex THEN
BEGIN
put(F);
S := S + 1;
P := 0
END;
F^(.P.) := Length;
P := P + 1;
move(R.Name(.1.), F^(.P.), Length);
P := P + Length;
Status := Success;
IF test((.0,2.)) THEN
BEGIN
write(TestOut, 'FPV-2 '); TSTstat(Status); TSTindt;
writeln(TestOut, 'F^(.P.)=', F^(.P.):1, ' S=', S:1
, ' P=', P:1);
END
END
END; (*FPV*)
(*$I B:LNKDF7.PAS Log file access primitives *)
FUNCTION OPTLFK: LogFileKindType;
BEGIN (*OPTLFK*)
optlfk := OptionTable.LogFileKind;
END; (*OPTLFK*)
PROCEDURE FNTP(VAR Status: StatusType
; FileName: FileNameType
);
BEGIN (*FNTP*)
IF CurFileNo < MaxNooInputFiles THEN
BEGIN
CurFileNo := CurFileNo + 1;
FileNameTable(.CurFileNo.) := FileName;
Status := Success;
END
ELSE
Status := FileNameTableOverFlow;
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'FNTP '); TSTstat(Status); TSTindt;
TSTfnt(CurFileNo); TSTln
END
END; (*FNTP*)
PROCEDURE FNTG(VAR Status: StatusType
; Inx: FileNameTableIndexType
;VAR FileName: FileNameType
);
BEGIN (*FNTG*)
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'FNTG '); TSTfnt(Inx); TSTln
END;
FileName := FileNameTable(.Inx.);
Status := Success
END; (*FNTG*)
PROCEDURE EITP(VAR Status: StatusType
; SymbolTableEntryNo: SymbolTableIndexType
);
BEGIN (*EITP*)
(***********************Something is wrong here***********************)
ExternalImportTable(.
(ModuleTable(.CurModuleNo.).EITOffset +
CurExternalImportSymbolNo)
.).SymbolNo := SymbolTableEntryNo;
END; (*EITP*)
(* ModuleTable *)
PROCEDURE MDTP(VAR Status: StatusType
;VAR ModuleNo: ModuleTableIndexType
; SymbolNo: SymbolTableIndexType
; FileNo: FileNameTableIndexType
; StartAddressOfNextModule: FileAddressType
; OMH_Record: ObjectRecordType
);
BEGIN (*MDTP*)
IF ModuleNo >= MaxNooModules THEN
Status := ModuleTableOverflow
ELSE
BEGIN
Status := Success;
ModuleNo := ModuleNo + 1;
WITH ModuleTable(.ModuleNo.), OMH_Record DO
BEGIN
ModuleNameReference := SymbolNo;
FileNameReference := FileNo;
CurrentFileAddress := StartAddressOfNextModule;
Referenced := false;
NooSegments := OMH_NooSegments;
NooExternalImportSymbols := OMH_NooExtImportSymbols;
IF OMH_NooSegments > CurSegmentCount THEN
CurSegmentCount := OMH_NooSegments
END
END;
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'MDTP '); TSTstat(Status); TSTindt;
TSTmdt(ModuleNo);
END
END; (*MDTP*)
PROCEDURE MDTPLH(VAR Status: StatusType
; ModuleNo: ModuleTableIndexType
; LinkHead: SymbolTableIndexType
);
BEGIN (*MDTPLH*)
ModuleTable(.ModuleNo.).SBTLinkHead := LinkHead;
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'MDTPLH '); TSTstat(Status); TSTindt;
TSTmdt(ModuleNo);
END
END; (*MDTPLH*)
FUNCTION MDTGLH( ModuleNo: ModuleTableIndexType
): SymbolTableIndexType;
BEGIN (*MDTGLH*)
MDTGLH := ModuleTable(.ModuleNo.).SBTLinkHead;
END; (*MDTGLH*)
PROCEDURE MDTPEI(VAR Status: StatusType
; ModuleNo: ModuleTableIndexType
);
BEGIN (*MDTPEI*)
ModuleTable(.ModuleNo.).EITOffset := CurExternalImportSymbolNo;
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'MDTPEI '); TSTstat(Status); TSTindt;
TSTmdt(ModuleNo);
END
END; (*MDTPEI*)
PROCEDURE MDTGMN(VAR Status: StatusType (*?*)
; ModuleNo: ModuleTableIndexType
;VAR SBTInx: SymbolTableIndexType
);
BEGIN (*MDTGMN*)
SBTInx := ModuleTable(.ModuleNo.).ModuleNameReference;
Status := Success;
END; (*MDTGMN*)
(* SectionTable *)
PROCEDURE SCTP(VAR Status: StatusType
; P_ModuleNo: ModuleTableIndexType
; P_SegmentNo: SegmentNoType
; SGD_Record: ObjectRecordType
);
BEGIN (*SCTP*)
IF SCTOffset >= MaxNooSections THEN
Status := Sectiontableoverflow
ELSE
BEGIN
Status := Success;
SCTOffset := SCTOffset + 1;
WITH SectionTable(.SCTOffset.), SGD_Record DO
BEGIN
ModuleNo := P_ModuleNo;
SegmentNo := P_SegmentNo;
ImageSize := SGD_Image;
RldSize := SGD_Rld;
NooInternalImportSymbols := SGD_NooIntImportSymbols;
RelocationConstant := 0
END;
END;
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'SCTP '); TSTstat(Status); TSTln;
TSTsct(SCTOffset);
END
END; (*SCTP*)
PROCEDURE SCTG(VAR Status: StatusType
; SectionNo: SectionTableIndexType
;VAR Section: SectionTableRecordType
);
BEGIN (*SCTG*)
Section := SectionTable(.SectionNo.)
END; (*SCTG*)
PROCEDURE SCTWB(VAR Status: StatusType
; SectionNo: SectionTableIndexType
; Section: SectionTableRecordType
);
BEGIN (*SCTWB*)
SectionTable(.SectionNo.) := Section;
IF test((.0,6.)) THEN
BEGIN
write(TestOut, 'SCTWB '); TSTstat(Status); TSTindt;
TSTsct(SCTOffset);
END
END; (*SCTWB*)
FUNCTION SCTGSG( SectionNo: SectionTableIndexType
): RelocationIndicatorType;
BEGIN (*SCTGSG*)
SCTGSG := SectionTable(.SectionNo.).SegmentNo
END; (*SCTGSG*)
FUNCTION SCTGRC( SectionNo: SectionTableIndexType
): SizeType;
BEGIN (*SCTGRC*)
SCTGRC := SectionTable(.SectionNo.).RelocationConstant
END; (*SCTGRC*)
BEGIN (*LNKDF2X SEGMENT*)
END. (*LNKDF2X SEGMENT*)
«eof»