X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=%3Cmdl.int%3E%2Foreadch.mid.208;fp=%3Cmdl.int%3E%2Foreadch.mid.208;h=6c2c33a35d633a32537259373d6dd7630869602d;hp=0000000000000000000000000000000000000000;hb=bab072f950a643ac109660a223b57e635492ac25;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c

diff --git a/<mdl.int>/oreadch.mid.208 b/<mdl.int>/oreadch.mid.208
new file mode 100644
index 0000000..6c2c33a
--- /dev/null
+++ b/<mdl.int>/oreadch.mid.208
@@ -0,0 +1,1433 @@
+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
+
+; 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
+	TLZE	D,40		; SKIP IF NOT ESCAPED
+	JRST	INCHR2		; ESCAPED
+	CAMN	A,ESCAP(E)	; IF ESCAPE
+	TLO	D,40		; REMEMBER
+	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,
+
+; 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
+
+; 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
+
+; 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,,^  _
+
+; 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
+
+; 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,
+
+; 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 //		; ITS SOFTWARE
+	ASCII //		; DATAMEDIA
+	ASCII /HJ/		; HP2640
+	0
+	0
+	0
+	0
+	ASCII /HJ/		; VT50
+	0
+	ASCII /(/		; GT40
+	0
+	ASCII /HJ/		; VT52
+	0
+	0
+	ASCII /HJ/		; VT100
+	ASCII /HJ/		; TELERAY
+	ASCII /HJ/		; 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 //	; ITS SOFTWARE DISPLAY
+	0
+	ASCII /DK/		; HP2640
+	0
+	0
+	0
+	0
+	ASCII /DK/		; VT50
+	0
+	0
+	0
+	ASCII /DK/		; VT52
+	0
+	0
+	ASCII /DK/		; VT100
+	ASCII /DK/		; TELERAY
+	ASCII /DK/		; 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 //		; ITS SOFTWARE DISPLAY
+	0
+	ASCII /K/		; HP2640
+	0
+	0
+	0
+	0
+	ASCII /K/		; VT50
+	0
+	0
+	0
+	ASCII /K/		; VT52
+	0
+	0
+	ASCII /K/		; VT100
+	ASCII /K/		; TELERAY
+	ASCII /K/		; 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
+/
+
+
+
+
+; 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,
+]
+
+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,
+
+; 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
+	MOVEI	B,DIRECT-1(D)	;AND ITS DIRECTION
+	PUSHJ	P,CHRWRD
+	JFCL
+	CAME	B,[ASCII /PRINT/]
+	JRST	WRONGD
+
+	MOVE	B,BUFRIN(A)	;GET A'S AUX BUFFER
+	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:	MOVEI	B,DIRECT-1(A)	;GET DIRECTION
+	PUSHJ	P,CHRWRD	; CONVERT
+	JFCL
+	CAME	B,[ASCII /READ/]
+	JRST	WRONGD
+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,
+]
+
+; 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,[
+	SKIPN	IMAGFL
+	 JRST	MTYI1
+	PUSH	P,B
+	PUSHJ	P,MTYO1
+	POP	P,B
+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,
+
+MTYO1:	MOVE	B,TTOCHN+1
+	PUSH	P,0
+	PUSHJ	P,REASCI
+	POP	P,0
+	POPJ	P,
+
+; HERE FOR TYO TO ANY TTY FLAVOR DEVICE
+
+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:	ERRUUO	EQUOTE NOT-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,
+
+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
+	PUSHJ	P,INCHAR
+	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
+
+
+DEVTOC:	PUSH	P,D
+	PUSH	P,E
+	PUSH	P,0
+	PUSH	P,A
+	MOVE	D,RDEVIC(B)
+	MOVE	E,[220600,,C]
+	MOVEI	A,3
+	MOVEI	C,0
+	ILDB	0,D
+	SUBI	0,40
+	IDPB	0,E
+	SOJG	A,.-3
+	POP	P,A
+	POP	P,0
+	POP	P,E
+	POP	P,D
+	POPJ	P,
+
+IMGBLK:	OUT+IMAGEM+UNIT,,(SIXBIT /TTY/)
+	0
+	0
+
+
+
+IMPURE
+IMAGFL:	0
+PURE
+
+
+END
+
\ No newline at end of file