reduce-historical/psl-1983/kernel/other-io.red

%
% OTHER-IO.RED - Miscellaneous input and output functions
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        28 August 1981
% Copyright (c) 1981 University of Utah
%

% Edit by Cris Perdue, 27 Jan 1983 1428-PST
% put in Kessler's change so ChannelLineLength allows Len=0 to mean that
% EOL is not to be automatically written.
%  <PSL.KERNEL>OTHER-IO.RED.3, 29-Dec-82 12:23:52, Edit by PERDUE
%  added LPosn and ChannelLPosn
%  <PSL.KERNEL>OTHER-IO.RED.2, 17-Sep-82 15:46:38, Edit by BENSON
%  Added ChannelLinelength, ChannelPosn, ChannelEject, ChannelTerPri
%   ChannelReadCH, ChannelPrinC
%  <PSL.INTERP>OTHER-IO.RED.3, 21-Jul-82 00:48:35, Edit by BENSON
%  Made ReadCh do case conversion for *Raise

% Most of the uninteresting I/O functions from the Standard Lisp report

global '(OUT!*);			% Current output channel

fluid '(!*Raise);			% controls case conversion of IDs

on SysLisp;

external WArray LinePosition,		% Array indexed by channel
		MaxLine;		% ditto

syslsp procedure ChannelEject C;	%. Skip to top of next output page
<<  ChannelWriteChar(C, char FF);	% write a formfeed
    NIL >>;

syslsp procedure Eject();		%. Skip to top of next output page
    ChannelEject LispVar OUT!*;

syslsp procedure ChannelLineLength(Chn, Len);	%. Set maximum line length
begin scalar OldLen, StripLen;
    OldLen := MaxLine[Chn];
    if Len then
	if IntP Len and Len >= 0 then
	    MaxLine[Chn] := Len
	else
	    StdError BldMsg('"%r is an invalid line length", Len);
    return OldLen;		% if Len is NIL, just return current
end;

syslsp procedure LineLength Len;	%. Set maximum line length
    ChannelLineLength(LispVar OUT!*, Len);

syslsp procedure ChannelPosn Chn;	%. Number of characters since last EOL
    LinePosition[Chn];

syslsp procedure Posn();		%. Number of characters since last EOL
    ChannelPosn LispVar OUT!*;

syslsp procedure ChannelLPosn Chn;	%. Number of EOLs since last FF
    PagePosition[Chn];

syslsp procedure LPosn();		%. Number of EOLs since last FF
    ChannelLPosn LispVar OUT!*;

syslsp procedure ChannelReadCH Chn;	%. Read a single character ID
begin scalar X;				% for Standard Lisp compatibility
    X := ChannelReadChar Chn;		% converts lower to upper when *RAISE
    if LispVar !*Raise and X >= char lower a and X <= char lower z then
	X := char A + (X - char lower a);
    return MkID X;
end;

syslsp procedure ReadCH();		%. Read a single character ID
    ChannelReadCH LispVar IN!*;

syslsp procedure ChannelTerPri Chn;	%. Terminate current output line
<<  ChannelWriteChar(Chn, char EOL);
    NIL >>;

syslsp procedure TerPri();		%. Terminate current output line
    ChannelTerPri LispVar OUT!*;

off SysLisp;

LoadTime PutD('PrinC, 'EXPR, cdr GetD 'Prin2);	% same definition as Prin2
LoadTime PutD('ChannelPrinC, 'EXPR, cdr GetD 'ChannelPrin2);
					% same definition as ChannelPrin2
END;