Artifact 35c5686fe3a261e50df83e49a70b8d738d86dceb84659294bb58a420df613d54:

• File psl-1983/20-util/exec.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 5363) [annotate] [blame] [check-ins using] [more...]

%
% 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;