Google
 

Trailing-Edge - PDP-10 Archives - klad_sources - klad.sources/gkbd.mac
There is 1 other file named gkbd.mac in the archive. Click here to see a list.
SUBTTL	KEYBOARD INTERFACE

;This module provides a timesharing terminal interface for the
;DIAGNOSTIC library.  The interface itself attempts to emulate as
;far as possible the TEXTI JSYS implemented in the TOPS20 monitor.

SUBTTL Table of Contents

;               TABLE OF CONTENTS FOR GLXKBD
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. Revision History..........................................   3
;    3. Local Definitions.........................................   5
;    4. Module Storage............................................   6
;    5. K%INIT  --  Initialization of the Scanning Module.........   7
;    6. K%RCOC  --  Read Character Output Control Table...........   8
;    7. K%WCOC  --  Write Character  Output Control table.........   9
;    8. K%SUET  --  Set User Escape Table.........................  10
;    9. K%STYP  --  Set terminal type.............................  11
;   10. K%TXTI  --  Handle Terminal Input.........................  13
;   11. TXTL  --  Loop for inputting text.........................  14
;   12. TTYCHR  --  Here to receive 1 character from the TTY......  16
;   13. Utilities for text handling...............................  17
;   14. SPCHK  --  Check for special characters...................  22
;   15. CCU  --  Handle ^U (Rubout entire line)...................  23
;   16. CCR  --  Handle ^R (Re-type the line).....................  24
;   17. CCDEL  --  Handle Rubout (Delete one character)...........  25
;   18. CCW  --  Handle ^W (Delete back to punctuation character).  26
;   19. BEGBUF  --  Handle rubouts to beginning of buffer.........  27
;   20. TYPEBP  --  Type a string according to a byte-pointer.....  27
SUBTTL	Revision History


COMMENT \

Edit	GCO	Reason
----	---	-------------------------------------------

0001		Create GLXKBD module
0002		Fix a number of interrupt race problems and
		start adding ESCape sequence code
0003	009	Implement a new TEXTI flag to causes 'nothing' to echo.
0004	010	Make K%STYP set some additional characteristic like LC..
0005		Allow the source word (.RDIOJ) contain a byte-pointer to
		an ASCIZ string if RD%JFN is off in the flag word (this
		is additional compatibility with the TEXTI JSYS).
006		TOTALLY HACKED UP FOR DIAGNOSTICS

\  ;END OF REVISION HISTORY
; Entry Points found in this module

	ENTRY	K%INIT			;INITIALIZATION POINT
	ENTRY	K%TXTI			;TEXT INPUT ROUTINE
	ENTRY	K%RCOC			;READ COC TABLE
	ENTRY	K%WCOC			;WRITE COC TABLE
	ENTRY	K%STYP			;SET TERMINAL TYPE
	ENTRY	K%SUET			;SETUP USER ESCAPE TABLE
SUBTTL Local Definitions

; Special Accumulator definitions

	C==16				;GLOBAL CHARACTER REGISTER

; Special characters

	.CHBSL=="\"			;BACKSLASH

; Control character former

	DEFINE $C(A)<"A"-100>		;JUST ASCII MINUS LEAD BIT

SUBTTL	Module Storage


	$$DATA	TTYFLG			;FLAGS FROM INITIALIZATION BLOCK
;	$$DATA	RD,.RDSIZ		;INTERNAL ARGUMENT BLOCK
	$$DATA	COCTAB,2		;CHARACTER OUTPUT CONTROL TABLE
	$$DATA	TRMPTR			;POINTER TO TERMINAL CONTROL
	$$DATA	RUBFLG			;-1 WHEN LAST CHAR WAS RUBOUT
	$$DATA	ARGLOC			;LOCATION OF CALLER'S ARGUMENT BLOCK
	$$DATA	BCKFLG			;-1 WHEN BACKUP LIMIT HAS BEEN PASSED
	$$DATA	UESCTB			;ADDRESS OF USER ESCAPE TABLE
	$$DATA	CURESC			;CURRENT STATE OF ESCAPE SEQ PROCESSOR
	$$DATA	TRMTYP			;TERMINAL TYPE
;	$$DATA	TRMUDX			;UDX FOR TERMINAL
	$$DATA	BGLINE			;POINTER TO BEGINNING OF CURRENT LINE
	$$DATA	BGBUFR			;MY POINTER TO BEGINNING OF BUFFER

I%ION:	POPJ	P,
I%IOFF:	POPJ	P,
SUBTTL	K%INIT  --  Initialization of the Scanning Module

;K%INIT is called during the intialization phase of the host program via the
;	I%INIT call.  If command scanning is desired, the controlling terminal
;	is taken over, etc...

;CALL IS:	S1/ Length of the Initialization Block
;		S2/ Address of the Initialization Block 
;
;TRUE RETURN:	No arguments are returned

K%INIT:
IFN FTJSYS,<
	DMOVE	S1,[BYTE (2) 0,1,1,1,1,1,1,2,3,2,2,1,1,2,1,1,1,1
		    BYTE (2) 0,0,0,0,0,0,1,1,1,3,2,2,2,2,0,0,0,0] ;LOAD COCTAB
	PJRST	K%WCOC			;WRITE THE COC AND RETURN
>  ;END IFN FTJSYS

