TITLE READC TELETYPE DEVICE HANDLER FOR MUDDLE

RELOCATABLE

.INSRT MUDDLE >

.GLOBAL BUFRIN,CHRCNT,SYSCHR,ECHO,BYTPTR,ERASCH,KILLCH,BRKCH,AGC
.GLOBAL IOIN2,READC,WRONGT,WRONGD,WRONGC,CALER1,BRFCHR,ESCAP,TTYOPE,TYI,TYO
.GLOBAL RRESET,TTICHN,TTOCHN,CHANNO,STATUS

TTYOUT==1
TTYIN==2


; 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

READC:	PUSH	P,E		;SAVE E FROM DEATH
	MOVE	E,BUFRIN(B)	;GOBBLE POINTER TO BUFFER AND INFO
	SOSGE	CHRCNT(E)	;ANY CHARS LEFT?
	PUSHJ	P,INCHAR	;NO, GO READ SOME
	ILDB	A,BYTPTR(E)	;GOBBLE ONE
	POP	P,E		;RESTORE E
	POPJ	P,

; HERE TO ASK SYSTEM FOR SOME CHARACTERS

INCHAR:	IRP	A,,[0,C,D]	;SAVE ACS
	PUSH	P,A
	TERMIN
	CLEARM	CHRCNT(E)	;NO CHARS IN BUFFER
	MOVE	D,[010700,,BYTPTR(E)]	;MAKE A BYTE POINTER TO START OF BUFFER
	HLRE	0,E		;FIND END OF BUFFER
	SUBM	E,0
	ANDI	0,-1		;ISOLATE RH

INCHR1:	PUSHJ	P,GETCH		;GET A CHARACTER
	CAMN	A,ESCAP(E)		;ESCAPE CHAR?
	JRST	DOESCP
	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
	JRST	INCHR1

DONE:	IDPB	A,D		;STORE 
	MOVE	D,[010700,,BYTPTR(E)]	;RESET BYTER
	MOVEM	D,BYTPTR(E)
	IRP	A,,[D,C,0]
	POP	P,A
	TERMIN
	POPJ	P,


ERASE:	SUBI	A,177		;IS THE ERASE RUBOUT
	SKIPN	CHRCNT(E)	;ANYTHING IN BUFFER?
	JRST	BARFCR	;NO, MAYBE TYPE CR

	SOS	CHRCNT(E)	;DELETE FROM COUNT
	JUMPN	A,NECHO	;DONT ECHO IF ERASE OTHER THAN RUBOUT
	LDB	A,D		;RE-GOBBLE LAST CHAR
	SKIPE	C,ECHO(E)	;DOES AN ECHO INS EXIST?
	XCT	C		;YES, ECHO

NECHO:	ADD	D,[70000,,0]	;DECREMENT BYTE POINTER
	JUMPGE	D,INCHR1	;AND GO ON, UNLESS BYTE POINTER LOST
	SUB	D,[430000,,1]	;FIX UP BYTE POINTER
	JRST	INCHR1

; HERE TO KILL THE WHOLE BUFFER

KILL:	CLEARM	CHRCNT(E)	;NONE LEFT NOW
	MOVE	D,[010700,,BYTPTR(E)]	;RESET POINTER

BARFCR:	MOVE	A,ERASCH(E)	;GET THE ERASE CHAR
	CAIE	A,177		;IS IT RUBOUT?
	JRST	INCHR1		;NO, DO NOT TYPE A CR
	MOVEI	A,15			;GET THE CR
	SKIPE	C,ECHO(E)	;ECHO INS IN C
	XCT	C
	JRST	INCHR1

DOESCP:	PUSHJ	P,PUTCHR	;PUT INTO BUFFER
	PUSHJ	P,GETCH		;GET NEXT ONE
	JRST	INCHR2	;INSERT IT AND GO ON

CLEARQ:	MOVEI	A,0		;INSERT A NULL CHAR
	IDPB	A,D		;DEPOSIT A 0 TERMINATOR
	MOVE	A,STATUS(B)	;CHECK CONSOLE KIND
	ANDI	A,77
	CAIN	A,2		;DATAPOINT?
	PUSHJ	P,CLR		;YES, CLEAR SCREEN
	MOVEI	A,15		;C.R.
	MOVE	C,[010700,,BYTPTR(E)]	;POINT TO START OF BUFFER
	SKIPN	ECHO(E)		;ANY ECHO INS?
	JRST	NECHO

	XCT	ECHO(E)	;WRITE OUT C.R.

	ILDB	A,C			;GOBBLE CHAR
	JUMPE	A,NECHO
	XCT	ECHO(E)		;ECHO IT
	JRST	.-3		;DO FOR ENTIRE BUFFER

CLR:	SKIPN	C,ECHO(E)	;ONLY IF INS EXISTS
	POPJ	P,
	MOVEI	A,20		;ERASE SCREEN
	XCT	C
	MOVEI	A,103
	XCT	C
	POPJ	P,

