Artifact 0d2458d6d1f04659a9febf53e9996c14eb10bfe83dbdadef1d949e96fe32f029:

• File r30/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: 3018) [annotate] [blame] [check-ins using] [more...]

COMMENT This file provides support for calling the EXEC and the system
	editor under TOPS-20 or TENEX;

SYMBOLIC;

GLOBAL '(PROGEXT!* PSYSDEV!* CRLFST!* EXECFORK!* EXECFILE!* SYSTEM!*
	 !$EOL!$);

PROGEXT!* := IF SYSTEM!*>0 THEN '(V A S !.) ELSE '(E X E !.);

PSYSDEV!* := IF SYSTEM!*>0 THEN '(!< S U B S Y S !>) ELSE '(S Y S !:);

CRLFST!* := IF SYSTEM!*<0 THEN LIST(INTERN ASCII 13,INTERN ASCII 10,'!")
	     ELSE LIST(!$EOL!$,'!");

EXECFORK!* := EXECFILE!* := IF SYSTEM!*<0 THEN "<SYSTEM>EXEC.EXE"
			     ELSE "<SYSTEM>EXEC.SAV";

SYMBOLIC PROCEDURE PINSTAT;
 BEGIN SCALAR X,Y,Z;
  Z := CURSYM!*;
  IF DELCP(X := NXTSYM!*) THEN GO TO DUN;
  Y := REVERSIP EXPLODEC NXTSYM!*;
  IF DELCP(X := CRCHAR!*) THEN GO TO DUN;
  Y :=  CRCHAR!* . Y;
  CRCHAR!* := '! ;
  WHILE NOT DELCP(X := READCHQ()) DO Y := X . Y;
DUN:
  NXTSYM!* := X;
  TTYPE!* := 3;
  SCAN();
  RETURN LIST(Z,IF Y THEN MKQUOTE REVERSIP Y ELSE NIL)
 END;

SYMBOLIC PROCEDURE READCHQ;
 IF !*INT AND NULL IFL!* THEN READCH1() ELSE READCH();

REMPROP('EXEC,'STAT);

REMPROP('PUSH,'STAT);

REMFLAG('(EXEC PUSH),'GO);

SYMBOLIC PROCEDURE PUSH U; EXEC U;   %we might as well support both;

SYMBOLIC PROCEDURE EXEC U;
 BEGIN SCALAR V,X,Y,Z;
   IF NULL U THEN RETURN XEQKEEP('EXECFORK!*,EXECFILE!*,NIL);
   V := U;
A: IF CAR U EQ '!: OR CAR U EQ '!< THEN Y := T
    ELSE IF CAR U EQ '!. THEN Z := T
    ELSE IF SEPRP CAR U THEN GO TO B;
   X := CAR U . X;
   IF (U := CDR U) THEN GO TO A;
B: X := REVERSIP('!" . IF Z THEN X ELSE APPEND(PROGEXT!*,X));
   X := COMPRESS('!" . IF Y THEN X ELSE APPEND(PSYSDEV!*,X));
   RETURN XEQKILL(X,LIST COMPRESS('!" . APPEND(V,CRLFST!*)))
 END;

PUT('EXEC,'STAT,'PINSTAT);

PUT('PUSH,'STAT,'PINSTAT);

%FLAG('(EXEC PUSH),'GO);

SYMBOLIC PROCEDURE XEQKILL(FILENAME,ARG);
   %handles infrequent calls by creating and killing each fork;
   <<!%XEQ(FILENAME,T,T,NIL,ARG); TERPRI();
     PRIN2T "Returned to REDUCE ..."; NIL>>;

SYMBOLIC EXPR PROCEDURE XEQKEEP(FORKN,FILE,ARG);
   %This retains the lower fork for speedy subsequent calls to the same
   %program (e.g., PUSH or EDIT), and the ---FILE check will set up the
   %fork again after a SAVE;
 BEGIN SCALAR A;
  A:=ERRORSET(LIST('!%XEQ,FORKN,T,NIL,NIL,MKQUOTE ARG),NIL,NIL);
  SET(FORKN,IF ATOM A THEN !%XEQ(FILE,T,NIL,NIL,ARG) ELSE CAR A);
  TERPRI();
  PRIN2T "Returned to REDUCE ..."
 END;

%SYMBOLIC PROCEDURE KFORK U;
% PAIRP ERRORSET(LIST('JSYS,153,MKQUOTE U,0,0,1),NIL,NIL);

%DATE!*:=JSYS(144,'(BUF),-1,604241920,1);

%The following function is called by BEGIN. It checks that terminal 
% linelength in REDUCE is shorter than the width of the controlling
% terminal.
% Commented out as it is to sensitive to operating system differences.
%SYMBOLIC PROCEDURE CHKLEN;
% BEGIN SCALAR A,B;
%  A := ERRORSET('(JSYS 63 65 24 0 3),NIL,NIL);	%Try MTOPR first, 
%  A := IF PAIRP A THEN CAR A
%        ELSE BOOLE(1,LSH(JSYS(71,65,0,0,2),-18),127); % else use RFMOD
%  IF A<10 THEN RETURN;
%  B := LINELENGTH NIL;
%  IF A LEQ B THEN LINELENGTH(A-1);
%  RETURN B
% END;


END;