IFN FTUUOS,<
;	MOVEI	S1,16			;USE CHANNEL 16
;	IOR	S1,[OPEN [IO.LEM+IO.SUP+IO.TEC+.IOASC ;SET ALL THE FUNNY MODES
;		    SIXBIT /TTY/	;ON THE CONTROLLING TERMINAL
;		    XWD  0,0 ]]		;ALLOCATING NO BUFFERS
;	XCT	S1			;OPEN UP THE TERMINAL FOR SCANNING
	OPEN	16,[IO.LEM+IO.SUP+IO.TEC+.IOASC
		    SIXBIT/TTY/
		    0]
	  $STOP(COT,Cannot OPEN terminal)
	DMOVE	S1,[BYTE (2) 0,1,1,1,1,1,1,2,3,2,2,1,1,2,1,1,1,1
		    BYTE (2) 0,0,0,0,0,0,1,1,1,3,2,2,2,2,0,0,0,0] ;LOAD COCTAB
	PUSHJ	P,K%WCOC		;WRITE THE TABLE
	MOVSI	S1,'TTY'		;LOAD TTY NAME
	IONDX.	S1,			;GET IO INDEX
	  JFCL				;IGNORE ERROR
	MOVEM	S1,TRMUDX		;STORE FOR VARIOUS TRMOPS
	SETZM	UESCTB			;NO ESCAPE SEQUENCES
	SETZM	CURESC			;CLEAR ESCAPE MACHINE
	MOVX	S1,.TT33		;ASSUME THIS IS A 33
	SETOM	TTYFLG			;SET TTY OPENED
	PJRST	K%STYP			;SET TYPE AND RETURN
>  ;END IFN FTUUOS
SUBTTL K%RCOC  --  Read Character Output Control Table

;K%RCOC and K%WCOC are used to read/write the control character output
;	table.  For each character 0-37, there is a 2 bit field indicating
;	how this character should be echoed.  This two word table then
;	consists of bit pairs code as:
;	  00 - Do not echo at all
;	  01 - Indicate by ^X 
;	  10 - Send the actual ASCII code (I.E. 7 for ^G)
;	  11 - Simulate the character


;CALL IS:	No arguments
;
;TRUE RETURN:	S1/ First word of COC table
;		S2/ Second word of COC table

IFN FTUUOS,<
K%RCOC:	DMOVE	S1,COCTAB		;GET TABLE
	$RETT				;AND RETURN
>  ;END IFN FTUUOS


IFN FTJSYS,<
K%RCOC:	PUSH	P,S2+1			;SAVE A 3RD AC
	MOVX	S1,.PRIIN		;LOAD PRINCIPLE INPUT JFN
	RFCOC				;READ THE COC TABLE
	MOVE	S1,S2			;GET FIRST WORD INTO S1
	MOVE	S2,S2+1			;GET SECOND WORD INTO S2
	POP	P,S2+1			;RESTORE THE SAVED AC
	$RETT				;AND RETURN
>  ;END IFN FTJSYS
SUBTTL K%WCOC  --  Write Character  Output Control table

;See explanation above

;CALL IS:	S1/ First word of COC table
;		S2/ Second word of COC table
;
;TRUE RETURN:	Always

IFN FTUUOS,<
K%WCOC:	DMOVEM	S1,COCTAB		;STORE THE TABLE
	$RETT				;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
K%WCOC:	PUSH	P,S2+1			;SAVE A 3RD JSYS AC
	MOVE	S2+1,S2			;PUT SECOND WORD IN T1
	MOVE	S2,S1			;PUT FIRST WORD IN S2
	MOVEI	S1,.PRIIN		;GET PRINCIPLE INPUT JFN
	SFCOC				;SET COC TABLE
	POP	P,S2+1			;RESTORE S2+1
	$RETT				;AND RETURN
>  ;END IFN FTJSYS
SUBTTL	K%SUET  --  Set User Escape Table

;K%SUET is called to setup the address of the user escape table if the
;	program wants special action on ESCape sequences.
;
;Call:	S1/  address of User Escape Table
;	      or 0 to clear the UET entry
;
;T Ret:	always

IFN FTUUOS,<
K%SUET:	MOVEM	S1,UESCTB		;SAVE THE ESCAPE TABLE ADDRESS
	SETZM	CURESC			;CLEAR CURRENT STATE
	MOVE	S1,TRMTYP		;GET TERMINAL TYPE
	CAXE	S1,.TTV50		;IS IT A VT50?
	CAXN	S1,.TTV52		;OR A VT52?
	SKIPA				;YES, SET IT UP
	$RETT				;RETURN

	OUTCHR	[.CHESC]		;OUTPUT AN ESCAPE
	MOVEI	S1,"="			;THIS SETS THE MODE
	SKIPN	UESCTB			;PROGRAM IS CLEARING IT
	MOVEI	S1,76			;CLEAR IT
	OUTCHR	S1			;PUT OUT THE CHARACTER
	$RETT				;AND RETURN
>  ;END IFN FTUUOS

IFN FTJSYS,<
K%SUET:	HALT .				;NOT IMPLEMENT
>  ;END IFN FTJSYS
SUBTTL K%STYP  --  Set terminal type

;K%STYP is used to give the scanning module knowledge of the terminal type
;	in use as the command terminal.

;CALL IS:	S1/ Terminal type code (See GLXMAC)
;
;TRUE RETURN:	Terminal is a known type
;FALSE RETURN:	The terminal code does not appear in SCN's tables


IFN FTJSYS,<
K%STYP:	MOVE	S2,S1			;PUT TYPE IN S2
	MOVX	S1,.PRIIN		;LOAD PRINCIPLE INPUT JFN
	STTYP				;SET TERMINAL TYPE
	ERJMP	.RETF			;LOSE IF JSYS DID
	$RETT				;ELSE WIN.
>  ;END IFN FTJSYS

IFN FTUUOS,<
K%STYP:	PUSHJ	P,.SAVE4		;SAVE SOME PERM ACS
	MOVE	P1,S1			;AND COPY INPUT ARGUMENT
	MOVSI	S1,-TTTABL		;LENGTH OF TABLE

