Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0003/paslnx.not-quite-finished
There is 1 other file named paslnx.not-quite-finished in the archive. Click here to see a list.
{$m-,d-,c-}
program pasprm;
{ this is a replacement for pasprm in paslnk.mac, for use when you do
not want to interface to the EXEC. It calls a COMND jsys scanner}
{This program works in the following passes:
1) scan all commands, set a few global switches saying what kind of
command, and prepare filelist, listing all files
2) scan all files, once for each language, putting out the command files,
and building up a link command string.
3) now execute the Pascal command list
4) call the next step.
}
{A comment with %%%% in it will be used where edits are needed to add a
language}
include 'pascmd.pas','string.pas';
const
noswitch=0;
zero=1;
stack=2;
objectlist=3;
nomain=4;
nodebug=5;
nocheck=6;
nobinary=7;
list=8;
heap=9;
debug=10;
cref=11;
version=12;
compile=13;
load=14;
noload=15;
arithcheck=16;
noarithcheck=17;
pascal=18;
macro=19;
fortran=20;
{%%%%}
lastswitch=20;
type retblk=record
relnam:alfa;
stkval:integer;
heaval:integer;
verval:integer;
rpgsw:Boolean;
crsw:Boolean;
dsw:Boolean;
csw:Boolean;
msw:Boolean;
tsw:Boolean;
lsw:Boolean;
zsw:Boolean;
asw:Boolean
end;
retptr = ^ retblk;
char3=packed array[1..3]of char;
fileblock=record
filename:packed array[1:200]of char;
namefield:packed array[1:40]of char;
switches:set of noswitch..lastswitch;
stackval,heapval,versionval:integer;
nextfile:^fileblock;
language:integer;
end;
fileptr = ^fileblock;
var
firstrun:integer; {the language Pascal will call, -1 for LINK}
{%%%%}
macrolist,fortranlist,pascallist:^fileblock;
first:Boolean;
infile,relfile,linkfile:text;
curfile,filelist:^fileblock;
defaults:^fileblock;
dodeb,noexec,nolink,ccl:Boolean;
i,which,ptr,key:integer;
switchtable:table;
buf:packed array[1:200]of char;
r:retptr;
idate,odate:array[1:1]of integer;
xwd:packed record case Boolean of
true:(full:integer);
false:(lh:0..777777B;rh:0..777777B)
end;
initprocedure;
begin
first := true;
end;
procedure quit; extern;
procedure pascmp; extern;
procedure run(prog:alfa); extern;
procedure linkcommand;
var jobno:array[1:1]of integer;
tempname:packed array[1:12] of char;
i,j:integer;
begin
writeln(buf:findnull(buf)-1);
if noexec
then writeln('/G')
else writeln('/G/E');
close(output);
end;
function getoct:integer;
var x:packed record case Boolean of
true:(word:integer);
false:(junk:0..777777B;page:0..777B;addr:0..777B)
end;
begin
x.word := cmnum8;
with x do
begin
if (junk <> 0) or (page = 0)
then begin
writeln(tty);
writeln(tty,'? Must be between 1000 and 777777');
cmagain
end;
if addr = 0
then page := page-1;
addr := 777B;
getoct := word;
end;
end;
procedure parseswitch;
begin
with curfile^ do
case cmint of
zero: switches := switches + [zero];
-version: begin
switches := switches + [version];
versionval := cmnum8;
end;
-stack: begin
switches := switches + [stack];
stackval := getoct;
end;
objectlist: switches := switches + [objectlist];
nomain: switches := switches + [nomain];
nodebug: switches := switches + [nodebug];
arithcheck: switches := switches + [arithcheck];
noarithcheck: switches := switches + [noarithcheck];
nocheck: switches := switches + [nocheck];
nobinary: switches := switches + [nobinary];
list: switches := switches + [list];
-heap: begin
switches := switches + [heap];
heapval := getoct
end;
debug: dodeb := true;
cref: switches := switches + [cref];
compile: switches := switches + [compile];
load: noexec := true;
noload: nolink := true;
fortran: switches := switches + [fortran];
pascal: switches := switches + [pascal];
macro: switches := switches + [macro];
{%%%%}
end;
end;
procedure dodef(switch:integer);
begin
if switch in defaults^.switches
then curfile^.switches := curfile^.switches + [switch]
end;
procedure dodefi(switch:integer;var dval,lval:integer);
begin
if (switch in defaults^.switches) and not
(switch in curfile^.switches)
then begin
curfile^.switches := curfile^.switches + [switch];
lval := dval
end
end;
{The default for /ARITH is the setting of /CHECK}
if not aswseen
then r^.asw := r^.csw;
end;
procedure checkextension(defext:char3;language:integer);
begin
if curfile^.language <> 0
then if (buf[1]=defext[1]) and (buf[2]=defext[2]) and
(buf[3]=defext[3]) and (buf[4]=chr(0))
then curfile^.language := language
end;
procedure checkswitch(language);
begin
if language in curfile^.switches
then if curfile^.language = 0
then curfile^.language := language
else cmuerr('More than one language specified')
end;
{*****
PASS1
*****}
procedure pass1;
begin
{Switchtable is table of compiler switches}
switchtable := tbmak(20);
{%%%%}
tbadd(switchtable,zero,'ZERO',0);
tbadd(switchtable,version,'VERSION:',0);
tbadd(switchtable,stack,'STACK:',0);
tbadd(switchtable,pascal,'PASCAL',0);
tbadd(switchtable,objectlist,'OBJECTLIST',0);
tbadd(switchtable,nomain,'NOMAIN',0);
tbadd(switchtable,noload,'NOLOAD',0);
tbadd(switchtable,nodebug,'NODEBUG',0);
tbadd(switchtable,nocheck,'NOCHECK',0);
tbadd(switchtable,nobinary,'NOBINARY',0);
tbadd(switchtable,noarithcheck,'NOARITHCHECK',0);
tbadd(switchtable,macro,'MACRO',0);
tbadd(switchtable,load,'LOAD',0);
tbadd(switchtable,list,'LIST',0);
tbadd(switchtable,heap,'HEAP:',0);
tbadd(switchtable,fortra,'FORTRAN',0);
tbadd(switchtable,debug,'DEBUG',0);
tbadd(switchtable,cref,'CREF',0);
tbadd(switchtable,compile,'COMPILE',0);
tbadd(switchtable,arithcheck,'ARITHCHECK',0);
cminir('PASCAL>');
ccl := cmmode = rescan;
{init global state variables only - must be done after cminir in case
of recycle due to typo}
noexec := false;
nolink := false;
ccl := false;
dodeb := false;
filelist := nil;
newz(curfile); {Get a pseudo-file for global defaults}
loop {parse switches, stop when come to a file name}
cmmult; {multiple mode}
i := cmswi(switchtable); {global switches}
gjgen(100000000000B); {an input file}
gjext('PAS');
cmfil(infile);
exit if cmdo = 2; {stop on file name}
parseswitch {sets values into car filelist as sideeffect}
end;
defaults := curfile; {copy pseudofile as defaults}
loop {over file names}
newz(curfile); {new file block}
{we have seen a file name - put it in the block}
jsys(30B{jfns};-1:curfile^.filename,0:infile,111111140001B);
jsys(30B{jfns};-1:curfile^.namefield,0:infile,001000B:0);
jsys(30B{jfns};-1:buf,000100B:0); {get extension}
jsys(23B{rljfn},2;0:infile);
loop {parse switches, stop when come to comma or eol}
cmmult; {multiple mode}
i := cmswi(switchtable); {file switches}
cmcma; {comma}
cmcfm;
which := cmdo;
exit if which <> 1; {stop if not switch}
parseswitch {sets values into car filelist as sideeffect}
end;
{Now make sure we know the language, and validate some switches}
{%%%%}
checkswitch(pascal);
checkswitch(fortran);
checkswitch(macro);
checkextension('FOR',fortran);
checkextension('MAC',macro);
if curfile^.language = 0 {still undefined}
then curfile^.language := pascal;
if curfile^.language <> pascal
then if ([zero,stack,objectlist,nomain,nodebug,nocheck,heap,version,
arithcheck,noarithcheck] * curfile^.switches) <> []
then cmuerr('Pascal switch used with another language');
curfile^.nextfile := filelist; {link it into the list}
filelist := curfile;
exit if which = 3;
gjgen(100000000000B); {an input file}
gjext('PAS');
cmfil(infile);
end;
end; {of PASS1}
procedure addtolist(var whichlist:fileptr);
begin
curfile^.nextfile := whichlist;
whichlist := curfile
end;
procedure opentemp(var f:file;lang:char3);
begin
jsys(507B{getji},2;-1,-1:jobno,0);
tempname := '000LNK.TMP;T';
i := jobno[1];
for ptr := 3 downto 1 do {convert jobnumber to char's}
begin
tempname[ptr] := chr((i mod 10) + 60B);
i := i div 10;
end;
for ptr := 1 to 3 do
tempname[ptr+3] := lang[ptr];
rewrite(f,tempname);
end;
procedure dolang(lang:integer;langlist:fileptr;langname:char3);
var opened,doit:boolean;rellen:integer;
begin
opened := false;
curfile := langlist;
while curfile <> nil do
begin
{process one file}
{first set up switch values}
dodef(nobinary);
dodef(list);
dodef(cref);
dodef(compile);
{always put rel file name in link command}
rellen := findnull(curfile^.namefield)+3
putstr(curfile^.namefield,rellen-4,buf,1);
buf[rellen-3] := '.';
putstr('REL',3,buf,rellen-2);
buf[rellen+1] := chr(0);
writeln(linkfile,buf:rellen);
{Here we see if a compilation is really needed, by checking creation dates}
doit := false;
{check for forced}
if compile in curfile^.switches
then doit := true;
{check for no rel file}
if not doit
then begin
jsys(20B{gtjfn},2,i;100001B:0,-1:buf;relfile);
if i = 1 {no rel file}
then doit := true;
end;
{check dates}
if not doit
then begin
jsys(20B{gtjfn},2,i;100011B:0,-1:curfile^.filename;infile);
if i <> 2
then begin
writeln(tty,'? Can''t get back input file: ',curfile^.filename:
findnull(curfile^.filename)-1);
quit
end;
jsys(63B{gtfdb};infile,1:5,idate);
jsys(63B{gtfdb};relfile,1:5,odate);
if (odate[1] <= idate[1])
then doit := true;
jsys(23B{rljfn},2;0:infile);
jsys(23B{rljfn},2;0:relfile);
end;
{Now the code for actually doing a compilation}
if doit
then begin
if not opened
then begin
opentemp(output,langname);
opened := true
end;
if not (nobin in curfile^.switches)
then write(buf:rellen);
if list in curfile^.switches
then write(',',curfile^.namefield:rellen-4,'.LST');
writeln('=',curfile^.filename:findnull(curfile^.filename)-1);
end;
curfile := curfile^.nextfile;
end;
if opened {we wrote something}
then begin
if firstrun <> 0 {there is something to run after us}
then begin
if lang = fortran
then write('/RUN:');
case firstrun of
-1: write('SYS:LINK');
fortran: write('SYS:FORTRA');
macro: write('SYS:MACRO');
end;
if lang <> fortran
then write('!');
writeln;
end;
close(output);
end
end;
{*****
PASS2
*****}
procedure pass2;
begin
if not nolink {initialize for link}
then begin
opentemp(linkfile,'LNK');
if dodeb
then writeln(linkfile,'SYS:PASDDT');
end;
{sort into lists by language}
{%%%%}
pascallist := nil;
fortranlist := nil;
macrolist := nil;
curfile := filelist;
while curfile <> nil do
begin
case curfile^.language of
{%%%%}
pascal: addtolist(pascallist);
fortran: addtolist(fortranlist);
macro: addtolist(macro)
end;
curfile := curfile^.nextfile
end;
if nolink
then firstrun := 0
else firstrun := -1;
{%%%%}
if fortranlist <> nil
then dolang(fortran,fortranlist,'FOR');
if macrolist <> nil
then dolang(macro,macrolist,'MAC');
if not nolink
then begin
{do the part of dolang applying to pascal}
curfile := pascallist;
while curfile <> nil do
begin
writeln(linkfile,curfile^.namefield:findnull(curfile^.namefield)-1);
curfile := curfile^.nextfile
end;
{Closing stuff for link}
if noexec
then writeln(linkfile,'/G')
else writeln(linkfile,'/E/G')
end
end;
end; {of pass2}
{Pasprm is a coroutine with the Pascal compiler. The first time
it is called we do the early passes. The last time it is called,
we do the late passes}
function pasprm(var infile,outfile,relfile:text):retptr;
begin
if firsttime
then begin
pass1;
pass2;
pass3;
if pascallist = nil
then lastpasses {never returns}
end;
firsttime := false;
newz(r);
while pascallist <> nil do
begin
curfile := pascallist;
dodef(nobinary);
dodef(list);
dodef(cref);
dodef(compile);
dodef(zero);
dodefi(stack,defaults^.stackval,curfile^.stackval);
dodef(objectlist);
dodef(nomain);
dodef(nodebug);
dodef(nocheck);
dodefi(heap,defaults^.heapval,curfile^.heapval);
dodefi(version,defaults^.versionval,curfile^.versionval);
{/ARITH is the complex one}
aswseen := false;
if (arithcheck in curfile^.switches) or
(noarithcheck in curfile^.switches)
then aswseen := true;
if not aswseen and
((arithcheck in defaults^.switches) or
(noarithcheck in defaults^.switches))
then begin
dodef(arithcheck);
dodef(noarithcheck);
aswseen := true;
end;
if not aswseen then
if not (nocheck in curfile^.switches)
then curfile^.switches := curfile^.switches + [arithcheck];
{And make the rel file be the input name.REL. also copy name
as output module name.}
putstr(curfile^.namefield,40,buf,1);
if buf[1] = chr(0)
then begin
putstr('MAIN',4,buf,1);
buf[5] := chr(0);
end;
with r^ do
begin
ptr := findnull(buf);
buf[ptr] := ' ';
putstr(buf,10,relnam,1);
end;
putstr('.REL',4,buf,ptr);
buf[ptr+4] := chr(0);
{Here we see if a compilation is really needed, by checking creation dates}
jsys(20B{gtjfn},2,i;100001B:0,-1:buf;relfile);
if i = 2
then begin
jsys(63B{gtfdb};infile,1:5,idate);
jsys(63B{gtfdb};relfile,1:5,odate);
if (odate[1] > idate[1]) and not force\\\
then begin {not needed - call link now}
jsys(23B{rljfn},2;0:infile);
jsys(30B{jfns};-1:buf,0:relfile,201100B:1);
jsys(23B{rljfn},2;0:relfile);
calllink;
end
end;
jsys(23B{rljfn},2;0:relfile);
end;
if nobin\\\
then jsys(20B{gtjfn},2;400011B:0,-1:'NUL:';relfile)
else jsys(20B{gtjfn},2;400001B:0,-1:buf;relfile);
if dolist\\\ or r^.crsw or r^.lsw
then begin
if r^.crsw
then putstr('CRF',3,buf,ptr+1)
else putstr('LST',3,buf,ptr+1);
jsys(20B{gtjfn},2;400001B:0,-1:buf;outfile);
end
else jsys(20B{gtjfn},2;400011B:0,-1:'NUL:';outfile);
with r^ do
begin
r^.rpgsw := ccl;
dsw := true;
csw := true;
msw := true;
tsw := true;
end;
pasprm := r
end;
procedure pasxit(var infile,outfile,relfile:text);
begin
close(infile);
if ccl
then jsys(30B{jfns};-1:buf,0:relfile,201100B:1);
close(outfile);
close(relfile);
if ccl
then calllink
else pascmp
end
.