--- /dev/null
+TITLE READCH TELETYPE DEVICE HANDLER FOR MUDDLE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+SYSQ
+
+IF1,[
+IFE ITS,.INSRT STENEX >
+]
+
+.GLOBAL BUFRIN,CHRCNT,SYSCHR,ECHO,BYTPTR,ERASCH,KILLCH,BRKCH,AGC,CHRWRD,W1CHAR,GWB
+.GLOBAL IOIN2,READC,WRONGC,BRFCHR,ESCAP,TTYOPE,MTYI,MTYO,IMTYO,INMTYO,NOTTY,DEMFLG,TTYOP2,OPSYS
+.GLOBAL IBLOCK,PVSTOR,SPSTOR
+.GLOBAL RRESET,TTICHN,TTOCHN,CHANNO,STATUS,BRFCH2,TTYBLK,TTYUNB,WAITNS
+.GLOBAL EXBUFR,INCHAR,BYTDOP,BUFSTR,LSTCH,CHNCNT,DIRECT,IOINS,IBLOCK,INCONS
+.GLOBAL BADCHN,WRONGD,CHNLOS,MODE1,MODE2,GMTYO,IDVAL,GETCHR,PAGLN,LINLN
+.GLOBAL RDEVIC,DEMFLG,READ,MAKACT,CITOP,MPOPJ,CIMAGE,GTLPOS,LINPOS
+.GLOBAL NTTYPE,CLRSTR
+
+TTYOUT==1
+TTYIN==2
+
+; FLAGS CONCERNING TTY CHANNEL STATE
+
+N.ECHO==1 ; NO INPUT ECHO
+N.CNTL==2 ; NO RUBOUT ^L ^D ECHO
+N.IMED==4 ; ALL CHARS WAKE UP
+N.IME1==10 ; SOON WILL BE N.IMED
+CNTLPC==20 ; USE ^P CODE MODE IOT
+N.ESC==40
+
+; OPEN BLOCK MODE BITS
+OUT==1
+IMAGEM==4
+ASCIIM==0
+UNIT==0
+
+IFE ITS,[
+
+DP%AG1==200000,,0
+DP%AG2==100000,,0
+
+TC%MOV==400000,,0
+TC%CLR==40000,,0
+
+.VTUP==3
+.VTMOV==7
+.VTCLR==15
+.VTCEL==17
+.VTBEC==21
+]
+
+; READC IS CALLED BY PUSHJ P,READC
+; B POINTS TO A TTY FLAVOR CHANNEL
+; ONE CHARACTER IS RETURNED IN A
+; BECOMES INTERRUPTABLE IF NO CHARACTERS EXISTS
+
+; HERE TO ASK SYSTEM FOR SOME CHARACTERS
+
+INCHAR: IRP A,,[0,C,D,E] ;SAVE ACS
+ PUSH P,A
+ TERMIN
+ MOVE E,BUFRIN(B) ; GET AUX BUFFER
+ MOVE D,BYTPTR(E)
+ HLRE 0,E ;FIND END OF BUFFER
+ SUBM E,0
+ ANDI 0,-1 ;ISOLATE RH
+ MOVE C,SYSCHR(E) ; GET FLAGS
+
+INCHR1: TRNE C,N.IMED+N.CNTL ; SKIP IF NOT IMMEDIATE
+ JRST DONE
+ LDB C,D ; GET PREV CHAR
+ CAMN C,ESCAP(E) ; SKIP IF NOT ESCAPED
+ JRST INCHR2 ; ESCAPED
+ CAMN A,BRFCH2(E)
+ JRST BRF
+ CAMN A,BRFCHR(E) ;BUFFER PRINT CHAR
+ JRST CLEARQ ;MAYBE CLEAR SCREEN
+ CAMN A,BRKCH(E) ;IS THIS A BREAK?
+ JRST DONE ;YES, DONE
+ CAMN A,ERASCH(E) ;ARE IS IT ERASE?
+ JRST ERASE ;YES, GO PROCESS
+ CAMN A,KILLCH(E) ;OR KILL
+ JRST KILL
+
+INCHR2: PUSHJ P,PUTCHR ;PUT ACHAR IN BUFFER
+INCHR3: MOVEM D,BYTPTR(E)
+ JRST DONE1
+
+DONE: SKIPL A ; IF JUST BUFFER FORCE, SKIP
+ PUSHJ P,PUTCHR ; STORE CHAR
+ MOVEI A,N.IMED ; TURN OFF IMEDIACY
+ ANDCAM A,SYSCHR(E)
+ MOVEM D,BYTPTR(E)
+ PUSH TP,$TCHAN ; SAVE CHANNEL
+ PUSH TP,B
+ MOVE A,CHRCNT(E) ; GET # OF CHARS
+ SETZM CHRCNT(E)
+ PUSH P,A
+ ADDI A,4 ; ROUND UP
+ IDIVI A,5 ; AND DOWN
+ PUSHJ P,IBLOCK ; GET CORE
+ HLRE A,B ; FIND D.W.
+ SUBM B,A
+ MOVSI 0,TCHRS+.VECT. ; GET TYPE
+ MOVEM 0,(A) ; AND STORE
+ MOVEI D,-1(B) ; COPY PNTR
+ MOVE C,(P) ; CHAR COUNT
+ HRLI D,010700
+ HRLI C,TCHSTR
+ PUSH TP,$TUVEC
+ PUSH TP,B
+ PUSHJ P,INCONS ; CONS IT ON
+ MOVE C,-2(TP) ; GET CHAN BACK
+ MOVEI D,EXBUFR(C) ; POINT TO BUFFER LIST
+ HRRZ 0,(D) ; LAST?
+ JUMPE 0,.+3
+ MOVE D,0
+ JRST .-3 ; GO UNTIL END
+ HRRM B,(D) ; SPLICE
+
+; HERE TO BLT IN BUFFER
+
+ MOVE D,BUFRIN(C) ; POINT TO COMPLETED BUFFER
+ HRRZ C,(TP) ; START OF NEW STRING
+ HRLI C,BYTPTR+1(D) ; 1ST WORD OF CHARS
+ MOVE E,[010700,,BYTPTR(E)]
+ EXCH E,BYTPTR(D) ; END OF STRING
+ MOVEI E,-BYTPTR(E)
+ ADD E,(TP) ; ADD TO START
+ BLT C,-1(E)
+ MOVE B,-2(TP) ; CHANNEL BACK
+ POP P,C
+ SOJG C,.+3
+ MOVE E,BUFRIN(B)
+ SETZM BYTPTR+1(E)
+ SUB TP,[4,,4] ; FLUSH JUNK
+ PUSHJ P,TTYUNB ; UNBLOCK THIS TTY
+DONE1: IRP A,,[E,D,C,0]
+ POP P,A
+ TERMIN
+ POPJ P,
+\f
+; HERE TO ERASE A CHARACTER
+
+BARFC1: PUSHJ P,RUBALT ; CAN WE RUBOUT AN ALTMODE?
+ JRST BARFCR ; NO, C.R.
+ JRST ERASAL
+
+ERASE: SKIPN CHRCNT(E) ;ANYTHING IN BUFFER?
+ JRST BARFC1 ;NO, MAYBE TYPE CR
+
+ERASAL: SOS CHRCNT(E) ;DELETE FROM COUNT
+ LDB A,D ;RE-GOBBLE LAST CHAR
+IFN ITS,[
+ LDB C,[600,,STATUS(B)] ; CHECK FOR DISPLAY
+ CAIE C,2 ; SKIP IF IT IS
+]
+IFE ITS,[
+ HLRE C,STATUS(B) ; CONTAINS RESULT OF GTTYP
+ SKIPN DELSTR(C) ; INTERESTING DELETION METHOD?
+]
+ JUMPGE C,TYPCHR ; DELETE BY ECHOING DELETED CHAR
+ SKIPN ECHO(E) ; SKIP IF ECHOABLE
+ JRST NECHO
+ PUSHJ P,CHRTYP ; FOUND OUT DISPLAY BEHAVIOR
+ SKIPGE C,FIXIM2(C) ; METHOD OF FLUSHING THIS CHARACTER
+ JRST (C) ; DISPATCH TO FUNNY ONES
+
+NOTFUN: PUSHJ P,DELCHR ; DELETE ONE CHARACTER
+ SOJG C,.-1 ; AND LOOP UNTIL GOT THEM ALL
+
+; REJOINS HERE TO UPDATE BUFFER POINTER, ETC.
+NECHO: ADD D,[70000,,0] ;DECREMENT BYTE POINTER
+ JUMPGE D,INCHR3 ;AND GO ON, UNLESS BYTE POINTER LOST
+ SUB D,[430000,,1] ;FIX UP BYTE POINTER
+ JRST INCHR3
+\f
+; RUB OUT A CHARACTER BY ECHOING IT (NON-DISPLAYS)
+TYPCHR: SKIPE C,ECHO(E)
+ XCT C
+ JRST NECHO
+
+; SPECIAL HACKS FOR RUBBING OUT ON DISPLAYS
+
+; RUB OUT A LINE FEED
+LFKILL: PUSHJ P,LNSTRV
+ JRST NECHO
+
+LNSTRV: PUSH P,0 ; STORE USEFUL DATA
+IFN ITS,[
+ TLO 0,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
+ MOVEI A,20 ; ^P
+ XCT ECHO(E)
+ MOVEI A,"U ; U , MOVE UP ONE LINE
+ XCT ECHO(E)
+]
+IFE ITS,[
+ PUSH P,B
+ MOVE B,TTOCHN+1
+ HLRE A,STATUS(B) ; terminal type
+ JUMPGE A,UPCRF
+ MOVE A,1(B) ; DISPLAY IN VTS MODE
+ MOVEI B,.VTUP
+ VTSOP
+ JRST UPCXIT
+UPCRF: PUSHJ P,GETPOS ; HERE FOR DISPLAY STUFF IN IMAGE MODE
+ SOS LINPOS(B)
+ PUSHJ P,SETPOS
+UPCXIT: POP P,B
+]
+ POP P,0 ; RESTORE USEFUL DATA
+ POPJ P,
+
+; RUB OUT A BACK SPACE
+BSKILL: PUSHJ P,GETPOS ; CURRENT POSITION TO A
+ PUSHJ P,SETPOS ; POSITION DISPLAY CURSOR
+ PUSH P,0 ; STORE USEFUL DATA
+IFN ITS,[
+ TLO 0,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
+ MOVEI A,20 ; ^P
+ XCT ECHO(E)
+ MOVEI A,"L ; L , DELETE TO END OF LINE
+ XCT ECHO(E)
+]
+IFE ITS,[
+ HLRE A,STATUS(B)
+ JUMPGE A,CLECRF
+ PUSH P,B
+ MOVE A,1(B)
+ MOVEI B,.VTCEL
+ VTSOP
+ POP P,B
+ JRST CLEXIT
+
+CLECRF: MOVEI 0,EOLSTR(A)
+ PUSHJ P,STBOUT
+]
+CLEXIT: POP P,0 ; RESTORE USEFUL DATA
+ JRST NECHO
+
+; RUB OUT A TAB
+TBKILL: PUSHJ P,GETPOS
+ ANDI A,7
+ SUBI A,10 ; A -NUMBER OF DELS TO DO
+ PUSH P,A
+ PUSHJ P,DELCHR
+ AOSE (P)
+ JRST .-2
+ SUB P,[1,,1]
+ JRST NECHO
+
+; ROUTINE TO DEL CHAR ON DISPLAY
+DELCHR: PUSH P,0 ; STORE USEFUL DATA
+IFN ITS,[
+ TLO 0,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
+ MOVEI A,20
+ XCT ECHO(E)
+ MOVEI A,"X
+ XCT ECHO(E)
+]
+IFE ITS,[
+ HLRE A,STATUS(B)
+ JUMPGE A,DELCRF
+ PUSH P,B
+ MOVE A,1(B)
+ MOVEI B,.VTBEC ;BACKSPACE AND ERASE
+ VTSOP
+ POP P,B
+ JRST DELXIT
+DELCRF: MOVEI 0,DELSTR(A)
+ PUSHJ P,STBOUT
+]
+DELXIT: POP P,0 ;RESTORE USEFUL DATA
+ POPJ P,
+
+; DELETE FOUR-CHARACTER LOSSAGES
+FOURQ: PUSH P,CNOTFU
+FOURQ2: MOVEI C,2 ; FOR ^Z AND ^_
+ CAMN B,TTICHN+1 ; SKIP IF NOT CONSOLE TTY
+ MOVEI C,4
+CNOTFU: POPJ P,NOTFUN
+
+; HERE IF KILLING A C.R., RE-POSITION CURSOR
+CRKILL: PUSHJ P,GETPOS ; COMPUTE LINE POS
+ PUSHJ P,SETPOS
+ JRST NECHO
+\f
+; HERE TO SET CURRENT CURSOR POSITION, USUALLY TO END OF LINE
+; A/ POSITION TO GO TO
+SETPOS: PUSH P,0 ; STORE USEFUL DATA
+IFN ITS,[
+ TLO 0,CNTLPC ; SWITCH ON TEMPORARY ^P MODE
+ PUSH P,A ; SAVE POS
+ MOVEI A,20
+ XCT ECHO(E)
+ MOVEI A,"H
+ XCT ECHO(E)
+ POP P,A
+ ADDI A,10 ; MINIMUM CURSOR POS
+ XCT ECHO(E) ; HORIZ POSIT AT END OF LINE
+]
+IFE ITS,[
+ HLRE 0,STATUS(B)
+ JUMPGE ABPCRF
+
+ PUSH P,B ; VTS ABSOLUTE POSITIONING
+ PUSH P,C
+ PUSH P,A
+ PUSHJ P,GTLPOS
+ HRL C,A ; LINE NUMBER
+ POP P,A
+ HRR C,A ; COLUMN NUMBER
+ MOVE A,1(B)
+ MOVEI B,.VTMOV
+ HRLI B,(DP%AG1+DP%AG2)
+ VTSOP
+ POP P,C
+ POP P,B
+ JRST ABPXIT
+
+ABPCRF: ADD 0,[SETZ POSTAB]
+ XCT @0 ; ROUTINES FOR ABSOLUTE POSITIONING (UGH)
+]
+ABPXIT: POP P,0 ; RESTORE USEFUL DATA
+ POPJ P,
+
+; HERE TO CALCULATE CURRENT CURSOR POSITION
+; RETURNS A/ CURSOR POS (CORRESPONDS TO EOL, TOO)
+GETPOS: PUSH P,0
+ MOVEI 0,0 ; COUNT OF CHARACTER POSITIONS
+ PUSH P,[010700,,BYTPTR(E)] ; POINT TO BUFFER
+ PUSH P,CHRCNT(E) ; NUMBER THEREOF
+
+GETPO1: SOSGE (P) ; COUNT DOWN
+ JRST GETPO2
+ ILDB A,-1(P) ; CHAR FROM BUFFER
+ CAIN A,15 ; SKIP IF NOT CR
+ MOVEI 0,0 ; C.R., RESET COUNT
+ PUSHJ P,CHRTYP ; GET TYPE
+ XCT FIXIM3(C) ; GET FIXED COUNT
+ ADD 0,C
+ JRST GETPO1
+
+GETPO2: MOVE A,0 ; RET COUNT
+ MOVE 0,-2(P) ; RESTORE AC 0
+ SUB P,[3,,3]
+ POPJ P,
+
+; FIGURE OUT HOW MANY CHARACTER POSITIONS A CHARACTER TAKES
+CHRTYP: MOVEI C,0 ; NUMBER OF FLUSHEES
+ CAILE A,37 ; SKIP IF CONTROL CHAR
+ POPJ P,
+ PUSH TP,$TCHAN
+ PUSH TP,B ; SAVE CHAN
+ IDIVI A,12. ; FIND SPECIAL HACKS
+ MOVE A,FIXIML(A) ; GET CONT WORD
+ IMULI B,3
+ ROTC A,3(B) ; GET CODE IN B
+ ANDI B,7
+ MOVEI C,(B)
+ MOVE B,(TP) ; RESTORE CHAN
+ SUB TP,[2,,2]
+ POPJ P,
+
+; TABLE OF HOW MANY OR HOW TO FIND OUT
+FIXIM2: 1
+ 2
+ SETZ FOURQ
+ SETZ CRKILL
+ SETZ LFKILL
+ SETZ BSKILL
+ SETZ TBKILL
+
+; TABLE OF WHAT TO ADD TO HPOS ON ENCOUNTERING CHARACTER
+FIXIM3: MOVEI C,1
+ MOVEI C,2
+ PUSHJ P,FOURQ2
+ MOVEI C,0
+ MOVEI C,0
+ MOVNI C,1
+ PUSHJ P,CNTTAB
+
+; HORRIBLE KLUDGE TO COUNT SPACES FOR A TAB
+CNTTAB: ANDCMI 0,7 ; GET COUNT INCUDING TAB HACK
+ ADDI 0,10
+ MOVEI C,0
+ POPJ P,
+
+; TYPE TABLE FOR EACH CONTROL CHARACTER
+FIXIML: 111111,,115641 ; CNTL @ABCDE,,FGHIJK
+ 131111,,111111 ; LMNOPQ,,RSTUVW
+ 112011,,120000 ; XYZ LBRAK \ RBRAK,,^ _
+\f
+; HERE TO KILL THE WHOLE BUFFER
+
+KILL: PUSHJ P,RUBALT ; COULD WE RUB OUT ALT MODE
+ JFCL
+ CLEARM CHRCNT(E) ;NONE LEFT NOW
+ MOVE D,[010700,,BYTPTR(E)] ;RESET POINTER
+
+BARFCR:
+IFN ITS,[
+ MOVE A,ERASCH(E) ;GET THE ERASE CHAR
+ CAIN A,177 ;IS IT RUBOUT?
+]
+ PUSHJ P,CRLF1 ; PRINT CR-LF
+ JRST INCHR3
+
+; SKIP IF CAN RUB OUT AN ALTMODE
+RUBALT: PUSH TP,$TCHAN
+ PUSH TP,B
+ HRRZ A,FSAV(TB) ; ARE WE IN READ ?
+ CAIE A,READ
+ JRST RUBAL1
+ MOVEI A,(TP)
+ SUBI A,(TB)
+IFN ITS,CAIG A,53 ; SOMEWHAT HEURISTIC (WATCH OUT IN NEW VERSIONS!!!!!!)
+IFE ITS,CAIG A,17
+ JRST RUBAL1
+ HRRZ A,BUFSTR-1(B) ; IS BUFFER OF SAME RUN OUT?
+ JUMPN A,RUBAL1 ; NO
+ MOVE B,IMQUOTE INCHAN
+ PUSHJ P,IDVAL ; REALLY CHECK IT OUT
+ MOVE C,(TP)
+ CAME C,B
+ JRST RUBAL1
+ MOVE A,BUFSTR-1(B)
+ MOVE B,BUFSTR(B)
+ PUSHJ P,CITOP
+ ANDI A,-1
+ MOVE D,[10700,,BYTPTR(E)]
+ MOVE E,(TP)
+ MOVE E,BUFRIN(E)
+ MOVEM A,CHRCNT(E)
+; CHECK WINNAGE OF BUFFER
+ ILDB 0,D
+ ILDB C,B
+ CAIE 0,(C)
+ JRST RUBAL1
+ SOJG A,.-4
+ MOVE B,(TP)
+ MOVEM D,BYTPTR(E)
+ MOVE A,[JRST RETREA]
+ MOVEM A,WAITNS(B)
+ AOS (P)
+ SUB TP,[2,,2]
+ POPJ P,
+
+RUBAL1: MOVE B,(TP)
+ MOVE D,[010700,,BYTPTR(E)]
+ SETZM CHRCNT(E)
+ SUB TP,[2,,2]
+ POPJ P,
+
+RETREA: PUSHJ P,MAKACT
+ HRLI A,TFRAME
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 1,RETRY
+ JRST TTYBLK
+\f
+; HERE TO CLEAR SCREEN AND RETYPE BUFFER
+
+CLEARQ:
+IFN ITS,[
+ MOVE A,STATUS(B) ; FIGURE OUT CONSOLE TYPE
+ ANDI A,77
+ CAIN A,2 ; DISPLAY?
+]
+IFE ITS,[
+ HLRE A,STATUS(B)
+ SKIPE CLRSTR(A) ; TRY IT ONLY ON DISPLAYS
+]
+ PUSHJ P,CLR ; CLEAR SCREEN
+
+; HERE TO RETYPE BUFFER
+
+BRF: MOVE C,[010700,,BYTPTR(E)] ;POINT TO START OF BUFFER
+ SKIPN ECHO(E) ;ANY ECHO INS?
+ JRST NECHO
+IFE ITS,PUSH P,B
+ MOVE B,TTOCHN+1
+ PUSHJ P,CRLF2
+IFE ITS,AOS LINPOS(B)
+ PUSH P,CHRCNT(E)
+BRF1: SOSGE (P)
+ JRST DECHO
+ ILDB A,C ;GOBBLE CHAR
+ XCT ECHO(E) ;ECHO IT
+IFE ITS,[
+ CAIN A,12
+ AOS LINPOS(B)
+]
+ JRST BRF1 ;DO FOR ENTIRE BUFFER
+
+DECHO: SUB P,[1,,1]
+IFE ITS,POP P,B
+ JRST INCHR3
+
+; ROUTINE TO CRLF ON ANY TTY
+
+CRLF1: SKIPN ECHO(E)
+ POPJ P, ; NO ECHO INS
+CRLF2: MOVEI A,15
+ XCT ECHO(E)
+ MOVEI A,12
+ XCT ECHO(E)
+ POPJ P,
+
+; CLEAR SCREEN
+CLR: SKIPN C,ECHO(E) ;ONLY IF INS EXISTS
+ POPJ P,
+ PUSH P,0
+IFN ITS,[
+ TLO 0,CNTLPC ;SWITCH ON TEMPORARY ^P MODE
+ MOVEI A,20 ;ERASE SCREEN
+ XCT C
+ MOVEI A,103
+ XCT C
+]
+IFE ITS,[
+ JUMPGE A,CLRCRF
+ PUSH P,B
+ MOVE A,1(B)
+ MOVEI B,.VTCLR
+ VTSOP
+ POP P,B
+ JRST CLRXIT
+
+CLRCRF: MOVEI 0,CLRSTR(A)
+ PUSHJ P,STBOUT
+ PUSH P,B
+ MOVE B,TTOCHN+1
+ SETZM LINPOS(B)
+ POP P,B
+]
+CLRXIT: POP P,0 ;RESTORE USEFUL DATA
+ POPJ P,
+
+IFE ITS,[
+
+STBOUT: PUSH P,B
+ SKIPE IMAGFL
+ JRST STBOU1
+ MOVE A,1(B)
+ HRRZ B,STATUS(B)
+ TRZ B,300
+ SFMOD
+STBOU1: HRLI 0,440700
+ ILDB A,0
+ JUMPE A,STBOUX
+ PBOUT
+ JRST .-3
+
+STBOUX: SKIPE IMAGFL
+ JRST STBOU2
+ MOVE B,(P)
+ MOVE A,1(B)
+ HRRZ B,STATUS(B)
+ SFMOD
+STBOU2: POP P,B
+ POPJ P,
+\f
+; SPECIAL CASE GOODIES FOR DISPLAY TERMINALS
+
+NTTYPE==40 ; MAX TERMINAL TYPES SUPPORTED
+
+
+; HOW TO CLEAR SCREENS ON TOPS-20/TENEX
+CLRSTR: 0
+ 0
+ 0
+ 0
+ ASCII /\7f\12/ ; ITS SOFTWARE
+ ASCII /\1d\1e/ ; DATAMEDIA
+ ASCII /\eH\eJ/ ; HP2640
+ 0
+ 0
+ 0
+ 0
+ ASCII /\eH\eJ/ ; VT50
+ 0
+ ASCII /\e(\7f/ ; GT40
+ 0
+ ASCII /\eH\eJ/ ; VT52
+ 0
+ 0
+ ASCII /\eH\eJ/ ; VT100
+ ASCII /\eH\eJ/ ; TELERAY
+ ASCII /\eH\eJ/ ; H19
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+IFN <.-CLRSTR>-NTTYPE,PRINTC /ERROR -- CLEAR SCREEN TABLE LOSES
+/
+
+; HOW TO RUB OUT ON VARIOUS TERMINALS
+DELSTR: 0
+ 0
+ 0
+ 0
+ ASCII /\7f\v\7f\ 6/ ; ITS SOFTWARE DISPLAY
+ 0
+ ASCII /\eD\eK/ ; HP2640
+ 0
+ 0
+ 0
+ 0
+ ASCII /\eD\eK/ ; VT50
+ 0
+ 0
+ 0
+ ASCII /\eD\eK/ ; VT52
+ 0
+ 0
+ ASCII /\eD\eK/ ; VT100
+ ASCII /\eD\eK/ ; TELERAY
+ ASCII /\eD\eK/ ; H19
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+IFN <.-DELSTR>-NTTYPE,PRINTC /ERROR -- DELETE TABLE LOSES
+/
+
+; CLEAR TO EOL
+EOLSTR: 0
+ 0
+ 0
+ 0
+ ASCII /\7f\ 5/ ; ITS SOFTWARE DISPLAY
+ 0
+ ASCII /\eK/ ; HP2640
+ 0
+ 0
+ 0
+ 0
+ ASCII /\eK/ ; VT50
+ 0
+ 0
+ 0
+ ASCII /\eK/ ; VT52
+ 0
+ 0
+ ASCII /\eK/ ; VT100
+ ASCII /\eK/ ; TELERAY
+ ASCII /\eK/ ; H19
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+IFN <.-EOLSTR>-NTTYPE,PRINTC /ERROR -- END OF LINE TABLE LOSES
+/
+
+POSTAB: JFCL
+ JFCL
+ JFCL
+ JFCL
+ PUSHJ P,PSOFT ; ITS SOFTWARE
+ JFCL
+ PUSHJ P,PVT52 ; HP2640
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ PUSHJ P,PVT52 ; VT50
+ JFCL
+ JFCL
+ JFCL
+ PUSHJ P,PVT52 ; VT52
+ JFCL
+ JFCL
+ PUSHJ P,PVT52 ; VT100
+ PUSHJ P,PVT52 ; TELERAY
+ PUSHJ P,PVT52 ; H19
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+ JFCL
+IFN <.-POSTAB>-NTTYPE,PRINTC /ERROR -- ABSOLUTE POSITION TABLE LOSES
+/
+
+
+
+\f
+; ROUTINES FOR ABSOLUTE POSITIONING ON TENEX/TOPS-20
+
+PSOFT: PUSH P,A
+ PUSHJ P,TNXIMG
+ MOVEI A,177
+ XCT ECHO(E)
+ MOVEI A,21
+ XCT ECHO(E)
+ PUSHJ P,GTLPOS
+ XCT ECHO(E)
+ POP P,A
+ XCT ECHO(E)
+ PUSHJ P,TNXASC
+ POPJ P,
+
+PVT52: PUSH P,A
+ PUSHJ P,TNXIMG
+ MOVEI A,33
+ XCT ECHO(E)
+ MOVEI A,"Y
+ XCT ECHO(E)
+ PUSHJ P,GTLPOS
+ ADDI A,40 ; MUDDLE PAGES START AT 0, VT52 AT 1
+ XCT ECHO(E)
+ POP P,A
+ ADDI A,40 ; DITTO COLUMNS
+ XCT ECHO(E)
+ PUSHJ P,TNXASC
+ POPJ P,
+
+TNXIMG: PUSH P,B
+ MOVE A,1(B)
+ MOVE B,STATUS(B)
+ TRZ B,300
+ SFMOD
+ POP P,B
+ POPJ P,
+
+TNXASC: PUSH P,B
+ MOVE A,1(B)
+ HRRZ B,STATUS(B)
+ SFMOD
+ POP P,B
+ POPJ P,
+]
+\f
+PUTCHR: AOS CHRCNT(E) ;COUNT THIS CHARACTER
+ IBP D ;BUMP BYTE POINTER
+IFE ITS,[
+ HRRZ C,D
+ ADDI C,(E)
+ CAIG 0,(C) ;DONT SKIP IF BUFFER FULL
+]
+IFN ITS, CAIG 0,@D ;DONT SKIP IF BUFFER FULL
+ PUSHJ P,BUFULL ;GROW BUFFER
+IFE ITS,[
+ CAIN A,37 ; CHANGE EOL TO CRLF
+ MOVEI A,15
+]
+ DPB A,D ;CLOBBER BYTE POINTER IN
+ MOVE C,SYSCHR(E) ; FLAGS
+IFE ITS,[
+ POPJ P,
+]
+IFN ITS,[
+ TRNN C,N.IMED+N.CNTL
+ CAIE A,15 ; IF CR INPUT, FOLLOW WITH LF
+ POPJ P,
+ MOVEI A,12 ; GET LF
+ JRST PUTCHR
+]
+; BUFFER FULL, GROW THE BUFFER
+
+BUFULL: MOVEM D,BYTPTR(E)
+ PUSH TP,$TCHAN ;SAVE B
+ PUSH TP,B
+ PUSH P,A ; SAVE CURRENT CHAR
+ HLRE A,BUFRIN(B)
+ MOVNS A
+ ADDI A,100 ; MAKE ONE LONGER
+ PUSHJ P,IBLOCK ; GET IT
+ MOVE A,(TP) ;RESTORE CHANNEL POINTER
+ SUB TP,[2,,2] ;AND REMOVE CRUFT
+ MOVE E,BUFRIN(A) ;GET AUX BUFFER POINTER
+ MOVEM B,BUFRIN(A)
+ HLRE 0,E ;RECOMPUTE 0
+ MOVSI E,(E)
+ HRRI E,(B) ; POINT TO DEST
+ SUB B,0
+ BLT E,(B)
+ MOVEI 0,100-2(B)
+ MOVE B,A
+ MOVE E,BUFRIN(B)
+ POP P,A
+ MOVE D,BYTPTR(E)
+ POPJ P,
+
+; SUBROUTINE TO FLUSH BUFFER
+
+RRESET: SETZM LSTCH(B) ; CLOBBER RE-USE CHAR
+ MOVE E,BUFRIN(B) ;GET AUX BUFFER
+ SETZM CHRCNT(E)
+ MOVEI D,N.IMED+N.IME1
+ ANDCAM D,SYSCHR(E)
+ MOVE D,[010700,,BYTPTR(E)] ;RESET BYTE POINTER
+ MOVEM D,BYTPTR(E)
+ MOVE D,CHANNO(B) ;GOBBLE CHANNEL
+IFN ITS,[
+ SETZM CHNCNT(D) ; FLUSH COUNTERS
+ LSH D,23. ;POSITION
+ IOR D,[.RESET 0]
+ XCT D ;RESET ITS CHANNEL
+]
+IFE ITS,[
+ MOVEI A,100 ; TTY IN JFN
+ CFIBF
+]
+ SETZM EXBUFR(B) ; CLOBBER STAKED BUFFS
+ MOVEI C,BUFSTR-1(B) ; FIND D.W.
+ PUSHJ P,BYTDOP
+ SUBI A,2
+ HRLI A,010700
+ MOVEM A,BUFSTR(B)
+ HLLZS BUFSTR-1(B)
+ POPJ P,
+\f
+; SUBROUTINE TO ESTABLISH ECHO IOINS
+
+MFUNCTION ECHOPAIR,SUBR
+
+ ENTRY 2
+
+ GETYP A,(AB) ;CHECK ARG TYPES
+ GETYP C,2(AB)
+ CAIN A,TCHAN ;IS A CHANNEL
+ CAIE C,TCHAN ;IS C ALSO
+ JRST WRONGT ;NO, ONE OF THEM LOSES
+
+ MOVE A,1(AB) ;GET CHANNEL
+ PUSHJ P,TCHANC ; VERIFY TTY IN
+ MOVE D,3(AB) ;GET OTHER CHANNEL
+ HRRZ 0,-2(D) ; GET BITS
+ TRC 0,C.OPN+C.PRIN
+ TRNE 0,C.OPN+C.PRIN
+ JRST WRONGD
+
+ MOVE B,BUFRIN(A) ;GET A'S AUX BUFFER
+IFN ITS,[
+ HRLZ C,CHANNO(D) ; GET CHANNEL
+ LSH C,5
+ IOR C,[.IOT A] ; BUILD AN IOT
+ MOVEM C,ECHO(B) ;CLOBBER
+]
+CHANRT: MOVE A,(AB)
+ MOVE B,1(AB) ;RETURN 1ST ARG
+ JRST FINIS
+
+TCHANC: HRRZ 0,-2(A) ; GET BITS
+ TRC 0,C.OPN+C.READ
+ TRNE 0,C.OPN+C.READ
+ JRST BADCHN
+IFN ITS,[
+ LDB C,[600,,STATUS(A)] ;GET A CODE
+ CAILE C,2 ;MAKE SURE A TTY FLAVOR DEVICE
+ JRST WRONGC
+ POPJ P,
+]
+IFE ITS,[
+ PUSH P,A
+ MOVE A,1(A)
+ DVCHR
+ LDB A,[221100,,B] ;DEVICE TYPE FIELD
+ CAIE A,12 ;TTY
+ CAIN A,13 ;PTY
+ SKIPA
+ JRST WRONGC ;NOT A TTY, HOPE WE DON'T GET HERE IN LISTEN
+ POP P,A
+ POPJ P,
+]
+\f
+; TTY OPEN
+
+IFE ITS,[
+TTYOPEN:
+TTYOP2: SKIPE DEMFLG
+ POPJ P,
+ MOVE C,TTOCHN+1
+ HLLZS IOINS-1(C)
+ MOVEI A,-1 ; TERMINAL; STAYS HERE THROUGHOUT ROUTINE
+ MOVEI 2,175100 ; MAGIC BITS (SEE TENEX MANUAL)
+ SFMOD ; ZAP
+ RFMOD ; LETS FIND SCREEN SIZE
+ MOVEM B,STATUS(C)
+ LDB B,[220700,,B] ; GET PAGE WIDTH
+ JUMPG B,.+2
+ MOVEI B,80. ; MUST BE VIRTUAL, SO MAKE IT 80.
+ MOVEM B,LINLN(C)
+ LDB B,[310700,,STATUS(C)] ; AND LENGTH
+ MOVEM B,PAGLN(C)
+ SKIPE OPSYS ; CHECK FOR TOPS-20
+ JRST NONVTS ; ONLY TOPS-20 CAN HAVE VTS
+ RTCHR
+ ERJMP NONVTS ; NO RTCHR JSYS, HENCE NO VTS
+ TLNN B,(TC%MOV+TC%CLR) ; HAS MINIMAL CHARACTERISTICS?
+ JRST NONVTS ; NO GOOD ENOUGH FOR US
+ MOVNI B,1 ; TERMINAL TYPE -1 IS VTS DISPLAY
+ JRST HASVTS ; WINS
+
+NONVTS: PUSH P,C ; IDIOT GETTYP CLOBBERS C
+ GTTYP ; FIND TERMINAL TYPE
+ POP P,C
+HASVTS: HRLM B,STATUS(C) ; USED TO FIGURE OUT DISPLAY STUFF
+ MOVE B,STATUS(C)
+ MOVE C,TTICHN+1
+ MOVEM B,STATUS(C) ; SET UP INCHAN TOO
+ RFCOC ; GET CURRENT
+ AND B,[036377,,-1] ; CHANGE FOR ^@, ^A AND ^D (FOR NOW)
+ SFCOC ; AND RESUSE IT
+
+ POPJ P,
+]
+
+IFN ITS,[
+TTYOP2: .SUSET [.RTTY,,C]
+ SETZM NOTTY
+ JUMPL C,TTYNO ; DONT HAVE TTY
+
+TTYOPEN:
+ SKIPE NOTTY
+ POPJ P,
+ DOTCAL OPEN,[[1000,,TTYIN],[[SIXBIT /TTY /]]]
+ JRST TTYNO
+ DOTCAL OPEN,[[1000,,TTYOUT],[[SIXBIT /TTY /]],[5000,,1]]
+ FATAL CANT OPEN TTY
+ DOTCAL TTYGET,[[1000,,TTYOUT],[2000,,0],[2000,,A],[2000,,B]]
+ FATAL .CALL FAILURE
+ DOTCAL TTYSET,[[1000,,TTYOUT],MODE1,MODE2,B]
+ FATAL .CALL FAILURE
+
+SETCHN: MOVE B,TTICHN+1 ;GET CHANNEL
+ MOVEI C,TTYIN ;GET ITS CHAN #
+ MOVEM C,CHANNO(B)
+ .STATUS TTYIN,STATUS(B) ;CLOBBER STATUS
+
+ MOVE B,TTOCHN+1 ;GET OUT CHAN
+ MOVEI C,TTYOUT
+ MOVEM C,CHANNO(B)
+ .STATUS TTYOUT,STATUS(B)
+ SETZM IMAGFL ;RESET IMAGE MODE FLAG
+ HLLZS IOINS-1(B)
+ DOTCAL RSSIZE,[[1000,,TTYOUT],[2000,,C],[2000,,D]]
+ FATAL .CALL RSSIZE LOSSAGE
+ MOVEM C,PAGLN(B)
+ MOVEM D,LINLN(B)
+ POPJ P,
+
+; HERE IF TTY WONT OPEN
+
+TTYNO: SETOM NOTTY
+ POPJ P,
+]
+
+GTLPOS:
+IFN ITS,[
+ DOTCAL RCPOS,[[CHANNO(B)],[2000,,A]]
+ JFCL
+ HLRZS A
+ POPJ P,
+]
+IFE ITS,[
+ PUSH P,B
+ MOVE B,TTOCHN+1
+ HLRE A,STATUS(B)
+ JUMPGE A,GETCRF
+ MOVE A,1(B)
+ RFPOS
+ HLRZ A,B
+ SKIPA
+GETCRF: MOVE A,LINPOS(B)
+ POP P,B
+ POPJ P,
+]
+
+MTYI: SKIPN DEMFLG ; SKIP IF DEMON
+ SKIPE NOTTY ; SKIP IF HAVE TTY
+ FATAL TRIED TO USE NON-EXISTANT TTY
+
+; TRY TO AVOID HANGING IN .IOT TO TTY
+
+IFN ITS,[
+ DOTCAL IOT,[[1000,,TTYIN],[A],[5000,,1000]]
+ JFCL
+]
+IFE ITS,[
+
+MTYI1: PBIN
+]
+ POPJ P,
+
+INMTYO: ; BOTH ARE INTERRUPTABLE
+MTYO: ENABLE
+ PUSHJ P,IMTYO
+ DISABLE
+ POPJ P,
+
+; NON-INTERRUPTABLE VERSION, FOR ECHO INSTRUCTION AND SUCHLIKE
+IMTYO: SKIPE NOTTY
+ POPJ P, ; IGNORE, DONT HAVE TTY
+
+IFN ITS,[
+ CAIN A,177 ;DONT OUTPUT A DELETE
+ POPJ P,
+ PUSH P,B
+ MOVEI B,0 ; SETUP CONTROL BITS
+ TLNE 0,CNTLPC ; SKIP IF ^P MODE SWITCH IS OFF
+ MOVEI B,%TJDIS ; SWITCH ON TEMPORARY ^P MODE
+ DOTCAL IOT,[[1000,,TTYOUT],[A],[4000,,B]]
+ JFCL
+ POP P,B
+]
+IFE ITS, PBOUT
+ POPJ P,
+
+; HERE FOR TYO TO ANY TTY FLAVOR DEVICE
+IFN ITS,[
+GMTYO: PUSH P,0
+IFE ITS,[
+ HRRZ 0,IOINS-1(B) ; GET FLAG
+ SKIPE 0
+ PUSHJ P,REASCI ; RE-OPEN TTY
+]
+ HRLZ 0,CHANNO(B)
+ ASH 0,5
+ IOR 0,[.IOT A]
+ CAIE A,177 ; DONE OUTPUT A DELETE
+ XCT 0
+ POP P,0
+ POPJ P,
+
+REASCI: PUSH P,A
+ PUSH P,C
+IFE ITS,[
+ PUSH P,B
+ MOVE A,1(B)
+ RFMOD
+ TRO B,102
+ SFMOD
+ STPAR
+ POP P,B ]
+
+ POP P,C
+ POP P,A
+ HLLZS IOINS-1(B)
+ CAMN B,TTOCHN+1
+ SETZM IMAGFL
+ POPJ P,
+]
+
+
+WRONGC: FATAL TTYECHO--NOT ON A TTY-TYPE CHANNEL
+
+
+
+; HERE TO HANDLE TTY BLOCKING AND UNBLOCKING
+
+TTYBLK: PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH P,0
+ PUSH P,E ; SAVE SOME ACS
+IFN ITS,[
+ MOVE A,CHANNO(B) ; GET CHANNEL NUMBER
+ SOSG CHNCNT(A) ; ANY PENDING CHARS
+ JRST TTYBL1
+ SETZM CHNCNT(A)
+ MOVEI 0,1
+ LSH 0,(A)
+ .SUSET [.SIFPI,,0] ; SLAM AN INT ON
+]
+TTYBL1: MOVE C,BUFRIN(B)
+ MOVE A,SYSCHR(C) ; GET FLAGS
+ TRZ A,N.IMED
+ TRZE A,N.IME1 ; IF WILL BE
+ TRO A,N.IMED ; THE MAKE IT
+ MOVEM A,SYSCHR(C)
+IFN ITS,[
+ MOVE A,[.CALL TTYIOT] ; NON-BUSY WAIT (IF CHAR READ, LEAVE IN BUFFER
+ ; TO LET IT BE READ AT INTERRUPT LEVEL)
+ SKIPE NOTTY
+ MOVE A,[.SLEEP A,]
+]
+IFE ITS,[
+ MOVE A,[PUSHJ P,TNXIN]
+]
+ MOVEM A,WAITNS(B)
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE BLOCKED
+ PUSH TP,$TPVP
+ PUSH TP,PVSTOR+1
+ MCALL 2,INTERRUPT
+ MOVSI A,TCHAN
+ MOVE PVP,PVSTOR+1
+ MOVEM A,BSTO(PVP)
+ MOVE B,(TP)
+ ENABLE
+REBLK: MOVEI A,-1 ; IN CASE SLEEPING
+ XCT WAITNS(B) ; NOW WAIT
+ JFCL
+IFE ITS, JRST .-3
+IFN ITS, JRST CHRSNR ; SNARF CHAR
+REBLK1: DISABLE ; FALL THROUG=> UNBLOCKED
+ MOVE PVP,PVSTOR+1
+ SETZM BSTO(PVP)
+ POP P,E
+ POP P,0
+ MOVE B,(TP)
+ SUB TP,[2,,2]
+ POPJ P,
+IFN ITS,[
+CHRSNR: SKIPN DEMFLG ; SKIP IF DEMON
+ SKIPE NOTTY ; TTY?
+ JRST REBLK ; NO, JUST RESET AND BLOCK
+ .SUSET [.SIFPI,,[1_<TTYIN>]]
+ JRST REBLK ; AND GO BACK
+
+TTYIOT: SETZ
+ SIXBIT /IOT/
+ 1000,,TTYIN
+ 0
+ 405000,,20000
+]
+; HERE TO UNBLOCK TTY
+
+TTYUNB: MOVE A,WAITNS(B) ; GET INS
+ CAMN A,[JRST REBLK1]
+ JRST TTYUN1
+ MOVE A,[JRST REBLK1] ; LEAVE THE SLEEP
+ MOVEM A,WAITNS(B)
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE UNBLOCKED
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 2,INTERRUPT
+ MOVE B,(TP) ; RESTORE CHANNEL
+ SUB TP,[2,,2]
+TTYUN1: POPJ P,
+
+IFE ITS,[
+; TENEX BASIC TTY I/O ROUTINE
+
+TNXIN: PUSHJ P,MTYI
+ DISABLE
+ PUSHJ P,INCHAR
+ ENABLE
+ POPJ P,
+]
+MFUNCTION TTYECHO,SUBR
+
+ ENTRY 2
+
+ GETYP 0,(AB)
+ CAIE 0,TCHAN
+ JRST WTYP1
+ MOVE A,1(AB) ; GET CHANNEL
+ PUSHJ P,TCHANC ; MAKE SURE IT IS TTY INPUT
+ MOVE E,BUFRIN(A) ; EXTRA INFO BUFFER
+IFN ITS,[
+ DOTCAL TTYGET,[CHANNO(A),[2000,,B],[2000,,C],[2000,,0]]
+ FATAL .CALL FAILURE
+]
+IFE ITS,[
+ MOVEI A,100 ; TTY JFN
+ RFMOD ; MODE IN B
+ TRZ B,6000 ; TURN OFF ECHO
+]
+ GETYP D,2(AB) ; ARG 2
+ CAIE D,TFALSE ; SKIP IF WANT ECHO OFF
+ JRST ECHOON
+
+IFN ITS,[
+ ANDCM B,[606060,,606060]
+ ANDCM C,[606060,,606060]
+
+ DOTCAL TTYSET,[CHANNO(A),B,C,0]
+ FATAL .CALL FAILURE
+]
+IFE ITS,[
+ SFMOD
+]
+
+ MOVEI B,N.ECHO+N.CNTL ; SET FLAGS
+ IORM B,SYSCHR(E)
+
+ JRST CHANRT
+
+ECHOON:
+IFN ITS,[
+ IOR B,[202020,,202020]
+ IOR C,[202020,,200020]
+ DOTCAL TTYSET,[CHANNO(A),B,C,0]
+ FATAL .CALL FAILURE
+]
+IFE ITS,[
+ TRO B,4000
+ SFMOD
+]
+ MOVEI A,N.ECHO+N.CNTL
+ ANDCAM A,SYSCHR(E)
+ JRST CHANRT
+
+
+
+; USER SUBR FOR INSTANT CHARACTER SNARFING
+
+MFUNCTION UTYI,SUBR,TYI
+
+ ENTRY
+ CAMGE AB,[-3,,]
+ JRST TMA
+ MOVE A,(AB)
+ MOVE B,1(AB)
+ JUMPL AB,.+3
+ MOVE B,IMQUOTE INCHAN
+ PUSHJ P,IDVAL ; USE INCHAN
+ GETYP 0,A ; GET TYPE
+ CAIE 0,TCHAN
+ JRST WTYP1
+IFN ITS,[
+ LDB 0,[600,,STATUS(B)]
+ CAILE 0,2
+ JRST WTYP1
+ SKIPN A,LSTCH(B) ; ANY READ AHEAD CHAR
+ JRST UTYI1 ; NO, SKIP
+ ANDI A,-1
+ SETZM LSTCH(B)
+ TLZN A,400000 ; ! HACK?
+ JRST UTYI2 ; NO, OK
+ HRRM A,LSTCH(B) ; YES SAVE
+ MOVEI A,"! ; RET AN !
+ JRST UTYI2
+
+UTYI1: MOVE 0,IOINS(B)
+ CAME 0,[PUSHJ P,GETCHR]
+ JRST WTYP1
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MOVE C,BUFRIN(B)
+ MOVEI D,N.IME1+N.IMED
+ IORM D,SYSCHR(C) ; CLOBBER IT IN
+ DOTCAL TTYGET,[CHANNO(B),[2000,,A],[2000,,D],[2000,,0]]
+ FATAL .CALL FAILURE
+ PUSH P,A
+ PUSH P,0
+ PUSH P,D ; SAVE THEM
+ IOR D,[030303,,030303]
+ IOR A,[030303,,030303]
+ DOTCAL TTYSET,[CHANNO(B),A,D,0]
+ FATAL .CALL FAILURE
+ MOVNI A,1
+ SKIPE CHRCNT(C) ; ALREADY SOME?
+ PUSHJ P,INCHAR
+ MOVE C,BUFRIN(B) ; GET BUFFER BACK
+ MOVEI D,N.IME1
+ IORM D,SYSCHR(C)
+ PUSHJ P,GETCHR
+ MOVE B,1(TB)
+ MOVE C,BUFRIN(B)
+ MOVEI D,N.IME1+N.IMED
+ ANDCAM D,SYSCHR(C)
+ POP P,D
+ POP P,0
+ POP P,C
+ DOTCAL TTYSET,[CHANNO(B),C,D,0]
+ FATAL .CALL FAILURE
+UTYI2: MOVEI B,(A) ]
+IFE ITS,[
+ MOVE A,1(B) ;GET JFN FOR INPUT
+ ENABLE
+ BIN ;SNARF A CHARACTER
+ DISABLE
+]
+ MOVSI A,TCHRS
+ JRST FINIS
+
+MFUNCTION IMAGE,SUBR
+ ENTRY
+ JUMPGE AB,TFA ; 1 OR 2 ARGS NEEDED
+ GETYP A,(AB) ;GET THE TYPE OF THE ARG
+ CAIE A,TFIX ;CHECK IT FOR CORRECT TYPE
+ JRST WTYP1 ;WAS WRONG...ERROR EXIT
+ HLRZ 0,AB
+ CAIL 0,-2
+ JRST USEOTC
+ CAIE 0,-4
+ JRST TMA
+ GETYP 0,2(AB)
+ CAIE 0,TCHAN
+ JRST WTYP2
+ MOVE B,3(AB) ; GET CHANNEL
+IMAGE1: MOVE A,1(AB)
+ PUSHJ P,CIMAGE
+ JRST FINIS
+
+CIMAGE: SUBM M,(P)
+IFN ITS,[
+ LDB 0,[600,,STATUS(B)]
+ CAILE 0,2 ; MUST BE TTY
+ JRST IMAGFO
+ MOVE 0,IOINS(B)
+ CAMN 0,[PUSHJ P,MTYO]
+ JRST .+3
+ CAME 0,[PUSHJ P,GMTYO]
+ JRST WRONGD ]
+IFE ITS,[
+ MOVE 0,CHANNO(B) ; SEE IF TTY
+ CAIE 0,101
+ JRST IMAGFO
+]
+
+IFN ITS,[
+ DOTCAL IOT,[[5000,,2000],[CHANNO(B)],[A]]
+ JFCL
+ MOVE B,A
+]
+IFE ITS,[
+ SKIPE IMAGFL
+ JRST IMGOK
+
+ PUSH P,A
+ PUSH P,B
+ MOVSI A,1
+ HRROI B,[ASCIZ /TTY:/]
+ GTJFN
+ HALTF
+ MOVE B,[074000,,102000]
+ OPENF
+ HALTF
+ HRRZM A,IMAGFL
+ POP P,B
+ POP P,A
+IMGOK: MOVE B,IMAGFL
+ EXCH A,B
+ BOUT
+
+
+IMGEXT: MOVSI A,TFIX
+ JRST MPOPJ
+
+
+IMAGFO: PUSH TP,$TCHAN ;IMAGE OUTPUT FOR NON TTY
+ PUSH TP,B
+ PUSH P,A
+ HRRZ 0,-2(B) ; GET BITS
+ TRC 0,C.OPN+C.PRIN
+ TRNE 0,C.OPN+C.PRIN
+ JRST BADCHN
+ MOVE B,(TP)
+ PUSHJ P,GWB ; MAKE SURE CHANNEL HAS BUFFER
+ MOVE A,(P) ; GET THE CHARACTER TO DO
+ PUSHJ P,W1CHAR
+ POP P,B
+ MOVSI A,TFIX
+ SUB TP,[2,,2]
+ JRST MPOPJ
+
+
+USEOTC: MOVSI A,TATOM
+ MOVE B,IMQUOTE OUTCHAN
+ PUSHJ P,IDVAL
+ GETYP 0,A
+ CAIE 0,TCHAN
+ MOVE B,TTOCHN+1
+ MOVE A,1(B)
+ JRST IMAGE1
+
+IFN ITS,[
+IMGBLK: OUT+IMAGEM+UNIT,,(SIXBIT /TTY/)
+ 0
+ 0
+]
+
+
+IMPURE
+IMAGFL: 0
+PURE
+
+
+END
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff