Artifact 8f8022ebcab5ebdc8b3b62e17a8a7c3bcd135edc1021b3d7dd6773d66c04787d:

• File psl-1983/20-kernel/system-io.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: 8745) [annotate] [blame] [check-ins using] [more...]

%
% SYSTEM-IO.RED - System dependent IO routines for Dec-20 PSL
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        16 September 1981
% Copyright (c) 1981 University of Utah
%

global '(IN!* OUT!*);
LoadTime <<
IN!* := 0;
OUT!* := 1;
>>;

fluid '(StdIN!* StdOUT!* ErrOUT!* !*Echo);
LoadTime <<
StdIN!* := 0;
StdOUT!* := 1;
ErrOUT!* := 1;
>>;

CompileTime flag('(RDTTY FindFreeChannel Dec20Open ContOpenError ClearIO1),
		 'InternalFunction);

on SysLisp;

external WArray JFNOfChannel, ReadFunction, WriteFunction, CLoseFunction;

if_system(Tops20,
lap '((!*entry Dec20ReadChar expr 1)
	(!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
Loop					% get JFN for channel
	(bin)				% read a character
	(erjmp CheckEOF)		% check for end-of-file on error
	(!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
	(!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
	(!*MOVE (reg 2) (reg 1))	% move char to reg 1
	(camn (reg nil) (fluid !*ECHO))	% is echo on?
	(!*EXIT 0)			% no, just return char
	(!*PUSH (reg 1))		% yes, save char
	(!*CALL WriteChar)		% and write it
	(!*POP (reg 1))			% restore it
	(!*EXIT 0)			% and return
CheckEOF
	(gtsts)				% check file status
	(tlnn (reg 2) 2#000000001000000000)	% gs%eof
	(!*JUMP (Label ReadError))
	(!*MOVE (WConst 26) (reg 1))	% return EOF char
	(!*EXIT 0)
ReadError
	(!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
	(!*JCALL IoError)
));

if_system(Tenex,
lap '((!*entry Dec20ReadChar expr 1)
	(!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
Loop					% get JFN for channel
	(bin)				% read a character
	(erjmp CheckEOF)		% check for end-of-file on error
	(!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
	(!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
	(cain (reg 2) (WConst 8#37))	% TENEX EOL
	(!*MOVE (WConst 8#12) (reg 2))	% replace it with a linefeed
	(!*MOVE (reg 2) (reg 1))	% move char to reg 1
	(camn (reg nil) (fluid !*ECHO))	% is echo on?
	(!*EXIT 0)			% no, just return char
	(!*PUSH (reg 1))		% yes, save char
	(!*CALL WriteChar)		% and write it
	(!*POP (reg 1))			% restore it
	(!*EXIT 0)			% and return
CheckEOF
	(gtsts)				% check file status
	(tlnn (reg 2) 2#000000001000000000)	% gs%eof
	(!*JUMP (Label ReadError))
	(!*MOVE (WConst 26) (reg 1))	% return EOF char
	(!*EXIT 0)
ReadError
	(!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
	(!*JCALL IoError)
));

lap '((!*entry Dec20WriteChar expr 2)
	(!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
					% get JFN for channel
	(!*JUMPEQ (Label CRLF) (reg 2) (WConst 8#12))	% if LF, echo CRLF
	(bout)				% no, just echo char
	(!*EXIT 0)			% return
CRLF
	(!*MOVE (WConst 8#15) (reg 2))	% write carriage-return
	(bout)
	(!*MOVE (WConst 8#12) (reg 2))	% write linefeed
	(bout)
	(!*EXIT 0)			% return
);

internal WConst MaxTerminalBuffer = 200;
internal WVar NextTerminalChar = 1;
internal WString TerminalInputBuffer[MaxTerminalBuffer];

lap '((!*entry ClearIO1 expr 0)
%
% ^C from RDTTY and restart causes trouble, but we don't want a full RESET
% (don't want to close files or kill forks), so we'll just do the
% part of RESET that we want, for terminal input
%
	(!*MOVE (WConst 8#100) (reg 1))	% .priin
	(rfmod)
	(tro 2 2#001111100001000000)	% tt%wak + tt%eco + .ttasi, like RESET
	(sfmod)
	(!*EXIT 0)
);

syslsp procedure ClearIO();
<<  ClearIO1();
    TerminalInputBuffer[0] := -1;
    NextTerminalChar := 0;
    LispVar IN!* := LispVar STDIN!*;
    LispVar OUT!* := LispVar STDOUT!* >>;

if_system(Tops20,
lap '((!*entry RDTTY expr 3)
	(dmove (reg t1) (reg 1))
	(!*MOVE (WConst 8#101) (reg 1))	% .priou
	(rfmod)				% read mode word
	(tlze (reg 2) 2#100000000000000000)	% if tt%osp is 0, then skip
	(sfmod)				% otherwise turn on output
	(dmove (reg 1) (reg t1))
	(!*MOVE (reg 2) (reg 4))	% save original count in r4
	(!*WPLUS2 (reg 1) (WConst 1))	% make input buffer into byte pointer
	(hrli (reg 1) 8#440700)
	(!*WPLUS2 (reg 3) (WConst 1))	% make prompt string into byte pointer
	(hrli (reg 3) 8#440700)
	(!*MOVE (reg 1) (reg 5))	% print it once
	(!*MOVE (reg 3) (reg 1))
	(psout)
	(!*MOVE (reg 5) (reg 1))
	(hrli (reg 2) 2#000110000000000000)	% rd%bel + rd%crf
	(jsys 8#523)			% RDTTY
	(!*JUMP (Label CantRDTTY))
	(!*MOVE (reg 4) (reg 1))	% move original count to r1
	(hrrzs (reg 2))			% clear flag bits in r2
	(!*WDIFFERENCE (reg 1) (reg 2))	% return # chars read, not # available
	(!*EXIT 0)
CantRDTTY
	(!*MOVE (QUOTE "Can't read from terminal") (reg 1))
	(!*JCALL IOError)
));

if_system(Tenex,
lap '((!*entry RDTTY expr 3)
	(move (reg t1) (reg 1))
	(move (reg t2) (reg 2))
	(!*MOVE (WConst 8#101) (reg 1))	% .priou
	(rfmod)				% read mode word
	(tlze (reg 2) 2#100000000000000000)	% if tt%osp is 0, then skip
	(sfmod)				% otherwise turn on output
	(move (reg 1) (reg t1))
	(move (reg 2) (reg t2))
	(!*MOVE (reg 2) (reg 4))	% save original count in r4
	(!*WPLUS2 (reg 1) (WConst 1))	% make input buffer into byte pointer
	(hrli (reg 1) 8#440700)
	(!*WPLUS2 (reg 3) (WConst 1))	% make prompt string into byte pointer
	(hrli (reg 3) 8#440700)
	(!*MOVE (reg 1) (reg 5))	% print it once
	(!*MOVE (reg 3) (reg 1))
	(psout)
	(!*MOVE (reg 5) (reg 1))
%	(hrli (reg 2) 2#000110000000000000)	% rd%bel + rd%crf
%	(jsys 8#523)			% RDTTY
%	(!*JUMP (Label CantRDTTY))
	(!*MOVE (WConst MaxTerminalBuffer) (reg 2))	% # of chars
	(setz 3 0)			% clear 3
	(jsys 8#611)			% PSTIN, IMSSS JSYS
	(!*MOVE (WConst 8#12) (reg 3))	% put linefeed at end of buffer
	(dpb (reg 3) (reg 1))		% 1 points to end of what's been read
	(!*MOVE (reg 4) (reg 1))	% move original count to r1
	(hrrzs (reg 2))			% clear flag bits in r2
	(!*WDIFFERENCE (reg 1) (reg 2))	% return # chars read, not # available
	(!*EXIT 0)
));

syslsp procedure TerminalInputHandler Chn;
begin scalar Ch;
    while NextTerminalChar >= StrLen TerminalInputBuffer do
    <<  NextTerminalChar := 0;
	TerminalInputBuffer[0] := RDTTY(TerminalInputBuffer,
					    MaxTerminalBuffer,
					    if StringP LispVar PromptString!*
						then LispVar PromptString!*
						else ">") >>;
    Ch := StrByt(TerminalInputBuffer, NextTerminalChar);
    NextTerminalChar := NextTerminalChar + 1;
    return Ch;
end;

syslsp procedure FindFreeChannel();
begin scalar Chn;
    Chn := 0;
    while JfnOfChannel[Chn] neq 0 do
    <<  if Chn >= MaxChannels then IOError("No free channels left");
	Chn := Chn + 1 >>;
    return Chn;
end;

syslsp procedure SystemMarkAsClosedChannel FileDes;
    JFNOfChannel[IntInf FileDes] := 0;

lap '((!*entry Dec20CloseChannel expr 1)
	(!*MOVE (reg 1) (reg 2))	% save in case of error
	(!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
	(closf)
	(!*JUMP (Label CloseError))
	(!*EXIT 0)
CloseError
	(!*MOVE (QUOTE "Channel could not be closed") (reg 1))
	(!*JCALL ChannelError)
);

syslsp procedure SystemOpenFileSpecial FileName;
<<  JFNOfChannel[FileName := FindFreeChannel()] := -1;
    FileName >>;

syslsp procedure SystemOpenFileForInput FileName;
begin scalar Chn, JFN;
    Chn := FindFreeChannel();
    JFN := Dec20Open(FileName,
		     %  gj%old	    gj%sht
		     2#001000000000000001000000000000000000,
		     % 7*of%bsz		of%rd
		     2#000111000000000000010000000000000000);
    if JFN eq 0 then return ContOpenError(FileName, 'INPUT);
    JFNOfChannel[Chn] := JFN;
    ReadFunction[Chn] := 'Dec20ReadChar;
    CloseFunction[Chn] := 'Dec20CloseChannel;
    return Chn;
end;

syslsp procedure SystemOpenFileForOutput FileName;
begin scalar Chn, JFN;
    Chn := FindFreeChannel();
    JFN := Dec20Open(FileName,
		    % gj%fou gj%new gj%sht
		    2#110000000000000001000000000000000000,
		    % 7*of%bsz		of%wr
		    2#000111000000000000001000000000000000);
    if JFN eq 0 then return ContOpenError(FileName, 'OUTPUT);
    JFNOfChannel[Chn] := JFN;
    WriteFunction[Chn] := 'Dec20WriteChar;
    CloseFunction[Chn] := 'Dec20CloseChannel;
    return Chn;
end;

lap '((!*entry Dec20Open expr 3)
%
%	Dec20Open(Filename string, GTJFN bits, OPENF bits)
%
	(!*WPLUS2 (reg 1) (WConst 1))	% increment r1 to point to characters
	(hrli (reg 1) 8#440700)		% turn r1 into a byte pointer
	(!*MOVE (reg 1) (reg 4))	% save filename string in r4
	(!*MOVE (reg 2) (reg 1))	% GTJFN flag bits in r1
	(!*MOVE (reg 4) (reg 2))	% string in r2
	(gtjfn)
	(!*JUMP (Label CantOpen))
	(!*MOVE (reg 3) (reg 2))	% OPENF bits in r2, JFN in r1
	(openf)
CantOpen
	(!*MOVE (WConst 0) (reg 1))	% return 0 on error
	(!*EXIT 0)			% else return the JFN
);

off SysLisp;

lisp procedure ContOpenError(FileName, AccessMode);
    ContinuableError(99,
		     BldMsg("`%s' cannot be open for %w",
			  FileName,		AccessMode),
		     list('OPEN, MkSTR FileName, MkQuote AccessMode));

END;