|
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: 9216 (0x2400)
Types: TextFile
Names: »LNKP0.PIS«
└─⟦91467e717⟧ Bits:30009789/_.ft.Ibm2.50007348.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »LNKP0.PIS«
(******************************************************************************)
(* *)
(* Copyright (1985) by Metanic Aps., Denmark *)
(* *)
(* Author: Lars Gregers Jakobsen. *)
(* *)
(******************************************************************************)
SEGMENT SetUp;
(*
This prospero Pascal segment holds the declarations for the setup
procedure for Metanic linker.
*)
(*$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 *)
(*$I B:LnkDC2.pas External Decl. of global access primitives *)
PROCEDURE SetUp(VAR Status: StatusType
;VAR TargetFile: FileType
;VAR LogFile: LogFileType
;VAR Out_file: text
);
CONST
CommandLineLength = 127;
InputFileNameSuffix = 'OBJ';
TargetFileNameSuffix = 'OUT';
LogFileNameSuffix = 'MAP';
NilSuffix = '';
TYPE
CommandLineIndexType = 0..CommandLineLength;
CommandLineType = String(.CommandLineLength.);
VAR
CommandLine: CommandLineType;
Ch: Char;
Current: CommandLineIndexType;
FileName: FileNameType;
PROCEDURE LogCmd(VAR LogFile: LogFileType
; CommandLine: CommandLineType
);
CONST Delta = 3;
BEGIN (*LOGCMD*)
LogFF(LogFile, Delta);
WITH LogFile DO
BEGIN
writeln(F, ' ':10, 'Invocation Command: ');
writeln(F, ' ':10, CommandLine);
writeln(F)
END
END; (*LOGCMD*)
PROCEDURE SkipBlanks;
BEGIN (*SKIPBLANKS*)
WHILE (CommandLine(.Current.) = ' ') and
(Current < length(CommandLine)) DO
Current := Current + 1;
END; (*SKIPBLANKS*)
PROCEDURE DecodeFileName(VAR Status: StatusType
;VAR FileName: FileNameType
; Suffix: FileNameType
; Terminators: CharSetType
);
VAR
I: CommandLineIndexType;
BEGIN (*DECODEFILENAME*)
I := 0;
WHILE (Current + I < length(CommandLine) ) and
not ( CommandLine(.Current + I.) in Terminators ) DO
I := I + 1;
IF (0 < I) and (I <= FileNameLength) THEN
BEGIN
FileName := Copy(CommandLine, Current, I);
Current := Current + I;
Status := Success;
IF (pos('.', FileName) = 0) THEN
IF (length(FileName) <= FileNameLength - 4) THEN
FileName := concat(FileName, '.', Suffix)
ELSE
Status := BadFileName
END
ELSE
Status := BadFileName;
IF test((.0,16,18.)) THEN
BEGIN
write(TestOut, 'DecodeFileName '); TSTstat(Status);
TSTindt; write(TestOut, 'Curr=', Current:1);
TSTindt; write(TestOut, 'I=', I:1);
TSTindt; writeln(TestOut, 'FileName=', FileName)
END
END; (*DECODEFILENAME*)
BEGIN (*SETUP*)
Getcomm(CommandLine);
CommandLine := concat(CommandLine, ' ');
Current := 1;
Status := Success;
SkipBlanks; (*Leaving current pointing at next non blank*)
(*Interpret option list*)
IF test((.0,16,18.)) THEN
BEGIN
write(TestOut, 'Setup-1 '); write(TestOut, 'Curr=', Current:1);
TSTindt; write(TestOut, 'Lng(ComLin)=', Length(CommandLine):1);
TSTindt; TSTmem; TSTln;
TSTindt; writeln(TestOut, 'ComLin=', CommandLine)
END;
WHILE (Current < length(CommandLine)) and
(CommandLine(.Current.) = '/') and
(Status = Success) DO
BEGIN
Current := Current + 1;
CASE CommandLine(.Current.) OF
'M','m':
BEGIN
Current := Current + 1;
IF CommandLine(.Current.) = '=' THEN
BEGIN
Current := Current + 1;
DecodeFileName(Status, FileNametable(.-1.)
, LogFileNameSuffix, (.' ', '/', ','.) );
IF Status = Success THEN
OptionTable.LogFileKind := Explicit
END
ELSE
OptionTable.LogFileKind := Implicit
END;
'O','o':
BEGIN
Current := Current + 1;
IF CommandLine(.Current.) = '=' THEN
BEGIN
Current := Current + 1;
DecodeFileName(Status, FileNameTable(.0.)
, TargetFileNameSuffix, (.' ', '/', ','.) );
IF Status = Success THEN
OptionTable.TargetFileKind := Explicit
END
ELSE
OptionTable.TargetFileKind := Implicit
END;
OTHERWISE
Status := BadOption
END; (*CASE*)
IF test((.0,16,18.)) THEN
BEGIN
write(TestOut, 'Setup-2 '); TSTstat(Status);
TSTindt; writeln(TestOut, 'Curr=', Current:1);
TSTindt; TSTopt;
TSTindt; TSTfnt(-1);
TSTindt; TSTfnt(0)
END;
END; (*WHILE*)
IF Status = Success THEN (*Interpret file list*)
BEGIN
SkipBlanks;
IF Current < length(CommandLine) THEN
Status := NotFinished;
WHILE (Current < length(CommandLine)) and
(Status = NotFinished) DO
BEGIN
DecodeFileName(Status, FileName
, InputFileNameSuffix, (.' ', ','.) );
IF (Status = Success) THEN
BEGIN
IF test((.0,16,18.)) THEN
BEGIN
write(TestOut, 'Setup-3 ');
write(TestOut, 'fstat(FileName)=');
TSTbool(fstat(FileName));
TSTln;
END;
IF fstat(FileName) THEN
BEGIN
FNTP(Status, FileName);
IF Status = Success THEN
CASE CommandLine(.Current.) OF
' ':
Status := Success;
',':
BEGIN
Status := NotFinished;
Current := Current + 1 (*Skip the comma*)
END
END (*CASE CommandLine(.Current.) OF*)
END (*IF fstat(FileName) THEN*)
ELSE
Status := NoSuchFile
END (*IF Status = Success THEN*)
END (* WHILE *** DO *)
END; (* IF Status = Success *)
IF (Status = Success) and (CurFileNo <= 0) THEN
Status := NoInputFiles;
IF Status = Success THEN
BEGIN
FileName := copy(FileNameTable(.1.), 1, pos('.',FileNameTable(.1.)) );
IF OptionTable.LogFileKind = Implicit THEN
FileNameTable(.-1.) := concat(FileName, LogFileNameSuffix);
IF OptionTable.TargetFileKind = Implicit THEN
FileNameTable(. 0.) := concat(FileName, TargetFileNameSuffix);
IF (OptionTable.LogFileKind <> none) and
( (not checkfn(FileNameTable(.-1.) ) ) or
(fstat(FileNameTable(.-1.) ) )
) THEN
Status := badlogfilename;
IF (not checkfn(FileNameTable(.0.) ) ) or
(fstat(FileNameTable(.0.) ) ) THEN
Status := badtargetfilename;
IF test((.0,16,18.)) THEN
BEGIN
write(TestOut, 'Setup-4 '); TSTstat(Status); TSTln;
TSTindt; TSTopt;
TSTindt; TSTfnt(-1);
TSTindt; TSTfnt(0);
TSTindt; TSTfnt(1)
END;
IF Status = Success THEN
BEGIN
IF OptionTable.LogFileKind <> None THEN
BEGIN
LogInit(LogFile, FileNameTable(.-1.) );
LogCmd(LogFile, CommandLine);
END;
FilAsg(TargetFile, FileNameTable(.0.) );
FilRwt(TargetFile);
END
END
ELSE
BEGIN
writeln(out_file, CommandLine);
writeln(out_file, '^':Current);
END
END; (*SETUP*)
BEGIN (*SETUP SEGMENT*)
END. (*SETUP SEGMENT*)
«eof»