Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/glxkbd.mac
There are 26 other files named glxkbd.mac in the archive. Click here to see a list.
	TITLE	GLXKBD  --  Keyboard Interface for GALAXY
	SUBTTL	Preliminaries

;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.


	SEARCH	GLXMAC			;OPEN SYMBOLS NEEDED
	PROLOG(GLXKBD,KBD)		;PART OF LIBRARY, ETC...

	KBDMAN==:57			;Maintenance edit number
	KBDDEV==:60			;Development edit number
	VERSIN (KBD)			;Generate edit number

;This module provides a timesharing terminal interface for the GALAXY
;	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. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Local Definitions. . . . . . . . . . . . . . . . . . .    5
;   5. Module Storage . . . . . . . . . . . . . . . . . . . .    6
;   6. K%INIT
;        6.1.   Initialization of the Scanning Module . . . .    7
;   7. K%OPEN
;        7.1.   Open the terminal . . . . . . . . . . . . . .    8
;   8. FNDUDX
;        8.1.   Find UDX or designator of TTY . . . . . . . .    9
;   9. MAKBUF
;        9.1.   Create buffers when monitor does not. . . . .    9
;  10. DWBUFF
;       10.1.   Deal with the buffer. . . . . . . . . . . . .   10
;  11. K%RCOC
;       11.1.   Read Character Output Control Table . . . . .   11
;  12. K%WCOC
;       12.1.   Write Character  Output Control table . . . .   12
;  13. K%SUET
;       13.1.   Set User Escape Table . . . . . . . . . . . .   13
;  14. K%STYP
;       14.1.   Set terminal type . . . . . . . . . . . . . .   14
;  15. K%BOUT
;       15.1.   Type one character on TTY . . . . . . . . . .   16
;  16. K%SOUT
;       16.1.   Type an ASCIZ string on TTY . . . . . . . . .   16
;  17. K%BUFF  -  Buffer a byte or a string . . . . . . . . .   17
;  18. K%FLSH  -  Flush the output buffer . . . . . . . . . .   18
;  19. K%BIN
;       19.1.   Accept a character from TTY . . . . . . . . .   19
;  20. K%BACK
;       20.1.   Back up terminal input by one character . . .   19
;  21. K%TPOS
;       21.1.   GET THE HORIZONTAL TERMINAL POSITION. . . . .   20
;  22. K%TXTI
;       22.1.   Handle Terminal Input . . . . . . . . . . . .   21
;  23. TXTL
;       23.1.   Loop for inputting text . . . . . . . . . . .   23
;  24. TXTINP . . . . . . . . . . . . . . . . . . . . . . . .   25
;  25. TXTOUT . . . . . . . . . . . . . . . . . . . . . . . .   25
;  26. STROUT . . . . . . . . . . . . . . . . . . . . . . . .   25
;  27. Utilities for text handling. . . . . . . . . . . . . .   26
;  28. STOC
;       28.1.   Store an input character. . . . . . . . . . .   26
;  29. USTOC
;       29.1.   Unstore a character . . . . . . . . . . . . .   26
;  30. CONVRT
;       30.1.   Do case conversion as necessary . . . . . . .   27
;  31. CONVBP
;       31.1.   Convert default byte pointers . . . . . . . .   27
;  32. MAKBP
;       32.1.   Un-default a byte pointer . . . . . . . . . .   28
;  33. IMGSTR
;       33.1.   Output a string as it was echoed. . . . . . .   28
;  34. CLINE
;       34.1.   Clear current video line. . . . . . . . . . .   28
;  35. GETCOC
;       35.1.   Fetch COC for a given character . . . . . . .   28
;  36. ECHO
;       36.1.   HANDLE CHARACTER ECHOING. . . . . . . . . . .   29
;  37. CBRK
;       37.1.   Check to see if character is a break. . . . .   30
;  38. SPCHK
;       38.1.   Check for special characters. . . . . . . . .   31
;  39. CCU
;       39.1.   Handle ^U (Rubout entire line). . . . . . . .   32
;  40. CCR
;       40.1.   Handle ^R (Re-type the line). . . . . . . . .   33
;  41. FNDLIN
;       41.1.   Find beginning of current line. . . . . . . .   34
;  42. CCDEL
;       42.1.   Handle Rubout (Delete one character). . . . .   35
;  43. CCW
;       43.1.   Handle ^W (Delete back to punctuation character)  36
;  44. BEGBUF
;       44.1.   Handle rubouts to beginning of buffer . . . .   37
;  45. TYPEBP
;       45.1.   Type a string according to a byte-pointer . .   37
SUBTTL	Revision History


COMMENT \
56
	Add INTCHR and INCHRW the next character into it @BIN.2 to prevent
losing characters due to interrupt.

*****  Release 4.2 -- begin maintenance edits  *****

57      Change K%OPEN to open the controlling terminal only as TTY:
        Clean up the code in K%INIT and K%OPEN

*****  Release 5.0 -- begin development edits  *****

60	5.1002		28-Dec-82
	Move to new development area.  Clean up edit organization.  Update TOC.