STYP.2:	HLRZ	S2,TTTAB(S1)		;GET A TERMINAL TYPE CODE
	CAME	P1,S2			;A MATCH?
	AOBJN	S1,STYP.2		;NO, TRY ALL THE ENTRIES
	JUMPGE	S1,.RETF		;TAKE FAILURE IF NOT FOUND

	MOVE	S2,TTSET(S1)		;GET ADDRESS OF SETUP ROUTINE
	ADDI	S1,TTTAB		;ADD TABLE ADDRESS TO OFFSET
	HRRZM	S1,TRMPTR		;STORE POINTER FOR LATER USE
	MOVEM	P1,TRMTYP		;AND SAVE THE TERMINAL TYPE
	TLNN	S2,-1			;IS THERE A WIDTH THERE?
	PJRST	0(S2)			;NO, JUST SET TERMINAL SPECIFIC STUFF
	MOVE	S1,[3,,P1]		;SETUP AN ARG BLOCK
	MOVX	P1,.TOWID+.TOSET	;SET WIDTH FUNCTION
	MOVE	P2,TRMUDX		;GET THE UDX
	HLRZ	P3,S2			;GET THE WIDTH
	TRMOP.	S1,			;SET THE WIDTH
	  JFCL				;IGNORE THE ERROR
	PJRST	0(S2)			;AND DO TERMINAL SPECIFIC STUFF


;TABLES ARE ON THE FOLLOWING PAGE
;
;STILL IN IFN FTUUOS
;FORMAT OF THE TTTAB TABLE IS:
;	XWD	TERMINAL-TYPE,ADDRESS-OF-CONTROL-TABLE
;
;EACH ENTRY IN THE CONTROL TABLE IS THE ADDRESS OF A PARTICULAR
;	CONTROL SEQUENCE FOR THE TERMINAL.
;
;THE SEQUENCES ARE:
	.TCEOL==0			;ERASE TO END-OF-LINE

TTTAB:	.TT33,,0			;MODEL 33 TTY
	.TT35,,0			;MODEL 35 TTY
	.TT37,,0			;MODEL 37 TTY
	.TTEXE,,0			;EXECUPORT
	.TTV05,,[[BYTE (7)37,177,177,177]];VT05
	.TTV50,,[[BYTE (7).CHESC,"J"]]	;VT50
	.TTL30,,0			;LA30
	.TTL36,,0			;LA36
	.TTV52,,[[BYTE (7) .CHESC,"J"]]	;VT52
	.TTV52,,[[BYTE (7) .CHESC,"J"]]	;AND ONE FOR PATCHING
	  TTTABL==.-TTTAB


;FORMAT OF TABLE IS WIDTH,,ADR OF SETUP ROUTINE
;    IF WIDTH IS 0, IT ISN'T SET
;	***MUST BE PARALLEL TO TTTAB***

TTSET:	XWD	^D72,.RETT		;MODEL 33 TTY
	XWD	^D72,.RETT		;MODEL 35 TTY
	XWD	^D72,.RETT		;MODEL 37 TTY
	XWD	^D72,.RETT		;EXECUPORT
	XWD	^D72,.RETT		;VT05
	XWD	^D80,SETVT5		;VT50
	XWD	^D72,.RETT		;LA30
	XWD	^D00,.RETT		;LA36
	XWD	^D80,SETVT5		;VT52
	XWD	^D80,SETVT5		;PATCH SPACE


;TERMINAL SETUP ROUTINES
SETVT5:	OUTCHR	[.CHESC]		;PUT OUT AN ESCAPE
	MOVEI	S1,"="			;TO SET ALTERNATE MODE
	SKIPN	UESCTB			;DID PROGRAM SET IT
	MOVEI	S1,76			;NOPE.
	OUTCHR	S1			;PUT IT OUT
	MOVE	S1,[3,,P1]		;GET TRMOP ARG POINTER
	MOVX	P1,.TOLCT+.TOSET	;SET TT LC
	MOVE	P2,TRMUDX		;GET THE UDX
	SETZ	P3,			;SET A FLAG?
	TRMOP.	S1,			;DO THE TRMOP
	  JFCL				;IGNORE ERROR
	$RETT				;AND RETURN
>  ;END IFN FTUUOS
SUBTTL K%TXTI  --  Handle Terminal Input

;This routine is used to do input from the controlling terminal.  It
;	acts much like the TOPS-20 JSYS TEXTI.

;CALL IS:	S1/ Address of a TEXTI format argument block
;
;TRUE RETURN:	Always, with an updated argument block

IFN FTJSYS,<
K%TXTI:	TEXTI				;DO THE TEXTI JSYS
	ERJMP	.RETF			;LOSE IF HE DID
	$RETT				;AND RETURN
>  ;END IFN FTJSYS

IFN FTUUOS,<
K%TXTI:	SKIPN	TTYFLG			;WAS TERMINAL EVER OPENED?
	$STOP(TNO,Terminal never opened) ;APPARENTLY NOT
	MOVEM	S1,ARGLOC		;REMEMBER ARGUMENT BLOCK LOCATION
	SAVE	C			;SAVE CHARACTER AC
	PUSHJ	P,.SAVET		;MAKE T REGS AVAILABLE FOR SCRATCH
	MOVEI	S1,.RDSIZ		;GET SIZE OF BLOCK
	MOVEI	S2,RD			;AND ITS LOCATION
	PUSHJ	P,.ZCHNK		;AND NOW ZERO THE BLOCK OUT
	HRL	S2,ARGLOC		;FORM A XFER POINTER
	MOVE	S1,ARGLOC		;GET LOCATION OF BLOCK
	MOVE	S1,.RDCWB(S1)		;LENGTH OF BLOCK TO MOVE
	ADDI	S1,0(S2)		;NOW HAVE LAST WORD TO MOVE
	BLT	S2,0(S1)		;MOVE USER BLOCK
	PUSHJ	P,CONVBP		;CONVERT ALL BYTE POINTERS ETC..
	SETZM	RUBFLG			;CLEAR RUBOUT IN PROGRESS FLAG
	SETZM	BCKFLG			;CLEAR BACKUP LIMIT FLAG
	JRST	TXTL			;YES, DON'T SLEEP


				;CONTINUED ON NEXT PAGE
				;CONTINUED FROM PREVIOUS PAGE

