reduce-historical/psl-1983/20-util/exec.red

%
% EXEC.RED -   Simple TOPS20 Interfaces, "EXEC Fork", etc
% 
% Author:      Martin L. Griss and Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        8 March 1981
% Copyright (c) 1981 University of Utah
%

%  <PSL.UTIL>EXEC.RED.5, 24-May-82 13:01:50, Edit by BENSON
%  Changed <EDITORS> and <SUBSYS> to SYS: in filenames
%/ Changed FILNAM->FileName, due to GLOBAL conflict
%/ Changed JSYS calls, so LIST(..) rather than '(..) used
%/ Changed for V3:JSYS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Simple JSYS interfaces

imports '(JSYS);

GLOBAL '(ForkNAMES!* EXECFork EMacsFork MMFork);

Lisp procedure GetOLDJfn FileName; %. test If file OLD and return Jfn
   Begin scalar Jfn; 
      If NULL StringP FileName then return NIL; 
      Jfn := JSYS1(Bits(2,3,17),FileName,0,0,jsGTJfn); 
	 % OLD!MSG!SHORT
      If Jfn<0 then return NIL; 
      return Jfn
   END;

Lisp procedure GetNEWJfn FileName; 	 %. test If file NEW and return Jfn
   Begin scalar Jfn; 
      If NULL StringP FileName then return NIL; 
      Jfn := JSYS1(Bits(0,1,3,17),FileName,0,0,jsGTJfn); 
	% GEN!NEW!MSG!SHORT
      If Jfn<0 then return NIL; 
      return Jfn
   END;

Lisp procedure RELJfn Jfn;	 %. return Jfn to system
 JSYS0(Jfn,0,0,0,jsRLJfn);

Lisp procedure OPENOLDJfn Jfn;	 %. OPEN to READ
 JSYS0(Jfn,Bits( (7 . 5),19),0,0,jsOPENF);

Lisp procedure OPENNEWJfn Jfn;	 %. Open to WRITE
 JSYS0(Jfn,Bits( (7 . 5),20),0,0,jsOPENF);

Lisp procedure GetFork Jfn; 	 %. Create Fork, READ File on Jfn
   Begin scalar FH; 
      FH := JSYS1(Bits(1),0,0,0,jsCFork); 
      JSYS0(Xword(FH ,Jfn),0,0,0,jsGet); 
      return FH
   END;

Lisp procedure STARTFork FH;	 %. Start (Restart) a Fork
  JSYS0(FH, 0,0,0,jsSFRKV);

Lisp procedure WAITFork FH;	 %. Wait for completion
 JSYS0(FH,0,0,0,jsWFork);

Lisp procedure RUNFork FH;	 %. Normal use, to run a Fork
 <<STARTFork FH; WAITFork FH>>;

Lisp procedure KILLFork FH;	 %. Kill a Fork
   JSYS0(FH,0,0,0,jsKFork);

Lisp procedure SETPRIMARYJfnS(FH,INJfn,OUTJfn);
   JSYS0(FH,Xword(INJfn , OUTJfn),0,0,JSSPJfn);  %. Change PRIMARY Jfns (BAD?)

Lisp procedure OPENFork FileName; 	 %. Get a File into a Fork
   Begin scalar FH,Jfn; 
      If NULL FileP FileName then StdError CONCAT("Cant find File ",FileName); 
      Jfn := GetOLDJfn FileName; 
      FH := GetFork Jfn; 
      return FH
   END;

Lisp procedure RUN FileName;	 %. Run A File
   Begin scalar FH; FH := OPENFork FileName; RUNFork FH; KILLFork FH END;

Lisp Procedure ForkP FH;         %. test if Valid Fork Handle
  FixP FH and not Zerop FH; %/Kludge

Lisp procedure EXEC; 
  <<If Not ForkP EXECFork then EXECFork := OPENFork "SYSTEM:EXEC.EXE"; 
    RUNFork EXECFork>>;

