Artifact 95292784560f588b16fc96c3999edf25bc074bed13a4299487a6561e7d527c14:
- File
psl-1983/3-1/tests/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: 9594) [annotate] [blame] [check-ins using] [more...]
- File
psl-1983/tests/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: 9594) [annotate] [blame] [check-ins using]
%============================================================================== % % SYSTEM-IO.RED - System independent IO routines for PSL % % Author: Modified by Robert R. Kessler % From System-io.red for the VAX by Eric Benson % Computer Science Dept. % University of Utah % Date: Modified 16 August 1982 % Original Date 16 September 1981 % % Copyright (c) 1982 University of Utah % %============================================================================== % Each individual system must have the following routines defined. % % The following definitions are used in the routines: % FileDescriptor - A machine dependent word that references a file once % opened; generated by the Open % FileName - A Lisp string of the file name. % % FileDescriptor := SysOpenRead (Channel,FileName); % % Open FileName for input and % % return a file descriptor used % % in later references to the % % file. Channel used only % % if needed to generate FileDesc % FileDescriptor := SysOpenWrite (Channel,FileName); % % Open FileName for output and % % return a file descriptor used % % in later references to the % % file. Channel used only % % if needed to generate FileDesc % SysWriteRec (FileDescriptor, StringToWrite, StringLength); % % Write StringLength characters % % from StringToWrite from the % % first position. % LengthRead := SysReadRec (FileDescriptor, StringBuffer); % % Read from the FileDescriptor, a % % record into the StringBuffer. % % Return the length of the % % string read. % SysClose (FileDescriptor); % Close FileDescriptor, allowing % % it to be reused. % TerminalInputHandler (FileDescriptor); % Input from the terminal, on % % FileDescriptor. This routine % % is expected to use the prompt % % in PromptString!*. % %============================================================================== CompileTime Load Fast!-Vector; global '(IN!* OUT!*); LoadTime << IN!* := 0; OUT!* := 1; >>; fluid '(StdIN!* StdOUT!* ErrOUT!* PromptOUT!* !*Echo); LoadTime << StdIN!* := 0; StdOUT!* := 1; ErrOUT!* := 5; PromptOUT!* := 6; >>; %============================================================================== % on SysLisp; % The channel table contains the actual file descriptor as returned from % the open routines. Since the file descriptor may be any value, it % may not be used in finding a free channel. Therefore, we now have a % warray ChannelStatus that is the current status of the channel. % NOTE: ChannelStatus must be initialized to all closed. % The following constants are used to indicate the status of the Channel. WConst ChannelClosed = 0, ChannelOpenRead = 1, ChannelOpenWrite = 2, ChannelOpenSpecial = 3; % Look into the ChannelStatus array for a free channel. syslsp procedure FindFreeChannel(); begin scalar Channel; Channel := 0; while ChannelStatus [Channel] neq ChannelClosed do << if Channel >= MaxChannels then IOError "No free channels left"; Channel := Channel + 1 >>; return Channel; end; CompileTime fluid '(IOBuffer); % Open the argument filename as a read only file. syslsp procedure SystemOpenFileForInput FileName; begin scalar Channel; Channel := FindFreeChannel(); ChannelTable [Channel] := SysOpenRead (Channel,FileName); ChannelStatus[Channel] := ChannelOpenRead; MaxBuffer [Channel] := SysMaxBuffer (ChannelTable [Channel]); ReadFunction [Channel] := 'IndependentReadChar; WriteFunction [Channel] := 'ReadOnlyChannel; CloseFunction [Channel] := 'IndependentCloseChannel; IGetV (LispVar IOBuffer, Channel) := MkString (MaxBuffer [Channel], 32); NextPosition [Channel] := 0; % Will be post Incremented BufferLength [Channel] := -1; return Channel; end; syslsp procedure SystemOpenFileForOutput FileName; begin scalar Channel; Channel := FindFreeChannel(); ChannelTable [Channel] := SysOpenWrite (Channel,FileName); ChannelStatus[Channel] := ChannelOpenWrite; MaxBuffer [Channel] := SysMaxBuffer (ChannelTable [Channel]); ReadFunction [Channel] := 'WriteOnlyChannel; WriteFunction [Channel] := 'IndependentWriteChar; CloseFunction [Channel] := 'IndependentCloseChannel; Igetv(LispVar IOBuffer,Channel) := MkString (MaxBuffer [Channel], 32); NextPosition [Channel] := -1; % Will be set pre-incremented BufferLength [Channel] := MaxBuffer [Channel]; return Channel; end; % Mark a channel as open for a special purpose. syslsp procedure SystemOpenFileSpecial FileName; begin scalar Channel; ChannelStatus [Channel] := ChannelOpenSpecial; return Channel end; syslsp procedure TestLegalChannel Channel; If not( PosIntP Channel and Channel <=MaxChannels) then IoError List(Channel," is not a legal channel "); % This function will read in a character from the buffer. It will read % the record on buffer length overflow only. Thus when an EOL character % is read, it is processed as any other character, except, if it is the last % one, in the record, it will do the read automatically. % Note, this will not read the next record until after the final character % has been processed. syslsp procedure IndependentReadChar Channel; begin scalar Chr; TestLegalChannel Channel; if NextPosition [Channel] > BufferLength [Channel] then << BufferLength [Channel] := SysReadRec (ChannelTable[Channel], IGetV(LispVar IOBuffer, Channel)); NextPosition [Channel] := 0 >>; Chr := StrByt (IGetV (LispVar IOBuffer, Channel), NextPosition [Channel]); NextPosition [Channel] := NextPosition [Channel] + 1; if LispVar !*Echo then WriteChar Chr; return Chr; end; % Write a character into the buffer. Actually dump the buffer when the % EOL character is found, or when the buffer is full. This happens % immediately upon meeting this condition, not waiting for the % next character. Note, that this places the EOL character into the % buffer for machine dependent treatment as CR/LF etc syslsp procedure IndependentWriteChar (Channel, Chr); Begin TestLegalChannel Channel; NextPosition [Channel] := NextPosition [Channel] + 1; StrByt (IGetV (LispVar IOBuffer, Channel), NextPosition [Channel]) := Chr; if (Chr eq char EOL) or (NextPosition [Channel] >= BufferLength [Channel]) then % 12/13/82 - rrk Placed code in FlushBuffer and added a call. FlushBuffer Channel; End; % 12/13/82 - rrk Added FlushBuffer procedure. % Flush out the buffer whether or not we have an EOL character. Procedure FlushBuffer Channel; << SysWriteRec (ChannelTable[Channel], IGetV (LispVar IOBuffer, Channel), NextPosition [Channel]); NextPosition[Channel] :=-1 >>; % Start Fresh Buffer % Mark the argument channel as closed and update the read, write and % close functions likewise. Careful, if the caller does this first % and then trys to access a read, write or close function we are % in big trouble. Is it correct to do this????? Or is a marking of % the channel status table sufficient. syslsp procedure SystemMarkAsClosedChannel Channel; << TestLegalChannel Channel; ChannelStatus [Channel] := ChannelClosed; ReadFunction [Channel] := WriteFunction [Channel] := CloseFunction [Channel] := 'ChannelNotOpen >>; % Actually close the argument channel. syslsp procedure IndependentCloseChannel Channel; << TestLegalChannel Channel; SysClose ChannelTable [Channel]>>; % Initialize Channel Tables etc Syslsp procedure ClearOneChannel(Chn,Bufflen,How); << MaxBuffer [Chn] := Bufflen; NextPosition [Chn] := 0; % SAL - Next two not properly initialized. LinePosition [Chn] := 0; UnreadBuffer [Chn] := 0; If how eq 'Input then BufferLength [Chn] := -1 else BufferLength [Chn] := 0; IGetV (LispVar IOBuffer, Chn) := MkString(Bufflen,32)>>; syslsp procedure ClearIO(); << SysClearIo(); If not VectorP LispVar Iobuffer then <<LispVar IOBuffer := MkVect (MaxChannels); ClearOneChannel(LispVar StdIn!*,200,'Input); ClearOneChannel(LispVar StdOut!*,200,'Output); ClearOneChannel(LispVar ErrOut!*,200,'OutPut); ClearOneChannel(LispVar PromptOut!*,200,'Output)>>; LispVar IN!* := LispVar StdIN!*; LispVar OUT!* := LispVar StdOUT!* >>; syslsp procedure TerminalInputHandler Channel; begin scalar Chr; TestLegalChannel Channel; if NextPosition [Channel] > BufferLength [Channel] then << ChannelWriteString(LispVar PromptOUT!*, if StringP LispVar PromptString!* then LispVar PromptString!* else ">"); % 12/13/82 - rrk Flush out the Prompt character. FlushBuffer LispVar PromptOut!*; BufferLength [Channel] := SysReadRec (ChannelTable[Channel], IGetV (LispVar IOBuffer, Channel)); NextPosition [Channel] := 0 >>; Chr := StrByt (IGetV (LispVar IOBuffer, Channel), NextPosition [Channel]); NextPosition [Channel] := NextPosition [Channel] + 1; if LispVar !*Echo then WriteChar Chr; return Chr; end; off SysLisp; END;