; HERE WHEN ALL IS DONE, S1 CONTAINS FLAGS TO STORE

FINTXT:	SKIPE	BCKFLG			;WAS BACKUP LIMIT REACHED?
	IORX	S1,RD%BLR		;YES, TURN ON THE INDICATOR
	IORM	S1,RD+.RDFLG		;STORE FLAGS
	SKIPN	RD+.RDDBC		;ANY ROOM FOR A TERMINATING NULL?
	JRST	FINT.1			;NO, SO CANNOT DEPOSIT NULL
	SETZ	S1,			;GET A NULL
	MOVE	S2,RD+.RDDBP		;GET THE BYTE POINTER
	IDPB	S1,S2			;AND STORE IT
FINT.1:	MOVE	S1,ARGLOC		;GET LOCATION OF ARG BLOCK
	MOVE	S2,.RDCWB(S1)		;AND SIZE OF IT-1
	ADD	S2,S1			;GET LAST WORD TO MOVE
	HRLI	S1,RD			;TRANSFER FROM OUR FULL ARG BLOCK
	BLT	S1,0(S2)		;TO THE USER'S POSSIBLY PARTIAL
	PUSHJ	P,I%ION			;RE-ENABLE INTERRUPTS JUST IN CASE
	$RETT

;STILL IN IFN FTUUOS FOR A LONG TIME
SUBTTL TXTL  --  Loop for inputting text

;TXTL is a lower level routine which loops for each character, calling
;	all the worker routines.  It exits when the appropriate condition
;	 (ie, break or full) occurs.

;CALL IS:	No arguments
;
;TRUE RETURN:	Always


TXTL:	PUSHJ	P,I%ION			;TURN ON INTERRUPTS IF OFF
	SKIPL	BCKFLG			;WAS BACKUP LIMIT REACHED?
	SKIPG	S1,RD+.RDDBC		;ANY ROOM FOR ANOTHER CHARACTER?
	JRST	FINTXT			;NO, RETURN WITH NO FLAGS SET
	MOVX	S1,RD%JFN		;GET THE "JFN PRESENT" BIT
	TDNN	S1,RD+.RDFLG		;SKIP IF SET
	JRST	[ILDB C,RD+.RDFLG	;ELSE, GET A CHARACTER
		 JUMPN C,TXTL.2		;AND CONTINUE IF NOT NULL
		 MOVX S1,RD%BTM		;LOAD "BREAK TERMINATOR" FLAG
		 JRST FINTXT]		;AND RETURN
	HLRZ	S1,RD+.RDIOJ		;GET PRIMARY INPUT JFN
	CAXE	S1,.PRIIN		;TERMINAL?
	JRST	TXTL.4			;NO

	SKIPE	CURESC			;ARE WE IN AN ESCAPE SEQUENCE?
	JRST	TXTL.5			;YES, GET NEXT CHARACTER
	PUSHJ	P,TTYCHR		;NO,GET A CHARACTER
	CAIN	C,.CHESC		;IS IT AN ESCAPE?
	SKIPN	S1,UESCTB		;YES, HAS USER SETUP A TABLE?
	JRST	TXTL.2			;NO, CONTINUE ON
	MOVEM	S1,CURESC		;SAVE AS CURRENT STATE

TXTL.1:	PUSHJ	P,TTYCHR		;GET THE NEXT CHARACTER
	ADD	C,CURESC		;GET ADR OF TABLE ENTRY
	MOVE	S1,0(C)			;AND GET THE WORD
	MOVEM	S1,CURESC		;STORE AS CURRENT STATE
	JUMPE	S1,[OUTCHR [.CHBEL]	;TYPE A BELL
		    JRST TXTL]		;AND LOOP AROUND
	TLNN	S1,-1			;IS IT 0,,ADR?
	JRST	TXTL.1			;YES, LOOP
	JRST	TXTL			;NO, A BP FINALLY


				;TXTL IS CONTINUED ON THE FOLLOWING PAGE
				;CONTINUED FROM THE PREVIOUS PAGE

TXTL.2:	JUMPE	C,TXTL			;IGNORE NULLS

	PUSHJ	P,CONVRT		;CONVERT LOWER TO UPPER, ETC.
	PUSHJ	P,SPCHK			;SEE IF ITS A SPECIAL FUNCTION
	JUMPT	0(S1)			;IF ITS SPECIAL, GO HANDLE IT

	PUSHJ	P,STOC			;STORE THE CHARACTER
	PUSHJ	P,I%ION			;OK, SAFE TO BE INTERRUPTED
	AOSN	RUBFLG			;CLEAR RUBFLG, WAS IT UP?
	OUTCHR	[.CHBSL]		;YES, CLOSE THE RUBOUT SET
	PUSHJ	P,ECHO			;AND ECHO IT
TXTL.3:	PUSHJ	P,CBRK			;CHECK FOR A BREAK
	JUMPF	TXTL			;IF NOT, GET NEXT CHARACTER
	MOVX	S1,RD%BTM		;FLAG THAT BREAK ENDED INPUT
	JRST	FINTXT			;AND RETURN