PUTCHR:	AOS	CHRCNT(E)	;COUNT THIS CHARACTER
	IBP	D		;BUMP BYTE POINTER
	CAIG	0,@D		;DONT SKIP IF BUFFER FULL
	PUSHJ	P,BUFULL		;GROW BUFFER
	DPB	A,D		;CLOBBER BYTE POINTER IN
	POPJ	P,

; BUFFER FULL, GROW THE BUFFER

BUFULL:	MOVEI	E,1000		;GET GROWTH SPECS
	HRRM	E,@0
	PUSH	TP,$TCHAN	;SAVE B
	PUSH	TP,B
	PUSHJ	P,AGC		;GROW THE VECTOR
	MOVE	B,(TP)		;RESTORE CHANNEL POINTER
	SUB	TP,[2,,2]	;AND REMOVE CRUFT
	MOVE	E,BUFRIN(B)	;GET AUX BUFFER POINTER
	HLRE	0,E		;RECOMPUTE 0
	SUBM	E,0
	ANDI	0,-1
	POPJ	P,

GETCH:	SOSGE	C,SYSCHR(E)	;ANY CHARS IN SYSTEM?
	JRST	ENBL		;NO, ENABLE INTERRUPTS
	XCT	IOIN2(E)	;YES, GOBBLE ONE
	POPJ	P,		;AND RETURN

ENBL:	MOVSI	A,TCHAN		;SET A'S TYPE
	MOVEM	A,BSTO(PVP)
	ENABLE			;ENABLE INTERRUPTS
	XCT	IOIN2(E)
	DISABLE			;GOT A CHARACTER, DISABLE INTERRUPTS
	SETZM	BSTO(PVP)
	POPJ	P,

; SUBROUTINE TO FLUSH BUFFER

RRESET:	MOVE	E,BUFRIN(B)		;GET AUX BUFFER
	SETZM	CHRCNT(E)
	SETZM	SYSCHR(E)
	MOVE	D,[010700,,BYTPTR(E)]	;RESET BYTE POINTER
	MOVEM	D,BYTPTR(E)
	MOVE	D,CHANNO(B)	;GOBBLE CHANNEL
	LSH	D,23.		;POSITION
	IOR	D,[.RESET 0]
	XCT	D		;RESET ITS CHANNEL
	POPJ	P,

; SUBROUTINE TO ESTABLISH ECHO IOINS

MFUNCTION ECHOPAIR,SUBR

	ENTRY	2

	HLRZ	A,(AB)		;CHECK ARG TYPES
	HLRZ	C,(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
	MOVE	B,DIRECT(A)	;GET DIRECTION
	CAME	B,CHQUOTE READ
	JRST	WRONGD
	LDB	C,[600,,STATUS(A)]	;GET A CODE
	CAILE	C,2		;MAKE SURE A TTY FLAVOR DEVICE
	JRST	WRONGC
	MOVE	D,3(AB)		;GET OTHER CHANNEL
	MOVE	E,DIRECT(D)	;AND ITS DIRECTION
	CAME	E,CHQUOTE PRINT
	JRST	WRONGD

	MOVE	B,BUFRIN(A)	;GET A'S AUX BUFFER
	MOVE	C,IOINS(D)	;AND C'S IO INS
	MOVEM	C,ECHO(B)		;CLOBBER
	MOVE	A,(AB)
	MOVE	B,1(AB)		;RETURN 1ST ARG
	JRST FINIS

TTYOPEN:	.OPEN	TTYIN,[SIXBIT /   TTY/]
	.VALUE
	.OPEN	TTYOUT,[SIXBIT /  !TTY/]	;AND OUTPUT
	.VALUE
	.STATUS	TTYOUT,A		;CHECK IT OUT
	ANDI	A,77		;GET DEVICE
	CAIE	A,2		;IF 2, CAN OPEN IN DISPLAY MODE
	JRST	SETCHN
	.CLOSE	TTYOUT,
	.OPEN	TTYOUT,[21,,(SIXBIT /TTY/)]
	.VALUE
	
SETCHN:	MOVE	B,TTICHN+1(TVP)	;GET CHANNEL
	MOVEI	A,TTYIN		;GET ITS CHAN #
	MOVEM	A,CHANNO(B)
	.STATUS	TTYIN,STATUS(B)	;CLOBBER STATUS

	MOVE	B,TTOCHN+1(TVP)	;GET OUT CHAN
	MOVEI	A,TTYOUT
	MOVEM	A,CHANNO(B)
	.STATUS	TTYOUT,STATUS(B)
	POPJ	P,

TYI:	.IOT	TTYIN,A
	POPJ	P,

TYO:	.IOT	TTYOUT,A
	POPJ	P,


WRONGD:	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE WROND-DIRECTION-CHANNEL
	JRST	CALER1

WRONGC:	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE NOT-A-TTY-TYPE-CHANNEL
	JRST	CALER1

END