mim/development/mim/vax/tty/ttymisc.mud

   1 "Routines to create and reset tty channels--OPEN and RESET operations"
   2
   3 <DEFINE TTY-OPEN (STYPE OPR "OPTIONAL" (NAME <>) (MODE "") (BSZ "")
   4                   OBUF? IBUF?
   5                   "AUX" OJFN IJFN ERR VAL (TBUF <>) TC)
   6   #DECL ((OJFN IJFN ERR) <OR FALSE FIX> (TC) TTY-CHANNEL)
   7   <COND (<NOT <ASSIGNED? IBUF?>>
   8          <COND (<TYPE? .BSZ STRING>
   9                 <SET IBUF? T>)
  10                (<SET IBUF? .BSZ>)>)>
  11   <COND (<NOT <ASSIGNED? OBUF?>>
  12                <COND (<TYPE? .MODE STRING>
  13                       <SET OBUF? T>)
  14                      (<SET OBUF? .MODE>)>)>
  15   <COND (<NOT .NAME>
  16          <SET OJFN ,STDOUT>
  17          <SET IJFN ,STDIN>)
  18         (<ERROR CANT-OPEN-FOREIGN-TTY!-ERRORS .NAME TTY-OPEN>)>
  19   <SET TC
  20    <CHTYPE [.IJFN
  21            "/DEV/TTY"
  22            <>
  23            <>
  24            <>
  25            <>
  26            <PUTLHW %<+ ,STATUS-NO-FLUSH ,STATUS-READ ,STATUS-WRITE> ,BS-ASCII>
  27            .OJFN
  28            <COND (.IBUF? <SET TBUF <ISTRING 320>>)>
  29            .TBUF
  30            0
  31            <COND (.OBUF? <SET TBUF <ISTRING 320>>)
  32                  (<SET TBUF <>>)>
  33            .TBUF
  34            0
  35            <>
  36            0
  37            ,TM-DEFAULT
  38            ,TM-DEFAULT
  39            <>] TTY-CHANNEL>>
  40   <COND (<AND <GASSIGNED? TERMNAME> ,TERMNAME>
  41          <TTY-RESET .TC .OPR>
  42          .TC)
  43         (.TC)>>
  44
  45 <GDECL (TTY-LIST) <LIST [REST STRING TTY]>>
  46
  47 <SETG TTY-DESC-DIR "/MIM/TTYS/">
  48
  49 ; "NEW? arg is true when muddle is starting up (after save, for example)."
  50 <DEFINE TTY-RESET TR (CHANNEL OPER "OPTIONAL" (NEW? <>) "AUX" TN
  51                    CH TD DATA TT TCHARS
  52                    LTCHARS SGTTY LMODE JFN
  53                    OSPEED SPEC-CHARS OSTATE NSTATE FLAGS L)
  54   #DECL ((CHANNEL) <OR TTY-CHANNEL CHANNEL> (NEW?) <OR ATOM FALSE> (TN) STRING
  55          (TD) TTY-DESC (DATA) TTY-CHANNEL (TT) TTY (JFN) FIX
  56          (TT) TTY (TCHARS LTCHARS SGTTY) STRING (LMODE) UVECTOR
  57          (OSPEED) FIX (OSTATE NSTATE) TTSTATE (SPEC-CHARS) STRING
  58          (FLAGS) FIX)
  59   <COND (<TYPE? .CHANNEL CHANNEL> <SET DATA <CHANNEL-DATA .CHANNEL>>)
  60         (<SET DATA .CHANNEL>)>
  61   <SET JFN <TC-IJFN .DATA>>
  62   <COND (<AND <GASSIGNED? TTY-LIST>
  63               <SET L <MEMBER <TC-DEV .DATA> ,TTY-LIST>>>
  64          <TC-TTY .DATA <2 .L>>)>
  65   <COND (<SET NEW? <OR .NEW? <NOT <TC-TTY .DATA>>>>
  66          ; "Read in descriptor file for this terminal"
  67          <COND (<AND <GASSIGNED? TERMNAME> ,TERMNAME>
  68                 <SET TN ,TERMNAME>)
  69                (<RETURN <> .TR>)>
  70          <COND (<SET CH <CHANNEL-OPEN DISK <STRING ,HOME-STRUC
  71                                                    ,TTY-DESC-DIR .TN>
  72                                       "READ" "ASCII">>
  73                 <SET TD <PARSE-SPEC-FILE .CH>>)
  74                (T
  75                 <SET TD
  76                      <CHTYPE ["RANDOM" <MIN> 80 <ASCII 0> 0 0 []] TTY-DESC>>)>
  77          <COND (<=? .TN "VS100">
  78                 <PROG ((ESTR <GET-ENV-STR "TERMCAP">) TS)
  79                   #DECL ((ESTR) <OR FALSE STRING>)
  80                   <COND
  81                    (.ESTR
  82                     <COND (<SET TS <MEMBER "co#" .ESTR>>
  83                            <SET TS <REST .TS 3>>
  84                            <TD-WIDTH .TD <- <GET-NUM .TS> 1>>)>
  85                     <COND (<SET TS <MEMBER "li#" .ESTR>>
  86                            <SET TS <REST .TS 3>>
  87                            <TD-HEIGHT .TD <GET-NUM .TS>>)>)>>)>
  88          ; "Get speed &c"
  89          <CALL SYSCALL IOCTL .JFN ,TIOCGLTC <SET LTCHARS <ISTRING 6>>>
  90          <SET SGTTY <ISTRING 6>>
  91          <SET LMODE <UVECTOR 0>>
  92          <SET TCHARS <ISTRING 6>>
  93          <SET OSTATE <CHTYPE [.TCHARS .LMODE .SGTTY .LTCHARS] TTSTATE>>
  94          ; "Get normal tty state from kernel, if it knows; otherwise from
  95             system"
  96          <COND (<NOT <CALL GETTTY .OSTATE>>
  97                 <COND (<TC-TTY .DATA>
  98                        <TT-SCREWED <TC-TTY .DATA> <>>)>
  99                 <CALL SYSCALL IOCTL .JFN ,TIOCGETP .SGTTY>
 100                 <CALL SYSCALL IOCTL .JFN ,TIOCGETC .TCHARS>
 101                 <CALL SYSCALL IOCTL .JFN ,TIOCLGET .LMODE>)>
 102          <SET NSTATE <CHTYPE [<SET TCHARS <STRING .TCHARS>>
 103                               <SET LMODE <UVECTOR <1 .LMODE>>>
 104                               <SET SGTTY <STRING .SGTTY>>
 105                               <STRING .LTCHARS>] TTSTATE>>
 106          ; "Get editing chars, as defined by loser"
 107          <SET SPEC-CHARS <STRING <T-RPRNTC .LTCHARS>
 108                                  <T-WERASC .LTCHARS>
 109                                  <T-LNEXTC .LTCHARS>
 110                                  <SG-ERASE .SGTTY>
 111                                  <SG-KILL .SGTTY>>>
 112          ; "Lookup speed"
 113          <SET OSPEED <NTH '![0 50 75 110 134 150 200 300 600 1200
 114                              1800 2400 4800 9600 0 0]
 115                           <+ 1 <ASCII <SG-OSPEED .SGTTY>>>>>
 116          ; "Change interrupt and quit chars in new state"
 117          <T-INTRC .TCHARS <ASCII 7> ;"Char Bell">
 118          <T-QUITC .TCHARS <ASCII 1> ;"Char Cntl-A">
 119          <T-STARTC .TCHARS <ASCII 17> ;"Char Cntl-Q">
 120          <T-STOPC .TCHARS <ASCII 19> ;"Char Cntl-S">
 121          ; "Get flags out of SGTTY"
 122          <SET FLAGS <ORB <LSH <NTH .SGTTY <+ ,SG-FLAGS 1>> 8>
 123                          <SG-FLAGS .SGTTY>>>
 124          ; "Turn on CBREAK, turn off ECHO."
 125          <SET FLAGS <ANDB <ORB .FLAGS ,CBREAK> %<CHTYPE <XORB ,ECHO -1> FIX>>>
 126          ; "Make sure the system doesn't screw around with tabs"
 127          <SET FLAGS <ANDB .FLAGS %<CHTYPE <XORB ,XTABS -1> FIX>>>
 128          ; "Stuff flags back into SGTTY"
 129          <SG-FLAGS .SGTTY <CHTYPE <ANDB .FLAGS *377*> CHARACTER>>
 130          <PUT .SGTTY <+ ,SG-FLAGS 1> <CHTYPE <LSH .FLAGS -8> CHARACTER>>
 131          ; "Turn off output processing in local mode"
 132          <1 .LMODE <ORB <1 .LMODE> ,LLITOUT>>
 133          ; "Build the TTY object"
 134          <COND (<NOT <TC-TTY .DATA>>
 135                 <SET TT <CHTYPE [.OSTATE
 136                                  .NSTATE
 137                                  <>
 138                                  .SPEC-CHARS
 139                                  .OSPEED
 140                                  0
 141                                  0
 142                                  <>
 143                                  <>
 144                                  0
 145                                  0
 146                                  .TD
 147                                  ,MORE-TYPE-LIMIT] TTY>>
 148                 <COND (<NOT <GASSIGNED? TTY-LIST>>
 149                        <SETG TTY-LIST ()>)>
 150                 <SETG TTY-LIST (<TC-DEV .DATA> .TT !,TTY-LIST)>
 151                 <TC-TTY .DATA .TT>)
 152                (T
 153                 <SET TT <TC-TTY .DATA>>
 154                 <TT-OSTATE .TT .OSTATE>
 155                 <TT-NSTATE .TT .NSTATE>
 156                 <TT-SPEC-CHARS .TT .SPEC-CHARS>
 157                 <TT-OSPEED .TT .OSPEED>
 158                 <TT-X .TT 0>
 159                 <TT-Y .TT 0>
 160                 <TT-SAV-X .TT 0>
 161                 <TT-SAV-Y .TT 0>
 162                 <TT-LAST-MORE .TT 0>
 163                 <TT-LAST-IN .TT 0>
 164                 <TT-DESC .TT .TD>)>
 165          ; "Mung the state of the world"
 166          <COND (<NOT <TT-SCREWED .TT>>
 167                 <CALL SAVTTY <TT-OSTATE .TT> .NSTATE>
 168                 <TT-SCREWED .TT T>
 169                 <SET-TERMINAL-MODES .JFN .NSTATE>)>
 170          .TT)
 171         (T
 172          ; "If not new, just make sure system knows about us"
 173          <CALL SAVTTY <TT-OSTATE <SET TT <TC-TTY .DATA>>>
 174                <TT-NSTATE .TT>>
 175          <TT-SCREWED .TT T>
 176          <SET-TERMINAL-MODES <TC-IJFN .DATA>
 177                              <TT-NSTATE <TC-TTY .DATA>> T>)>
 178   ; "Normal reset stuff--clear buffers, set modes to normal muddle stuff."
 179   <TC-IBC .DATA 0>
 180   <TC-IBUF .DATA <TC-TIBUF .DATA>>
 181   <TC-OBC .DATA 0>
 182   <TC-QCT .DATA 0>
 183   <COND (<TYPE? <TC-QUEUE .DATA> STRING>
 184          <TC-QUEUE .DATA <TOP <TC-QUEUE .DATA>>>)
 185         (<TC-QUEUE .DATA <>>)>
 186   <TC-OBUF .DATA <TC-TOBUF .DATA>>
 187   <TC-MODE .DATA <TC-SMODE .DATA>>
 188   <COND (.NEW?
 189          <TC-MODE .DATA <ORB <TC-MODE .DATA> ,TM-BADPOS>>)>
 190   <TT-LAST-IN <TC-TTY .DATA> 0>
 191   .CHANNEL>
 192
 193 <DEFINE GET-NUM (STR)
 194   #DECL ((STR) STRING)
 195   <REPEAT ((NUM 0) CHR)
 196     <COND (<EMPTY? .STR> <RETURN .NUM>)>
 197     <COND (<OR <L? <ASCII <SET CHR <1 .STR>>>
 198                    <ASCII !\0>>
 199                <G? <ASCII .CHR> <ASCII !\9>>>
 200            <RETURN .NUM>)>
 201     <SET NUM <+ <* .NUM 10> <- <ASCII .CHR> <ASCII !\0>>>>
 202     <SET STR <REST .STR>>>>
 203
 204 <SETG CHAR-CHAR-ERASE %,SG-ERASE>
 205 <SETG CHAR-LINE-ERASE %,SG-KILL>
 206 <SETG CHAR-INTERRUPT %,T-INTRC>
 207 <SETG CHAR-QUIT %,T-QUITC>
 208 <SETG CHAR-START %,T-STARTC>
 209 <SETG CHAR-STOP %,T-STOPC>
 210 <SETG CHAR-STOP-PROCESS %,T-SUSPC>
 211 <SETG CHAR-DELAYED-STOP %,T-DSUSPC>
 212 <SETG CHAR-FLUSH-OUTPUT %,T-FLUSHC>
 213 <SETG CHAR-LITERAL-NEXT %,T-LNEXTC>
 214 <SETG CHAR-WORD-ERASE %,T-WERASC>
 215
 216 <DEFINE TTY-SET-CHARS ACT (CHAN OPER WHICH "OPT" CHAR "AUX" OLD OFFS
 217                        (TC <CHANNEL-DATA .CHAN>) (TTY <TC-TTY .TC>)
 218                        (OS <TT-OSTATE .TTY>) (NS <TT-NSTATE .TTY>)
 219                        (SPEC-CHARS <TT-SPEC-CHARS .TTY>)
 220                        (LTCHARS <TST-LTCHARS .NS>) (JFN <TC-IJFN .TC>)
 221                        (TCHARS <TST-TCHARS .NS>) (SGTTY <TST-SGTTYB .NS>)
 222                        DEFSTR RSTR)
 223   #DECL ((CHAN) <CHANNEL 'TTY> (WHICH) ATOM (CHAR) <OR ATOM CHARACTER FALSE>
 224          (TC) TTY-CHANNEL (DEFSTR RSTR SPEC-CHARS LTCHARS TCHARS SGTTY) STRING
 225          (OS NS) TTSTATE (OFFS) FIX)
 226   <COND (<MEMQ .WHICH '[CHAR-CHAR-ERASE CHAR-LINE-ERASE]>
 227          <SET DEFSTR ,SGTTY-DEFAULTS>
 228          <SET RSTR .SGTTY>)
 229         (<MEMQ .WHICH '[CHAR-STOP-PROCESS CHAR-DELAYED-STOP CHAR-LITERAL-NEXT
 230                         CHAR-WORD-ERASE CHAR-FLUSH-OUTPUT]>
 231          <SET DEFSTR ,LTCHAR-DEFAULTS>
 232          <SET RSTR .LTCHARS>)
 233         (<MEMQ .WHICH '[CHAR-INTERRUPT CHAR-QUIT CHAR-START CHAR-STOP]>
 234          <SET DEFSTR ,TCHAR-DEFAULTS>
 235          <SET RSTR .TCHARS>)
 236         (T
 237          <RETURN <ERROR UNKNOWN-CHARACTER-NAME!-ERRORS .WHICH TTY-CHAR> .ACT>)>
 238   <SET OLD <NTH .RSTR <SET OFFS ,.WHICH>>>
 239   <COND (<NOT <ASSIGNED? CHAR>>)
 240         (T
 241          <COND (<NOT .CHAR>
 242                 <SET CHAR <CHTYPE -1 CHARACTER>>)
 243                (<TYPE? .CHAR ATOM>
 244                 <SET CHAR <NTH .DEFSTR .OFFS>>)>
 245          <COND (<N==? .CHAR <NTH .RSTR .OFFS>>
 246                 <PUT .RSTR .OFFS .CHAR>
 247                 <COND (<==? .WHICH CHAR-CHAR-ERASE>
 248                        <TS-RUBOUT .SPEC-CHARS .CHAR>)
 249                       (<==? .WHICH CHAR-LINE-ERASE>
 250                        <TS-KILL .SPEC-CHARS .CHAR>)
 251                       (<==? .WHICH CHAR-WORD-ERASE>
 252                        <TS-WORD .SPEC-CHARS .CHAR>)
 253                       (<==? .WHICH CHAR-LITERAL-NEXT>
 254                        <TS-QUOTE .SPEC-CHARS .CHAR>)>
 255                 <CALL SAVTTY .OS .NS>
 256                 <SET-TERMINAL-MODES .JFN .NS <>>)>)>
 257   .OLD>
 258
 259 <DEFINE TTY-FLOW-CONTROL (CHAN OPER ON? "AUX" (TC <CHANNEL-DATA .CHAN>)
 260                           (TTY <TC-TTY .TC>) (NS <TT-NSTATE .TTY>)
 261                           (OS <TT-OSTATE .TTY>) (ST <TST-TCHARS .NS>))
 262   #DECL ((CHAN) CHANNEL (ON?) <OR ATOM FALSE> (TC) TTY-CHANNEL)
 263   <COND (.ON?
 264          <T-STARTC .ST <ASCII 17> ;"Char Cntl-Q">
 265          <T-STOPC .ST <ASCII 19> ;"Char Cntl-S">)
 266         (T
 267          <T-STARTC .ST <CHTYPE -1 CHARACTER>>
 268          <T-STOPC .ST <CHTYPE -1 CHARACTER>>)>
 269   <CALL SAVTTY .OS .NS>
 270   <SET-TERMINAL-MODES <TC-IJFN .TC> .NS <>>
 271   .ON?>
 272
 273 <DEFINE TTY-FIX-TTY (CHAN OPER "AUX" (TC <CHANNEL-DATA .CHAN>)
 274                      (TTY <TC-TTY .TC>))
 275   #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL (TTY) TTY)
 276   <COND (<TT-SCREWED .TTY>
 277          <TT-SCREWED .TTY <>>
 278          <CALL SAVTTY 0 0>
 279          <SET-TERMINAL-MODES <TC-OJFN .TC> <TT-OSTATE .TTY>>)>>
 280
 281 <DEFINE TTY-BROKEN? (CHAN OPER "AUX" (TC <CHANNEL-DATA .CHAN>))
 282   #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL)
 283   <TT-SCREWED <TC-TTY .TC>>>
 284
 285 <DEFINE TTY-BREAK-TTY (CHAN OPER "AUX" (TC <CHANNEL-DATA .CHAN>)
 286                        (TTY <TC-TTY .TC>))
 287   #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL (TTY) TTY)
 288   <COND (<NOT <TT-SCREWED .TTY>>
 289          <TT-SCREWED .TTY T>
 290          <CALL SAVTTY <TT-OSTATE .TTY> <TT-NSTATE .TTY>>
 291          <SET-TERMINAL-MODES <TC-OJFN .TC> <TT-NSTATE .TTY>>)>>
 292
 293 <DEFINE FIX-TTY (CHAN "AUX" (TC <CHANNEL-DATA .CHAN>) (TTY <TC-TTY .TC>))
 294   #DECL ((CHAN) CHANNEL (TC) TTY-CHANNEL (TTY) TTY)
 295   <COND (<TT-SCREWED .TTY>
 296          <TT-SCREWED .TTY <>>
 297          <CALL SAVTTY 0 0>
 298          <SET-TERMINAL-MODES <TC-OJFN .TC> <TT-OSTATE .TTY>>
 299          T)>>
 300
 301 <DEFINE SET-TERMINAL-MODES (JFN TTSTATE "OPTIONAL" (FLUSH? <>))
 302   #DECL ((JFN) FIX (TTSTATE) TTSTATE)
 303   <CALL SYSCALL IOCTL .JFN
 304         <COND (.FLUSH? ,TIOCSETP)
 305               (T ,TIOCSETN)>
 306         <TST-SGTTYB .TTSTATE>>
 307   <CALL SYSCALL IOCTL .JFN ,TIOCLSET <TST-BITS .TTSTATE>>
 308   <CALL SYSCALL IOCTL .JFN ,TIOCSETC <TST-TCHARS .TTSTATE>>
 309   <CALL SYSCALL IOCTL .JFN ,TIOCSLTC <TST-LTCHARS .TTSTATE>>>
 310 \f
 311 "Interfaces for reading and writing--FILL-READ-BUFFER, WRITE-BUFFER,
 312  WRITE-BYTE, READ-BYTE, BUFOUT, BUFLEN"
 313 <DEFINE TTY-BUFLEN (CHANNEL OPER "OPTIONAL" NEW
 314                     "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 315   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (NEW) FIX)
 316   <COND (<ASSIGNED? NEW>
 317          <TC-IBC .TC .NEW>
 318          .NEW)
 319         (T
 320          <TC-IBC .TC>)>>
 321
 322 <DEFINE TTY-GET-READ (CHANNEL OPER "OPTIONAL" NEW
 323                       "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 324   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (NEW) STRING)
 325   <COND (<ASSIGNED? NEW>
 326          <TC-IBUF .TC .NEW>
 327          .NEW)
 328         (T
 329          <TC-IBUF .TC>)>>
 330
 331 <DEFINE TTY-IMAGE-OUT (CHANNEL OPER CHRS "OPTIONAL" (LENGTH <>)
 332                        "TUPLE" MORE "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 333   #DECL ((CHANNEL) CHANNEL (CHRS) <OR FIX CHARACTER STRING>
 334          (LENGTH) <OR FIX FALSE> (TC) TTY-CHANNEL
 335          (MORE) <TUPLE [REST <OR FIX STRING CHARACTER>]>)
 336   <COND (<TYPE? .CHRS STRING CHARACTER>
 337          <OUTPUT-RAW-STRING .CHANNEL .CHRS .LENGTH>)
 338         (<TYPE? .CHRS FIX>
 339          <OUTPUT-NUMBER .CHANNEL .CHRS <>>)>
 340   <MAPF <>
 341     <FUNCTION (X)
 342       <COND (<TYPE? .X FIX>
 343              <OUTPUT-NUMBER .CHANNEL .X <>>)
 344             (T
 345              <OUTPUT-RAW-STRING .CHANNEL .X <>>)>>
 346     .MORE>>
 347
 348 <DEFINE TTY-TYPE-CHAR (CHANNEL OPER CHAR
 349                        "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 350   #DECL ((CHANNEL) CHANNEL (CHAR) CHARACTER (DATA) TTY-CHANNEL)
 351   <STORE-QUEUE-CHAR .DATA .CHAR>
 352   .CHAR>
 353
 354 <DEFINE TTY-READ-BYTE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>) CHR
 355                        (IB <TC-IBUF .DATA>) (IC <TC-IBC .DATA>) TMP MODE)
 356   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL (IB) <OR STRING FALSE> (IC) FIX
 357          (TMP) <OR FALSE FIX> (MODE) FIX)
 358   <COND (.IB
 359          <COND (<NOT <0? .IC>>
 360                 <SET CHR <1 .IB>>
 361                 <TC-IBUF .DATA <REST .IB>>
 362                 <TC-IBC .DATA <- .IC 1>>
 363                 .CHR)>)
 364         (<SET CHR <GET-BYTE .DATA>>
 365          <SET MODE <TC-MODE .DATA>>
 366          <COND (<ECHO-ON? .MODE>
 367                 <TTY-NORMAL-OUT .CHANNEL .OPER ,BUF1 1>)>
 368          <UPDATE-INPUT <TC-TTY .DATA> .MODE>
 369          <1 ,BUF1>)>>
 370
 371 <DEFINE GET-BYTE (TC "AUX" TEMP CHR)
 372   #DECL ((TC) TTY-CHANNEL (TEMP) <OR <FALSE [REST FIX]> FIX>)
 373   <COND (<NOT <SET CHR <GET-QUEUE-CHAR .TC>>>
 374          <PROG ()
 375            <COND (<AND <SET TEMP <ISYSCALL READ <TC-IJFN .TC> ,BUF1 1>>
 376                        <G? .TEMP 0>>
 377                   <SET CHR <1 ,BUF1>>)
 378                  (<AND <NOT <EMPTY? .TEMP>>
 379                        <==? <1 .TEMP> 4>>
 380                   ; "Handle interrupted system call"
 381                   <AGAIN>)>>)>
 382   .CHR>
 383
 384 <DEFINE GET-QUEUE-CHAR (TC "AUX" (Q <TC-QUEUE .TC>) CHR CT)
 385   #DECL ((TC) TTY-CHANNEL (Q) <OR CHARACTER STRING FALSE> (CT) FIX)
 386   <COND (<0? <SET CT <TC-QCT .TC>>>
 387          <>)
 388         (<TYPE? .Q STRING>
 389          <SET CHR <1 .Q>>
 390          <TC-QUEUE .TC <REST .Q>>
 391          <TC-QCT .TC <- .CT 1>>
 392          .CHR)
 393         (T
 394          <TC-QCT .TC 0>
 395          <TC-QUEUE .TC <>>
 396          .Q)>>
 397
 398 <DEFINE STORE-QUEUE-CHAR (TC CHAR "AUX" (Q <TC-QUEUE .TC>) NQ CT)
 399   #DECL ((TC) TTY-CHANNEL (CHAR) CHARACTER (Q) <OR CHARACTER STRING FALSE>
 400          (CT) FIX)
 401   <COND (<NOT .Q>
 402          <TC-QUEUE .TC .CHAR>
 403          <TC-QCT .TC 1>)
 404         (<TYPE? .Q CHARACTER>
 405          <SET NQ <ISTRING 12>>
 406          <1 .NQ .Q>
 407          <2 .NQ .CHAR>
 408          <TC-QUEUE .TC .NQ>
 409          <TC-QCT .TC 2>)
 410         (<==? <SET CT <TC-QCT .TC>> <LENGTH .Q>>
 411          <COND (<==? <SET NQ <TOP .Q>> .Q>
 412                 <SET NQ <STRING .Q "            ">>
 413                 <PUT .NQ <SET CT <+ .CT 1>> .CHAR>
 414                 <TC-QUEUE .TC .NQ>
 415                 <TC-QCT .TC .CT>)
 416                (T
 417                 <SUBSTRUC .Q 0 <LENGTH .Q> .NQ>
 418                 <PUT .NQ <SET CT <+ .CT 1>> .CHAR>
 419                 <TC-QUEUE .TC .NQ>
 420                 <TC-QCT .TC .CT>)>)
 421         (T
 422          <PUT .Q <SET CT <+ .CT 1>> .CHAR>
 423          <TC-QCT .TC .CT>)>>
 424
 425 <DEFINE TTY-READ-IMMEDIATE (CHANNEL OPER "OPTIONAL" (NOWAIT? <>)
 426                             (QUEUE? T) "AUX" (TC <CHANNEL-DATA .CHANNEL>)
 427                             (ECHO? <ECHO-ON? <TC-MODE .TC>>) (CHR <>) VAL)
 428   #DECL ((CHANNEL) CHANNEL (NOWAIT? QUEUE? ECHO?) <OR ATOM FALSE>
 429          (TC) TTY-CHANNEL (VAL) <OR <FALSE [REST FIX]> FIX>)
 430   <DUMP-WRITE-BUFFER .TC>
 431   <COND (<OR <AND .QUEUE?
 432                   <SET CHR <GET-QUEUE-CHAR .TC>>>
 433              <COND (<OR <NOT .NOWAIT?>
 434                         <AND <CALL SYSCALL IOCTL <TC-IJFN .TC> ,FIONREAD ,UV1>
 435                              <G? <1 ,UV1> 0>>>
 436                     <PROG ()
 437                       <COND (<AND <SET VAL <ISYSCALL READ <TC-IJFN .TC>
 438                                                  ,BUF1 1>>
 439                                   <G? .VAL 0>>
 440                              <SET CHR <1 ,BUF1>>)
 441                             (<AND <NOT <EMPTY? .VAL>>
 442                                   <==? <1 .VAL> 4>>
 443                              <AGAIN>)>>)>>
 444          <COND (.ECHO?
 445                 <TTY-NORMAL-OUT .CHANNEL READ-IMMEDIATE .CHR>
 446                 <DUMP-WRITE-BUFFER .TC>)>
 447          .CHR)>>
 448
 449 <DEFINE TTY-TYPE-AHEAD? (CHANNEL OPER "AUX" (TC <CHANNEL-DATA .CHANNEL>) VAL)
 450   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (VAL) <OR FALSE FIX>)
 451   <1 ,UV1 0>
 452   <COND (<SET VAL <CALL SYSCALL IOCTL <TC-IJFN .TC> ,FIONREAD ,UV1>>
 453          <COND (<G? <SET VAL <+ <1 ,UV1> <TC-QCT .TC>>> 0>
 454                 .VAL)>)>>
 455
 456 <SETG UV1 <UVECTOR 0>>
 457 <GDECL (UV1) <UVECTOR FIX>>
 458 <SETG END-STRING <STRING <ASCII 27> ;"Char Alt">>
 459 <DEFINE TTY-FILL-READ (CHANNEL OPER "OPTIONAL" (CONT 0) (RBUF <>)
 460                        END (NOMORE <>)
 461                        "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 462                              (BB <TC-IBUF .TC>) (BBUF <TC-TIBUF .TC>) CT
 463                              (PROMPT <>) TS)
 464   #DECL ((CHANNEL) CHANNEL (CONT) FIX (RBUF) <OR STRING FALSE>
 465          (END) <OR STRING FALSE> (NOMORE) <OR ATOM FALSE> (TC) TTY-CHANNEL
 466          (BB BBUF) STRING (CT) FIX)
 467   <COND (<OR <NOT <ASSIGNED? END>>
 468              <NOT .END>>
 469          <COND (<AND <ASSIGNED? READ-BREAKS>
 470                      <TYPE? <SET TS .READ-BREAKS> STRING>>
 471                 <SET END .TS>)
 472                (T <SET END ,END-STRING>)>)>
 473   <COND (.RBUF
 474          <SET BB <SET BBUF .RBUF>>)
 475         (<0? <TC-IBC .TC>>
 476          <COND (<NOT <0? .CONT>>
 477                 <SET BB <BACK .BB .CONT>>
 478                 <COND (<N==? .BB .BBUF>
 479                        <SUBSTRUC .BB 0 <LENGTH .BB> .BBUF>)>)>)
 480         (<SET CONT 0>)>
 481   <COND (<AND <ASSIGNED? READ-PROMPT>
 482               <TYPE? <SET TS .READ-PROMPT> STRING>>
 483          <SET PROMPT .TS>)>
 484   <COND (<AND <0? .CONT>
 485               .PROMPT>
 486          <TTY-NORMAL-OUT .CHANNEL .OPER .PROMPT>)>
 487   <PROG ()
 488     <SET CT <DO-RDTTY .CHANNEL .TC .BBUF .CONT .END .PROMPT>>
 489     <COND (<AND <NOT .NOMORE> <==? .CT <LENGTH .BBUF>>>
 490            <TC-IBUF .TC <ISTRING <+ <LENGTH .BBUF> 320>>>
 491            <TC-TIBUF .TC <TC-IBUF .TC>>
 492            <MAPR <>
 493              <FUNCTION (OLD NEW)
 494                <1 .NEW <1 .OLD>>>
 495              .BBUF <TC-IBUF .TC>>
 496            <SET BBUF <TC-IBUF .TC>>
 497            <SET CONT .CT>
 498            <AGAIN>)>>
 499   <COND (<NOT .RBUF>
 500          <TC-IBUF .TC .BBUF>
 501          <TC-IBC .TC .CT>)>
 502   .CT>
 503
 504 <DEFINE TTY-BUFOUT (CHANNEL OPER "OPTIONAL" (FORCE? T)
 505                     "AUX" (TC <CHANNEL-DATA .CHANNEL>)
 506                           (JFN <TC-OJFN .TC>) (BC <TC-OBC .TC>)
 507                           (BUF <TC-OBUF .TC>))
 508   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (JFN) <OR FALSE FIX>
 509          (BC) FIX (BUF) <OR STRING FALSE> (FORCE?) <OR ATOM FALSE>)
 510   <COND (.JFN
 511          <COND (<AND .BUF <G? .BC 0>>
 512                 <DUMP-WRITE-BUFFER .TC>)>
 513          ; "Doesn't seem to be any way to force output"
 514          T)>>
 515
 516 <DEFINE TTY-WRITE-BYTE (CHANNEL OPER BYTE "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 517   #DECL ((CHANNEL) CHANNEL (BYTE) CHARACTER (TC) TTY-CHANNEL)
 518   <COND (<TEST-TC-MODE .TC ,TM-IMAGE>
 519          <TTY-IMAGE-OUT .CHANNEL .OPER .BYTE>)
 520         (<TTY-NORMAL-OUT .CHANNEL .OPER .BYTE>)>>
 521
 522 <DEFINE TTY-WRITE-BUFFER (CHANNEL OPER BYTES "OPTIONAL" (LEN <LENGTH .BYTES>)
 523                           "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 524   #DECL ((CHANNEL) CHANNEL (BYTES) STRING (LEN) FIX (TC) TTY-CHANNEL)
 525   <COND (<TEST-TC-MODE .TC ,TM-IMAGE>
 526          <TTY-IMAGE-OUT .CHANNEL .OPER .BYTES .LEN>)
 527         (<TTY-NORMAL-OUT .CHANNEL .OPER .BYTES .LEN>)>>
 528 \f
 529 "Miscellaneous operations"
 530
 531 <DEFINE TTY-QUERY (CHANNEL OPER BIT "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 532   #DECL ((CHANNEL) CHANNEL (BIT) FIX (DATA) TTY-CHANNEL)
 533   <COND (<==? .BIT ,BIT-INTELLIGENT>
 534          <COND (<TC-IBUF .DATA> T)>)>>
 535
 536 <DEFINE TTY-TERM-MOVE? (CHANNEL OPER "AUX" (TC <CHANNEL-DATA .CHANNEL>)
 537                         (OPS <TD-PRIMOPS <TT-DESC <TC-TTY .TC>>>))
 538   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (OPS) VECTOR)
 539   <AND <G=? <LENGTH .OPS> ,TTY-MOV>
 540        <TTY-MOV .OPS>>>
 541
 542 <DEFINE TTY-GET-TYPE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 543   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL)
 544   <TD-NAME <TT-DESC <TC-TTY .DATA>>>>
 545
 546 <DEFINE TTY-PAD (CHANNEL OPER AMT "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 547   #DECL ((CHANNEL) CHANNEL (AMT) FIX (TC) TTY-CHANNEL)
 548   <OUTPUT-PAD .CHANNEL <TT-DESC <TC-TTY .TC>> .AMT>>
 549
 550 <DEFINE TTY-SET-IMAGE (CHANNEL OPER ON? "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 551   #DECL ((CHANNEL) CHANNEL (ON?) <OR ATOM FALSE> (TC) TTY-CHANNEL)
 552   <TC-MODE .TC <COND (.ON? <ORB <TC-MODE .TC> ,TM-IMAGE>)
 553                      (T
 554                       <ANDB <TC-MODE .TC> %<CHTYPE <XORB ,TM-IMAGE -1>
 555                                                    FIX>>)>>>
 556
 557 <DEFINE TTY-SET-ECHO (CHANNEL OPER ON? "AUX" (TC <CHANNEL-DATA .CHANNEL>))
 558   #DECL ((CHANNEL) CHANNEL (ON?) <OR ATOM FALSE> (TC) TTY-CHANNEL)
 559   <TC-MODE .TC <COND (.ON? <ORB <TC-MODE .TC> ,TM-ECHO>)
 560                      (T
 561                       <ANDB <TC-MODE .TC> %<CHTYPE <XORB ,TM-ECHO -1>
 562                                                    FIX>>)>>>
 563
 564 <DEFINE TTY-CLOSE (CHANNEL OPER)
 565   <ERROR CANT-CLOSE-TTY-CHANNEL .CHANNEL .OPER>>
 566
 567 <DEFINE TTY-PRINT-DATA (CHANNEL OPER OUTCHAN "AUX" (TC <CHANNEL-DATA .CHANNEL>)
 568                         TS)
 569   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TS) <OR FALSE STRING>)
 570   <PRINC "#TTY-CHANNEL [">
 571   <PRINC "JFN:">
 572   <COND (<==? <TC-IJFN .TC> ,STDIN> <PRINC "PRIMARY">)
 573         (T <PRIN1 <TC-IFJN .TC>>)>
 574   <COND (<TC-TTY .TC>
 575          <PRINC !\ >
 576          <PRINC <TD-NAME <TT-DESC <TC-TTY .TC>>>>)>
 577   <COND (<SET TS <TC-IBUF .TC>>
 578          <PRINC " IBUF:">
 579          <PRIN1 <LENGTH <TC-TIBUF .TC>>>
 580          <PRINC !\/>
 581          <PRIN1 <LENGTH .TS>>
 582          <PRINC !\/>
 583          <PRIN1 <TC-IBC .TC>>)>
 584   <COND (<SET TS <TC-OBUF .TC>>
 585          <PRINC " OBUF:">
 586          <PRIN1 <LENGTH <TC-TOBUF .TC>>>
 587          <PRINC !\/>
 588          <PRIN1 <LENGTH .TS>>
 589          <PRINC !\/>
 590          <PRIN1 <TC-OBC .TC>>)>
 591   <PRINC !\]>>