TXTL.4:	PUSHJ	P,F%IBYT		;GET NEXT CHARACTER FROM FILE
	JUMPF	[CAXE	S1,EREOF$
		JRST	TXTL.6
		$RETF]
	SKIPN	C,S2			;NULL?
	JRST	TXTL.4			;YES
	HRRZ	S1,RD+.RDIOJ
	CAIN	S1,.PRIOU		;OUTPUT TO TERMINAL ?
	PUSHJ	P,ECHO			;YES
	PUSHJ	P,CONVRT		;CONVERT CASING
	PUSHJ	P,STOC			;STORE
	JRST	TXTL.3			;LOOP

TXTL.5:	ILDB	C,CURESC		;GET THE CHARACTER
	SKIPN	C			;FINALLY HIT A NULL?
	SETZM	CURESC			;YES, CLEAR THE POINTER
	CAIGE	C,200			;SPECIAL CHARACTER?
	JRST	TXTL.2			;NO, HANDLE NORMALLY
	SUBI	C,200			;MAKE SOMETHING OF IT
	OUTCHR	C			;OUTPUT IT
	JRST	TXTL.5			;AND LOOP

TXTL.6:	$STOP(FSE,File System Error)
SUBTTL	TTYCHR  --  Here to receive 1 character from the TTY

;TTYCHR is written to be interruptable until a character is typed.
;	When a character is available, TTYCHR goes IOFF and returns
;	the character in C   WITH INTERRUPTS OFF so that input is not
;	lost.

TTYCHR:	SKPINC				;SKIP IF A CHARACTER IS THERE
	SKIPA				;NONE THERE YET, SLEEP
	JRST	TTYC.1			;READY!!
	MOVX	S1,HB.RTC		;LOAD SOME HIBER BITS
	HIBER	S1,			;SLEEP
	  JFCL				;IGNORE IT
	JRST	TTYCHR			;AND LOOP FOR A CHARACTER

TTYC.1:	PUSHJ	P,I%IOFF		;NEED NOT TO BE INTERRUPTED HERE
	INCHRW	C			;ASK FOR A CHARACTER
	$RETT				;AND RETURN """IOFF"""
SUBTTL Utilities for text handling

; STOC - Store an input character

STOC:	CAIE	C,.CHCRT		;IS THIS A CARRIAGE-RETURN?
	JRST	STOC.1			;NO
	LOAD	S1,RD+.RDFLG,RD%CRF	;DO WE WANT TO SUPRESS IT?
	JUMPN	S1,.RETT		;YES,GIVE UP NOW
STOC.1:	IDPB	C,RD+.RDDBP		;STORE FOR POINTER
	SOS	RD+.RDDBC		;AND DECREMENT COUNT
	$RETT				;THEN RETURN

; USTOC - Unstore a character

USTOC:	SKIPN	S1,RD+.RDBKL		;IS BACKUP LIMIT GIVEN?
	JRST	USTO.1			;NO
	CAMN	S1,RD+.RDDBP		;AND ARE WE AT THE LIMIT?
	SETOM	BCKFLG			;REMEMBER THIS FOR LATER
USTO.1:	SOS	S1,RD+.RDDBP		;BACK OFF 5 BYTES
	MOVEI	S2,4			;AND THEN GO FORWARD
	IBP	S1			;BY INCREMENTING
	SOJG	S2,.-1			;FOUR TIMES
	PUSHJ	P,MAKBP			;CONVERT IT
	MOVEM	S1,RD+.RDDBP		;AND RE-STORE IT
	AOS	RD+.RDDBC		;ONE MORE BYTE AVAILABLE
	$RETT				;THEN RETURN
; CONVRT - Do case conversion as necessary

CONVRT:	LOAD	S1,RD+.RDFLG,RD%RAI	;DOES CALLER WANT INPUT RAISED?
	CAXE	C,$C(H)			;OR IS THIS ^H?
	JUMPE	S1,.RETT		;IF NOT, RETURN NOW
	CAIL	C,"a"			;IS IT IN RANGE OF LC A
	CAILE	C,"z"			; TO LC Z?
	SKIPA				;NO, DON'T CONVERT IT
	SUBI	C,"a"-"A"		;ELSE DO THE CONVERSION
	CAXE	C,$C(H)			;IF NOT ^H, THEN
	$RETT				;RETURN
	PUSHJ	P,GETCOC		;GET CONTROL CODE
	CAXN	S1,3			;IS "SIMULATE" ON?
	MOVEI	C,.CHDEL		;YES, CONVERT TO RUBOUT
	$RETT				;THEN RETURN


;  CONVBP - Convert default byte pointers

CONVBP:	SKIPN	S1,RD+.RDDBP		;GET REQUIRED POINTER
	$STOP(IBP,Illegal byte pointer in K%TXTI)
	PUSHJ	P,MAKBP			;CONVERT TO NORMAL
	MOVEM	S1,RD+.RDDBP		;STORE IT BACK
	SKIPN	S1,RD+.RDBFP		;GET INITIAL POINTER IF GIVEN
	MOVE	S1,RD+.RDDBP		;IF NOT, SET TO DESTINATION
	PUSHJ	P,MAKBP			;CONVERT
	MOVEM	S1,BGLINE		;STORE AS BEGINNING OF LINE
	MOVEM	S1,BGBUFR		;STORE AS BEGINNING OF BUFFER
	SKIPN	S1,RD+.RDBKL		;GET BACKUP LIMIT IF GIVEN
	JRST	COBP.1			;NOT GIVEN, SKIP THIS
	PUSHJ	P,MAKBP			;CONVERT IT
	MOVEM	S1,RD+.RDBKL		;AND STORE IT BACK
