Disable the "purify high core" CORBLK (dubious).
[pdp10-muddle.git] / <mdl.int> / readch.215
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         LDB     C,D             ; GET PREV CHAR
75         CAMN    C,ESCAP(E)      ; SKIP IF NOT ESCAPED
76         JRST    INCHR2          ; ESCAPED
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         HRRZ    0,-2(D)         ; GET BITS
860         TRC     0,C.OPN+C.PRIN
861         TRNE    0,C.OPN+C.PRIN
862         JRST    WRONGD
863
864         MOVE    B,BUFRIN(A)     ;GET A'S AUX BUFFER
865 IFN ITS,[
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 ]
871 CHANRT: MOVE    A,(AB)
872         MOVE    B,1(AB)         ;RETURN 1ST ARG
873         JRST    FINIS
874
875 TCHANC: HRRZ    0,-2(A)         ; GET BITS
876         TRC     0,C.OPN+C.READ
877         TRNE    0,C.OPN+C.READ
878         JRST    BADCHN
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         MOVEI   A,-1            ; TERMINAL; STAYS HERE THROUGHOUT ROUTINE
907         MOVEI   2,175100        ; MAGIC BITS (SEE TENEX MANUAL)
908         SFMOD                   ; ZAP
909         RFMOD                   ; LETS FIND SCREEN SIZE
910         MOVEM   B,STATUS(C)
911         LDB     B,[220700,,B]   ; GET PAGE WIDTH
912         JUMPG   B,.+2
913          MOVEI  B,80.           ; MUST BE VIRTUAL, SO MAKE IT 80.
914         MOVEM   B,LINLN(C)
915         LDB     B,[310700,,STATUS(C)] ; AND LENGTH
916         MOVEM   B,PAGLN(C)
917         SKIPE   OPSYS           ; CHECK FOR TOPS-20
918          JRST   NONVTS          ; ONLY TOPS-20 CAN HAVE VTS
919         RTCHR
920          ERJMP  NONVTS          ; NO RTCHR JSYS, HENCE NO VTS
921         TLNN    B,(TC%MOV+TC%CLR)       ; HAS MINIMAL CHARACTERISTICS?
922          JRST   NONVTS          ; NO GOOD ENOUGH FOR US
923         MOVNI   B,1             ; TERMINAL TYPE -1 IS VTS DISPLAY
924         JRST    HASVTS          ; WINS
925
926 NONVTS: PUSH    P,C             ; IDIOT GETTYP CLOBBERS C
927         GTTYP                   ; FIND TERMINAL TYPE
928         POP     P,C
929 HASVTS: HRLM    B,STATUS(C)     ; USED TO FIGURE OUT DISPLAY STUFF
930         MOVE    B,STATUS(C)
931         MOVE    C,TTICHN+1
932         MOVEM   B,STATUS(C)     ; SET UP INCHAN TOO
933         RFCOC                   ; GET CURRENT
934         AND     B,[036377,,-1]  ; CHANGE FOR ^@, ^A AND ^D (FOR NOW)
935         SFCOC                   ; AND RESUSE IT
936
937         POPJ    P,
938 ]
939
940 IFN ITS,[
941 TTYOP2: .SUSET  [.RTTY,,C]
942         SETZM   NOTTY
943         JUMPL   C,TTYNO         ; DONT HAVE TTY
944
945 TTYOPEN:
946         SKIPE   NOTTY
947         POPJ    P,
948         .CALL   [SETZ
949                 SIXBIT /OPEN/
950                 1000,,TTYIN
951                 SETZ [SIXBIT /TTY   /]]
952         JRST    TTYNO
953         DOTCAL  OPEN,[[1000,,TTYOUT],[[SIXBIT /TTY   /]],[5000,,1]]
954         FATAL CANT OPEN TTY
955         DOTCAL  TTYGET,[[1000,,TTYOUT],[2000,,0],[2000,,A],[2000,,B]]
956         FATAL .CALL FAILURE
957         DOTCAL  TTYSET,[[1000,,TTYOUT],MODE1,MODE2,B]
958         FATAL .CALL FAILURE
959         
960 SETCHN: MOVE    B,TTICHN+1      ;GET CHANNEL
961         MOVEI   C,TTYIN         ;GET ITS CHAN #
962         MOVEM   C,CHANNO(B)
963         .STATUS TTYIN,STATUS(B) ;CLOBBER STATUS
964
965         MOVE    B,TTOCHN+1      ;GET OUT CHAN
966         MOVEI   C,TTYOUT
967         MOVEM   C,CHANNO(B)
968         .STATUS TTYOUT,STATUS(B)
969         SETZM   IMAGFL          ;RESET IMAGE MODE FLAG
970         HLLZS   IOINS-1(B)
971         DOTCAL  RSSIZE,[[1000,,TTYOUT],[2000,,C],[2000,,D]]
972         FATAL   .CALL RSSIZE LOSSAGE
973         MOVEM   C,PAGLN(B)
974         MOVEM   D,LINLN(B)
975         POPJ    P,
976
977 ; HERE IF TTY WONT OPEN
978
979 TTYNO:  SETOM   NOTTY
980         POPJ    P,
981 ]
982
983 GTLPOS:
984 IFN ITS,[
985         DOTCAL  RCPOS,[[CHANNO(B)],[2000,,A]]
986         JFCL
987         HLRZS   A
988         POPJ    P,
989 ]
990 IFE ITS,[
991         PUSH    P,B
992         MOVE    B,TTOCHN+1
993         HLRE    A,STATUS(B)
994         JUMPGE  A,GETCRF
995         MOVE    A,1(B)
996         RFPOS
997         HLRZ    A,B
998         SKIPA
999 GETCRF: MOVE    A,LINPOS(B)
1000         POP     P,B
1001         POPJ    P,
1002 ]
1003
1004 MTYI:   SKIPN   DEMFLG          ; SKIP IF DEMON
1005         SKIPE   NOTTY           ; SKIP IF HAVE TTY
1006         FATAL TRIED TO USE NON-EXISTANT TTY
1007
1008 ; TRY TO AVOID HANGING IN .IOT TO TTY
1009
1010 IFN ITS,[
1011         DOTCAL  IOT,[[1000,,TTYIN],[A],[5000,,1000]]
1012         JFCL
1013 ]
1014 IFE ITS,[
1015
1016 MTYI1:  PBIN
1017 ]
1018         POPJ    P,
1019
1020 INMTYO:                         ; BOTH ARE INTERRUPTABLE
1021 MTYO:   ENABLE
1022         PUSHJ   P,IMTYO
1023         DISABLE
1024         POPJ    P,
1025
1026 ; NON-INTERRUPTABLE VERSION, FOR ECHO INSTRUCTION AND SUCHLIKE
1027 IMTYO:  SKIPE   NOTTY
1028         POPJ    P,              ; IGNORE, DONT HAVE TTY
1029
1030 IFN ITS,[
1031         CAIN    A,177           ;DONT OUTPUT A DELETE
1032          POPJ   P,
1033         PUSH    P,B
1034         MOVEI   B,0             ; SETUP CONTROL BITS
1035         TLNE    0,CNTLPC        ; SKIP IF ^P MODE SWITCH IS OFF
1036         MOVEI   B,%TJDIS        ; SWITCH ON TEMPORARY ^P MODE
1037         DOTCAL  IOT,[[1000,,TTYOUT],[A],[4000,,B]]
1038         JFCL
1039         POP     P,B
1040 ]
1041 IFE ITS, PBOUT
1042         POPJ    P,
1043
1044 ; HERE FOR TYO TO ANY TTY FLAVOR DEVICE
1045 IFN ITS,[
1046 GMTYO:  PUSH    P,0
1047 IFE ITS,[
1048         HRRZ    0,IOINS-1(B)    ; GET FLAG
1049         SKIPE   0
1050         PUSHJ   P,REASCI        ; RE-OPEN TTY
1051 ]
1052         HRLZ    0,CHANNO(B)
1053         ASH     0,5
1054         IOR     0,[.IOT A]
1055         CAIE    A,177           ; DONE OUTPUT A DELETE
1056         XCT     0
1057         POP     P,0
1058         POPJ    P,
1059
1060 REASCI: PUSH    P,A
1061         PUSH    P,C
1062 IFE ITS,[
1063         PUSH    P,B
1064         MOVE    A,1(B)
1065         RFMOD
1066         TRO     B,102
1067         SFMOD 
1068         STPAR
1069         POP     P,B ]
1070
1071         POP     P,C
1072         POP     P,A
1073         HLLZS   IOINS-1(B)
1074         CAMN    B,TTOCHN+1
1075         SETZM   IMAGFL
1076         POPJ    P,
1077 ]
1078
1079
1080 WRONGC: FATAL   TTYECHO--NOT ON A TTY-TYPE CHANNEL
1081
1082
1083
1084 ; HERE TO HANDLE TTY BLOCKING AND UNBLOCKING
1085
1086 TTYBLK: PUSH    TP,$TCHAN
1087         PUSH    TP,B
1088         PUSH    P,0
1089         PUSH    P,E             ; SAVE SOME ACS
1090 IFN ITS,[
1091         MOVE    A,CHANNO(B)     ; GET CHANNEL NUMBER
1092         SOSG    CHNCNT(A)       ; ANY PENDING CHARS
1093         JRST    TTYBL1
1094         SETZM   CHNCNT(A)
1095         MOVEI   0,1
1096         LSH     0,(A)
1097         .SUSET  [.SIFPI,,0]     ; SLAM AN INT ON
1098 ]
1099 TTYBL1: MOVE    C,BUFRIN(B)
1100         MOVE    A,SYSCHR(C)     ; GET FLAGS
1101         TRZ     A,N.IMED
1102         TRZE    A,N.IME1        ; IF WILL BE
1103         TRO     A,N.IMED        ; THE MAKE IT
1104         MOVEM   A,SYSCHR(C)
1105 IFN ITS,[
1106         MOVE    A,[.CALL TTYIOT]        ; NON-BUSY WAIT (IF CHAR READ, LEAVE IN BUFFER
1107                                         ;       TO LET IT BE READ AT INTERRUPT LEVEL)
1108         SKIPE   NOTTY
1109         MOVE    A,[.SLEEP A,]
1110 ]
1111 IFE ITS,[
1112         MOVE    A,[PUSHJ P,TNXIN]
1113 ]
1114         MOVEM   A,WAITNS(B)
1115         PUSH    TP,$TCHSTR
1116         PUSH    TP,CHQUOTE BLOCKED
1117         PUSH    TP,$TPVP
1118         PUSH    TP,PVSTOR+1
1119         MCALL   2,INTERRUPT
1120         MOVSI   A,TCHAN
1121         MOVE    PVP,PVSTOR+1
1122         MOVEM   A,BSTO(PVP)
1123         MOVE    B,(TP)
1124         ENABLE
1125 REBLK:  MOVEI   A,-1            ; IN CASE SLEEPING
1126         XCT     WAITNS(B)       ; NOW WAIT
1127         JFCL
1128 IFE ITS,        JRST    .-3
1129 IFN ITS,        JRST    CHRSNR  ; SNARF CHAR
1130 REBLK1: DISABLE                 ; FALL THROUG=> UNBLOCKED
1131         MOVE    PVP,PVSTOR+1
1132         SETZM   BSTO(PVP)
1133         POP     P,E
1134         POP     P,0
1135         MOVE    B,(TP)
1136         SUB     TP,[2,,2]
1137         POPJ    P,
1138 IFN ITS,[
1139 CHRSNR: SKIPN   DEMFLG          ; SKIP IF DEMON
1140         SKIPE   NOTTY           ; TTY?
1141         JRST    REBLK           ; NO, JUST RESET AND BLOCK
1142         .SUSET  [.SIFPI,,[1_<TTYIN>]]
1143         JRST    REBLK           ; AND GO BACK
1144
1145 TTYIOT: SETZ
1146         SIXBIT /IOT/
1147         1000,,TTYIN
1148         0
1149         405000,,20000
1150 ]
1151 ; HERE TO UNBLOCK TTY
1152
1153 TTYUNB: MOVE    A,WAITNS(B)     ; GET INS
1154         CAMN    A,[JRST REBLK1]
1155         JRST    TTYUN1
1156         MOVE    A,[JRST REBLK1] ; LEAVE THE SLEEP
1157         MOVEM   A,WAITNS(B)
1158         PUSH    TP,$TCHAN
1159         PUSH    TP,B
1160         PUSH    TP,$TCHSTR
1161         PUSH    TP,CHQUOTE UNBLOCKED
1162         PUSH    TP,$TCHAN
1163         PUSH    TP,B
1164         MCALL   2,INTERRUPT
1165         MOVE    B,(TP)          ; RESTORE CHANNEL
1166         SUB     TP,[2,,2]
1167 TTYUN1: POPJ    P,
1168
1169 IFE ITS,[
1170 ; TENEX BASIC TTY I/O ROUTINE
1171
1172 TNXIN:  PUSHJ   P,MTYI
1173         DISABLE
1174         PUSHJ   P,INCHAR
1175         ENABLE
1176         POPJ    P,
1177 ]
1178 MFUNCTION TTYECHO,SUBR
1179
1180         ENTRY   2
1181
1182         GETYP   0,(AB)
1183         CAIE    0,TCHAN
1184         JRST    WTYP1
1185         MOVE    A,1(AB)         ; GET CHANNEL
1186         PUSHJ   P,TCHANC        ; MAKE SURE IT IS TTY INPUT
1187         MOVE    E,BUFRIN(A)     ; EXTRA INFO BUFFER
1188 IFN ITS,[
1189         DOTCAL  TTYGET,[CHANNO(A),[2000,,B],[2000,,C],[2000,,0]]
1190         FATAL .CALL FAILURE
1191 ]
1192 IFE ITS,[
1193         MOVEI   A,100           ; TTY JFN
1194         RFMOD                   ; MODE IN B
1195         TRZ     B,6000          ; TURN OFF ECHO 
1196 ]
1197         GETYP   D,2(AB)         ; ARG 2
1198         CAIE    D,TFALSE        ; SKIP IF WANT ECHO OFF
1199         JRST    ECHOON
1200
1201 IFN ITS,[
1202         ANDCM   B,[606060,,606060]
1203         ANDCM   C,[606060,,606060]
1204
1205         DOTCAL  TTYSET,[CHANNO(A),B,C,0]
1206         FATAL .CALL FAILURE
1207 ]
1208 IFE ITS,[
1209         SFMOD
1210 ]
1211
1212         MOVEI   B,N.ECHO+N.CNTL ; SET FLAGS
1213         IORM    B,SYSCHR(E)
1214
1215         JRST    CHANRT
1216
1217 ECHOON:
1218 IFN ITS,[
1219         IOR     B,[202020,,202020]
1220         IOR     C,[202020,,200020]
1221         DOTCAL  TTYSET,[CHANNO(A),B,C,0]
1222         FATAL .CALL FAILURE
1223 ]
1224 IFE ITS,[
1225         TRO     B,4000
1226         SFMOD
1227 ]
1228         MOVEI   A,N.ECHO+N.CNTL
1229         ANDCAM  A,SYSCHR(E)
1230         JRST    CHANRT
1231
1232
1233
1234 ; USER SUBR FOR INSTANT CHARACTER SNARFING
1235
1236 MFUNCTION UTYI,SUBR,TYI
1237
1238         ENTRY
1239         CAMGE   AB,[-3,,]
1240         JRST    TMA
1241         MOVE    A,(AB)
1242         MOVE    B,1(AB)
1243         JUMPL   AB,.+3
1244         MOVE    B,IMQUOTE INCHAN
1245         PUSHJ   P,IDVAL         ; USE INCHAN
1246         GETYP   0,A             ; GET TYPE
1247         CAIE    0,TCHAN
1248         JRST    WTYP1
1249 IFN ITS,[
1250         LDB     0,[600,,STATUS(B)]
1251         CAILE   0,2
1252         JRST    WTYP1
1253         SKIPN   A,LSTCH(B)      ; ANY READ AHEAD CHAR
1254         JRST    UTYI1           ; NO, SKIP
1255         ANDI    A,-1
1256         SETZM   LSTCH(B)
1257         TLZN    A,400000        ; ! HACK?
1258         JRST    UTYI2           ; NO, OK
1259         HRRM    A,LSTCH(B)      ; YES SAVE
1260         MOVEI   A,"!            ; RET AN !
1261         JRST    UTYI2
1262
1263 UTYI1:  MOVE    0,IOINS(B)
1264         CAME    0,[PUSHJ P,GETCHR]
1265         JRST    WTYP1
1266         PUSH    TP,$TCHAN
1267         PUSH    TP,B
1268         MOVE    C,BUFRIN(B)
1269         MOVEI   D,N.IME1+N.IMED 
1270         IORM    D,SYSCHR(C)     ; CLOBBER IT IN
1271         DOTCAL  TTYGET,[CHANNO(B),[2000,,A],[2000,,D],[2000,,0]]
1272         FATAL .CALL FAILURE
1273         PUSH    P,A
1274         PUSH    P,0
1275         PUSH    P,D             ; SAVE THEM
1276         IOR     D,[030303,,030303]
1277         IOR     A,[030303,,030303]
1278         DOTCAL  TTYSET,[CHANNO(B),A,D,0]
1279         FATAL .CALL FAILURE
1280         MOVNI   A,1
1281         SKIPE   CHRCNT(C)       ; ALREADY SOME?
1282         PUSHJ   P,INCHAR
1283         MOVE    C,BUFRIN(B)     ; GET BUFFER BACK
1284         MOVEI   D,N.IME1
1285         IORM    D,SYSCHR(C)
1286         PUSHJ   P,GETCHR
1287         MOVE    B,1(TB)
1288         MOVE    C,BUFRIN(B)
1289         MOVEI   D,N.IME1+N.IMED
1290         ANDCAM  D,SYSCHR(C)
1291         POP     P,D
1292         POP     P,0
1293         POP     P,C
1294         DOTCAL  TTYSET,[CHANNO(B),C,D,0]
1295         FATAL .CALL FAILURE
1296 UTYI2:  MOVEI   B,(A) ]
1297 IFE ITS,[
1298         MOVE    A,1(B)          ;GET JFN FOR INPUT
1299         ENABLE
1300         BIN                     ;SNARF A CHARACTER
1301         DISABLE
1302 ]
1303         MOVSI   A,TCHRS
1304         JRST    FINIS
1305
1306 MFUNCTION       IMAGE,SUBR
1307         ENTRY
1308         JUMPGE  AB,TFA          ; 1 OR 2 ARGS NEEDED
1309         GETYP   A,(AB)          ;GET THE TYPE OF THE ARG
1310         CAIE    A,TFIX          ;CHECK IT FOR CORRECT TYPE
1311         JRST    WTYP1           ;WAS WRONG...ERROR EXIT
1312         HLRZ    0,AB
1313         CAIL    0,-2
1314         JRST    USEOTC
1315         CAIE    0,-4
1316         JRST    TMA
1317         GETYP   0,2(AB)
1318         CAIE    0,TCHAN
1319         JRST    WTYP2
1320         MOVE    B,3(AB)         ; GET CHANNEL
1321 IMAGE1: MOVE    A,1(AB)
1322         PUSHJ   P,CIMAGE
1323         JRST    FINIS
1324
1325 CIMAGE: SUBM    M,(P)
1326 IFN ITS,[
1327         LDB     0,[600,,STATUS(B)]
1328         CAILE   0,2             ; MUST BE TTY
1329         JRST    IMAGFO
1330         MOVE    0,IOINS(B)
1331         CAMN    0,[PUSHJ P,MTYO]
1332         JRST    .+3
1333         CAME    0,[PUSHJ P,GMTYO]
1334         JRST    WRONGD ]
1335 IFE ITS,[
1336         MOVE    0,CHANNO(B)     ; SEE IF TTY
1337         CAIE    0,101
1338         JRST    IMAGFO
1339 ]
1340
1341 IFN ITS,[
1342         DOTCAL  IOT,[[5000,,2000],[CHANNO(B)],[A]]
1343         JFCL
1344         MOVE    B,A
1345 ]
1346 IFE ITS,[
1347         SKIPE   IMAGFL
1348          JRST   IMGOK
1349         
1350         PUSH    P,A
1351         PUSH    P,B
1352         MOVSI   A,1
1353         HRROI   B,[ASCIZ /TTY:/]
1354         GTJFN
1355          HALTF
1356         MOVE    B,[074000,,102000]
1357         OPENF
1358          HALTF
1359         HRRZM   A,IMAGFL
1360         POP     P,B
1361         POP     P,A
1362 IMGOK:  MOVE    B,IMAGFL
1363         EXCH    A,B
1364         BOUT
1365 ]
1366
1367 IMGEXT: MOVSI   A,TFIX
1368         JRST    MPOPJ
1369
1370
1371 IMAGFO: PUSH    TP,$TCHAN       ;IMAGE OUTPUT FOR NON TTY
1372         PUSH    TP,B
1373         PUSH    P,A
1374         HRRZ    0,-2(B)         ; GET BITS
1375         TRC     0,C.OPN+C.PRIN
1376         TRNE    0,C.OPN+C.PRIN
1377         JRST    BADCHN
1378         MOVE    B,(TP)
1379         PUSHJ   P,GWB           ; MAKE SURE CHANNEL HAS BUFFER
1380         MOVE    A,(P)           ; GET THE CHARACTER TO DO
1381         PUSHJ   P,W1CHAR
1382         POP     P,B
1383         MOVSI   A,TFIX
1384         SUB     TP,[2,,2]
1385         JRST    MPOPJ
1386
1387
1388 USEOTC: MOVSI   A,TATOM
1389         MOVE    B,IMQUOTE OUTCHAN
1390         PUSHJ   P,IDVAL
1391         GETYP   0,A
1392         CAIE    0,TCHAN
1393         MOVE    B,TTOCHN+1
1394         MOVE    A,1(B)
1395         JRST    IMAGE1
1396
1397 IFN ITS,[
1398 IMGBLK: OUT+IMAGEM+UNIT,,(SIXBIT /TTY/)
1399         0
1400         0
1401 ]
1402
1403
1404 IMPURE
1405 IMAGFL: 0
1406 PURE
1407
1408
1409 END
1410 \f