\   ;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
	ENTRY	K%BIN			;READ ONE CHARACTER
	ENTRY	K%BOUT			;TYPE ONE CHARACTER
	ENTRY	K%SOUT			;TYPE AN ASCIZ STRING
	ENTRY	K%BACK			;BACK UP OVER LAST INPUT CHARACTER
	ENTRY	K%TPOS			;TERMINAL CURSOR POSITION ROUTINE
	ENTRY	K%BUFF			;BUFFER A BYTE OR A STRING
	ENTRY	K%FLSH			;FLUSH THE OUTPUT BUFFER
	ENTRY	K%OPEN			;OPEN THE TERMINAL
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

; Buffer symbols

	SYSPRM	.BFPTR,.BFPTR,1		;OFFSET TO BUFFER POINTER
	SYSPRM	.BFCTR,.BFCTR,2		;OFFSET TO BUFFER COUNTER
	BUFSIZ==23			;NUMBER OF WORDS IN TTY BUFFERS
	BUFFUL==BUFSIZ*5-1		;MAX CHARS IN TTY BUFFER	
SUBTTL	Module Storage

	EXT	IIB			;PERSONAL IB FOR LIBRARY

	$DATA	KBDBEG,0		;START OF ZEROABLE $DATA SPACE
	$DATA	TTYFLG			;FLAGS FROM INITIALIZATION BLOCK
	$DATA	BATFLG			;-1 IF RUNNING UNDER BATCH
	$GDATA	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	TRMTY			;TERMINAL TYPE
	$GDATA	CHNJFN			;CHANNEL OR JFN OF OPEN TERMINAL
	$DATA	BUFIN,3			;INPUT BUFFER CONTROL BLOCK
	$DATA	BUFOUT,3		;OUTPUT BUFFER CONTROL BLOCK
	$DATA	BGLINE			;POINTER TO BEGINNING OF CURRENT LINE
	$DATA	BGBUFR			;MY POINTER TO BEGINNING OF BUFFER
	$DATA	LSTCHR			;LAST CHARACTER RETURNED BY K%BIN
	$DATA	BAKCHR			;-1 IF USER CALL K%BACK
	$DATA	TSTACK			;TEXT STACK POINTER
	$DATA	KBDEND,0		;END OF ZEROABLE $DATA SPACE
TOPS10<
	$DATA	INTCHR			;Interim character that is read in.
					;  -1 indicates no character yet.
> ; End of TOPS10
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:	Arguments set up in our personal IIB
;
;TRUE RETURN:	No arguments are returned

K%INIT:	MOVE	S1,[KBDBEG,,KBDBEG+1]	;BLT PTR TO ZEROABLE $DATA SPACE
	SETZM	KBDBEG			;KILL THE FIRST LOCATION
	BLT	S1,KBDEND-1		;AND FIRE AWAY AT THE REST
	LOAD	S1,IIB+IB.FLG		;GET TTY FLAG WORD
	MOVEM	S1,TTYFLG		;BY CALLING PROGRAM
	SETOM	CHNJFN			;NO JFN OR CHANNEL YET
	TXNE	S1,IT.OCT		;WANT CONTROLLING TTY OPENED?
	JRST	[SETZ	S1,		;NO FUNNY STUFF
		 $CALL	K%OPEN		;GO OPEN THE TTY
		 JRST	KINI.3]		;AND CONTINUE WITH REST OF K%INIT
KINI.3:	PUSHJ	P,MAKBUF		;Make buffers always on the -20
	$RETT
SUBTTL	K%OPEN  --  Open the terminal

;Call:
;	S1/ Flags
;		Flags:  1B0 - Open terminal in image mode (default is Ascii)
;			1B1 - Open controlling terminal.   Default is
;				to open TTY:.
;			1B2 - Do non-blocking I/O (TOPS-10 only)
;				(currently, there is only support for
;				 non-blocking output, and only with K%FLSH).
;Return:
;	S2/ JFN or Channel Number of terminal
;
;	JFN or Channel Number is also placed in CHNJFN.
;	UDX or device designator of open terminal is placed in TRMUDX.
;
K%OPEN:	TXNE	S1,1B1+1B2		;Always open terminal as TTY:
	$RETF				;Non-blocking I/O not supported
	$SAVE	<T1,T2,T3,T4,P1>        ;Save for later use
	PUSH	P,S1			;Save caller's flags
	PUSHJ	P,DWBUFF		;DEAL WITH THE BUFFER
	POP	P,T1			;Restore flags
	HRROI	S2,[ASCIZ/TTY:/]	;ESTABLISH POINTER TO DEVICE NAME
	MOVX	S1,GJ%SHT		;SHORT FORM FOR GTJFN
	GTJFN				
          $STOP(CGT,Cannot GTJFN terminal) 
	MOVX	S2,OF%RD+OF%WR		;READ AND WRITE
	OPENF				
	  $STOP(COT,Cannot OPENF terminal)
	MOVEM	S1,CHNJFN		;SAVE OUR OPEN JFN
	RFMOD				;GET THE MODE
	SETZ	T2,			;CODE FOR IMAGE MODE
	TXNN	T1,1B0			;DO WE WANT IMAGE MODE
	ADDI	T2,1			;MAKE INTO CODE FOR ASCII MODE
	LDB	T3,[POINTR(S2,TT%DAM)]  ;GET CURRENT MODE IN T3
	CAIN	T2,(T3)			;IS OUR MODE WHAT WE WANT
	JRST	[MOVE S2,CHNJFN		;YES, GET THE JFN IN S2
		 $RETT]			;AND RETURN
	DPB	T2,[POINTR(S2,TT%DAM)]	;PUT OUR DESIRED MODE IN
	TXO	T2,TT%IGN		;IGNORE BREAKSET
	SFMOD				;SET THE MODE
	MOVE	S2,CHNJFN		;GET THE CHANNEL
	$RETT				;AND RETURN

