<mdl.int>/readch.mid.206

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