Artifact 470fc5e9aab9a6cf9e5ae5a885c6cb0f93b3dc08ef20a88d751e2ef31c4b07f7:
- File
psl-1983/util/rawio.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: 6948) [annotate] [blame] [check-ins using] [more...]
% % RAWIO.RED - Support routines for PSL Emode % % Author: Eric Benson % Computer Science Dept. % University of Utah % Date: 17 August 1981 % Copyright (c) 1981, 1982 University of Utah % Modified and maintained by William F. Galway. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % DEC-20 version FLUID '(!*rawio); % T if terminal is using "raw" i.o. CompileTime << load if!-system; load syslisp$ if_system(Dec20, << load monsym$ load jsys$ >>) >>; BothTimes if_system(Dec20, % CompileTime probably suffices. << FLUID '( % Global? OldCCOCWords OldTIW OldJFNModeWord ); lisp procedure BITS1 U; if not NumberP U then Error(99, "Non-numeric argument to BITS") else lsh(1, 35 - U); macro procedure BITS U; begin scalar V; V := 0; for each X in cdr U do V := lor(V, BITS1 X); return V; end; >>); LoadTime if_system(Dec20, << OldJfnModeWord := NIL; % Flag "modes not saved yet" lap '((!*entry PBIN expr 0) % Read a single character from the TTY as a Lisp integer (pbin) % Issue PBIN (!*CALL Sys2Int) % Turn it into a number (!*exit 0) ); lap '((!*entry PBOUT expr 1) % write a single charcter to the TTY, works for integers and single char IDs % Don't bother with Int2Sys? (pbout) (!*exit 0) ); lap '((!*entry CharsInInputBuffer expr 0) % Returns the number of characters in the terminal input buffer. (!*MOVE (WConst 8#101) (reg 1)) % The input file (the terminal, = % 8#101) (sibe) % skip if input buffer empty (skipa (reg 1) (reg 2)) % otherwise # chars in r2 (setz (reg 1) 0) % if skipped, then zero (!*CALL Sys2Int) % Turn it into a number (!*exit 0) ); lap '((!*entry RFMOD expr 1) % returns the JFN mode word as Lisp integer (hrrzs (reg 1)) (rfmod) (!*MOVE (reg 2) (reg 1)) % Get mode word from R2 (!*CALL Sys2Int) (!*exit 0) ); lap '((!*entry RFCOC expr 1) % returns the 2 CCOC words for JFN as dotted pair of Lisp integers (hrrzs (reg 1)) (rfcoc) (!*PUSH (reg 2)) % save the first word (!*MOVE (reg 3) (reg 1)) (!*CALL Sys2Int) % make second into number (exch (reg 1) (indexed (reg st) 0)) % grab first word, save % tagged 2nd word. (!*CALL Sys2Int) % make first into number (!*POP (reg 2)) (!*JCALL Cons) % and cons them together ); lap '((!*entry RTIW expr 1) % Returns terminal interrupt word for specified process, or -5 for entire job, % as Lisp integer (hrrzs (reg 1)) % strip tag (rtiw) (!*MOVE (reg 2) (reg 1)) % result in r2, return in r1 (!*JCALL Sys2Int) % return as Lisp integer ); lisp procedure SaveInitialTerminalModes(); % Save the terminal modes, if not already saved. if null OldJfnModeWord then << OldJFNModeWord := RFMOD(8#101); OldCCOCWords := RFCOC(8#101); OldTIW := RTIW(-5); >>; lap '((!*entry SFMOD expr 2) % SFMOD(JFN, ModeWord); % set program related modes for the specified terminal (hrrzs (reg 1)) (!*PUSH (reg 1)) (!*MOVE (reg 2) (reg 1)) (!*CALL Int2Sys) (!*MOVE (reg 1) (reg 2)) (!*POP (reg 1)) (sfmod) (!*exit 0) ); lap '((!*entry STPAR expr 2) % STPAR(JFN, ModeWord); % set device related modes for the specified terminal (hrrzs (reg 1)) (!*PUSH (reg 1)) (!*MOVE (reg 2) (reg 1)) (!*CALL Int2Sys) (!*MOVE (reg 1) (reg 2)) (!*POP (reg 1)) (stpar) (!*exit 0) ); lap '((!*entry SFCOC expr 3) % SFCOC(JFN, CCOCWord1, CCOCWord2); % set control character output control for the specified terminal (hrrzs (reg 1)) (!*PUSH (reg 1)) (!*PUSH (reg 3)) (!*MOVE (reg 2) (reg 1)) (!*CALL Int2Sys) (exch (reg 1) (indexed (reg st) 0)) (!*CALL Int2Sys) (!*MOVE (reg 1) (reg 3)) (!*POP (reg 2)) (!*POP (reg 1)) (sfcoc) (!*exit 0) ); lap '((!*entry STIW expr 2) % STIW(JFN, ModeWord); % set terminal interrupt word for the specified terminal (hrrzs (reg 1)) (!*PUSH (reg 1)) (!*MOVE (reg 2) (reg 1)) (!*CALL Int2Sys) (!*MOVE (reg 1) (reg 2)) (!*POP (reg 1)) (stiw) (!*exit 0) ); lisp procedure EchoOff(); % A bit of a misnomer, perhaps "on_rawio" would be better. % Off echo, On formfeed, send all control characters % Allow input of 8-bit characters (meta key) if not !*rawio then % Avoid doing anything if already "raw mode" << SaveInitialTerminalModes(); % Note that 8#101, means "the terminal". % Clear bit 24 to turn echo off, % bits 28,29 turn off "translation" SFMOD(8#101, LAND(OldJFNModeWord, LNOT BITS(24, 28, 29))); % Set bit 0 to indicate "has mechanical tab" (so cntrl-L gets % through?). % Clear bit 34 to turn off cntrl-S/cntrl-Q STPAR(8#101, LAND(lor(OldJFNModeWord, BITS 1), LNOT BITS(34))); % More nonsense to turn off processing of control characters? SFCOC(8#101, LNOT(8#252525252525), LNOT(8#252525252525)); % Turn off terminal interrupts for entire job (-5), for everything % except cntrl-C (the bit number three that's one). STIW(-5,8#040000000000); !*rawio := T; % Turn on flag >>; lisp procedure EchoOn(); % Restore initial terminal echoing modes << % Avoid doing anything if OldJFNModeWord is NIL, means terminal mode % already "restored". if OldJFNModeWord then << SFMOD(8#101,OldJFNModeWord); STPAR(8#101,OldJFNModeWord); SFCOC(8#101,car OldCCOCWords,cdr OldCCOCWords); STIW(-5,OldTIW); >>; % Set to NIL so that things get saved again by % SaveInitialTerminalModes. (The terminal status may have been changed % between times.) OldJFNModeWord := NIL; !*rawio := NIL; % Indicate "cooked" i/o. >>; % Flush output buffer for stdoutput. (On theory that we're using buffered % I/O to speed things up.) Symbolic Procedure FlushStdOutputBuffer(); NIL; % Just a dummy routine for the 20. >> ); % END OF DEC-20 version. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % VAX Unix version LoadTime if_system(Unix, << % EchoOn, EchoOff, and CharsInInputBuffer are part of "kernel". Symbolic Procedure PBIN(); % Read a "raw character". NOTE--assumption that 0 gives terminal input. VaxReadChar(0); % Just call this with "raw mode" on. Symbolic Procedure PBOUT(chr); % NOTE ASSUMPTION that 1 gives terminal output. VaxWriteChar(1,chr); >>); % END OF Unix version. fluid '(!*EMODE); LoadTime << !*EMODE := NIL; Symbolic Procedure rawio_break(); % Redefined break handler to turn echoes back on after a break, unless % EMODE is running. << if !*rawio and not !*EMODE then EchoOn(); pre_rawio_break(); % May want to be paranoid and use a "catch(nil, % '(pre_rawio_break)" here. >>; % Carefully redefine the break handler. if null getd('pre_rawio_break) then << CopyD('pre_rawio_break, 'Break); CopyD('break, 'rawio_break); >>; >>;