{$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
.