COBP.1:	SKIPN	S1,RD+.RDRTY		;IS RE-TYPE PROMPT GIVEN?
	$RETT				;NO
	PUSHJ	P,MAKBP			;CONVERT IT
	MOVEM	S1,RD+.RDRTY		;STORE IT BACK
	MOVX	S1,RD%JFN		;GET THE "JFN PRESENT" BIT
	TDNE	S1,RD+.RDFLG		;SKIP IF NOT SET
	$RETT				;SET...NO BYTE-POINTER
	SKIPN	S1,RD+.RDIOJ		;GET THE BYTE POINTER
	$STOP(IIP,Illegal Input Pointer)
	PUSHJ	P,MAKBP			;CONVERT THE BYTE POINTER
	MOVEM	S1,RD+.RDIOJ		;AND RE-STORE IT
	$RETT				;RETURN
; MAKBP - Un-default a byte pointer

MAKBP:	TLC	S1,-1			;COMPLEMENT LH (BYTE POINTER PART)
	TLCN	S1,-1			;CHANGE BACK , TEST FOR -1
	HRLI	S1,(POINT 7)		;IF DEFAULTED,CONVERT TO ASCII
	LOAD	S2,S1,BP.POS		;GET POSITION (BITS TO RIGHT)
	CAIGE	S2,7			;ENOUGH FOR ANOTHER BYTE?
	JRST	[ MOVEI S2,^D36		;NO, MAKE IT ^D36 BITS TO
		  STORE S2,S1,BP.POS	;THE RIGHT IN NEXT WORD
		  AOJA	S1,.RETT]	;AND RETURN
	$RETT				;THEN RETURN




; IMGSTR - Output a string as it was echoed

IMGSTR:	SAVE	C			;SAVE CHARACTER REGISTER
	PUSHJ	P,.SAVE1		;SAVE P1
	PUSHJ	P,MAKBP			;MAKE A BYTE POINTER
	MOVE	P1,S1			;GET THE POINTER IN P1
IMGS.1:	ILDB	C,P1			;GET A CHARACTER
	JUMPE	C,.POPJ			;RETURN ON NULL
	PUSHJ	P,ECHO			;RE-ECHO IT
	JRST	IMGS.1			;LOOP FOR MORE



; CLINE - Clear current video line

CLINE:	OUTCHR	[.CHCRT]		;OUTPUT A CARRAIGE RETURN
	HRRZ	S1,@TRMPTR		;GET CONTROL CODE FOR ERASE
	OUTSTR	@.TCEOL(S1)		;TO END OF LINE
	$RETT				;AND RETURN


; GETCOC - Fetch COC for a given character

GETCOC:	MOVE	S1,C			;GET CHARACTER
	IDIVI	S1,^D18			;2 BITS PER CHAR = 18 CHARS PER WORD
	MOVE	S1,COCTAB(S1)		;GET RIGHT WORD OF COC
	ASH	S2,1			;TWO BITS NEEDED FOR ONE CHARACTER
	ROTC	S1,2(S2)		;POSITION COC AS BITS 34&5 OF S2
	LDB	S1,[POINT 2,S2,35]	;GET INTO S1 FOR RETURN
	$RETT				;AND RETURN
; ECHO - HANDLE CHARACTER ECHOING

ECHO:	MOVX	S1,RD%NEC		;GET NO ECHO BIT
	TDNE	S1,RD+.RDFLG		;TEST IT
	$RETT				;RETURN IF SET
	CAIL	C," "			;IS THIS A PRINTABLE CHARACTER?
	JRST	ECHO.2			;YES, JUST OUTPUT IT
	PUSHJ	P,GETCOC		;GET COC CODE FOR CHARACTER
	JRST	@[EXP .RETT,ECHO.1,ECHO.2,ECHO.3](S1) ;DISPATCH FOR HANDLING

; SEND ^ (UP-ARROW) FOLLOWED BY PRINTABLE FORM OF CHARACTER

ECHO.1:	MOVEI	S1,100(C)		;GET PRINTABLE FORM OF CHARACTER
	OUTCHR	["^"]			;PRINT UP-ARROW
	OUTCHR	S1			;AND THE CHARACTER
	$RETT				;AND RETURN

; SEND ACTUAL CODE FOR THIS CHARACTER (TRUE ECHO)

ECHO.2:	OUTCHR	C			;PRINT IT
	$RETT				;AND RETURN

; SIMULATE ACTION FOR CHARACTER

ECHO.3:	CAXE	C,.CHESC		;ONLY KNOW HOW TO SIMULATE ESCAPE (33)
	JRST	ECHO.2			;SO IF NOT THAT, SEND ACTUAL CODE
	OUTCHR	["$"]			;SIMULATE ESC WITH "$" (DOLLAR SIGN)
	$RETT				;AND RETURN
; CBRK - Check to see if character is a break

CBRK:	SKIPN	RD+.RDBRK		;IS A USER SUPPLIED BREAK TABLE PRESENT?
	JRST	CBRK.1			;NO, GO TO NEXT SECTION
	MOVE	S1,C			;GET CODE FOR CHARACTER
	IDIVI	S1,^D32			;32 CODES PER WORD
	ADD	S1,RD+.RDBRK		;GET RIGHT WORD OF TABLE
	MOVE	S1,0(S1)		;IE WORD 0-3
	LSH	S1,0(S2)		;POSITION RIGHT BIT TO SIGN BIT
	JUMPL	S1,.RETT		;TAKE THIS BREAK IF WANTED

CBRK.1:	MOVSI	S1,-BTBLL		;GET BREAK TABLE LENGTH

CBRK.2:	HLLZ	S2,BTBL(S1)		;GET ONLY FLAG PORTION
	TDNN	S2,RD+.RDFLG		;IS THIS BREAK SET FLAG ON?
	JRST	CBRK.4			;NO, SKIP THIS TEST
	HRRZ	S2,BTBL(S1)		;NOW GET ADDRESS PORTION
	HRLI	S2,(POINT 7)		;FORM A BYTE POINTER
	