SUBTTL	MAKBUF  --  Create buffers when monitor does not

MAKBUF:	$SAVE	<T1,T2,T3>		;GET REGISTERS
	MOVE	T1,S1			;PROTECT S1
	MOVEI	S1,BUFSIZ		;THIS IS THE SIZE OF BUFFER (WORDS)
	$CALL	M%GMEM			;GET A BUFFER
	MOVEM	S2,BUFIN		;ADDRESS OF BUFFER
	HRLI	S2,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEM	S2,BUFIN+.BFPTR		;AND PUT IT IN INPUT BCB
	SETZM	BUFIN+.BFCTR		;NO CHARS YET
	$CALL	M%GMEM			;NOW GET OUTPUT BUFFER
	MOVEM	S2,BUFOUT		;ADDRESS OF OUTPUT BUFFER
	HRLI	S2,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEM	S2,BUFOUT+.BFPTR	;PUT IT OUTPUT BCB
	MOVEI	S2,BUFFUL		;THIS IS HOW MANY CHARS WILL FIT
	MOVEM	S2,BUFOUT+.BFCTR	;LET IT GO TO THE BUFFER
	$RET
SUBTTL	DWBUFF  --  Deal with the buffer

;Call: No arguments
;Effect:  On TOPS-20, it flushes and deletes the buffers.
;	  On TOPS-10, it flushes the buffer and deletes it only if
;	  it was created by MAKBUF.

DWBUFF:	SKIPE	BUFOUT			;DOES AN OUTPUT BUFFER EXIST?
	$CALL	K%FLSH			;YES, FLUSH IT

TOPS10	<
	SKIPL	CHNJFN			;CONTINUE ONLY IF TTY NEVER OPENED
	$RET				;ELSE LEAVE BUFFERS BE
	> ; END TOPS 10 CONDITIONAL

	$SAVE	<T1,T2>			;SO WE DON'T CLOBBER REGS
	DMOVE	T1,S1			;SAVE REGS
	MOVEI	S1,BUFSIZ		;SIZE OF BUFFER
	MOVE	S2,BUFOUT		;ADDRESS OF OUTPUT BUFFER
	SKIPE	BUFOUT			;DON'T M%RMEM IF THERE IS NO BUFFER
	$CALL	M%RMEM			;GIVE BUFFER BACK TO FREE SPACE
	SETZM	BUFOUT			;NO OUTPUT BUFFER
	SETZM	BUFOUT+.BFPTR		;NO OUTPUT BUFFER POINTER
	SETZM	BUFOUT+.BFCTR		;NO OUTPUT BUFFER COUNTER
	MOVEI	S1,BUFSIZ		;SIZE OF BUFFER
	MOVE	S2,BUFIN		;ADDRESS OF INPUT BUFFER
	SKIPE	BUFIN			;DON'T M%RMEM IF THERE IS NO BUFFER
	$CALL	M%RMEM			;GIVE BACK TO FREE POOL
	SETZM	BUFIN			;NO INPUT BUFFER
	SETZM	BUFIN+.BFPTR		;NO INPUT BUFFER POINTER
	SETZM	BUFIN+.BFCTR		;NO INPUT BUFFER COUNTER
	DMOVE	S1,T1			;RESTORE REGS
	$RET
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

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


TOPS20 <
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 TOPS20 CONDITIONAL
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

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

TOPS20 <
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 TOPS20 CONDITIONAL
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

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

SUET.1:	MOVX	S1,.CHESC		;LOAD AN ESCAPE
	PUSHJ	P,K%BOUT		;AND TYPE IT
	MOVEI	S1,"="			;THIS SETS THE MODE
	SKIPN	UESCTB			;PROGRAM IS CLEARING IT
	MOVEI	S1,76			;CLEAR IT
	PUSHJ	P,K%BOUT		;PUT OUT THE CHARACTER
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
K%SUET:	HALT .				;NOT IMPLEMENT
>  ;END TOPS20 CONDITIONAL
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


TOPS20 <
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 TOPS20 CONDITIONAL

TOPS10 <
K%STYP:	PUSHJ	P,.SAVE4		;SAVE SOME PERM ACS
	MOVE	P1,S1			;AND COPY INPUT ARGUMENT
	MOVSI	S1,-<.TIMAX+1>		;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

	MOVX	P2,.TOTRM+.TOSET	;CODE TO SET TERMINAL TYPE
	MOVE	P3,TRMUDX		;ON OUR UNIVERSAL DEVICE INDEX (TTY)
	MOVE	P4,TSTAB(S1)		;GET SIXBIT TTY NAME
	MOVE	S2,[XWD 3,P2]		;LENGTH, ADR OF ARG BLOCK
	TRMOP.	S2,			;TELL THE MONITOR
	$RETF				;CAN'T... TELL CALLER

;Enter here with table index in S1 to just set our internal tables
;Can't use anything put the scratch acs in here.
STYP.3:	HLRZ	S2,TTTAB(S1)		;GET BACK TERMINAL TYPE CODE
	MOVEM	S2,TRMTY		;SAVE TYPE CODE FOR LATER
	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
	SKIPN	S2			;ANY SETUP NEEDED?
	$RETT				;NONE NEEDED, ALL DONE HERE
	PJRST	0(S2)			;SET TERMINAL SPECIFIC STUFF


