"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 !\]>>