CBRK.3:	ILDB	T1,S2			;GET BYTE
	JUMPE	T1,CBRK.4		;IF NULL, WE HAVE A NO MATCH
	CAMN	T1,C			;DOES THIS MATCH A BREAK CHARACTER?
	$RETT				;YES, TAKE TRUE RETURN
	JRST	CBRK.3			;LOOP FOR ALL

CBRK.4:	AOBJN	S1,CBRK.2		;STEP THROUGH ENTIRE TABLE
	$RETF				;FINALLY, ITS NOT A BREAK


; FORMAT OF TABLE IS:  FLGS,,[BYTE (7) CHR,CHR, WHICH ARE BREAK IF FLG IS SET]

BTBL:	RD%BRK+[BYTE(7) $C(Z),.CHESC]	;^Z,$
	RD%TOP+[BYTE(7) $C(G),$C(L),$C(Z),.CHESC,.CHLFD,.CHCRT,0]
	RD%PUN+PUNTAB
	RD%BEL+[BYTE(7) .CHLFD,0]
	
	BTBLL==.-BTBL


PUNTAB:					;TABLE OF PUNCTUATION CHARACTERS
	BYTE (7) 40,41,42,43,44,45,46,47,50,51,52,53,54,55,56,57,34,35,36,37
	BYTE (7) 72,73,74,75,76,77,100,133,134,135,136,137,140,173,174
	BYTE(7) $C(A),$C(B),$C(C),$C(D),$C(E),$C(F),$C(H),$C(I),$C(K),$C(N)
	BYTE(7) $C(O),$C(P),$C(Q),$C(S),$C(T),175,176,$C(X),$C(Y),0
SUBTTL SPCHK  --  Check for special characters

;SPCHK is called to detect special formatting and edit characters as they
; come in.
;
;CALL IS:	C/ Character
;
;TRUE RETURN:	S1/ Address of routine to call
;FALSE RETURN:	Character was not special

SPCHK:	MOVSI	S1,-SCTBLL		;GET LENGTH OF TABLE

SPCH.1:	HLRZ	S2,SCTBL(S1)		;GET CHARACTER
	CAME	S2,C			;A MATCH?
	AOBJN	S1,SPCH.1		;LOOP LOOKING FOR MATCH
	JUMPGE	S1,.RETF		;IF NO MATCH, RETURN FALSE

	HRRZ	S1,SCTBL(S1)		;GET PROCESSOR ADDRESS
	LOAD	S2,RD+.RDFLG,RD%SUI	;GET ^U SUPRESS BIT
	CAIN	S1,$C(U)		;IF NOT CONTROL-U,
	PJUMPN	S2,.RETF		;IF A SUPPRESS ^U, RETURN FALSE
	$RETT				;RETURN TRUE


SCTBL:	.CHDEL,,CCDEL			;DELETE (177)
	$C(U),,CCU			;^U
	$C(R),,CCR			;^R
	$C(W),,CCW			;^W

	  SCTBLL==.-SCTBL
SUBTTL  CCU  --  Handle ^U (Rubout entire line)

;HERE TO PROCESS ^U (RESTART INPUT)

CCU:	SETZM	RUBFLG			;CLEAR RUBOUT FLAG
	MOVE	S1,BGLINE		;GET BEGINNING POINTER
	CAMN	S1,RD+.RDDBP		;DOES CURRENT MATCH FIRST?
	JRST	CCU.1			;YES, SO WE ARE AT FRONT
	PUSHJ	P,USTOC			;UNSTORE 1 CHARACTER
	JRST	CCU			;TRY AGAIN

CCU.1:	HRRZ	S1,@TRMPTR		;GET CONTROL CODE PART
	JUMPN	S1,CCU.2		;IF VIDEO, HANDLE IT THAT WAY

	OUTSTR	[ASCIZ/
/]					;GIVE A NEW LINE
	JRST	CCU.3			;AND CONTINUE

CCU.2:	PUSHJ	P,CLINE			;CLEAR THE LINE

CCU.3:	PUSH	P,T1			;SAVE T1
	SKIPE	T1,RD+.RDRTY		;IF A PROMPT WAS GIVEN,
	PUSHJ	P,TYPEBP		;RESEND THE PROMPT
	POP	P,T1			;RESTORE T1
	LOAD	S1,RD+.RDFLG,RD%RND	;DOES USER WANT RETURN ON EMPTY?
	JUMPE	S1,TXTL			;NO, GO FOR MORE INPUT
	MOVX	S1,RD%BFE		;INDICATE BUFFER EMPTY
	JRST	FINTXT			;AND FINISH UP
SUBTTL CCR  --  Handle ^R (Re-type the line)


CCR:	SETZM	RUBFLG			;CLEAR RUBOUT FLAG
	HRRZ	S1,@TRMPTR		;GET TERMINAL POINTER
	JUMPE	S1,CCR.1		;IF NULL, ITS HARD COPY
	PUSHJ	P,CLINE			;CLEAR THE LINE
	SKIPA				;AND DON'T GO TO NEXT ONE
CCR.1:	OUTSTR	[ASCIZ/
/]					;GET TO NEXT LINE
	PUSH	P,T1			;SAVE T1
	SKIPE	T1,RD+.RDRTY		;IS RE-PROMPT GIVEN?
	PUSHJ	P,TYPEBP		;YES, OUTPUT IT
	MOVE	S1,RD+.RDDBP		;GET CURRENT BYTE POINTER
	MOVEI	S2,0			;AND A NULL TO DEPOSIT
	IDPB	S2,S1			;STORE AS ASCIZ TERMINATOR
	MOVE	S1,BGLINE		;GET POINTER TO LINE
	PUSHJ	P,IMGSTR		;OUTPUT AN STRING AS ECHOED
	POP	P,T1			;RESTORE T1
	JRST	TXTL			;WHEN DONE, GET NEXT CHARACTER