;TABLES ARE ON THE FOLLOWING PAGE
;
;STILL IN TOPS10 CONDITIONAL
;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

;DEFINE THE EXPANDER MACRO
DEFINE X(PARNAM,SIXNAM,SUF,EOLSEQ),<
IFNB <EOLSEQ>,<	$SET	(.TI'SUF,,<.TT'SUF,,[[BYTE (7)'EOLSEQ']]>)>
IFB  <EOLSEQ>,<	$SET	(.TI'SUF,,<.TT'SUF,,0>)>
>

TTTAB:	$BUILD	(.TIMAX+1)
	TRMTYP
	$EOB

;	.TT33,,0			;MODEL 33 TTY
;	.TT35,,0			;MODEL 35 TTY
;	.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

;BUILD A TABLE OF SIXBIT NAMES TO MATCH AGAINST THE TRMOP. RETURNED CODES

DEFINE X(PARNAM,SIXNAM,SUF,EOLSEQ),<
	$SET	(.TI'SUF,,<SIXBIT/SIXNAM/>)
>;END DEFINE X

TSTAB:	$BUILD	(.TIMAX+1)
	TRMTYP
	$EOB


;FORMAT OF TABLE IS 0,,ADR OF SETUP ROUTINE
;	OR 0,,0 TO ALWAYS RETURN TRUE
;	***MUST BE PARALLEL TO TTTAB***

TTSET:	$BUILD	(.TIMAX+1)
	$SET	(.TIV50,,SETVT5)
	$SET	(.TIV52,,SETVT5)
TOPS10<	$SET	(.TTV61,,SETVT5)>
	$EOB

;	EXP	.RETT			;MODEL 33 TTY
;	EXP	.RETT			;MODEL 35 TTY
;	EXP	.RETT			;VT05
;	EXP	SETVT5			;VT50
;	EXP	.RETT			;LA30
;	EXP	.RETT			;LA36
;	EXP	SETVT5			;VT52
;	EXP	SETVT5			;PATCH SPACE


;TERMINAL SETUP ROUTINES
SETVT5:	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 TOPS10 CONDITIONAL
SUBTTL	K%BOUT  --  Type one character on TTY

;Call:		S1/  character, right justified
;
;True Return:	always

TOPS10 <
K%BOUT:	OUTCHR	S1			;TYPE THE CHARACTER
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL


TOPS20 <
K%BOUT:	PBOUT				;TYPE THE CHARACTER
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL




SUBTTL	K%SOUT  --  Type an ASCIZ string on TTY

;Call:		S1/ address of string (word-aligned)
;
;True Return:	always

TOPS10 <
K%SOUT:	OUTSTR	0(S1)			;TYPE THE STRING
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
K%SOUT:	PSOUT				;TYPE THE STRING
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL
SUBTTL	K%BUFF  -  Buffer a byte or a string

;Call:
;	S1/ Character right justified
;		or
;	S1/ Byte pointer to ASCIZ string
;	S2/ 0
;		or
;	S1/ Byte pointer to ASCII string
;	S2/ Count of bytes to buffer
;True Return:
;	Always
K%BUFF:	$SAVE	<T1>
	TXNN	S1,LHMASK		;IS IT A CHARACTER OR A BP
	PJRST	BBUFF			;IT IS A CHARACTER

SBUFF:	TXC	S1,LHMASK		;DO WE HAVE A TOPS 20 STYLE BP
	TXCN	S1,LHMASK
	HRLI	S1,(POINT 7,)		;MAKE IT A REAL LIVE BP
	MOVE	T1,S1			;FREE S1 TO TAKE CHARACTERS
SBUFF1:	ILDB	S1,T1			;GET A BYTE
	CAIN	S2,0			;ARE WE COUNTING OR ASCIZ?
	JRST	[CAIN	S1,0		;ASCIZ - HAVE WE FOUND NULL BYTE?
		 $RETT			;YES, WE'RE DONE
		 PUSHJ	P,BBUFF		;NO, BUFFER THE BYTE WE HAVE
		 JRST	SBUFF1]		;AND GO FOR THE NEXT BYTE
	CAIN	S2,1			;COUNTING - WILL THIS BYTE BE THE LAST
	PJRST	BBUFF			;YES, BUFFER IT AND RETURN
	PUSHJ	P,BBUFF			;NO, BUFFER IT
	SOJA	S2,SBUFF1		;DECREMENT COUNT AND GET NEXT BYTE

BBUFF:	SOSGE	BUFOUT+.BFCTR		;ROOM IN OUTPUT BUFFER?
	JRST	[$CALL	K%FLSH		;NO, FLUSH BUFFER
		 JRST	BBUFF]		;AND TRY AGAIN
	IDPB	S1,BUFOUT+.BFPTR	;STICK IT IN OUTPUT BUFFER
	$RETT				;AND RETURN
SUBTTL	K%FLSH  -  Flush the output buffer

;Call:
;	No arguments

K%FLSH:	$SAVE	<T1,T2,T3,T4>
TOPS10	<
	SKIPL	CHNJFN			;IS THE TTY OPEN
	PJRST	[MOVX	T1,.FOOUT	;YES IT IS, WE'RE DOING OUTPUT
		 HRL	T1,CHNJFN	;GET THE CHANNEL
		 SETZ	T2,		;MONITOR KNOWS ABOUT BUFFERS
		 MOVX	T3,<2,,T1>	;FILOP. ARGUMENT POINTER
		 FILOP.	T3,		;WE DO IT
		   $STOP(TFF,FILOP. OUT failed to terminal)
		 $RETT]			;WE WON
	> ; END TOPS 10 CONDITIONAL

; Here for
; a. TOPS-20
; b. TOPS-10 and no TTY open
LIK20:
TOPS10	<
	SETZ	T1,			;TTY NOT OPEN, WE WILL OUTPUT
	IDPB	T1,BUFOUT+.BFPTR	;WE LEFT ROOM FOR TRAILING NULL
	MOVE	T2,BUFOUT		;GET ADDRESS OF OUTSTR
	OUTSTR	(T2)			;SEND IT
	PJRST	RESOUT			;RESTORE BUFFER
	> ; END TOPS 10 CONDITIONAL
TOPS20	<
	SKIPL	CHNJFN			;IS THE TTY OPEN
	PJRST	[DMOVE	T3,S1		;SAVE THE AC'S
		 MOVE	S1,CHNJFN	;TTY OPEN, WE WILL SOUT
		 MOVEI	T1,BUFFUL	;MAXIMUM NUMBER OF CHARACTERS TO SEND
		 SUB	T1,BUFOUT+.BFCTR ;LESS BYTES THAT REMAIN
		 CAILE	T1,BUFFUL	;BUT WE MUST NOT BE GREATER THAN BUFFUL
		 MOVEI	T1,BUFFUL	;SO WE ENFORCE THIS
		 MOVNI	T1,0(T1)	;IT MUST BE NEGATIVE
		 HRRO	S2,BUFOUT	;"BYTE POINTER" TO BUFFER
		 SOUT			;HERE GOES
		 DMOVE	S1,T3		;RESTORE AC'S
		 PJRST	RESOUT]		;FIX UP BUFFERS
	MOVE	T3,S1			;SAVE S1
	SETZ	S1,			;TTY NOT OPEN WE WILL PSOUT
	IDPB	S1,BUFOUT+.BFPTR	;WE LEFT ROOM FOR IT
	HRRO	S1,BUFOUT		;"BYTE POINTER" TO BUFFER
	PSOUT				;WELL PSOUT ON YOU
	MOVE	S1,T3			;RESTORE S1
	> ; END TOPS 20 CONDITIONAL

RESOUT:	MOVE	T1,BUFOUT		;GET ADDRESS OF BUFFER
	HRLI	T1,(POINT 7,)		;MAKE INTO BYTE POINTER
	MOVEM	T1,BUFOUT+.BFPTR	;PUT THEM TOGETHER
	MOVEI	T1,BUFFUL		;MAX CHARS THAT FIT IN BUFFER
	MOVEM	T1,BUFOUT+.BFCTR	;STICK IT IN BCB
	$RETT				;AND WIN
SUBTTL	K%BIN   --  Accept a character from TTY

;Call:		No arguments
;
;True Return:	S1/  one character right justified

K%BIN:	SKIPN	BAKCHR			;HAVE WE BEEN BACKED UP?
	JRST	BIN.1			;NO, GET A CHARACTER
	SETZM	BAKCHR			;YES, CLEAR THE FLAG
	MOVE	S1,LSTCHR		;GET THE LAST CHARACTER
	$RETT				;AND RETURN

TOPS10 <
BIN.1:	SKPINC				;CHECK FOR CHARACTER
	SKIPF	BATFLG			;[45] NONE..SLEEP IF NOT BATCH
	JRST	BIN.2			;ELSE GET THE CHARACTER
	MOVX	S1,HB.RTC		;SLEEP FOR CHARACTER
	$CALL	I%SLP			;Sleep till character input
	JRST	BIN.1			;TRY AGAIN
BIN.2:	SKIPGE	INTCHR			;Do we have a character yet?
	INCHRW	INTCHR			;No, go get one
	MOVE	S1,INTCHR		;Get the character
	MOVEM	S1,LSTCHR		;Remember it
	SETOM	INTCHR			;Will need another character
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
BIN.1:	PBIN				;GET A CHARACTER
	MOVEM	S1,LSTCHR		;PUT IN LOCATION FOR BACKSPACE
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL


SUBTTL	K%BACK  --  Back up terminal input by one character

;K%BACK is called to cause the next call to read a character from the
;	terminal to re-read the last character read from the terminal.
;	If K%BACK is called, it cannot be called again until K%BIN
;	has been called at least once.

;Call:		No arguments
;
;True Return:	Always

K%BACK:	SKIPE	BAKCHR			;CALLED TWICE ALREADY?
	$STOP(BTT,Backing up terminal twice)
	SKIPE	LSTCHR			;SKIP IF AT BEGINNING OF BUFFER
	SETOM	BAKCHR			;ELSE, BACK UP
	$RETT				;AND RETURN
SUBTTL	K%TPOS  --  GET THE HORIZONTAL TERMINAL POSITION

;K%TPOS IS CALLED TO DETERMINE THE POSITION OF THE CURSOR 
;
;CALL:		NO ARGUMENTS
;
;TRUE RETURN:	ALWAYS	S1/	HORIZONTAL POSITION


TOPS10 <
K%TPOS:	PUSHJ	P,.SAVE1		;SAVE AN AC
	MOVE	S2,TRMUDX		;Get the TTY UDX

TPOS.1:	MOVEI	S1,.TOSOP		;Skip if output buffer empty
	HRLI	P1,2			;Number of args
	HRRI	P1,S1			;Address of args
	TRMOP.	P1,			;See if still typing
	 JRST	TPOS.2			;Output done..get position
	MOVEI	S1,0			;Set 0 sleep time
	SLEEP	S1,			;ZZZZZZ
	JRST	TPOS.1			;Try again

TPOS.2:	MOVEI	S1,.TOHPS		;TRMOP FUNCTION FOR POSITION
	HRLI	P1,2			;NUMBER OF ARGUMENTS
	HRRI	P1,S1			;ADDRESS OF ARGUMENTS
	TRMOP.	P1,			;DO THE TRMOP
	  $RETF				;RETURN FALSE
	MOVE	S1,P1			;PLACE VALUE IN S1
	$RETT				;RETURN..TRUE
>;END TOPS10 CONDITIONAL

TOPS20 <
K%TPOS:	MOVX	S1,.CTTRM		;CONTROLLING TERMINAL
	RFPOS				;GET THE POSITION
	ERJMP	.RETF			;ERROR..RETURN FALSE
	HRRZ	S1,S2			;RETURN HORIZONTAL POSITION
	$RETT
>;END TOPS20 CONDITIONAL
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

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

TOPS10 <
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
	MOVEM	P,TSTACK		;SAVE THE STACK
	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
	$RETT

;STILL IN TOPS10 CONDITIONAL 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:	SETZ	S1,			;CLEAR FLAGS IN CASE WE RETURN
	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+.RDIOJ	;[41] 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,K%BIN			;NO, GET A CHARACTER
	MOVE	C,S1			;PUT THE CHARACTER IN C
	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,K%BIN			;GET THE NEXT CHARACTER
	MOVE	C,S1			;PUT THE CHARACTER IN C
	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,[MOVX S1,.CHBEL	;LOAD A BELL
		    PUSHJ P,TXTOUT	;TYPE IT
		    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
	MOVX	S1,.CHBSL		;LOAD A BACKSLASH
	AOSN	RUBFLG			;CLEAR RUBFLG, WAS IT UP?
	PUSHJ	P,TXTOUT		;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,TXTINP		;DO THE TEXT INPUT
	JUMPF [	PUSH	P,S1			;Save error code
		PUSHJ	P,FINTXT		;Update user's arg block
		POP	P,S1			;Restore error code
		$RETF]				;Give failure return
	SKIPN	C,S2			;NULL?
	JRST	TXTL.4			;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			;SPECAIL CHARACTER?
	JRST	TXTL.2			;NO, HANDLE NORMALLY
	SUBI	C,200			;MAKE SOMETHING OF IT
	MOVE	S1,C			;PUT THE CHARACTER IN S1
	PUSHJ	P,TXTOUT		;TYPE IT
	JRST	TXTL.5			;AND LOOP
	SUBTTL	TXTINP	--	INPUT ROUTINE FOR NON TERMINAL INPUT


TXTINP:	CAXN	S1,.NULIO		;NULL INPUT
	  $RETE(EOF)			;GENERATE EOF ERROR
	PUSHJ	P,F%IBYT		;GET NEXT CHARACTER FROM FILE
	JUMPT	.POPJ			;O.K.  RETURN
	CAXN	S1,EREOF$		;EOF?
	$RETF				;YES..RETURN FALSE
	$STOP(FSE,File System Error)


	SUBTTL	TXTOUT	--	CHARACTER OUTPUT FOR TERMINALS AND FILES

	;THIS ROUTINE WILL DUMP A CHARACTER TO THE TERMINAL OR A FILE
	;DEPENDING ON THE JFN IN THE TEXTI ARGUMENT BLOCK

TXTOUT:	HRRZ	S2,RD+.RDIOJ		;GET OUTPUT JFN
	CAXN	S2,.NULIO		;NULL?
	  $RETT				;JUST IGNORE IT
	CAXN	S2,.PRIOU		;PRIMARY OUTPUT TERMINAL?
	  PJRST	K%BOUT			;OUTPUT IT
	MOVE	S2,S1			;GET THE CHARACTER
	HRRZ	S1,RD+.RDIOJ		;GET THE OUTPUT JFN
	PUSHJ	P,F%OBYT		;DUMP THE CHARACTER
	JUMPT	.POPJ			;O.K.. RETURN
	MOVE	P,TSTACK		;RESTORE THE STACK
	$RETF				;RETURN FALSE

	SUBTTL	STROUT	--	STRING OUTPUT TO FILE AND TERMINAL

	;This routine will check the output JFN and pass the data to
	;the file, terminal or null

STROUT:	HRRZ	S2,RD+.RDIOJ		;GET OUTPUT JFN
	CAXN	S2,.NULIO		;NULL?
	  $RETT				;JUST RETURN
	CAXN	S2,.PRIOU		;PRIMARY OUTPUT?
	  PJRST	K%SOUT			;YES.. DUMP THE STRING
	MOVE	T1,S1			;GET THE STRING POINTER
STRO.1:	ILDB	S1,T1			;GET A BYTE
	JUMPE	S1,.RETT		;RETURN TRUE
	PUSHJ	P,TXTOUT		;DUMP THE CHARACTER
	JRST 	STRO.1			;GET NEXT ONE
SUBTTL	Utilities for text handling
SUBTTL	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

SUBTTL	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
	LDB	S2,S1			;GET PRECEEDING CHARACTER
	CAIE	S2,.CHCRT		;IS IT A <CR>?
	JRST	USTO.2			;NO..JUST RETURN
	MOVE	S2,S1			;GET THE POINTER
	ILDB	S2,S2			;GET DELETED CHARACTER
	CAIE	S2,.CHLFD		;DID WE HAVE <CRLF>
	JRST	USTO.2			;NO..JUST RETURN
	SOS	S1			;YES..DELETE THE <CR>
	MOVEI	S2,4
	IBP	S1
	SOJG	S2,.-1
	AOS	RD+.RDDBC		;ONE MORE BYTE AVAILABLE
USTO.2:	PUSHJ	P,MAKBP			;CONVERT IT
	MOVEM	S1,RD+.RDDBP		;RE-STORE THE POINTER
	AOS	RD+.RDDBC		;ONE MORE BYTE AVAILABLE
	$RETT
SUBTTL	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


SUBTTL	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
SUBTTL	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




SUBTTL	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



SUBTTL	CLINE   --  Clear current video line

CLINE:	MOVX	S1,.CHCRT		;LOAD A CARRAIGE RETURN
	PUSHJ	P,TXTOUT		;TYPE IT
	HRRZ	S1,@TRMPTR		;GET CONTROL CODE FOR ERASE
	MOVEI	S1,@.TCEOL(S1)		; TO END OF LINE
	PUSHJ	P,STROUT		;TYPE IT
	$RETT				;AND RETURN


SUBTTL	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
SUBTTL	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,"^"			;LOAD AN UP-ARROW
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVEI	S1,100(C)		;GET PRINTABLE FORM OF CHARACTER
	PUSHJ	P,TXTOUT		;AND PRINT IT
	$RETT				;AND RETURN

; SEND ACTUAL CODE FOR THIS CHARACTER (TRUE ECHO)

ECHO.2:	MOVE	S1,C			;PUT THE CHARACTER IN S1
	PJRST	TXTOUT			;TYPE IT 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
	MOVEI	S1,"$"			;LOAD A DOLLAR SIGN
	PJRST	TXTOUT			;TYPE IT AND RETURN
SUBTTL	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) .CHBEL,.CHLFD,.CHVTB,.CHFFD,.CHCNZ,.CHESC,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,
	JUMPN	S2,.RETF		;IF A SUPPRESS ^U, RETURN FALSE
	$RETT				;RETURN TRUE


SCTBL:	.CHDEL,,CCDEL			;DELETE (177)
	$C(H),,CCDEL			;^H
	$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:	PUSHJ	P,FNDLIN		;RESET BEGINNING OF LINE
CDX:	SETZM	RUBFLG			;CLEAR RUBOUT FLAG
	MOVE	T3,BGLINE		;COMPARE PTR'S
	MOVE	T4,RD+.RDDBP
	PUSHJ	P,CMPPTR		;ARE WE AT BEGINNING OF LINE?
	JRST	CCU.1			;YES, SO WE ARE AT FRONT
	PUSHJ	P,USTOC			;UNSTORE 1 CHARACTER
	JRST	CDX			;TRY AGAIN

CCU.1:	HRRZ	S1,@TRMPTR		;GET CONTROL CODE PART
	JUMPN	S1,CCU.2		;IF VIDEO, HANDLE IT THAT WAY
	MOVEI	S1,[BYTE(7).CHCRT,.CHLFD] ;GIVE A NEW LINE
	PUSHJ	P,STROUT		;TYPE IT
	JRST	CCU.3			;AND CONTINUE

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

CCU.3:	MOVE	T3,BGLINE		;COMPARE PTR'S
	MOVE	T4,BGBUFR		;..
	PUSHJ	P,CMPPTR		;SAME?
	JRST	CCU.4			;YES, WE'RE AT THE TOP OF BUFFER
	JRST	TXTL
CCU.4:	SKIPE	T1,RD+.RDRTY		;IF THERE'S ANY PROMPT TEXT
	PUSHJ	P,TYPEBP		;TYPE IT
	LOAD	S2,RD+.RDFLG,RD%RND	;RETURN ON EMPTY BIT
	MOVX	S1,RD%BFE		;RETURN BIT
	JUMPN	S2,FINTXT		;FINISH UP IF HE WANTS RETURN
	JRST	TXTL			;GO BACK FOR MORE INPUT
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
	JRST	CCR.2			;AND DON'T GO TO NEXT ONE
CCR.1:	MOVEI	S1,[BYTE(7).CHCRT,.CHLFD] ;GET TO NEXT LINE
	PUSHJ	P,STROUT		;TYPE IT

CCR.2:	PUSH	P,T1			;SAVE T1
	PUSHJ	P,FNDLIN		;RESET BEGINNING OF LINE
	MOVE	T3,BGLINE		;COMPARE PTR'S
	MOVE	T4,BGBUFR		;..
	PUSHJ	P,CMPPTR		;SAME?
	JRST	[SKIPE T1,RD+.RDRTY     ;YUP, PROMPT TEXT AVAILABLE?
		PUSHJ	P,TYPEBP	;YES, TYPE IT
		JRST	.+1]
	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	FNDLIN  --  Find beginning of current line

FNDLIN:	MOVE	T3,BGBUFR	;GET PTR TO BEGIN OF BUFFER
	MOVE	T4,RD+.RDDBP	;GET CURRENT PTR
	PUSHJ	P,CMPPTR	;AND COMPARE
	JRST	FNDL.2		;THEY'RE THE SAME
	MOVE	T3,RD+.RDDBP	;GET CURRENT PTR IN T3
FNDL.1:	LDB	S1,T3		;AND GET THAT BYTE
	CAIN	S1,.CHLFD		;LINEFEED?
	JRST	FNDL.2		;YUP
	PUSHJ	P,DECBP		;NO, BACK PTR UP
	MOVE	T4,BGBUFR	;GET PTR TO BEGIN OF BUFFER
	PUSHJ	P,CMPPTR	;COMPARE BP'S
	JRST	FNDL.2		;POINTERS ARE EQUAL
	JRST	FNDL.1		;POINTERS ARE NOT EQUAL
FNDL.2:	MOVEM	T3,BGLINE	;SAVE AS BEGINNING OF LINE
	$RETT			;RETURN TRUE

;ROUTINE TO DECREMENT ASCII BYTE POINTER IN T3
DECBP:	LDB	T2,[POINT 6,T3,5] ;GET POSITION
	ADDI	T2,7		;INDICATE PREVIOUS BYTE
DECB.1:	DPB	T2,[POINT 6,T3,5] ;AND STORE IT
	CAIG	T2,^D35		;IMPOSSIBLE POSITION?
	POPJ	P,0		;NO, RIGHT ON
	SUBI	T3,1		;MAKE SO LDB GETS PREVIOUS BYTE
	MOVEI	T2,1		;..
	JRST	DECB.1		;STORE CORRECT POSITION

;ROUTINE TO COMPARE ASCII BP'S ALLOWING FOR NORMALIZATION.
;BP'S ARE IN T3/T4 AND ROUTINE SKIP RETURNS IF BP'S NOT EQUAL

CMPPTR:	PUSH	P,T3		;SAVE ARGUMENT REGISTERS
	PUSH	P,T4		;..
	IBP	T4		;INCREMENT AND NORMALIZE
	IBP	T3		;..
	CAME	T3,T4		;GOTTA MATCH?
	AOS	-2(P)		;NO, SETUP FOR SKIP RETURN ON POPJ
	POP	P,T4		;RESTORE ORIGINAL ARGUMENTS
	POP	P,T3		;..
	POPJ	P,0		;RETURN AS INDICATED
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
	MOVE	TF,C			;SAVE ^H OR <RUBOUT>
	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
	CAIN	TF,$C(H)		;WAS IT ^H
	JRST	CCDL.0			;YES

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

CCDL.0:	MOVEI	S1,$C(H)		;GET ^H
	PUSHJ	P,TXTOUT		;ECHO IT
	JRST	TXTL			;RETURN FOR NEXT CHARACTER

CCDL.1:	CAIGE	C," "			;WAS DELETED CHARACTER PRINTING?
	JRST	CCDL.2			;NO, NEED FURTHER ANALYSIS
	MOVEI	S1,[BYTE (7)10,40,10]	;OUTPUT BACKSPACE,SPACE,BACKSPACE
	PUSHJ	P,STROUT		;TYPE IT
	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
	MOVEI	S1,[BYTE (7)10,10,40,40,10,10]	;OUTPUT BACK,BACK,SPACE,SPACE,BACK,BACK
	PUSHJ	P,STROUT		;TYPE IT
	JRST	TXTL			;THEN GET NEXT INPUT
SUBTTL	CCW     --  Handle ^W (Delete back to punctuation character)


CCW:	PUSHJ	P,FNDLIN		;RESET BEGINNING OF LINE PTR
	SETZM	RUBFLG			;CLEAR RUBOUT FLAG
	MOVE	T3,RD+.RDDBP		;SEE IF WE'RE AT TOP OF BUFFER
	MOVE	T4,BGBUFR		;..
	PUSHJ	P,CMPPTR		;AT TOP OF BUFFER?
	JRST	BEGBUF			;YUP, SPECIAL HANDLE

CCW.1:	PUSHJ	P,USTOC			;UN-STORE ONE CHARACTER
	MOVE	T3,RD+.RDDBP		;SEE IF WE'RE AT
	MOVE	T4,BGLINE		; THE BEGINNING OF A LINE
	PUSHJ	P,CMPPTR		;ARE WE?
	JRST	CCW.3			;YES, THAT'S 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
	MOVX	S1,.CHBEL		;LOAD A "BELL"
	PUSHJ	P,TXTOUT		;AND SEND IT
	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
	CAIE	S1,(POINT 7,0)		;WORD ALIGNED?
	JRST	STRO.1			;NO.. DUMP THE STRING BY CHARACTER
TYPE.2:	MOVE	S1,T1			;PUT ADDRESS IN S1
	PUSHJ	P,STROUT		;AND TYPE THE STRING
	$RETT				;AND RETURN


>  ;END TOPS10 CONDITIONAL FROM K%TXTI
KBD%L:			;LABEL THE LITERAL POOL

	END