<mdl.int>/readch.mid.213

   1 TITLE READCH TELETYPE DEVICE HANDLER FOR MUDDLE
   2
   3 RELOCATABLE
   4
   5 .INSRT MUDDLE >
   6
   7 SYSQ
   8
   9 IF1,[
  10 IFE ITS,.INSRT STENEX >
  11 ]
  12
  13 .GLOBAL BUFRIN,CHRCNT,SYSCHR,ECHO,BYTPTR,ERASCH,KILLCH,BRKCH,AGC,CHRWRD,W1CHAR,GWB
  14 .GLOBAL IOIN2,READC,WRONGC,BRFCHR,ESCAP,TTYOPE,MTYI,MTYO,IMTYO,INMTYO,NOTTY,DEMFLG,TTYOP2,OPSYS
  15 .GLOBAL IBLOCK,PVSTOR,SPSTOR
  16 .GLOBAL RRESET,TTICHN,TTOCHN,CHANNO,STATUS,BRFCH2,TTYBLK,TTYUNB,WAITNS
  17 .GLOBAL EXBUFR,INCHAR,BYTDOP,BUFSTR,LSTCH,CHNCNT,DIRECT,IOINS,IBLOCK,INCONS
  18 .GLOBAL BADCHN,WRONGD,CHNLOS,MODE1,MODE2,GMTYO,IDVAL,GETCHR,PAGLN,LINLN
  19 .GLOBAL RDEVIC,DEMFLG,READ,MAKACT,CITOP,MPOPJ,CIMAGE,GTLPOS,LINPOS
  20 .GLOBAL NTTYPE,CLRSTR
  21
  22 TTYOUT==1
  23 TTYIN==2
  24
  25 ; FLAGS CONCERNING TTY CHANNEL STATE
  26
  27 N.ECHO==1                       ; NO INPUT ECHO
  28 N.CNTL==2                       ; NO RUBOUT ^L ^D ECHO
  29 N.IMED==4                       ; ALL CHARS WAKE UP
  30 N.IME1==10                      ; SOON WILL BE N.IMED
  31 CNTLPC==20                      ; USE ^P CODE MODE IOT
  32 N.ESC==40
  33
  34 ; OPEN BLOCK MODE BITS
  35 OUT==1
  36 IMAGEM==4
  37 ASCIIM==0
  38 UNIT==0
  39
  40 IFE ITS,[
  41
  42 DP%AG1==200000,,0
  43 DP%AG2==100000,,0
  44
  45 TC%MOV==400000,,0
  46 TC%CLR==40000,,0
  47
  48 .VTUP==3
  49 .VTMOV==7
  50 .VTCLR==15
  51 .VTCEL==17
  52 .VTBEC==21
  53 ]
  54
  55 ; READC IS CALLED BY PUSHJ P,READC
  56 ; B POINTS TO A TTY FLAVOR CHANNEL
  57 ; ONE CHARACTER IS RETURNED IN  A
  58 ; BECOMES INTERRUPTABLE IF NO CHARACTERS EXISTS
  59
  60 ; HERE TO ASK SYSTEM FOR SOME CHARACTERS
  61
  62 INCHAR: IRP     A,,[0,C,D,E]    ;SAVE ACS
  63         PUSH    P,A
  64         TERMIN
  65         MOVE    E,BUFRIN(B)             ; GET AUX BUFFER
  66         MOVE    D,BYTPTR(E)
  67         HLRE    0,E             ;FIND END OF BUFFER
  68         SUBM    E,0
  69         ANDI    0,-1            ;ISOLATE RH
  70         MOVE    C,SYSCHR(E)     ; GET FLAGS
  71
  72 INCHR1: TRNE    C,N.IMED+N.CNTL ; SKIP IF NOT IMMEDIATE
  73         JRST    DONE
  74         TLZE    C,N.ESC         ; SKIP IF NOT ESCAPED
  75         JRST    INCHR2          ; ESCAPED
  76         CAMN    A,ESCAP(E)      ; IF ESCAPE
  77         TLO     C,N.ESC         ; REMEMBER
  78         CAMN    A,BRFCH2(E)
  79         JRST    BRF
  80         CAMN    A,BRFCHR(E)             ;BUFFER PRINT CHAR
  81         JRST    CLEARQ          ;MAYBE CLEAR SCREEN
  82         CAMN    A,BRKCH(E)      ;IS THIS A BREAK?
  83         JRST    DONE            ;YES, DONE
  84         CAMN    A,ERASCH(E)     ;ARE IS IT ERASE?
  85         JRST    ERASE           ;YES, GO PROCESS
  86         CAMN    A,KILLCH(E)     ;OR KILL
  87         JRST    KILL
  88
  89 INCHR2: PUSHJ   P,PUTCHR        ;PUT ACHAR IN BUFFER
  90 INCHR3: MOVEM   D,BYTPTR(E)
  91         JRST    DONE1
  92
  93 DONE:   SKIPL   A               ; IF JUST BUFFER FORCE, SKIP
  94         PUSHJ   P,PUTCHR        ; STORE CHAR
  95         MOVEI   A,N.IMED        ; TURN OFF IMEDIACY
  96         ANDCAM  A,SYSCHR(E)
  97         MOVEM   D,BYTPTR(E)
  98         PUSH    TP,$TCHAN       ; SAVE CHANNEL
  99         PUSH    TP,B
 100         MOVE    A,CHRCNT(E)     ; GET # OF CHARS
 101         SETZM   CHRCNT(E)
 102         PUSH    P,A
 103         ADDI    A,4             ; ROUND UP
 104         IDIVI   A,5             ; AND DOWN
 105         PUSHJ   P,IBLOCK        ; GET CORE
 106         HLRE    A,B             ; FIND D.W.
 107         SUBM    B,A
 108         MOVSI   0,TCHRS+.VECT.  ; GET TYPE
 109         MOVEM   0,(A)           ; AND STORE
 110         MOVEI   D,-1(B)         ; COPY PNTR
 111         MOVE    C,(P)           ; CHAR COUNT
 112         HRLI    D,010700
 113         HRLI    C,TCHSTR
 114         PUSH    TP,$TUVEC
 115         PUSH    TP,B
 116         PUSHJ   P,INCONS        ; CONS IT ON
 117         MOVE    C,-2(TP)        ; GET CHAN BACK
 118         MOVEI   D,EXBUFR(C)     ; POINT TO BUFFER LIST
 119         HRRZ    0,(D)           ; LAST?
 120         JUMPE   0,.+3
 121         MOVE    D,0
 122         JRST    .-3             ; GO UNTIL END
 123         HRRM    B,(D)           ; SPLICE
 124
 125 ; HERE TO BLT IN BUFFER
 126
 127         MOVE    D,BUFRIN(C)     ; POINT TO COMPLETED BUFFER
 128         HRRZ    C,(TP)          ; START OF NEW STRING
 129         HRLI    C,BYTPTR+1(D)   ; 1ST WORD OF CHARS
 130         MOVE    E,[010700,,BYTPTR(E)]
 131         EXCH    E,BYTPTR(D)     ; END OF STRING
 132         MOVEI   E,-BYTPTR(E)
 133         ADD     E,(TP)          ; ADD TO START
 134         BLT     C,-1(E)
 135         MOVE    B,-2(TP)        ; CHANNEL BACK
 136         POP     P,C
 137         SOJG    C,.+3
 138         MOVE    E,BUFRIN(B)
 139         SETZM   BYTPTR+1(E)
 140         SUB     TP,[4,,4]       ; FLUSH JUNK
 141         PUSHJ   P,TTYUNB        ; UNBLOCK THIS TTY
 142 DONE1:  IRP     A,,[E,D,C,0]
 143         POP     P,A
 144         TERMIN
 145         POPJ    P,
 146 \f
 147 ; HERE TO ERASE A CHARACTER
 148
 149 BARFC1: PUSHJ   P,RUBALT        ; CAN WE RUBOUT AN ALTMODE?
 150          JRST   BARFCR          ; NO, C.R.
 151         JRST    ERASAL
 152
 153 ERASE:  SKIPN   CHRCNT(E)       ;ANYTHING IN BUFFER?
 154          JRST   BARFC1          ;NO, MAYBE TYPE CR
 155
 156 ERASAL: SOS     CHRCNT(E)       ;DELETE FROM COUNT
 157         LDB     A,D             ;RE-GOBBLE LAST CHAR
 158 IFN ITS,[
 159         LDB     C,[600,,STATUS(B)] ; CHECK FOR DISPLAY
 160         CAIE    C,2             ; SKIP IF IT IS
 161 ]
 162 IFE ITS,[
 163         HLRE    C,STATUS(B)     ; CONTAINS RESULT OF GTTYP
 164         SKIPN   DELSTR(C)       ; INTERESTING DELETION METHOD?
 165 ]
 166          JUMPGE C,TYPCHR        ; DELETE BY ECHOING DELETED CHAR
 167         SKIPN   ECHO(E)         ; SKIP IF ECHOABLE
 168          JRST   NECHO
 169         PUSHJ   P,CHRTYP        ; FOUND OUT DISPLAY BEHAVIOR
 170         SKIPGE  C,FIXIM2(C)     ; METHOD OF FLUSHING THIS CHARACTER
 171          JRST   (C)             ; DISPATCH TO FUNNY ONES
 172
 173 NOTFUN: PUSHJ   P,DELCHR        ; DELETE ONE CHARACTER
 174         SOJG    C,.-1           ; AND LOOP UNTIL GOT THEM ALL
 175
 176 ; REJOINS HERE TO UPDATE BUFFER POINTER, ETC.
 177 NECHO:  ADD     D,[70000,,0]    ;DECREMENT BYTE POINTER
 178         JUMPGE  D,INCHR3        ;AND GO ON, UNLESS BYTE POINTER LOST
 179         SUB     D,[430000,,1]   ;FIX UP BYTE POINTER
 180         JRST    INCHR3
 181 \f
 182 ; RUB OUT A CHARACTER BY ECHOING IT (NON-DISPLAYS)
 183 TYPCHR: SKIPE   C,ECHO(E)
 184          XCT    C
 185         JRST    NECHO
 186
 187 ; SPECIAL HACKS FOR RUBBING OUT ON DISPLAYS
 188
 189 ; RUB OUT A LINE FEED
 190 LFKILL: PUSHJ   P,LNSTRV
 191         JRST    NECHO
 192
 193 LNSTRV: PUSH    P,0             ; STORE USEFUL DATA
 194 IFN ITS,[
 195         TLO     0,CNTLPC        ; SWITCH ON TEMPORARY ^P MODE
 196         MOVEI   A,20            ; ^P
 197         XCT     ECHO(E)
 198         MOVEI   A,"U            ; U , MOVE UP ONE LINE
 199         XCT     ECHO(E)
 200 ]
 201 IFE ITS,[
 202         PUSH    P,B
 203         MOVE    B,TTOCHN+1
 204         HLRE    A,STATUS(B)     ; terminal type
 205         JUMPGE  A,UPCRF
 206         MOVE    A,1(B)          ; DISPLAY IN VTS MODE
 207         MOVEI   B,.VTUP
 208         VTSOP
 209         JRST    UPCXIT
 210 UPCRF:  PUSHJ   P,GETPOS        ; HERE FOR DISPLAY STUFF IN IMAGE MODE
 211         SOS     LINPOS(B)
 212         PUSHJ   P,SETPOS
 213 UPCXIT: POP     P,B
 214 ]
 215         POP     P,0             ; RESTORE USEFUL DATA
 216         POPJ    P,
 217
 218 ; RUB OUT A BACK SPACE
 219 BSKILL: PUSHJ   P,GETPOS        ; CURRENT POSITION TO A
 220         PUSHJ   P,SETPOS        ; POSITION DISPLAY CURSOR
 221         PUSH    P,0             ; STORE USEFUL DATA
 222 IFN ITS,[
 223         TLO     0,CNTLPC        ; SWITCH ON TEMPORARY ^P MODE
 224         MOVEI   A,20            ; ^P
 225         XCT     ECHO(E)
 226         MOVEI   A,"L            ; L , DELETE TO END OF LINE
 227         XCT     ECHO(E)
 228 ]
 229 IFE ITS,[
 230         HLRE    A,STATUS(B)
 231         JUMPGE  A,CLECRF
 232         PUSH    P,B
 233         MOVE    A,1(B)
 234         MOVEI   B,.VTCEL
 235         VTSOP
 236         POP     P,B
 237         JRST    CLEXIT
 238
 239 CLECRF: MOVEI   0,EOLSTR(A)
 240         PUSHJ   P,STBOUT
 241 ]
 242 CLEXIT: POP     P,0             ; RESTORE USEFUL DATA
 243         JRST    NECHO
 244
 245 ; RUB OUT A TAB
 246 TBKILL: PUSHJ   P,GETPOS
 247         ANDI    A,7
 248         SUBI    A,10            ; A -NUMBER OF DELS TO DO
 249         PUSH    P,A
 250         PUSHJ   P,DELCHR
 251         AOSE    (P)
 252          JRST   .-2
 253         SUB     P,[1,,1]
 254         JRST    NECHO
 255
 256 ; ROUTINE TO DEL CHAR ON DISPLAY
 257 DELCHR: PUSH    P,0             ; STORE USEFUL DATA
 258 IFN ITS,[
 259         TLO     0,CNTLPC        ; SWITCH ON TEMPORARY ^P MODE
 260         MOVEI   A,20
 261         XCT     ECHO(E)
 262         MOVEI   A,"X
 263         XCT     ECHO(E)
 264 ]
 265 IFE ITS,[
 266         HLRE    A,STATUS(B)
 267         JUMPGE  A,DELCRF
 268         PUSH    P,B
 269         MOVE    A,1(B)
 270         MOVEI   B,.VTBEC        ;BACKSPACE AND ERASE
 271         VTSOP
 272         POP     P,B
 273         JRST    DELXIT
 274 DELCRF: MOVEI   0,DELSTR(A)
 275         PUSHJ   P,STBOUT
 276 ]
 277 DELXIT: POP     P,0             ;RESTORE USEFUL DATA
 278         POPJ    P,
 279
 280 ; DELETE FOUR-CHARACTER LOSSAGES
 281 FOURQ:  PUSH    P,CNOTFU
 282 FOURQ2: MOVEI   C,2             ; FOR ^Z AND ^_
 283         CAMN    B,TTICHN+1      ; SKIP IF NOT CONSOLE TTY
 284         MOVEI   C,4
 285 CNOTFU: POPJ    P,NOTFUN
 286
 287 ; HERE IF KILLING A C.R., RE-POSITION CURSOR
 288 CRKILL: PUSHJ   P,GETPOS        ; COMPUTE LINE POS
 289         PUSHJ   P,SETPOS
 290         JRST    NECHO
 291 \f
 292 ; HERE TO SET CURRENT CURSOR POSITION, USUALLY TO END OF LINE
 293 ; A/ POSITION TO GO TO
 294 SETPOS: PUSH    P,0             ; STORE USEFUL DATA
 295 IFN ITS,[
 296         TLO     0,CNTLPC        ; SWITCH ON TEMPORARY ^P MODE
 297         PUSH    P,A             ; SAVE POS
 298         MOVEI   A,20
 299         XCT     ECHO(E)
 300         MOVEI   A,"H
 301         XCT     ECHO(E)
 302         POP     P,A
 303         ADDI    A,10            ; MINIMUM CURSOR POS
 304         XCT     ECHO(E)         ; HORIZ POSIT AT END OF LINE
 305 ]
 306 IFE ITS,[
 307         HLRE    0,STATUS(B)
 308         JUMPGE  ABPCRF
 309
 310         PUSH    P,B             ; VTS ABSOLUTE POSITIONING
 311         PUSH    P,C
 312         PUSH    P,A
 313         PUSHJ   P,GTLPOS
 314         HRL     C,A             ; LINE NUMBER
 315         POP     P,A
 316         HRR     C,A             ; COLUMN NUMBER
 317         MOVE    A,1(B)
 318         MOVEI   B,.VTMOV
 319         HRLI    B,(DP%AG1+DP%AG2)
 320         VTSOP
 321         POP     P,C
 322         POP     P,B
 323         JRST    ABPXIT
 324
 325 ABPCRF: ADD     0,[SETZ POSTAB]
 326         XCT     @0              ; ROUTINES FOR ABSOLUTE POSITIONING (UGH)
 327 ]
 328 ABPXIT: POP     P,0             ; RESTORE USEFUL DATA
 329         POPJ    P,
 330
 331 ; HERE TO CALCULATE CURRENT CURSOR POSITION
 332 ; RETURNS A/ CURSOR POS (CORRESPONDS TO EOL, TOO)
 333 GETPOS: PUSH    P,0
 334         MOVEI   0,0             ; COUNT OF CHARACTER POSITIONS
 335         PUSH    P,[010700,,BYTPTR(E)]   ; POINT TO BUFFER
 336         PUSH    P,CHRCNT(E)     ; NUMBER THEREOF
 337
 338 GETPO1: SOSGE   (P)             ; COUNT DOWN
 339          JRST   GETPO2
 340         ILDB    A,-1(P)         ; CHAR FROM BUFFER
 341         CAIN    A,15            ; SKIP IF NOT CR
 342          MOVEI  0,0             ; C.R., RESET COUNT
 343         PUSHJ   P,CHRTYP        ; GET TYPE
 344         XCT     FIXIM3(C)       ; GET FIXED COUNT
 345         ADD     0,C
 346         JRST    GETPO1
 347
 348 GETPO2: MOVE    A,0             ; RET COUNT
 349         MOVE    0,-2(P)         ; RESTORE AC 0
 350         SUB     P,[3,,3]
 351         POPJ    P,
 352
 353 ; FIGURE OUT HOW MANY CHARACTER POSITIONS A CHARACTER TAKES
 354 CHRTYP: MOVEI   C,0             ; NUMBER OF FLUSHEES
 355         CAILE   A,37            ; SKIP IF CONTROL CHAR
 356          POPJ   P,
 357         PUSH    TP,$TCHAN
 358         PUSH    TP,B            ; SAVE CHAN
 359         IDIVI   A,12.           ; FIND SPECIAL HACKS
 360         MOVE    A,FIXIML(A)     ; GET CONT WORD
 361         IMULI   B,3
 362         ROTC    A,3(B)          ; GET CODE IN B
 363         ANDI    B,7
 364         MOVEI   C,(B)
 365         MOVE    B,(TP)          ; RESTORE CHAN
 366         SUB     TP,[2,,2]
 367         POPJ    P,
 368
 369 ; TABLE OF HOW MANY OR HOW TO FIND OUT
 370 FIXIM2: 1
 371         2
 372         SETZ    FOURQ
 373         SETZ    CRKILL
 374         SETZ    LFKILL
 375         SETZ    BSKILL
 376         SETZ    TBKILL
 377
 378 ; TABLE OF WHAT TO ADD TO HPOS ON ENCOUNTERING CHARACTER
 379 FIXIM3: MOVEI   C,1
 380         MOVEI   C,2
 381         PUSHJ   P,FOURQ2
 382         MOVEI   C,0
 383         MOVEI   C,0
 384         MOVNI   C,1
 385         PUSHJ   P,CNTTAB
 386
 387 ; HORRIBLE KLUDGE TO COUNT SPACES FOR A TAB
 388 CNTTAB: ANDCMI  0,7     ; GET COUNT INCUDING TAB HACK
 389         ADDI    0,10
 390         MOVEI   C,0
 391         POPJ    P,
 392
 393 ; TYPE TABLE FOR EACH CONTROL CHARACTER
 394 FIXIML: 111111,,115641  ; CNTL @ABCDE,,FGHIJK
 395         131111,,111111  ; LMNOPQ,,RSTUVW
 396         112011,,120000  ; XYZ LBRAK \ RBRAK,,^  _
 397 \f
 398 ; HERE TO KILL THE WHOLE BUFFER
 399
 400 KILL:   PUSHJ   P,RUBALT        ; COULD WE RUB OUT ALT MODE
 401         JFCL
 402         CLEARM  CHRCNT(E)       ;NONE LEFT NOW
 403         MOVE    D,[010700,,BYTPTR(E)]   ;RESET POINTER
 404
 405 BARFCR:
 406 IFN ITS,[
 407         MOVE    A,ERASCH(E)     ;GET THE ERASE CHAR
 408         CAIN    A,177           ;IS IT RUBOUT?
 409 ]
 410         PUSHJ   P,CRLF1         ; PRINT CR-LF
 411         JRST    INCHR3
 412
 413 ; SKIP IF CAN RUB OUT AN ALTMODE
 414 RUBALT: PUSH    TP,$TCHAN
 415         PUSH    TP,B
 416         HRRZ    A,FSAV(TB)      ; ARE WE IN READ ?
 417         CAIE    A,READ
 418          JRST   RUBAL1
 419         MOVEI   A,(TP)
 420         SUBI    A,(TB)
 421 IFN ITS,CAIG    A,53            ; SOMEWHAT HEURISTIC (WATCH OUT IN NEW VERSIONS!!!!!!)
 422 IFE ITS,CAIG    A,17
 423          JRST   RUBAL1
 424         HRRZ    A,BUFSTR-1(B)   ; IS BUFFER OF SAME RUN OUT?
 425         JUMPN   A,RUBAL1        ; NO
 426         MOVE    B,IMQUOTE INCHAN
 427         PUSHJ   P,IDVAL         ; REALLY CHECK IT OUT
 428         MOVE    C,(TP)
 429         CAME    C,B
 430          JRST   RUBAL1
 431         MOVE    A,BUFSTR-1(B)
 432         MOVE    B,BUFSTR(B)
 433         PUSHJ   P,CITOP
 434         ANDI    A,-1
 435         MOVE    D,[10700,,BYTPTR(E)]
 436         MOVE    E,(TP)
 437         MOVE    E,BUFRIN(E)
 438         MOVEM   A,CHRCNT(E)
 439 ; CHECK WINNAGE OF BUFFER
 440         ILDB    0,D
 441         ILDB    C,B
 442         CAIE    0,(C)
 443          JRST   RUBAL1
 444         SOJG    A,.-4
 445         MOVE    B,(TP)
 446         MOVEM   D,BYTPTR(E)
 447         MOVE    A,[JRST RETREA]
 448         MOVEM   A,WAITNS(B)
 449         AOS     (P)
 450         SUB     TP,[2,,2]
 451         POPJ    P,
 452
 453 RUBAL1: MOVE    B,(TP)
 454         MOVE    D,[010700,,BYTPTR(E)]
 455         SETZM   CHRCNT(E)
 456         SUB     TP,[2,,2]
 457         POPJ    P,
 458
 459 RETREA: PUSHJ   P,MAKACT
 460         HRLI    A,TFRAME
 461         PUSH    TP,A
 462         PUSH    TP,B
 463         MCALL   1,RETRY
 464         JRST    TTYBLK
 465 \f
 466 ; HERE TO CLEAR SCREEN AND RETYPE BUFFER
 467
 468 CLEARQ:
 469 IFN ITS,[
 470         MOVE    A,STATUS(B)     ; FIGURE OUT CONSOLE TYPE
 471         ANDI    A,77
 472         CAIN    A,2             ; DISPLAY?
 473 ]
 474 IFE ITS,[
 475         HLRE    A,STATUS(B)
 476         SKIPE   CLRSTR(A)       ; TRY IT ONLY ON DISPLAYS
 477 ]
 478          PUSHJ  P,CLR           ; CLEAR SCREEN
 479
 480 ; HERE TO RETYPE BUFFER
 481
 482 BRF:    MOVE    C,[010700,,BYTPTR(E)]   ;POINT TO START OF BUFFER
 483         SKIPN   ECHO(E)         ;ANY ECHO INS?
 484          JRST   NECHO
 485 IFE ITS,PUSH    P,B
 486         MOVE    B,TTOCHN+1
 487         PUSHJ   P,CRLF2
 488 IFE ITS,AOS     LINPOS(B)
 489         PUSH    P,CHRCNT(E)
 490 BRF1:   SOSGE   (P)
 491          JRST   DECHO
 492         ILDB    A,C             ;GOBBLE CHAR
 493         XCT     ECHO(E)         ;ECHO IT
 494 IFE ITS,[
 495         CAIN    A,12
 496          AOS    LINPOS(B)
 497 ]
 498         JRST    BRF1            ;DO FOR ENTIRE BUFFER
 499
 500 DECHO:  SUB     P,[1,,1]
 501 IFE ITS,POP     P,B
 502         JRST    INCHR3
 503
 504 ; ROUTINE TO CRLF ON ANY TTY
 505
 506 CRLF1:  SKIPN   ECHO(E)
 507         POPJ    P,              ; NO ECHO INS
 508 CRLF2:  MOVEI   A,15
 509         XCT     ECHO(E)
 510         MOVEI   A,12
 511         XCT     ECHO(E)
 512         POPJ    P,
 513
 514 ; CLEAR SCREEN
 515 CLR:    SKIPN   C,ECHO(E)       ;ONLY IF INS EXISTS
 516          POPJ   P,
 517         PUSH    P,0
 518 IFN ITS,[
 519         TLO     0,CNTLPC        ;SWITCH ON TEMPORARY ^P MODE
 520         MOVEI   A,20            ;ERASE SCREEN
 521         XCT     C
 522         MOVEI   A,103
 523         XCT     C
 524 ]
 525 IFE ITS,[
 526         JUMPGE  A,CLRCRF
 527         PUSH    P,B
 528         MOVE    A,1(B)
 529         MOVEI   B,.VTCLR
 530         VTSOP
 531         POP     P,B
 532         JRST    CLRXIT
 533
 534 CLRCRF: MOVEI   0,CLRSTR(A)
 535         PUSHJ   P,STBOUT
 536         PUSH    P,B
 537         MOVE    B,TTOCHN+1
 538         SETZM   LINPOS(B)
 539         POP     P,B
 540 ]
 541 CLRXIT: POP     P,0             ;RESTORE USEFUL DATA
 542         POPJ    P,
 543
 544 IFE ITS,[
 545
 546 STBOUT: PUSH    P,B
 547         SKIPE   IMAGFL
 548          JRST   STBOU1
 549         MOVE    A,1(B)
 550         HRRZ    B,STATUS(B)
 551         TRZ     B,300
 552         SFMOD
 553 STBOU1: HRLI    0,440700
 554         ILDB    A,0
 555         JUMPE   A,STBOUX
 556         PBOUT
 557         JRST    .-3
 558
 559 STBOUX: SKIPE   IMAGFL
 560          JRST   STBOU2
 561         MOVE    B,(P)
 562         MOVE    A,1(B)
 563         HRRZ    B,STATUS(B)
 564         SFMOD
 565 STBOU2: POP     P,B
 566         POPJ    P,
 567 \f
 568 ; SPECIAL CASE GOODIES FOR DISPLAY TERMINALS
 569
 570 NTTYPE==40      ; MAX TERMINAL TYPES SUPPORTED
 571
 572
 573 ; HOW TO CLEAR SCREENS ON TOPS-20/TENEX
 574 CLRSTR: 0
 575         0
 576         0
 577         0
 578         ASCII /\7f\12/              ; ITS SOFTWARE
 579         ASCII /\1d\1e/              ; DATAMEDIA
 580         ASCII /\eH\eJ/            ; HP2640
 581         0
 582         0
 583         0
 584         0
 585         ASCII /\eH\eJ/            ; VT50
 586         0
 587         ASCII /\e(\7f/             ; GT40
 588         0
 589         ASCII /\eH\eJ/            ; VT52
 590         0
 591         0
 592         ASCII /\eH\eJ/            ; VT100
 593         ASCII /\eH\eJ/            ; TELERAY
 594         ASCII /\eH\eJ/            ; H19
 595         0
 596         0
 597         0
 598         0
 599         0
 600         0
 601         0
 602         0
 603         0
 604         0
 605         0
 606 IFN <.-CLRSTR>-NTTYPE,PRINTC /ERROR -- CLEAR SCREEN TABLE LOSES
 607 /
 608
 609 ; HOW TO RUB OUT ON VARIOUS TERMINALS
 610 DELSTR: 0
 611         0
 612         0
 613         0
 614         ASCII /\7f\v\7f\ 6/    ; ITS SOFTWARE DISPLAY
 615         0
 616         ASCII /\eD\eK/            ; HP2640
 617         0
 618         0
 619         0
 620         0
 621         ASCII /\eD\eK/            ; VT50
 622         0
 623         0
 624         0
 625         ASCII /\eD\eK/            ; VT52
 626         0
 627         0
 628         ASCII /\eD\eK/            ; VT100
 629         ASCII /\eD\eK/            ; TELERAY
 630         ASCII /\eD\eK/            ; H19
 631         0
 632         0
 633         0
 634         0
 635         0
 636         0
 637         0
 638         0
 639         0
 640         0
 641         0
 642 IFN <.-DELSTR>-NTTYPE,PRINTC /ERROR -- DELETE TABLE LOSES
 643 /
 644
 645 ; CLEAR TO EOL
 646 EOLSTR: 0
 647         0
 648         0
 649         0
 650         ASCII /\7f\ 5/              ; ITS SOFTWARE DISPLAY
 651         0
 652         ASCII /\eK/              ; HP2640
 653         0
 654         0
 655         0
 656         0
 657         ASCII /\eK/              ; VT50
 658         0
 659         0
 660         0
 661         ASCII /\eK/              ; VT52
 662         0
 663         0
 664         ASCII /\eK/              ; VT100
 665         ASCII /\eK/              ; TELERAY
 666         ASCII /\eK/              ; H19
 667         0
 668         0
 669         0
 670         0
 671         0
 672         0
 673         0
 674         0
 675         0
 676         0
 677         0
 678 IFN <.-EOLSTR>-NTTYPE,PRINTC /ERROR -- END OF LINE TABLE LOSES
 679 /
 680
 681 POSTAB: JFCL
 682         JFCL
 683         JFCL
 684         JFCL
 685         PUSHJ   P,PSOFT         ; ITS SOFTWARE
 686         JFCL
 687         PUSHJ   P,PVT52         ; HP2640
 688         JFCL
 689         JFCL
 690         JFCL
 691         JFCL
 692         PUSHJ   P,PVT52         ; VT50
 693         JFCL
 694         JFCL
 695         JFCL
 696         PUSHJ   P,PVT52         ; VT52
 697         JFCL
 698         JFCL
 699         PUSHJ   P,PVT52         ; VT100
 700         PUSHJ   P,PVT52         ; TELERAY
 701         PUSHJ   P,PVT52         ; H19
 702         JFCL
 703         JFCL
 704         JFCL
 705         JFCL
 706         JFCL
 707         JFCL
 708         JFCL
 709         JFCL
 710         JFCL
 711         JFCL
 712         JFCL
 713 IFN <.-POSTAB>-NTTYPE,PRINTC /ERROR -- ABSOLUTE POSITION TABLE LOSES
 714 /
 715
 716
 717
 718 \f
 719 ; ROUTINES FOR ABSOLUTE POSITIONING ON TENEX/TOPS-20
 720
 721 PSOFT:  PUSH    P,A
 722         PUSHJ   P,TNXIMG
 723         MOVEI   A,177
 724         XCT     ECHO(E)
 725         MOVEI   A,21
 726         XCT     ECHO(E)
 727         PUSHJ   P,GTLPOS
 728         XCT     ECHO(E)
 729         POP     P,A
 730         XCT     ECHO(E)
 731         PUSHJ   P,TNXASC
 732         POPJ    P,
 733
 734 PVT52:  PUSH    P,A
 735         PUSHJ   P,TNXIMG
 736         MOVEI   A,33
 737         XCT     ECHO(E)
 738         MOVEI   A,"Y
 739         XCT     ECHO(E)
 740         PUSHJ   P,GTLPOS
 741         ADDI    A,40            ; MUDDLE PAGES START AT 0, VT52 AT 1
 742         XCT     ECHO(E)
 743         POP     P,A
 744         ADDI    A,40            ; DITTO COLUMNS
 745         XCT     ECHO(E)
 746         PUSHJ   P,TNXASC
 747         POPJ    P,
 748
 749 TNXIMG: PUSH    P,B
 750         MOVE    A,1(B)
 751         MOVE    B,STATUS(B)
 752         TRZ     B,300
 753         SFMOD
 754         POP     P,B
 755         POPJ    P,
 756
 757 TNXASC: PUSH    P,B
 758         MOVE    A,1(B)
 759         HRRZ    B,STATUS(B)
 760         SFMOD
 761         POP     P,B
 762         POPJ    P,
 763 ]
 764 \f
 765 PUTCHR: AOS     CHRCNT(E)       ;COUNT THIS CHARACTER
 766         IBP     D               ;BUMP BYTE POINTER
 767 IFE ITS,[
 768         HRRZ    C,D
 769         ADDI    C,(E)
 770         CAIG    0,(C)           ;DONT SKIP IF BUFFER FULL
 771 ]
 772 IFN ITS,        CAIG    0,@D            ;DONT SKIP IF BUFFER FULL
 773          PUSHJ  P,BUFULL        ;GROW BUFFER
 774 IFE ITS,[
 775         CAIN    A,37            ; CHANGE EOL TO CRLF
 776         MOVEI   A,15
 777 ]
 778         DPB     A,D             ;CLOBBER BYTE POINTER IN
 779         MOVE    C,SYSCHR(E)     ; FLAGS
 780 IFE ITS,[
 781         POPJ    P,
 782 ]
 783 IFN ITS,[
 784         TRNN    C,N.IMED+N.CNTL
 785         CAIE    A,15            ; IF CR INPUT, FOLLOW WITH LF
 786         POPJ    P,
 787         MOVEI   A,12            ; GET LF
 788         JRST    PUTCHR
 789 ]
 790 ; BUFFER FULL, GROW THE BUFFER
 791
 792 BUFULL: MOVEM   D,BYTPTR(E)
 793         PUSH    TP,$TCHAN       ;SAVE B
 794         PUSH    TP,B
 795         PUSH    P,A             ; SAVE CURRENT CHAR
 796         HLRE    A,BUFRIN(B)
 797         MOVNS   A
 798         ADDI    A,100           ; MAKE ONE LONGER
 799         PUSHJ   P,IBLOCK        ; GET IT
 800         MOVE    A,(TP)          ;RESTORE CHANNEL POINTER
 801         SUB     TP,[2,,2]       ;AND REMOVE CRUFT
 802         MOVE    E,BUFRIN(A)     ;GET AUX BUFFER POINTER
 803         MOVEM   B,BUFRIN(A)
 804         HLRE    0,E             ;RECOMPUTE 0
 805         MOVSI   E,(E)
 806         HRRI    E,(B)           ; POINT TO DEST
 807         SUB     B,0
 808         BLT     E,(B)
 809         MOVEI   0,100-2(B)
 810         MOVE    B,A
 811         MOVE    E,BUFRIN(B)
 812         POP     P,A
 813         MOVE    D,BYTPTR(E)
 814         POPJ    P,
 815
 816 ; SUBROUTINE TO FLUSH BUFFER
 817
 818 RRESET: SETZM   LSTCH(B)        ; CLOBBER RE-USE CHAR
 819         MOVE    E,BUFRIN(B)             ;GET AUX BUFFER
 820         SETZM   CHRCNT(E)
 821         MOVEI   D,N.IMED+N.IME1
 822         ANDCAM  D,SYSCHR(E)
 823         MOVE    D,[010700,,BYTPTR(E)]   ;RESET BYTE POINTER
 824         MOVEM   D,BYTPTR(E)
 825         MOVE    D,CHANNO(B)     ;GOBBLE CHANNEL
 826 IFN ITS,[
 827         SETZM   CHNCNT(D)       ; FLUSH COUNTERS
 828         LSH     D,23.           ;POSITION
 829         IOR     D,[.RESET 0]
 830         XCT     D               ;RESET ITS CHANNEL
 831 ]
 832 IFE ITS,[
 833         MOVEI   A,100           ; TTY IN JFN
 834         CFIBF
 835 ]
 836         SETZM   EXBUFR(B)       ; CLOBBER STAKED BUFFS
 837         MOVEI   C,BUFSTR-1(B)   ; FIND D.W.
 838         PUSHJ   P,BYTDOP
 839         SUBI    A,2
 840         HRLI    A,010700
 841         MOVEM   A,BUFSTR(B)
 842         HLLZS   BUFSTR-1(B)
 843         POPJ    P,
 844 \f
 845 ; SUBROUTINE TO ESTABLISH ECHO IOINS
 846
 847 MFUNCTION ECHOPAIR,SUBR
 848
 849         ENTRY   2
 850
 851         GETYP   A,(AB)          ;CHECK ARG TYPES
 852         GETYP   C,2(AB)
 853         CAIN    A,TCHAN         ;IS A CHANNEL
 854         CAIE    C,TCHAN         ;IS C ALSO
 855         JRST    WRONGT          ;NO, ONE OF THEM LOSES
 856
 857         MOVE    A,1(AB)         ;GET CHANNEL
 858         PUSHJ   P,TCHANC        ; VERIFY TTY IN
 859         MOVE    D,3(AB)         ;GET OTHER CHANNEL
 860         HRRZ    0,-2(D)         ; GET BITS
 861         TRC     0,C.OPN+C.PRIN
 862         TRNE    0,C.OPN+C.PRIN
 863         JRST    WRONGD
 864
 865         MOVE    B,BUFRIN(A)     ;GET A'S AUX BUFFER
 866 IFN ITS,[
 867         HRLZ    C,CHANNO(D)     ; GET CHANNEL
 868         LSH     C,5
 869         IOR     C,[.IOT A]      ; BUILD AN IOT
 870         MOVEM   C,ECHO(B)               ;CLOBBER
 871 ]
 872 CHANRT: MOVE    A,(AB)
 873         MOVE    B,1(AB)         ;RETURN 1ST ARG
 874         JRST    FINIS
 875
 876 TCHANC: HRRZ    0,-2(A)         ; GET BITS
 877         TRC     0,C.OPN+C.READ
 878         TRNE    0,C.OPN+C.READ
 879         JRST    BADCHN
 880 IFN ITS,[
 881         LDB     C,[600,,STATUS(A)]      ;GET A CODE
 882         CAILE   C,2             ;MAKE SURE A TTY FLAVOR DEVICE
 883         JRST    WRONGC
 884         POPJ    P,
 885 ]
 886 IFE ITS,[
 887         PUSH    P,A
 888         MOVE    A,1(A)
 889         DVCHR
 890         LDB     A,[221100,,B]   ;DEVICE TYPE FIELD
 891         CAIE    A,12            ;TTY
 892         CAIN    A,13            ;PTY
 893          SKIPA
 894           JRST  WRONGC          ;NOT A TTY, HOPE WE DON'T GET HERE IN LISTEN
 895         POP     P,A
 896         POPJ    P,
 897 ]
 898 \f
 899 ; TTY OPEN
 900
 901 IFE ITS,[
 902 TTYOPEN:
 903 TTYOP2: SKIPE   DEMFLG
 904          POPJ   P,
 905         MOVE    C,TTOCHN+1
 906         HLLZS   IOINS-1(C)
 907         MOVEI   A,-1            ; TERMINAL; STAYS HERE THROUGHOUT ROUTINE
 908         MOVEI   2,175100        ; MAGIC BITS (SEE TENEX MANUAL)
 909         SFMOD                   ; ZAP
 910         RFMOD                   ; LETS FIND SCREEN SIZE
 911         MOVEM   B,STATUS(C)
 912         LDB     B,[220700,,B]   ; GET PAGE WIDTH
 913         JUMPG   B,.+2
 914          MOVEI  B,80.           ; MUST BE VIRTUAL, SO MAKE IT 80.
 915         MOVEM   B,LINLN(C)
 916         LDB     B,[310700,,STATUS(C)] ; AND LENGTH
 917         MOVEM   B,PAGLN(C)
 918         SKIPE   OPSYS           ; CHECK FOR TOPS-20
 919          JRST   NONVTS          ; ONLY TOPS-20 CAN HAVE VTS
 920         RTCHR
 921          ERJMP  NONVTS          ; NO RTCHR JSYS, HENCE NO VTS
 922         TLNN    B,(TC%MOV+TC%CLR)       ; HAS MINIMAL CHARACTERISTICS?
 923          JRST   NONVTS          ; NO GOOD ENOUGH FOR US
 924         MOVNI   B,1             ; TERMINAL TYPE -1 IS VTS DISPLAY
 925         JRST    HASVTS          ; WINS
 926
 927 NONVTS: PUSH    P,C             ; IDIOT GETTYP CLOBBERS C
 928         GTTYP                   ; FIND TERMINAL TYPE
 929         POP     P,C
 930 HASVTS: HRLM    B,STATUS(C)     ; USED TO FIGURE OUT DISPLAY STUFF
 931         MOVE    B,STATUS(C)
 932         MOVE    C,TTICHN+1
 933         MOVEM   B,STATUS(C)     ; SET UP INCHAN TOO
 934         RFCOC                   ; GET CURRENT
 935         AND     B,[036377,,-1]  ; CHANGE FOR ^@, ^A AND ^D (FOR NOW)
 936         SFCOC                   ; AND RESUSE IT
 937
 938         POPJ    P,
 939 ]
 940
 941 IFN ITS,[
 942 TTYOP2: .SUSET  [.RTTY,,C]
 943         SETZM   NOTTY
 944         JUMPL   C,TTYNO         ; DONT HAVE TTY
 945
 946 TTYOPEN:
 947         SKIPE   NOTTY
 948         POPJ    P,
 949         DOTCAL  OPEN,[[1000,,TTYIN],[[SIXBIT /TTY   /]]]
 950         JRST    TTYNO
 951         DOTCAL  OPEN,[[1000,,TTYOUT],[[SIXBIT /TTY   /]],[5000,,1]]
 952         FATAL CANT OPEN TTY
 953         DOTCAL  TTYGET,[[1000,,TTYOUT],[2000,,0],[2000,,A],[2000,,B]]
 954         FATAL .CALL FAILURE
 955         DOTCAL  TTYSET,[[1000,,TTYOUT],MODE1,MODE2,B]
 956         FATAL .CALL FAILURE
 957
 958 SETCHN: MOVE    B,TTICHN+1      ;GET CHANNEL
 959         MOVEI   C,TTYIN         ;GET ITS CHAN #
 960         MOVEM   C,CHANNO(B)
 961         .STATUS TTYIN,STATUS(B) ;CLOBBER STATUS
 962
 963         MOVE    B,TTOCHN+1      ;GET OUT CHAN
 964         MOVEI   C,TTYOUT
 965         MOVEM   C,CHANNO(B)
 966         .STATUS TTYOUT,STATUS(B)
 967         SETZM   IMAGFL          ;RESET IMAGE MODE FLAG
 968         HLLZS   IOINS-1(B)
 969         DOTCAL  RSSIZE,[[1000,,TTYOUT],[2000,,C],[2000,,D]]
 970         FATAL   .CALL RSSIZE LOSSAGE
 971         MOVEM   C,PAGLN(B)
 972         MOVEM   D,LINLN(B)
 973         POPJ    P,
 974
 975 ; HERE IF TTY WONT OPEN
 976
 977 TTYNO:  SETOM   NOTTY
 978         POPJ    P,
 979 ]
 980
 981 GTLPOS:
 982 IFN ITS,[
 983         DOTCAL  RCPOS,[[CHANNO(B)],[2000,,A]]
 984         JFCL
 985         HLRZS   A
 986         POPJ    P,
 987 ]
 988 IFE ITS,[
 989         PUSH    P,B
 990         MOVE    B,TTOCHN+1
 991         HLRE    A,STATUS(B)
 992         JUMPGE  A,GETCRF
 993         MOVE    A,1(B)
 994         RFPOS
 995         HLRZ    A,B
 996         SKIPA
 997 GETCRF: MOVE    A,LINPOS(B)
 998         POP     P,B
 999         POPJ    P,
1000 ]
1001
1002 MTYI:   SKIPN   DEMFLG          ; SKIP IF DEMON
1003         SKIPE   NOTTY           ; SKIP IF HAVE TTY
1004         FATAL TRIED TO USE NON-EXISTANT TTY
1005
1006 ; TRY TO AVOID HANGING IN .IOT TO TTY
1007
1008 IFN ITS,[
1009         DOTCAL  IOT,[[1000,,TTYIN],[A],[5000,,1000]]
1010         JFCL
1011 ]
1012 IFE ITS,[
1013
1014 MTYI1:  PBIN
1015 ]
1016         POPJ    P,
1017
1018 INMTYO:                         ; BOTH ARE INTERRUPTABLE
1019 MTYO:   ENABLE
1020         PUSHJ   P,IMTYO
1021         DISABLE
1022         POPJ    P,
1023
1024 ; NON-INTERRUPTABLE VERSION, FOR ECHO INSTRUCTION AND SUCHLIKE
1025 IMTYO:  SKIPE   NOTTY
1026         POPJ    P,              ; IGNORE, DONT HAVE TTY
1027
1028 IFN ITS,[
1029         CAIN    A,177           ;DONT OUTPUT A DELETE
1030          POPJ   P,
1031         PUSH    P,B
1032         MOVEI   B,0             ; SETUP CONTROL BITS
1033         TLNE    0,CNTLPC        ; SKIP IF ^P MODE SWITCH IS OFF
1034         MOVEI   B,%TJDIS        ; SWITCH ON TEMPORARY ^P MODE
1035         DOTCAL  IOT,[[1000,,TTYOUT],[A],[4000,,B]]
1036         JFCL
1037         POP     P,B
1038 ]
1039 IFE ITS, PBOUT
1040         POPJ    P,
1041
1042 ; HERE FOR TYO TO ANY TTY FLAVOR DEVICE
1043 IFN ITS,[
1044 GMTYO:  PUSH    P,0
1045 IFE ITS,[
1046         HRRZ    0,IOINS-1(B)    ; GET FLAG
1047         SKIPE   0
1048         PUSHJ   P,REASCI        ; RE-OPEN TTY
1049 ]
1050         HRLZ    0,CHANNO(B)
1051         ASH     0,5
1052         IOR     0,[.IOT A]
1053         CAIE    A,177           ; DONE OUTPUT A DELETE
1054         XCT     0
1055         POP     P,0
1056         POPJ    P,
1057
1058 REASCI: PUSH    P,A
1059         PUSH    P,C
1060 IFE ITS,[
1061         PUSH    P,B
1062         MOVE    A,1(B)
1063         RFMOD
1064         TRO     B,102
1065         SFMOD
1066         STPAR
1067         POP     P,B ]
1068
1069         POP     P,C
1070         POP     P,A
1071         HLLZS   IOINS-1(B)
1072         CAMN    B,TTOCHN+1
1073         SETZM   IMAGFL
1074         POPJ    P,
1075 ]
1076
1077
1078 WRONGC: FATAL   TTYECHO--NOT ON A TTY-TYPE CHANNEL
1079
1080
1081
1082 ; HERE TO HANDLE TTY BLOCKING AND UNBLOCKING
1083
1084 TTYBLK: PUSH    TP,$TCHAN
1085         PUSH    TP,B
1086         PUSH    P,0
1087         PUSH    P,E             ; SAVE SOME ACS
1088 IFN ITS,[
1089         MOVE    A,CHANNO(B)     ; GET CHANNEL NUMBER
1090         SOSG    CHNCNT(A)       ; ANY PENDING CHARS
1091         JRST    TTYBL1
1092         SETZM   CHNCNT(A)
1093         MOVEI   0,1
1094         LSH     0,(A)
1095         .SUSET  [.SIFPI,,0]     ; SLAM AN INT ON
1096 ]
1097 TTYBL1: MOVE    C,BUFRIN(B)
1098         MOVE    A,SYSCHR(C)     ; GET FLAGS
1099         TRZ     A,N.IMED
1100         TRZE    A,N.IME1        ; IF WILL BE
1101         TRO     A,N.IMED        ; THE MAKE IT
1102         MOVEM   A,SYSCHR(C)
1103 IFN ITS,[
1104         MOVE    A,[.CALL TTYIOT]        ; NON-BUSY WAIT (IF CHAR READ, LEAVE IN BUFFER
1105                                         ;       TO LET IT BE READ AT INTERRUPT LEVEL)
1106         SKIPE   NOTTY
1107         MOVE    A,[.SLEEP A,]
1108 ]
1109 IFE ITS,[
1110         MOVE    A,[PUSHJ P,TNXIN]
1111 ]
1112         MOVEM   A,WAITNS(B)
1113         PUSH    TP,$TCHSTR
1114         PUSH    TP,CHQUOTE BLOCKED
1115         PUSH    TP,$TPVP
1116         PUSH    TP,PVSTOR+1
1117         MCALL   2,INTERRUPT
1118         MOVSI   A,TCHAN
1119         MOVE    PVP,PVSTOR+1
1120         MOVEM   A,BSTO(PVP)
1121         MOVE    B,(TP)
1122         ENABLE
1123 REBLK:  MOVEI   A,-1            ; IN CASE SLEEPING
1124         XCT     WAITNS(B)       ; NOW WAIT
1125         JFCL
1126 IFE ITS,        JRST    .-3
1127 IFN ITS,        JRST    CHRSNR  ; SNARF CHAR
1128 REBLK1: DISABLE                 ; FALL THROUG=> UNBLOCKED
1129         MOVE    PVP,PVSTOR+1
1130         SETZM   BSTO(PVP)
1131         POP     P,E
1132         POP     P,0
1133         MOVE    B,(TP)
1134         SUB     TP,[2,,2]
1135         POPJ    P,
1136 IFN ITS,[
1137 CHRSNR: SKIPN   DEMFLG          ; SKIP IF DEMON
1138         SKIPE   NOTTY           ; TTY?
1139         JRST    REBLK           ; NO, JUST RESET AND BLOCK
1140         .SUSET  [.SIFPI,,[1_<TTYIN>]]
1141         JRST    REBLK           ; AND GO BACK
1142
1143 TTYIOT: SETZ
1144         SIXBIT /IOT/
1145         1000,,TTYIN
1146         0
1147         405000,,20000
1148 ]
1149 ; HERE TO UNBLOCK TTY
1150
1151 TTYUNB: MOVE    A,WAITNS(B)     ; GET INS
1152         CAMN    A,[JRST REBLK1]
1153         JRST    TTYUN1
1154         MOVE    A,[JRST REBLK1] ; LEAVE THE SLEEP
1155         MOVEM   A,WAITNS(B)
1156         PUSH    TP,$TCHAN
1157         PUSH    TP,B
1158         PUSH    TP,$TCHSTR
1159         PUSH    TP,CHQUOTE UNBLOCKED
1160         PUSH    TP,$TCHAN
1161         PUSH    TP,B
1162         MCALL   2,INTERRUPT
1163         MOVE    B,(TP)          ; RESTORE CHANNEL
1164         SUB     TP,[2,,2]
1165 TTYUN1: POPJ    P,
1166
1167 IFE ITS,[
1168 ; TENEX BASIC TTY I/O ROUTINE
1169
1170 TNXIN:  PUSHJ   P,MTYI
1171         DISABLE
1172         PUSHJ   P,INCHAR
1173         ENABLE
1174         POPJ    P,
1175 ]
1176 MFUNCTION TTYECHO,SUBR
1177
1178         ENTRY   2
1179
1180         GETYP   0,(AB)
1181         CAIE    0,TCHAN
1182         JRST    WTYP1
1183         MOVE    A,1(AB)         ; GET CHANNEL
1184         PUSHJ   P,TCHANC        ; MAKE SURE IT IS TTY INPUT
1185         MOVE    E,BUFRIN(A)     ; EXTRA INFO BUFFER
1186 IFN ITS,[
1187         DOTCAL  TTYGET,[CHANNO(A),[2000,,B],[2000,,C],[2000,,0]]
1188         FATAL .CALL FAILURE
1189 ]
1190 IFE ITS,[
1191         MOVEI   A,100           ; TTY JFN
1192         RFMOD                   ; MODE IN B
1193         TRZ     B,6000          ; TURN OFF ECHO
1194 ]
1195         GETYP   D,2(AB)         ; ARG 2
1196         CAIE    D,TFALSE        ; SKIP IF WANT ECHO OFF
1197         JRST    ECHOON
1198
1199 IFN ITS,[
1200         ANDCM   B,[606060,,606060]
1201         ANDCM   C,[606060,,606060]
1202
1203         DOTCAL  TTYSET,[CHANNO(A),B,C,0]
1204         FATAL .CALL FAILURE
1205 ]
1206 IFE ITS,[
1207         SFMOD
1208 ]
1209
1210         MOVEI   B,N.ECHO+N.CNTL ; SET FLAGS
1211         IORM    B,SYSCHR(E)
1212
1213         JRST    CHANRT
1214
1215 ECHOON:
1216 IFN ITS,[
1217         IOR     B,[202020,,202020]
1218         IOR     C,[202020,,200020]
1219         DOTCAL  TTYSET,[CHANNO(A),B,C,0]
1220         FATAL .CALL FAILURE
1221 ]
1222 IFE ITS,[
1223         TRO     B,4000
1224         SFMOD
1225 ]
1226         MOVEI   A,N.ECHO+N.CNTL
1227         ANDCAM  A,SYSCHR(E)
1228         JRST    CHANRT
1229
1230
1231
1232 ; USER SUBR FOR INSTANT CHARACTER SNARFING
1233
1234 MFUNCTION UTYI,SUBR,TYI
1235
1236         ENTRY
1237         CAMGE   AB,[-3,,]
1238         JRST    TMA
1239         MOVE    A,(AB)
1240         MOVE    B,1(AB)
1241         JUMPL   AB,.+3
1242         MOVE    B,IMQUOTE INCHAN
1243         PUSHJ   P,IDVAL         ; USE INCHAN
1244         GETYP   0,A             ; GET TYPE
1245         CAIE    0,TCHAN
1246         JRST    WTYP1
1247 IFN ITS,[
1248         LDB     0,[600,,STATUS(B)]
1249         CAILE   0,2
1250         JRST    WTYP1
1251         SKIPN   A,LSTCH(B)      ; ANY READ AHEAD CHAR
1252         JRST    UTYI1           ; NO, SKIP
1253         ANDI    A,-1
1254         SETZM   LSTCH(B)
1255         TLZN    A,400000        ; ! HACK?
1256         JRST    UTYI2           ; NO, OK
1257         HRRM    A,LSTCH(B)      ; YES SAVE
1258         MOVEI   A,"!            ; RET AN !
1259         JRST    UTYI2
1260
1261 UTYI1:  MOVE    0,IOINS(B)
1262         CAME    0,[PUSHJ P,GETCHR]
1263         JRST    WTYP1
1264         PUSH    TP,$TCHAN
1265         PUSH    TP,B
1266         MOVE    C,BUFRIN(B)
1267         MOVEI   D,N.IME1+N.IMED
1268         IORM    D,SYSCHR(C)     ; CLOBBER IT IN
1269         DOTCAL  TTYGET,[CHANNO(B),[2000,,A],[2000,,D],[2000,,0]]
1270         FATAL .CALL FAILURE
1271         PUSH    P,A
1272         PUSH    P,0
1273         PUSH    P,D             ; SAVE THEM
1274         IOR     D,[030303,,030303]
1275         IOR     A,[030303,,030303]
1276         DOTCAL  TTYSET,[CHANNO(B),A,D,0]
1277         FATAL .CALL FAILURE
1278         MOVNI   A,1
1279         SKIPE   CHRCNT(C)       ; ALREADY SOME?
1280         PUSHJ   P,INCHAR
1281         MOVE    C,BUFRIN(B)     ; GET BUFFER BACK
1282         MOVEI   D,N.IME1
1283         IORM    D,SYSCHR(C)
1284         PUSHJ   P,GETCHR
1285         MOVE    B,1(TB)
1286         MOVE    C,BUFRIN(B)
1287         MOVEI   D,N.IME1+N.IMED
1288         ANDCAM  D,SYSCHR(C)
1289         POP     P,D
1290         POP     P,0
1291         POP     P,C
1292         DOTCAL  TTYSET,[CHANNO(B),C,D,0]
1293         FATAL .CALL FAILURE
1294 UTYI2:  MOVEI   B,(A) ]
1295 IFE ITS,[
1296         MOVE    A,1(B)          ;GET JFN FOR INPUT
1297         ENABLE
1298         BIN                     ;SNARF A CHARACTER
1299         DISABLE
1300 ]
1301         MOVSI   A,TCHRS
1302         JRST    FINIS
1303
1304 MFUNCTION       IMAGE,SUBR
1305         ENTRY
1306         JUMPGE  AB,TFA          ; 1 OR 2 ARGS NEEDED
1307         GETYP   A,(AB)          ;GET THE TYPE OF THE ARG
1308         CAIE    A,TFIX          ;CHECK IT FOR CORRECT TYPE
1309         JRST    WTYP1           ;WAS WRONG...ERROR EXIT
1310         HLRZ    0,AB
1311         CAIL    0,-2
1312         JRST    USEOTC
1313         CAIE    0,-4
1314         JRST    TMA
1315         GETYP   0,2(AB)
1316         CAIE    0,TCHAN
1317         JRST    WTYP2
1318         MOVE    B,3(AB)         ; GET CHANNEL
1319 IMAGE1: MOVE    A,1(AB)
1320         PUSHJ   P,CIMAGE
1321         JRST    FINIS
1322
1323 CIMAGE: SUBM    M,(P)
1324 IFN ITS,[
1325         LDB     0,[600,,STATUS(B)]
1326         CAILE   0,2             ; MUST BE TTY
1327         JRST    IMAGFO
1328         MOVE    0,IOINS(B)
1329         CAMN    0,[PUSHJ P,MTYO]
1330         JRST    .+3
1331         CAME    0,[PUSHJ P,GMTYO]
1332         JRST    WRONGD ]
1333 IFE ITS,[
1334         MOVE    0,CHANNO(B)     ; SEE IF TTY
1335         CAIE    0,101
1336         JRST    IMAGFO
1337 ]
1338
1339 IFN ITS,[
1340         DOTCAL  IOT,[[5000,,2000],[CHANNO(B)],[A]]
1341         JFCL
1342         MOVE    B,A
1343 ]
1344 IFE ITS,[
1345         SKIPE   IMAGFL
1346          JRST   IMGOK
1347
1348         PUSH    P,A
1349         PUSH    P,B
1350         MOVSI   A,1
1351         HRROI   B,[ASCIZ /TTY:/]
1352         GTJFN
1353          HALTF
1354         MOVE    B,[074000,,102000]
1355         OPENF
1356          HALTF
1357         HRRZM   A,IMAGFL
1358         POP     P,B
1359         POP     P,A
1360 IMGOK:  MOVE    B,IMAGFL
1361         EXCH    A,B
1362         BOUT
1363
1364
1365 IMGEXT: MOVSI   A,TFIX
1366         JRST    MPOPJ
1367
1368
1369 IMAGFO: PUSH    TP,$TCHAN       ;IMAGE OUTPUT FOR NON TTY
1370         PUSH    TP,B
1371         PUSH    P,A
1372         HRRZ    0,-2(B)         ; GET BITS
1373         TRC     0,C.OPN+C.PRIN
1374         TRNE    0,C.OPN+C.PRIN
1375         JRST    BADCHN
1376         MOVE    B,(TP)
1377         PUSHJ   P,GWB           ; MAKE SURE CHANNEL HAS BUFFER
1378         MOVE    A,(P)           ; GET THE CHARACTER TO DO
1379         PUSHJ   P,W1CHAR
1380         POP     P,B
1381         MOVSI   A,TFIX
1382         SUB     TP,[2,,2]
1383         JRST    MPOPJ
1384
1385
1386 USEOTC: MOVSI   A,TATOM
1387         MOVE    B,IMQUOTE OUTCHAN
1388         PUSHJ   P,IDVAL
1389         GETYP   0,A
1390         CAIE    0,TCHAN
1391         MOVE    B,TTOCHN+1
1392         MOVE    A,1(B)
1393         JRST    IMAGE1
1394
1395 IFN ITS,[
1396 IMGBLK: OUT+IMAGEM+UNIT,,(SIXBIT /TTY/)
1397         0
1398         0
1399 ]
1400
1401
1402 IMPURE
1403 IMAGFL: 0
1404 PURE
1405
1406
1407 END
1408 \f