SUBTTL CCDEL  --  Handle Rubout (Delete one character)


CCDEL:	MOVE	S1,RD+.RDDBP		;GET CURRENT POINTER
	CAMN	S1,BGBUFR		;ARE WE BACK UP TO BEGINNING?
	JRST	BEGBUF			;YES, AT BEGINNING OF BUFFER

	PUSHJ	P,USTOC			;UN-STORE A CHARACTER
	MOVE	S1,RD+.RDDBP		;GET CORRECTED POINTER
	ILDB	C,S1			;THEN GET DELETED CHARACTER

	HRRZ	S1,@TRMPTR		;GET POINTER TO CONTROL CODE
	JUMPN	S1,CCDL.1		;IF THERE IS CODE,DO IT

	SKIPL	RUBFLG			;WAS PREVIOUS CHAR A RUBOUT?
	OUTCHR	[.CHBSL]		;START RUBOUT SET WITH BACKSLASH
	SETOM	RUBFLG			;AND SET FLAG TO REMEMBER IT
	PUSHJ	P,ECHO			;ECHO THE CHARACTER
	JRST	TXTL			;THEN RETURN FOR NEXT CHARACTER

CCDL.1:	CAIGE	C," "			;WAS DELETED CHARACTER PRINTING?
	JRST	CCDL.2			;NO, NEED FURTHER ANALYSIS
	OUTSTR	[BYTE (7)10,40,10]	;OUTPUT BACKSPACE,SPACE,BACKSPACE
	JRST	TXTL			;THEN CONTINUE

CCDL.2:	PUSHJ	P,GETCOC		;GET COC FOR THIS CHARACTER
	JUMPE	S1,TXTL			;IF CODE 0 , NOTHING THERE AT ALL
	CAXE	S1,1			;IF ITS A ONE, JUST RUBOUT 2 CHARACTERS
	JRST	CCR			;ELSE FORCE A RETYPE OF THE LINE
	OUTSTR	[BYTE (7)10,10,40,40,10,10]	;OUTPUT BACK,BACK,SPACE,SPACE,BACK,BACK
	JRST	TXTL			;THEN GET NEXT INPUT
SUBTTL CCW  --  Handle ^W (Delete back to punctuation character)


CCW:	SETZM	RUBFLG			;CLEAR RUBOUT FLAG
	MOVE	S1,RD+.RDDBP		;GET BYTE POINTER
	CAMN	S1,BGLINE		;IF AT THE BEGINNING, GO HANDLE IT
	JRST	BEGBUF			;BY RINGING OR RETURNING

CCW.1:	PUSHJ	P,USTOC			;UN-STORE ONE CHARACTER
	MOVE	S1,RD+.RDDBP		;GET CORRECTED POINTER
	CAMN	S1,BGLINE		;ARE WE AT BEGINNING NOW?
	JRST	CCW.3			;YES, THATS A PUNCTUATION ALL RIGHT
	SUBI	S1,1			;GET CHAR PRECEDING THIS ONE
	MOVEI	S2,5			;BY BACKING OFF AND INCREMENTING
	ILDB	C,S1			;THE RIGHT NUMBER OF TIMES
	SOJG	S2,.-1			;
	MOVE	S1,[POINT 7,PUNTAB]	;POINT TO PUNCTUATION TABLE

CCW.2:	ILDB	S2,S1			;GET A PUNCTUATION CHARACTER
	JUMPE	S2,CCW.1		;IF AT END, DELETE ANOTHER CHARACTER
	CAME	S2,C			;IS NEXT CHAR A PUNCTUATION CHAR?
	JRST	CCW.2			;NO, TRY NEXT IN LIST

CCW.3:	JRST	CCR			;HAVE DELETED FAR ENOUGH, RETYPE LINE
SUBTTL BEGBUF  --  Handle rubouts to beginning of buffer

;Here to handle deletion of characters till beginning of buffer.
;	Either ring bell and wait, or return to caller.

BEGBUF:	LOAD	S1,RD+.RDFLG,RD%RND	;GET FLAG FOR RETURN HERE
	JUMPN	S1,[ MOVX S1,RD%BFE	;FLAG IS LIT, RETURN BUFFER EMPTRY NOW
		     JRST FINTXT ]	;TO CALLER
	OUTCHR	[.CHBEL]		;SEND "BELL" AND
	JRST	TXTL			;THEN RETURN FOR NEXT CHARACTER



SUBTTL	TYPEBP  --  Type a string according to a byte-pointer

;Call with a byte-pointer in T1

TYPEBP:	HLRZ	S1,T1			;GET LEFT HALF OF POINTER
	CAIN	S1,-1			;IS IT -1
	MOVEI	S1,(POINT 7,0)		;YES, MAKE IT STANDARD
	CAIN	S1,(POINT 7,0)		;WORD ALIGNED?
	JRST	TYPE.2			;YES, DO AN OUTSTR

TYPE.1:	ILDB	S1,T1			;GET A CHARACTER
	JUMPE	S1,.RETT		;DONE ON A NULL
	OUTCHR	S1			;TYPE IT
	JRST	TYPE.1			;AND LOOP

TYPE.2:	OUTSTR	0(T1)			;TYPE THE STRING
	$RETT				;AND RETURN

>  ;END IFN FTUUOS FROM K%TXTI

KBD%L:			;LABEL THE LITERAL POOL