X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=mim%2Fdevelopment%2Fmim%2Fvax%2Ftty%2Fttymisc.mud;fp=mim%2Fdevelopment%2Fmim%2Fvax%2Ftty%2Fttymisc.mud;h=c180da1505ff14eb6aec13acd73016972899f741;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hp=0000000000000000000000000000000000000000;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07;p=pdp10-muddle.git

diff --git a/mim/development/mim/vax/tty/ttymisc.mud b/mim/development/mim/vax/tty/ttymisc.mud
new file mode 100644
index 0000000..c180da1
--- /dev/null
+++ b/mim/development/mim/vax/tty/ttymisc.mud
@@ -0,0 +1,591 @@
+"Routines to create and reset tty channels--OPEN and RESET operations"
+
+<DEFINE TTY-OPEN (STYPE OPR "OPTIONAL" (NAME <>) (MODE "") (BSZ "")
+		  OBUF? IBUF?
+		  "AUX" OJFN IJFN ERR VAL (TBUF <>) TC)
+  #DECL ((OJFN IJFN ERR) <OR FALSE FIX> (TC) TTY-CHANNEL)
+  <COND (<NOT <ASSIGNED? IBUF?>>
+	 <COND (<TYPE? .BSZ STRING>
+		<SET IBUF? T>)
+	       (<SET IBUF? .BSZ>)>)>
+  <COND (<NOT <ASSIGNED? OBUF?>>
+	       <COND (<TYPE? .MODE STRING>
+		      <SET OBUF? T>)
+		     (<SET OBUF? .MODE>)>)>
+  <COND (<NOT .NAME>
+	 <SET OJFN ,STDOUT>
+	 <SET IJFN ,STDIN>)
+	(<ERROR CANT-OPEN-FOREIGN-TTY!-ERRORS .NAME TTY-OPEN>)>
+  <SET TC
+   <CHTYPE [.IJFN
+	   "/DEV/TTY"
+	   <>
+	   <>
+	   <>
+	   <>
+	   <PUTLHW %<+ ,STATUS-NO-FLUSH ,STATUS-READ ,STATUS-WRITE> ,BS-ASCII>
+	   .OJFN
+	   <COND (.IBUF? <SET TBUF <ISTRING 320>>)>
+	   .TBUF
+	   0
+	   <COND (.OBUF? <SET TBUF <ISTRING 320>>)
+		 (<SET TBUF <>>)>
+	   .TBUF
+	   0
+	   <>
+	   0
+	   ,TM-DEFAULT
+	   ,TM-DEFAULT
+	   <>] TTY-CHANNEL>>
+  <COND (<AND <GASSIGNED? TERMNAME> ,TERMNAME>
+	 <TTY-RESET .TC .OPR>
+	 .TC)
+	(.TC)>>
+
+<GDECL (TTY-LIST) <LIST [REST STRING TTY]>>
+
+<SETG TTY-DESC-DIR "/MIM/TTYS/">
+
+; "NEW? arg is true when muddle is starting up (after save, for example)."
+<DEFINE TTY-RESET TR (CHANNEL OPER "OPTIONAL" (NEW? <>) "AUX" TN
+		   CH TD DATA TT TCHARS
+		   LTCHARS SGTTY LMODE JFN
+		   OSPEED SPEC-CHARS OSTATE NSTATE FLAGS L)
+  #DECL ((CHANNEL) <OR TTY-CHANNEL CHANNEL> (NEW?) <OR ATOM FALSE> (TN) STRING
+	 (TD) TTY-DESC (DATA) TTY-CHANNEL (TT) TTY (JFN) FIX
+	 (TT) TTY (TCHARS LTCHARS SGTTY) STRING (LMODE) UVECTOR
+	 (OSPEED) FIX (OSTATE NSTATE) TTSTATE (SPEC-CHARS) STRING
+	 (FLAGS) FIX)
+  <COND (<TYPE? .CHANNEL CHANNEL> <SET DATA <CHANNEL-DATA .CHANNEL>>)
+	(<SET DATA .CHANNEL>)>
+  <SET JFN <TC-IJFN .DATA>>
+  <COND (<AND <GASSIGNED? TTY-LIST>
+	      <SET L <MEMBER <TC-DEV .DATA> ,TTY-LIST>>>
+	 <TC-TTY .DATA <2 .L>>)>
+  <COND (<SET NEW? <OR .NEW? <NOT <TC-TTY .DATA>>>>
+	 ; "Read in descriptor file for this terminal"
+	 <COND (<AND <GASSIGNED? TERMNAME> ,TERMNAME>
+		<SET TN ,TERMNAME>)
+	       (<RETURN <> .TR>)>
+	 <COND (<SET CH <CHANNEL-OPEN DISK <STRING ,HOME-STRUC
+						   ,TTY-DESC-DIR .TN>
+				      "READ" "ASCII">>
+		<SET TD <PARSE-SPEC-FILE .CH>>)
+	       (T
+		<SET TD
+		     <CHTYPE ["RANDOM" <MIN> 80 <ASCII 0> 0 0 []] TTY-DESC>>)>
+	 <COND (<=? .TN "VS100">
+		<PROG ((ESTR <GET-ENV-STR "TERMCAP">) TS)
+		  #DECL ((ESTR) <OR FALSE STRING>)
+		  <COND
+		   (.ESTR
+		    <COND (<SET TS <MEMBER "co#" .ESTR>>
+			   <SET TS <REST .TS 3>>
+			   <TD-WIDTH .TD <- <GET-NUM .TS> 1>>)>
+		    <COND (<SET TS <MEMBER "li#" .ESTR>>
+			   <SET TS <REST .TS 3>>
+			   <TD-HEIGHT .TD <GET-NUM .TS>>)>)>>)>
+	 ; "Get speed &c"
+	 <CALL SYSCALL IOCTL .JFN ,TIOCGLTC <SET LTCHARS <ISTRING 6>>>
+	 <SET SGTTY <ISTRING 6>>
+	 <SET LMODE <UVECTOR 0>>
+	 <SET TCHARS <ISTRING 6>>
+	 <SET OSTATE <CHTYPE [.TCHARS .LMODE .SGTTY .LTCHARS] TTSTATE>>
+	 ; "Get normal tty state from kernel, if it knows; otherwise from
+	    system"
+	 <COND (<NOT <CALL GETTTY .OSTATE>>
+		<COND (<TC-TTY .DATA>
+		       <TT-SCREWED <TC-TTY .DATA> <>>)>
+		<CALL SYSCALL IOCTL .JFN ,TIOCGETP .SGTTY>
+		<CALL SYSCALL IOCTL .JFN ,TIOCGETC .TCHARS>
+		<CALL SYSCALL IOCTL .JFN ,TIOCLGET .LMODE>)>
+	 <SET NSTATE <CHTYPE [<SET TCHARS <STRING .TCHARS>>
+			      <SET LMODE <UVECTOR <1 .LMODE>>>
+			      <SET SGTTY <STRING .SGTTY>>
+			      <STRING .LTCHARS>] TTSTATE>>
+	 ; "Get editing chars, as defined by loser"
+	 <SET SPEC-CHARS <STRING <T-RPRNTC .LTCHARS>
+				 <T-WERASC .LTCHARS>
+				 <T-LNEXTC .LTCHARS>
+				 <SG-ERASE .SGTTY>
+				 <SG-KILL .SGTTY>>>
+	 ; "Lookup speed"
+	 <SET OSPEED <NTH '![0 50 75 110 134 150 200 300 600 1200
+			     1800 2400 4800 9600 0 0]
+			  <+ 1 <ASCII <SG-OSPEED .SGTTY>>>>>
+	 ; "Change interrupt and quit chars in new state"
+	 <T-INTRC .TCHARS <ASCII 7> ;"Char Bell">
+	 <T-QUITC .TCHARS <ASCII 1> ;"Char Cntl-A">
+	 <T-STARTC .TCHARS <ASCII 17> ;"Char Cntl-Q">
+	 <T-STOPC .TCHARS <ASCII 19> ;"Char Cntl-S">
+	 ; "Get flags out of SGTTY"
+	 <SET FLAGS <ORB <LSH <NTH .SGTTY <+ ,SG-FLAGS 1>> 8>
+			 <SG-FLAGS .SGTTY>>>
+	 ; "Turn on CBREAK, turn off ECHO."
+	 <SET FLAGS <ANDB <ORB .FLAGS ,CBREAK> %<CHTYPE <XORB ,ECHO -1> FIX>>>
+	 ; "Make sure the system doesn't screw around with tabs"
+	 <SET FLAGS <ANDB .FLAGS %<CHTYPE <XORB ,XTABS -1> FIX>>>
+	 ; "Stuff flags back into SGTTY"
+	 <SG-FLAGS .SGTTY <CHTYPE <ANDB .FLAGS *377*> CHARACTER>>
+	 <PUT .SGTTY <+ ,SG-FLAGS 1> <CHTYPE <LSH .FLAGS -8> CHARACTER>>
+	 ; "Turn off output processing in local mode"
+	 <1 .LMODE <ORB <1 .LMODE> ,LLITOUT>>
+	 ; "Build the TTY object"
+	 <COND (<NOT <TC-TTY .DATA>>
+		<SET TT <CHTYPE [.OSTATE
+				 .NSTATE
+				 <>
+				 .SPEC-CHARS
+				 .OSPEED
+				 0
+				 0
+				 <>
+				 <>
+				 0
+				 0
+				 .TD
+				 ,MORE-TYPE-LIMIT] TTY>>
+		<COND (<NOT <GASSIGNED? TTY-LIST>>
+		       <SETG TTY-LIST ()>)>
+		<SETG TTY-LIST (<TC-DEV .DATA> .TT !,TTY-LIST)>
+		<TC-TTY .DATA .TT>)
+	       (T
+		<SET TT <TC-TTY .DATA>>
+		<TT-OSTATE .TT .OSTATE>
+		<TT-NSTATE .TT .NSTATE>
+		<TT-SPEC-CHARS .TT .SPEC-CHARS>
+		<TT-OSPEED .TT .OSPEED>
+		<TT-X .TT 0>
+		<TT-Y .TT 0>
+		<TT-SAV-X .TT 0>
+		<TT-SAV-Y .TT 0>
+		<TT-LAST-MORE .TT 0>
+		<TT-LAST-IN .TT 0>
+		<TT-DESC .TT .TD>)>
+	 ; "Mung the state of the world"
+	 <COND (<NOT <TT-SCREWED .TT>>
+		<CALL SAVTTY <TT-OSTATE .TT> .NSTATE>
+		<TT-SCREWED .TT T>
+		<SET-TERMINAL-MODES .JFN .NSTATE>)>
+	 .TT)
+	(T
+	 ; "If not new, just make sure system knows about us"
+	 <CALL SAVTTY <TT-OSTATE <SET TT <TC-TTY .DATA>>>
+	       <TT-NSTATE .TT>>
+	 <TT-SCREWED .TT T>
+	 <SET-TERMINAL-MODES <TC-IJFN .DATA>
+			     <TT-NSTATE <TC-TTY .DATA>> T>)>
+  ; "Normal reset stuff--clear buffers, set modes to normal muddle stuff."
+  <TC-IBC .DATA 0>
+  <TC-IBUF .DATA <TC-TIBUF .DATA>>
+  <TC-OBC .DATA 0>
+  <TC-QCT .DATA 0>
+  <COND (<TYPE? <TC-QUEUE .DATA> STRING>
+	 <TC-QUEUE .DATA <TOP <TC-QUEUE .DATA>>>)
+	(<TC-QUEUE .DATA <>>)>
+  <TC-OBUF .DATA <TC-TOBUF .DATA>>
+  <TC-MODE .DATA <TC-SMODE .DATA>>
+  <COND (.NEW?
+	 <TC-MODE .DATA <ORB <TC-MODE .DATA> ,TM-BADPOS>>)>
+  <TT-LAST-IN <TC-TTY .DATA> 0>
+  .CHANNEL>
+
+<DEFINE GET-NUM (STR)
+  #DECL ((STR) STRING)
+  <REPEAT ((NUM 0) CHR)
+    <COND (<EMPTY? .STR> <RETURN .NUM>)>
+    <COND (<OR <L? <ASCII <SET CHR <1 .STR>>>
+		   <ASCII !\0>>
+	       <G? <ASCII .CHR> <ASCII !\9>>>
+	   <RETURN .NUM>)>
+    <SET NUM <+ <* .NUM 10> <- <ASCII .CHR> <ASCII !\0>>>>
+    <SET STR <REST .STR>>>>
+
+<SETG CHAR-CHAR-ERASE %,SG-ERASE>
+<SETG CHAR-LINE-ERASE %,SG-KILL>
+<SETG CHAR-INTERRUPT %,T-INTRC>
+<SETG CHAR-QUIT %,T-QUITC>
+<SETG CHAR-START %,T-STARTC>
+<SETG CHAR-STOP %,T-STOPC>
+<SETG CHAR-STOP-PROCESS %,T-SUSPC>
+<SETG CHAR-DELAYED-STOP %,T-DSUSPC>
+<SETG CHAR-FLUSH-OUTPUT %,T-FLUSHC>
+<SETG CHAR-LITERAL-NEXT %,T-LNEXTC>
+<SETG CHAR-WORD-ERASE %,T-WERASC>
+
+<DEFINE TTY-SET-CHARS ACT (CHAN OPER WHICH "OPT" CHAR "AUX" OLD OFFS
+		       (TC <CHANNEL-DATA .CHAN>) (TTY <TC-TTY .TC>)
+		       (OS <TT-OSTATE .TTY>) (NS <TT-NSTATE .TTY>)
+		       (SPEC-CHARS <TT-SPEC-CHARS .TTY>)
+		       (LTCHARS <TST-LTCHARS .NS>) (JFN <TC-IJFN .TC>)
+		       (TCHARS <TST-TCHARS .NS>) (SGTTY <TST-SGTTYB .NS>)
+		       DEFSTR RSTR)
+  #DECL ((CHAN) <CHANNEL 'TTY> (WHICH) ATOM (CHAR) <OR ATOM CHARACTER FALSE>
+	 (TC) TTY-CHANNEL (DEFSTR RSTR SPEC-CHARS LTCHARS TCHARS SGTTY) STRING
+	 (OS NS) TTSTATE (OFFS) FIX)
+  <COND (<MEMQ .WHICH '[CHAR-CHAR-ERASE CHAR-LINE-ERASE]>
+	 <SET DEFSTR ,SGTTY-DEFAULTS>
+	 <SET RSTR .SGTTY>)
+	(<MEMQ .WHICH '[CHAR-STOP-PROCESS CHAR-DELAYED-STOP CHAR-LITERAL-NEXT
+			CHAR-WORD-ERASE CHAR-FLUSH-OUTPUT]>
+	 <SET DEFSTR ,LTCHAR-DEFAULTS>
+	 <SET RSTR .LTCHARS>)
+	(<MEMQ .WHICH '[CHAR-INTERRUPT CHAR-QUIT CHAR-START CHAR-STOP]>
+	 <SET DEFSTR ,TCHAR-DEFAULTS>
+	 <SET RSTR .TCHARS>)
+	(T
+	 <RETURN <ERROR UNKNOWN-CHARACTER-NAME!-ERRORS .WHICH TTY-CHAR> .ACT>)>
+  <SET OLD <NTH .RSTR <SET OFFS ,.WHICH>>>
+  <COND (<NOT <ASSIGNED? CHAR>>)
+	(T
+	 <COND (<NOT .CHAR>
+		<SET CHAR <CHTYPE -1 CHARACTER>>)
+	       (<TYPE? .CHAR ATOM>
+		<SET CHAR <NTH .DEFSTR .OFFS>>)>
+	 <COND (<N==? .CHAR <NTH .RSTR .OFFS>>
+		<PUT .RSTR .OFFS .CHAR>
+		<COND (<==? .WHICH CHAR-CHAR-ERASE>
+		       <TS-RUBOUT .SPEC-CHARS .CHAR>)
+		      (<==? .WHICH CHAR-LINE-ERASE>
+		       <TS-KILL .SPEC-CHARS .CHAR>)
+		      (<==? .WHICH CHAR-WORD-ERASE>
+		       <TS-WORD .SPEC-CHARS .CHAR>)
+		      (<==? .WHICH CHAR-LITERAL-NEXT>
+		       <TS-QUOTE .SPEC-CHARS .CHAR>)>
+		<CALL SAVTTY .OS .NS>
+		<SET-TERMINAL-MODES .JFN .NS <>>)>)>
+  .OLD>
+
+<DEFINE TTY-FLOW-CONTROL (CHAN OPER ON? "AUX" (TC <CHANNEL-DATA .CHAN>)
+			  (TTY <TC-TTY .TC>) (NS <TT-NSTATE .TTY>)
+			  (OS <TT-OSTATE .TTY>) (ST <TST-TCHARS .NS>))
+  #DECL ((CHAN) CHANNEL (ON?) <OR ATOM FALSE> (TC) TTY-CHANNEL)
+  <COND (.ON?
+	 <T-STARTC .ST <ASCII 17> ;"Char Cntl-Q">
+	 <T-STOPC .ST <ASCII 19> ;"Char Cntl-S">)
+	(T
+	 <T-STARTC .ST <CHTYPE -1 CHARACTER>>
+	 <T-STOPC .ST <CHTYPE -1 CHARACTER>>)>
+  <CALL SAVTTY .OS .NS>
+  <SET-TERMINAL-MODES <TC-IJFN .TC> .NS <>>
+  .ON?>
+
+<DEFINE TTY-FIX-TTY (CHAN OPER "AUX" (TC <CHANNEL-DATA .CHAN>)
+		     (TTY <TC-TTY .TC>))
+  #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL (TTY) TTY)
+  <COND (<TT-SCREWED .TTY>
+	 <TT-SCREWED .TTY <>>
+	 <CALL SAVTTY 0 0>
+	 <SET-TERMINAL-MODES <TC-OJFN .TC> <TT-OSTATE .TTY>>)>>
+
+<DEFINE TTY-BROKEN? (CHAN OPER "AUX" (TC <CHANNEL-DATA .CHAN>))
+  #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL)
+  <TT-SCREWED <TC-TTY .TC>>>
+
+<DEFINE TTY-BREAK-TTY (CHAN OPER "AUX" (TC <CHANNEL-DATA .CHAN>)
+		       (TTY <TC-TTY .TC>))
+  #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL (TTY) TTY)
+  <COND (<NOT <TT-SCREWED .TTY>>
+	 <TT-SCREWED .TTY T>
+	 <CALL SAVTTY <TT-OSTATE .TTY> <TT-NSTATE .TTY>>
+	 <SET-TERMINAL-MODES <TC-OJFN .TC> <TT-NSTATE .TTY>>)>>
+
+<DEFINE FIX-TTY (CHAN "AUX" (TC <CHANNEL-DATA .CHAN>) (TTY <TC-TTY .TC>))
+  #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL (TTY) TTY)
+  <COND (<TT-SCREWED .TTY>
+	 <TT-SCREWED .TTY <>>
+	 <CALL SAVTTY 0 0>
+	 <SET-TERMINAL-MODES <TC-OJFN .TC> <TT-OSTATE .TTY>>
+	 T)>>
+
+<DEFINE SET-TERMINAL-MODES (JFN TTSTATE "OPTIONAL" (FLUSH? <>))
+  #DECL ((JFN) FIX (TTSTATE) TTSTATE)
+  <CALL SYSCALL IOCTL .JFN
+	<COND (.FLUSH? ,TIOCSETP)
+	      (T ,TIOCSETN)>
+	<TST-SGTTYB .TTSTATE>>
+  <CALL SYSCALL IOCTL .JFN ,TIOCLSET <TST-BITS .TTSTATE>>
+  <CALL SYSCALL IOCTL .JFN ,TIOCSETC <TST-TCHARS .TTSTATE>>
+  <CALL SYSCALL IOCTL .JFN ,TIOCSLTC <TST-LTCHARS .TTSTATE>>>
+
+"Interfaces for reading and writing--FILL-READ-BUFFER, WRITE-BUFFER,
+ WRITE-BYTE, READ-BYTE, BUFOUT, BUFLEN"
+<DEFINE TTY-BUFLEN (CHANNEL OPER "OPTIONAL" NEW
+		    "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (NEW) FIX)
+  <COND (<ASSIGNED? NEW>
+	 <TC-IBC .TC .NEW>
+	 .NEW)
+	(T
+	 <TC-IBC .TC>)>>
+
+<DEFINE TTY-GET-READ (CHANNEL OPER "OPTIONAL" NEW
+		      "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (NEW) STRING)
+  <COND (<ASSIGNED? NEW>
+	 <TC-IBUF .TC .NEW>
+	 .NEW)
+	(T
+	 <TC-IBUF .TC>)>>
+
+<DEFINE TTY-IMAGE-OUT (CHANNEL OPER CHRS "OPTIONAL" (LENGTH <>)
+		       "TUPLE" MORE "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (CHRS) <OR FIX CHARACTER STRING>
+	 (LENGTH) <OR FIX FALSE> (TC) TTY-CHANNEL
+	 (MORE) <TUPLE [REST <OR FIX STRING CHARACTER>]>)
+  <COND (<TYPE? .CHRS STRING CHARACTER>
+	 <OUTPUT-RAW-STRING .CHANNEL .CHRS .LENGTH>)
+	(<TYPE? .CHRS FIX>
+	 <OUTPUT-NUMBER .CHANNEL .CHRS <>>)>
+  <MAPF <>
+    <FUNCTION (X)
+      <COND (<TYPE? .X FIX>
+	     <OUTPUT-NUMBER .CHANNEL .X <>>)
+	    (T
+	     <OUTPUT-RAW-STRING .CHANNEL .X <>>)>>
+    .MORE>>
+
+<DEFINE TTY-TYPE-CHAR (CHANNEL OPER CHAR
+		       "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (CHAR) CHARACTER (DATA) TTY-CHANNEL)
+  <STORE-QUEUE-CHAR .DATA .CHAR>
+  .CHAR>
+
+<DEFINE TTY-READ-BYTE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>) CHR
+		       (IB <TC-IBUF .DATA>) (IC <TC-IBC .DATA>) TMP MODE)
+  #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL (IB) <OR STRING FALSE> (IC) FIX
+	 (TMP) <OR FALSE FIX> (MODE) FIX)
+  <COND (.IB
+	 <COND (<NOT <0? .IC>>
+		<SET CHR <1 .IB>>
+		<TC-IBUF .DATA <REST .IB>>
+		<TC-IBC .DATA <- .IC 1>>
+		.CHR)>)
+	(<SET CHR <GET-BYTE .DATA>>
+	 <SET MODE <TC-MODE .DATA>>
+	 <COND (<ECHO-ON? .MODE>
+		<TTY-NORMAL-OUT .CHANNEL .OPER ,BUF1 1>)>
+	 <UPDATE-INPUT <TC-TTY .DATA> .MODE>
+	 <1 ,BUF1>)>>
+
+<DEFINE GET-BYTE (TC "AUX" TEMP CHR)
+  #DECL ((TC) TTY-CHANNEL (TEMP) <OR <FALSE [REST FIX]> FIX>)
+  <COND (<NOT <SET CHR <GET-QUEUE-CHAR .TC>>>
+	 <PROG ()
+	   <COND (<AND <SET TEMP <ISYSCALL READ <TC-IJFN .TC> ,BUF1 1>>
+		       <G? .TEMP 0>>
+		  <SET CHR <1 ,BUF1>>)
+		 (<AND <NOT <EMPTY? .TEMP>>
+		       <==? <1 .TEMP> 4>>
+		  ; "Handle interrupted system call"
+		  <AGAIN>)>>)>
+  .CHR>
+
+<DEFINE GET-QUEUE-CHAR (TC "AUX" (Q <TC-QUEUE .TC>) CHR CT)
+  #DECL ((TC) TTY-CHANNEL (Q) <OR CHARACTER STRING FALSE> (CT) FIX)
+  <COND (<0? <SET CT <TC-QCT .TC>>>
+	 <>)
+	(<TYPE? .Q STRING>
+	 <SET CHR <1 .Q>>
+	 <TC-QUEUE .TC <REST .Q>>
+	 <TC-QCT .TC <- .CT 1>>
+	 .CHR)
+	(T
+	 <TC-QCT .TC 0>
+	 <TC-QUEUE .TC <>>
+	 .Q)>>
+
+<DEFINE STORE-QUEUE-CHAR (TC CHAR "AUX" (Q <TC-QUEUE .TC>) NQ CT)
+  #DECL ((TC) TTY-CHANNEL (CHAR) CHARACTER (Q) <OR CHARACTER STRING FALSE>
+	 (CT) FIX)
+  <COND (<NOT .Q>
+	 <TC-QUEUE .TC .CHAR>
+	 <TC-QCT .TC 1>)
+	(<TYPE? .Q CHARACTER>
+	 <SET NQ <ISTRING 12>>
+	 <1 .NQ .Q>
+	 <2 .NQ .CHAR>
+	 <TC-QUEUE .TC .NQ>
+	 <TC-QCT .TC 2>)
+	(<==? <SET CT <TC-QCT .TC>> <LENGTH .Q>>
+	 <COND (<==? <SET NQ <TOP .Q>> .Q>
+		<SET NQ <STRING .Q "            ">>
+		<PUT .NQ <SET CT <+ .CT 1>> .CHAR>
+		<TC-QUEUE .TC .NQ>
+		<TC-QCT .TC .CT>)
+	       (T
+		<SUBSTRUC .Q 0 <LENGTH .Q> .NQ>
+		<PUT .NQ <SET CT <+ .CT 1>> .CHAR>
+		<TC-QUEUE .TC .NQ>
+		<TC-QCT .TC .CT>)>)
+	(T
+	 <PUT .Q <SET CT <+ .CT 1>> .CHAR>
+	 <TC-QCT .TC .CT>)>>
+
+<DEFINE TTY-READ-IMMEDIATE (CHANNEL OPER "OPTIONAL" (NOWAIT? <>)
+			    (QUEUE? T) "AUX" (TC <CHANNEL-DATA .CHANNEL>)
+			    (ECHO? <ECHO-ON? <TC-MODE .TC>>) (CHR <>) VAL)
+  #DECL ((CHANNEL) CHANNEL (NOWAIT? QUEUE? ECHO?) <OR ATOM FALSE>
+	 (TC) TTY-CHANNEL (VAL) <OR <FALSE [REST FIX]> FIX>)
+  <DUMP-WRITE-BUFFER .TC>
+  <COND (<OR <AND .QUEUE?
+		  <SET CHR <GET-QUEUE-CHAR .TC>>>
+	     <COND (<OR <NOT .NOWAIT?>
+			<AND <CALL SYSCALL IOCTL <TC-IJFN .TC> ,FIONREAD ,UV1>
+			     <G? <1 ,UV1> 0>>>
+		    <PROG ()
+		      <COND (<AND <SET VAL <ISYSCALL READ <TC-IJFN .TC>
+						 ,BUF1 1>>
+				  <G? .VAL 0>>
+			     <SET CHR <1 ,BUF1>>)
+			    (<AND <NOT <EMPTY? .VAL>>
+				  <==? <1 .VAL> 4>>
+			     <AGAIN>)>>)>>
+	 <COND (.ECHO?
+		<TTY-NORMAL-OUT .CHANNEL READ-IMMEDIATE .CHR>
+		<DUMP-WRITE-BUFFER .TC>)>
+	 .CHR)>>
+
+<DEFINE TTY-TYPE-AHEAD? (CHANNEL OPER "AUX" (TC <CHANNEL-DATA .CHANNEL>) VAL)
+  #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (VAL) <OR FALSE FIX>)
+  <1 ,UV1 0>
+  <COND (<SET VAL <CALL SYSCALL IOCTL <TC-IJFN .TC> ,FIONREAD ,UV1>>
+	 <COND (<G? <SET VAL <+ <1 ,UV1> <TC-QCT .TC>>> 0>
+		.VAL)>)>>
+
+<SETG UV1 <UVECTOR 0>>
+<GDECL (UV1) <UVECTOR FIX>>
+<SETG END-STRING <STRING <ASCII 27> ;"Char Alt">>
+<DEFINE TTY-FILL-READ (CHANNEL OPER "OPTIONAL" (CONT 0) (RBUF <>)
+		       END (NOMORE <>)
+		       "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
+			     (BB <TC-IBUF .TC>) (BBUF <TC-TIBUF .TC>) CT
+			     (PROMPT <>) TS)
+  #DECL ((CHANNEL) CHANNEL (CONT) FIX (RBUF) <OR STRING FALSE>
+	 (END) <OR STRING FALSE> (NOMORE) <OR ATOM FALSE> (TC) TTY-CHANNEL
+	 (BB BBUF) STRING (CT) FIX)
+  <COND (<OR <NOT <ASSIGNED? END>>
+	     <NOT .END>>
+	 <COND (<AND <ASSIGNED? READ-BREAKS>
+		     <TYPE? <SET TS .READ-BREAKS> STRING>>
+		<SET END .TS>)
+	       (T <SET END ,END-STRING>)>)>
+  <COND (.RBUF
+	 <SET BB <SET BBUF .RBUF>>)
+	(<0? <TC-IBC .TC>>
+	 <COND (<NOT <0? .CONT>>
+		<SET BB <BACK .BB .CONT>>
+		<COND (<N==? .BB .BBUF>
+		       <SUBSTRUC .BB 0 <LENGTH .BB> .BBUF>)>)>)
+	(<SET CONT 0>)>
+  <COND (<AND <ASSIGNED? READ-PROMPT>
+	      <TYPE? <SET TS .READ-PROMPT> STRING>>
+	 <SET PROMPT .TS>)>
+  <COND (<AND <0? .CONT>
+	      .PROMPT>
+	 <TTY-NORMAL-OUT .CHANNEL .OPER .PROMPT>)>
+  <PROG ()
+    <SET CT <DO-RDTTY .CHANNEL .TC .BBUF .CONT .END .PROMPT>>
+    <COND (<AND <NOT .NOMORE> <==? .CT <LENGTH .BBUF>>>
+	   <TC-IBUF .TC <ISTRING <+ <LENGTH .BBUF> 320>>>
+	   <TC-TIBUF .TC <TC-IBUF .TC>>
+	   <MAPR <>
+	     <FUNCTION (OLD NEW)
+	       <1 .NEW <1 .OLD>>>
+	     .BBUF <TC-IBUF .TC>>
+	   <SET BBUF <TC-IBUF .TC>>
+	   <SET CONT .CT>
+	   <AGAIN>)>>
+  <COND (<NOT .RBUF>
+	 <TC-IBUF .TC .BBUF>
+	 <TC-IBC .TC .CT>)>
+  .CT>
+
+<DEFINE TTY-BUFOUT (CHANNEL OPER "OPTIONAL" (FORCE? T)
+		    "AUX" (TC <CHANNEL-DATA .CHANNEL>)
+			  (JFN <TC-OJFN .TC>) (BC <TC-OBC .TC>)
+			  (BUF <TC-OBUF .TC>))
+  #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (JFN) <OR FALSE FIX>
+	 (BC) FIX (BUF) <OR STRING FALSE> (FORCE?) <OR ATOM FALSE>)
+  <COND (.JFN
+	 <COND (<AND .BUF <G? .BC 0>>
+		<DUMP-WRITE-BUFFER .TC>)>
+	 ; "Doesn't seem to be any way to force output"
+	 T)>>
+
+<DEFINE TTY-WRITE-BYTE (CHANNEL OPER BYTE "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (BYTE) CHARACTER (TC) TTY-CHANNEL)
+  <COND (<TEST-TC-MODE .TC ,TM-IMAGE>
+	 <TTY-IMAGE-OUT .CHANNEL .OPER .BYTE>)
+	(<TTY-NORMAL-OUT .CHANNEL .OPER .BYTE>)>>
+
+<DEFINE TTY-WRITE-BUFFER (CHANNEL OPER BYTES "OPTIONAL" (LEN <LENGTH .BYTES>)
+			  "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (BYTES) STRING (LEN) FIX (TC) TTY-CHANNEL)
+  <COND (<TEST-TC-MODE .TC ,TM-IMAGE>
+	 <TTY-IMAGE-OUT .CHANNEL .OPER .BYTES .LEN>)
+	(<TTY-NORMAL-OUT .CHANNEL .OPER .BYTES .LEN>)>>
+
+"Miscellaneous operations"
+
+<DEFINE TTY-QUERY (CHANNEL OPER BIT "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (BIT) FIX (DATA) TTY-CHANNEL)
+  <COND (<==? .BIT ,BIT-INTELLIGENT>
+	 <COND (<TC-IBUF .DATA> T)>)>>
+
+<DEFINE TTY-TERM-MOVE? (CHANNEL OPER "AUX" (TC <CHANNEL-DATA .CHANNEL>)
+			(OPS <TD-PRIMOPS <TT-DESC <TC-TTY .TC>>>))
+  #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (OPS) VECTOR)
+  <AND <G=? <LENGTH .OPS> ,TTY-MOV>
+       <TTY-MOV .OPS>>>
+
+<DEFINE TTY-GET-TYPE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL)
+  <TD-NAME <TT-DESC <TC-TTY .DATA>>>>
+
+<DEFINE TTY-PAD (CHANNEL OPER AMT "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (AMT) FIX (TC) TTY-CHANNEL)
+  <OUTPUT-PAD .CHANNEL <TT-DESC <TC-TTY .TC>> .AMT>>
+
+<DEFINE TTY-SET-IMAGE (CHANNEL OPER ON? "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (ON?) <OR ATOM FALSE> (TC) TTY-CHANNEL)
+  <TC-MODE .TC <COND (.ON? <ORB <TC-MODE .TC> ,TM-IMAGE>)
+		     (T
+		      <ANDB <TC-MODE .TC> %<CHTYPE <XORB ,TM-IMAGE -1>
+						   FIX>>)>>>
+
+<DEFINE TTY-SET-ECHO (CHANNEL OPER ON? "AUX" (TC <CHANNEL-DATA .CHANNEL>))
+  #DECL ((CHANNEL) CHANNEL (ON?) <OR ATOM FALSE> (TC) TTY-CHANNEL)
+  <TC-MODE .TC <COND (.ON? <ORB <TC-MODE .TC> ,TM-ECHO>)
+		     (T
+		      <ANDB <TC-MODE .TC> %<CHTYPE <XORB ,TM-ECHO -1>
+						   FIX>>)>>>
+
+<DEFINE TTY-CLOSE (CHANNEL OPER)
+  <ERROR CANT-CLOSE-TTY-CHANNEL .CHANNEL .OPER>>
+
+<DEFINE TTY-PRINT-DATA (CHANNEL OPER OUTCHAN "AUX" (TC <CHANNEL-DATA .CHANNEL>)
+			TS)
+  #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TS) <OR FALSE STRING>)
+  <PRINC "#TTY-CHANNEL [">
+  <PRINC "JFN:">
+  <COND (<==? <TC-IJFN .TC> ,STDIN> <PRINC "PRIMARY">)
+	(T <PRIN1 <TC-IFJN .TC>>)>
+  <COND (<TC-TTY .TC>
+	 <PRINC !\ >
+	 <PRINC <TD-NAME <TT-DESC <TC-TTY .TC>>>>)>
+  <COND (<SET TS <TC-IBUF .TC>>
+	 <PRINC " IBUF:">
+	 <PRIN1 <LENGTH <TC-TIBUF .TC>>>
+	 <PRINC !\/>
+	 <PRIN1 <LENGTH .TS>>
+	 <PRINC !\/>
+	 <PRIN1 <TC-IBC .TC>>)>
+  <COND (<SET TS <TC-OBUF .TC>>
+	 <PRINC " OBUF:">
+	 <PRIN1 <LENGTH <TC-TOBUF .TC>>>
+	 <PRINC !\/>
+	 <PRIN1 <LENGTH .TS>>
+	 <PRINC !\/>
+	 <PRIN1 <TC-OBC .TC>>)>
+  <PRINC !\]>>