--- /dev/null
+"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>>>
+\f
+"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>)>>
+\f
+"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 !\]>>
projects / pdp10-muddle.git / blobdiff