Lisp procedure EMACS; 
  <<If Not ForkP EMacsFork then EMACSFork := OPENFork "SYS:EMACS.EXE"; 
    RUNFork EMACSFork>>;

Lisp procedure MM; 
  <<If Not ForkP MMFork then  MMFork := OPENFork "SYS:MM.EXE";
    RUNFork MMFork>>;

Lisp procedure GetUNAME; 	 %. USER name
 Begin Scalar S;
   S:=Mkstring 80;
   JSYS0(s,JSYS1(0,0,0,0,JSGJINF),0,0,JSDIRST);
   Return RecopyStringToNULL S
 End;

Lisp procedure GetCDIR;	 %. Connected DIRECTORY
  Begin scalar s;
   S:=Mkstring 80;
   JSYS0(S,JSYS2(0,0,0,0,jsGJINF),0,0,jsDIRST);
   return RecopyStringToNULL S
 end;

Lisp procedure PSOUT S;	 %. Print String
 JSYS0(S,0,0,0,jsPSOUT);

Lisp procedure GTJfn L;	 %. Get a Jfn
 JSYS1(L,0,0,0,jsGTJFN);

Lisp procedure NAMEFROMJfn J;	 %. name of File on a Jfn
  Begin scalar S;
       s:=Mkstring 100;
       JSYS0(S,J,0,0,JSJfnS);
  return RecopyStringToNULL S;
 end;

Fexpr Procedure InFile(U);   %. INPUT FILE, (prompt for name too?)
 If StringP U then DskIn EVAL CAR U
  else
    Begin scalar Jfn,Fname;
      PSOUT "Input file:";
	Jfn:=Jsys1(BITS(2,3,4,16,17),Xword(8#100,8#101),0,0,jsGTJFN);
	Fname:= NAMEFROMJFN JFN;
	RELJFN JFN;
        PRINTF("reading file %r %n", FNAME);
        DSKIN Fname;
    end;

%-- Command string processor and take

Lisp procedure  PutRescan(S);	%. Enter String
 <<JSYS0(S,0,0,0,jsRSCAN);
   JSYS0(0,0,0,0,jsRSCAN)>>;

On SYSLISP;

syslsp procedure  GetRescan();	%. Return as String
 Begin scalar N,S;
   XJSYS1(0,0,0,0,jsRSCAN);      % Announce to Get
   N:=XJSYS1(1,0,0,0,jsRSCAN); % How Many
   IF N=0 then return 'Nil;
   S:=GtStr N-1;   % To Drop Trailing EOL
   For I:=0:N-2 do
	StrByt(S,I):=XJsys1(0,0,0,0,JsPBIN);
   Return MkSTR S; % Will include Program name
 end;


OFF SYSLISP;

Global '(CRLF BL);

CRLF :=STRING(8#15,8#12);	%. CR-LF
BL :=STRING(8#40);		%. Blank

Lisp procedure  CONCATS (L);			%. Combine list of strings
 If PAIRP L then CONCAT(CAR L,CONCATS CDR L)
   else CRLF;

Lisp Fexpr Procedure CMDS (!%L);            %. user COMMAND submit
  DOCMDS EVLIS !%L;

Lisp procedure  DOCMDS (L);                  %. Submit via PutRescan
 <<PutRescan CONCATS L;		% Add CR, plant in RSCAN
   EXEC()>>;			% Run 'em

%. -------- Sample Commands

Lisp procedure  VDIR (L);
 DOCMDS LIST("VDIR ",L,CRLF,"POP");

Lisp procedure HelpDir();
 DOCMDS  LIST("DIR PH:*.HLP",CRLF,"POP");

Lisp procedure Take (FileName);
  If FileP FileName then DOCMDS LIST("Take ",FileName,CRLF,"POP");

Lisp procedure  SYS (L);
  DOCMDS LIST("SYS ", L, CRLF, "POP");

Lisp procedure  TALK (L);
  DOCMDS LIST("TALK ",L,CRLF);

Lisp procedure  TYPE (L);
  DOCMDS LIST("TYPE ",L,CRLF,"POP");

END;