Google
 

Trailing-Edge - PDP-10 Archives - BB-F493Z-DD_1986 - 10,7/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	AUTHOR: Irwin Goverman/ILG/LSS/MLB/WLH/DC/NT/LWS 18-Feb-84

;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986
;                    DIGITAL EQUIPMENT CORPORATION
;			 ALL RIGHTS RESERVED.
;
;     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...

		KBDEDT==101		;VERSION OF MODULE

;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. 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%BOUT  --  Type one character on TTY.....................  13
;   11. K%SOUT  --  Type an ASCIZ string on TTY...................  13
;   12. K%BIN   --  Accept a character from TTY...................  14
;   13. K%BACK  --  Back up terminal input by one character.......  14
;   14. K%TPOS  --  GET THE HORIZONTAL TERMINAL POSITION..........  15
;   15. K%TXTI  --  Handle Terminal Input.........................  16
;   16. TXTL    --  Loop for inputting text.......................  18
;   17. TXTINP  --      INPUT ROUTINE FOR NON TERMINAL INPUT......  20
;   18. TXTOUT  --      CHARACTER OUTPUT FOR TERMINALS AND FILES..  20
;   19. STROUT  --      STRING OUTPUT TO FILE AND TERMINAL........  20
;   20. Utilities for text handling...............................  21
;   21. STOC    --  Store an input character......................  21
;   22. USTOC   --  Unstore a character...........................  21
;   23. CONVRT  --  Do case conversion as necessary...............  22
;   24. CONVBP  --  Convert default byte pointers.................  22
;   25. MAKBP   --  Un-default a byte pointer.....................  23
;   26. IMGSTR  --  Output a string as it was echoed..............  23
;   27. CLINE   --  Clear current video line......................  23
;   28. GETCOC  --  Fetch COC for a given character...............  23
;   29. ECHO    --  HANDLE CHARACTER ECHOING......................  24
;   30. CBRK    --  Check to see if character is a break..........  25
;   31. SPCHK   --  Check for special characters..................  26
;   32. CCU     --  Handle ^U (Rubout entire line)................  27
;   33. CCR     --  Handle ^R (Re-type the line)..................  28
;   34. FNDLIN  --  Find beginning of current line................  29
;   35. CCDEL   --  Handle Rubout (Delete one character)..........  30
;   36. CCW     --  Handle ^W (Delete back to punctuation character)  31
;   37. BEGBUF  --  Handle rubouts to beginning of buffer.........  32
;   38. TYPEBP  --  Type a string according to a byte-pointer.....  32
;   28. SPCHK   --  Check for special characters..................  25
;   29. CCU     --  Handle ^U (Rubout entire line)................  26
;   30. CCR     --  Handle ^R (Re-type the line)..................  27
;   31. FNDLIN  --  Find beginning of current line................  28
;   32. CCDEL   --  Handle Rubout (Delete one character)..........  29
;   33. CCW     --  Handle ^W (Delete back to punctuation character)  30
;   34. BEGBUF  --  Handle rubouts to beginning of buffer.........  31
;   35. TYPEBP  --  Type a string according to a byte-pointer.....  31
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).
0006	015	1. The interrupt races supposedly solved in edit 2 actually
		   weren't solved, take the code out.
		2.  If backup-limit is reached, flag word can get garbaged.
		3.  If user requests return on buffer empty, ^U re-prompts
		   before returning to user, it shouldn't.
0007	020	Add the following new entry points:
		K%BIN  --  Input one character from TTY
		K%BOUT --  Type one character on TTY
		K%SOUT --  Type a string on TTY
		K%BACK --  Back up over the last character read by K%BIN
0010	030	K%TPOS --  Get the Horizontal terminal position
		also fix K%BIN to sleep if no character
0011	031	MAKE EDITING CHARACTERS EMULATE THE 20 IMPLEMENTATION.
0012	045	Modify K%INIT for the -20 not to do K%WCOC
0013		Modify K%INIT to USE IIB instead of calling args
0014		Modify K%INIT to conform to new IB (IB.TTY went away)
0015		Remove PJUMPN in TOPS10 conditional (replace with JUMPN)
0016		Change SAVE to $SAVE
0017		TOPS10..  make use of new TRMTYP macro to build tables
		And, try to get terminal type from monitor and set it up.
0020		TOPS10.. Fix 0017.  Make RH of TTTAB 0 if not video terminal
0021		TOPS10.. Make K%STYP tell the monitor.
		Make K%INIT use extnded chan
0022		TOPS10.. Don't bother (re-)telling monitor of terminal type
		during K%INIT. This keeps us from setting page n as a
		side effect of reading tty type, and resetting it.
0023		Add -10 KEYPAD support for VT100
0024		Add Support for .NULIO and OUTPUT IFN for the -10
		on K%TXTI call.
0025		Add a check to K%BIN to skip HIBER if under batch
0026		Delete <CRLF> pairs when rubbout is seen
0027		If BATCH, do no reset keypad mode on initialization.
0030		Zero out our own $DATA space.
0031		Change K%INIT to open the TTY on the -20 if IB.OCT
		is lit.   Also save the channel or JFN of the TTY
		and the UDX or device designator in global storage.
		Add entries K%BUFF and K%FLSH for buffering output.
		Add K%OPEN routine.
0032		On TOPS10, make K%TPOS wait for all output to terminal
		to be finished before checking horizontal position.
0033		For edit 32, do not loop continuously, but wait half
		a second between TRMOP.'s.
0034		Change the meaning of BATFLG to mean any random PTY, not
		just a Batch job.
0035		If a ^H is typed (not as the first character in a line),
		haldle it like the TOPS-10 monitor does.
0036		Add VT61 support for TOPS-10.
0037		Repair edit 33 so it sleeps until output is finished
0040		Remove edit 25 which causes K%BIN to skip Hiber
		if we are a batch job.  This edit caused characters
		to be lost and IPCF interrupts to be postponed
		until a character was typed.
0041 QAR 10-4661 Fix K%TXTI to look for byte pointer in .RDIOJ
		if RD%JFN is not set in .RDFLG
0042		Always set terminal type in K%INIT to prevent
		nasty Illegal Memory Reference when no type is set.
0043		At TXTL.4, if EOF on input file, update user's
		arg block before returning.
0044		Fix bugs in TOPS20 K%OPEN routine
0045		Restore original code to cause ONLY batch
		jobs to go into character wait.
0046		Delete the code to reset the terminals keypad state in SETVT5
0047		Change K%BIN to use I%SLP instead of HIBER
0050		Fix clobberage of S1 at K%OPEN which caused terminal
		to always be opened in image mode on TOPS20.
0051		Make MIC files work. Check for MIC status and set the "batch"
		flag if a MIC controlled TTY.
0052		More of edit 51.
0053		Correct TOPS-10 break character set.
0054		Fix a bad byte pointer at MAKPTR+ a few.
0055		Make sure that K%INIT always calls MAKBUF on the -20.
		Also make sure that K%FLSH has correct character count
		when SOUT'ing.
0056		Add INTCHR and INCHRW the next character into it @BIN.2 to
		prevent losing characters due to interrupt.
0057		Make K%SUET use new format of TRMTYP macro so it can handle
		setting of keypad mode on all terminals. 24-Oct-83/NT
0060		Make sure controlling TTY is opened as physical TTY in K%INIT.
		SPR 10-33713  7-Nov-83 /LWS
0061		Set BATFLG positive if MIC controlled and check before
		each input of a character to see if still under MIC's
		control.
		SPR 10-34367  19-Jan-83 /LWS
0062		Fix "delete char" problem for hard copy.
		9-Feb-84 /NT
0064		Add routine K%ECHO to enable/disable terminal echo.
		15-Aug-84 /WXD
0065		Rearranged keypad escape sequence processing to make OPR
		a bit more compact. 31-Aug-84 /NT
0066		Fix lose echo on too many deletes bug.
		5-Nov-84 /NT
0067		Fix lose echo on delete across multi-line messages.
		14-Jan-85 /NT
0070		Fix some loose ends:
		1. Turn off control C from break mask table.
		2. Make K%BOUT and K%SOUT default to OUTCHR and OUTSTR
		   if TRMOP. fails.
		15-Jan-85 /NT
0071	10149	Remove code to fake out MIC.  Let the monitor do it
		right for us (MCO 11845).
		18-Feb-85 /DPM
0072		Fix double carriage return after typing <DEL><CR>.
		22-Feb-85 /NT
0073	10215	Sleep in line mode, not characters. This allows
		interrupts in the middle of type in.
		21-May-85 /NT
0074	10235	Try not to stopcode too easily if we can't set break mask.
		Job could just be detached.
		19-Jun-85 /NT
0075	10251	Echo line feed if CRLF typed just after DELETE.
		15-Jul-85 /NT
0076	10284	Restore code to fake out MIC under FTFLBK.  MCO 11845
		is not part of 7.02.
		09-Sep-85 /RCB
0077	10290	Finish code started by MCO 11845.  Don't go into TI for BATCON.
		17-Sep-85 /RCB
0100	10298	Update code to handle MCO 12482.
		07-Oct-85 /RCB
101	10303	Check to see if JFN belongs to .PRIIN before attempting to
		begin processing Escape sequences.
		Also, if K%SOUT TRMOP. fails do OUTSTR on contents of
		P3, not T3.
		16-Oct-85 /NT
\  ;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
	ENTRY	K%ECHO			;ENABLE/DISABLE TERMINAL ECHO
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	ECHFLG			;ECHO FLAG (0= DISABLE ECHO)
	$DATA	PMPTNG			;-1 means we're at the prompt
	$DATA	ARGLOC			;LOCATION OF CALLER'S ARGUMENT BLOCK
	$DATA	BCKFLG			;-1 WHEN BACKUP LIMIT HAS BEEN PASSED
	$DATA	CHREAD			;Read single character at K%BIN
	$DATA	UESCTB			;ADDRESS OF USER ESCAPE TABLE
	$DATA	CURESC			;CURRENT STATE OF ESCAPE SEQ PROCESSOR
	$DATA	TRMTY			;TERMINAL TYPE
	$GDATA	TRMUDX			;UDX FOR TERMINAL
	$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.
	$DATA	BRKBLK,7		;Place to do the break set TRMOP.
> ; 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
	SETOM	ECHFLG			;ENABLE TERMINAL ECHO
	TXNE	S1,IT.OCT		;WANT CONTROLLING TTY OPENED?
;**;[60] Change 1 line and delete 1 line at K%INIT+7L. 7-Nov-83 /LWS
	JRST	[MOVSI	S1,200000	;[60] TELL K%OPEN TO USE UU.PHS
		 $CALL	K%OPEN		;GO OPEN THE TTY
		 JRST	KINI.3]		;AND CONTINUE WITH REST OF K%INIT
	SETZ	S1,			;THEN USE LOGICAL TERMINAL
	PUSHJ	P,FNDUDX		;TO FIND OUT OUR UDX

KINI.3:
TOPS10 <
	SETOM	INTCHR			;Have no characters yet
	SETOM	S1			;MY JOB
	MOVX	S2,JI.BAT		;GET BATCH WORD
	$CALL	I%JINF			;...
	SETZM	BATFLG			;ASSUME NOT BATCH
IFN FTFLBK,<
	MOVX	S1,%CNDAE		;POINTER TO DAEMON CONFIG WORD
	GETTAB	S1,			;FETCH IT FROM THE MONITOR
	  SETZ	S1,			;ANCIENT MONITOR
	HRRZS	S1			;KEEP ONLY BINARY PORTION
	CAIL	S1,703			;CAN WE IGNORE MIC AND BATCON?
	JRST	KINI.0			;YES, DO SO
	TXNE	S2,JB.LBT		;ARE WE BATCH?
	SETOM	BATFLG			;YES, REMEMBER IT
	SKIPE	BATFLG			;DETERMINED IF BATCH YET ?
	JRST	KINI.0			;YES CONTINUE
	MOVE	TF,[2,,S1]		;NO, SET UP AC
	MOVX	S1,.TOGMS		;FUNCTION CODE TO GET MIC STATUS
	MOVE	S2,TRMUDX		;GET UDX
	TRMOP.	TF,			;READ MIC STATUS
	  SETZ	TF,			;CAN'T
	SKIPE	TF			;MIC CONTROLLED TTY ?
	AOS	BATFLG			;YES - INDICATE MIC CONTROLLED

KINI.0:> ;END OF FTFLBK
	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
	SETZM	UESCTB			;NO ESCAPE SEQUENCES
	SETZM	CURESC			;CLEAR ESCAPE MACHINE
	MOVX	0,.TOTRM		;FUNCTION CODE TO GET TERMINAL TYPE
	MOVE	1,TRMUDX		;UDX FOR TRMOP.
	MOVE	S2,[XWD 2,0]		;ARG LIST FOR TRMOP.
	TRMOP.	S2,			;ASK FOR TERMINAL TYPE
	JRST	KINI.2			;NO? ASSUME A DEFAULT
	MOVSI	S1,-<.TIMAX+1>		;IOWD PTR TO SIXBIT NAME TABLE
KINI.1:	CAME	S2,TSTAB(S1)		;MATCH THIS ENTRY?
	AOBJN	S1,KINI.1		;NO, TRY AGAIN
	SKIPL	S1			;HIT ONE?
KINI.2:	MOVX	S1,.TI33		;NO, ASSUME THIS IS A 33
	HRRZS	S2,S1			;GET ONLY ITS INDEX
	$CALL	STYP.3			;[42] ALWAYS SET TYPE AND RETURN
	SKIPGE	CHNJFN			;TTY OPEN?
>  ;END TOPS10 CONDITIONAL

	PUSHJ	P,MAKBUF		;Make buffers always on the -20
					;Or when TTY is not open on -10
	$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:	$SAVE	<T1,T2,T3,T4,P1>
	PUSH	P,S1			;Save caller's flags
	PUSHJ	P,DWBUFF		;DEAL WITH THE BUFFER
	PUSHJ	P,FNDUDX		;GO GET OUR UDX
	POP	P,S1			;Restore flags

TOPS10	<
	MOVE	T2,[IO.LEM+IO.ABS+.IOASC] ;SET ALL THE FUNNY MODES
	TXNE	S1,1B0			;DO WE WANT IMAGE MODE?
	TXO	T2,.IOIMG		;YES, TURN IT ON
	TXNE	S1,1B1			;DO WE WANT PHYSICAL TTY
	TXO	T2,UU.PHS		;YES, SAY SO
	TXNE	S1,1B2			;NON-BLOCKING I/O?
	TXO	T2,UU.AIO		;YES, TURN IT ON
	SKIPGE	CHNJFN			;IS THIS OUR FIRST OPEN
	JRST	[MOVX	T1,<FO.ASC+.FOWRT> ;OPEN IN WRITE MODE EXTENDED CHANNEL
		 MOVSI	T3,'TTY'	;ON THE CONTROLLING TERMINAL
		 MOVE	T4,[BUFOUT,,BUFIN]  ;WE WANT BUFFERS
		 MOVX	P1,<2,,2>	;2 INPUT AND 2 OUTPUT BUFFERS
		 MOVEI	S1,BUFSIZ*4	;SPACE FOR 4 BUFFERS
		 $CALL	M%GMEM		;GET IT
		 MOVEI	S1,(S2)		;WHAT WAS THAT ADDRESS?
		 MOVE	S2,[XWD 5,T1]	;LENGTH, ADR OF ARG BLOCK
		 JRST	OPEN.1]		;DO THE FILOP
	MOVX	T1,.FOGET		;WE'RE GONNA LOOK UP THE MODE
	HRL	T1,CHNJFN		;GET THE CHANNEL
	MOVX	S2,<1,,T1>		;FILOP. PTR
	FILOP.	S2,			;DO THE FILOP.
	  $STOP	(CLS,Can't lookup status of terminal JFN)
	ANDX	S2,IO.MOD		;WE ONLY CARE ABOUT THE MODE
	TXNN	S1,1B0			;ARE WE CHANGING TO IMAGE OR TO ASCII
	JRST	[CAIN	S2,.IOASC	;DO WE ALREADY HAVE ASCII
		 $RETT			;THEN RETURN
		 MOVEI	S1,7		;BYTESIZE 7
		 DPB	S1,[POINT 6,BUFOUT+.BFPTR,11]  ;CHANGE BYTESIZE
		 MOVEI	S1,5		;CONVERSION FACTOR FOR WORD COUNT
		 IMULM	S1,BUFOUT+.BFCTR  ;DO THE CONVERSION
		 JRST   OPEN.2]		;CONTINUE WITH CALL
	CAIN	S2,.IOIMG		;DO WE ALREADY HAVE IMAGE MODE
	$RETT				;THEN RETURN
	MOVEI	S1,^D36			;BYTESIZE FOR IMAGE MODE
	DPB	S1,[POINT 6,BUFOUT+.BFPTR,11]  ;CHANGE BYTESIZE
	MOVE	S1,BUFOUT+.BFCTR	;WORD COUNT
	IDIVI	S1,5		  	;CONVERT WORD COUNT
	MOVEM	S1,BUFOUT+.BFCTR	;MAKE THE CHANGE STICK
OPEN.2:	MOVX	T1,.FOSET		;WE WILL REALLY DO A SETSTS
	HRL	T1,CHNJFN		;GET CHANNEL NUMBER
	MOVE	S2,[XWD 2,T1]		;POINTER HAS LENGTH OF 2
	MOVE	S1,.JBFF		;MAKE THE .JBFF SWITCH JUST A NOOP
OPEN.1:	EXCH	S1,.JBFF		;STUFF THE BUFFER ADDRESS HERE
	FILOP.	S2,			;DO THE OPEN OR SETSTS
	  $STOP(FFT,Action FILOP. failed to terminal)
	EXCH	S1,.JBFF		;RESTORE .JBFF
	LDB	S2,[POINTR(T1,FO.CHN)]	;GET THE CHANNEL NUMBER
	MOVEM	S2,CHNJFN		;SAVE FOR POSTERITY
	$RETT
	> ; END TOPS 10 CONDITIONAL

TOPS20	<
	MOVE	T1,S1			;FREE UP S1 FOR GTJFN
	SKIPL	CHNJFN			;IS THIS OUR FIRST OPEN?
	JRST	[MOVE	S1,CHNJFN	;YES, DON'T OPEN IT AGAIN
		 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 BEGONE
		 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
	MOVE	S2,TRMUDX		;OUR FIRST OPEN, LET'S DO IT
	HRROI	S1,T3			;PUT STRING IN T3 AND T4
	DEVST				;GET THE STRING
	 JRST	[MOVE	T3,[ASCIZ/TTY:/] ;[44] Use simple default
		 JRST	.+3]		;[44] Don't store terminator
	MOVEI	S2,":"			;[44] Store device terminator
	IDPB	S2,S1			;[44]
	HRROI	S2,T3			;MAKE S2 POINT TO THE STRING
	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
	MOVE	S1,T1			;RESTORE S1
	PJRST	K%OPEN			;AND START AGAIN, THIS TIME
					;MODE WILL BE SET
	> ; END TOPS 20 CONDITIONAL

SUBTTL	FNDUDX  --   Find UDX or designator of TTY
;Call:
;	S1/ 1B1  -  Off :  get designator for TTY:
;		    On : get designator for controlling TTY.
FNDUDX:	$SAVE	<T1>
TOPS10	<
	MOVSI	T1,'TTY'		;LOGICAL NAME
	TXNN	S1,1B1			;PHYSICAL OR LOGICAL TTY?
	IONDX.	T1,			;HERE IF LOGICAL
	  HRROI	T1,-1			;HERE IF PHYSICAL OR LOGICAL ERROR
	MOVEM	T1,TRMUDX		;PUT IT AWAY
	$RET				;AND RETURN
	> ; END TOPS 10 CONDITIONAL
TOPS20	<
	MOVE	T1,S1			;WE NEED THE REG
	HRROI	S1,[ASCIZ/TTY:/]	;[44] WE NEED IT FOR THIS
	TXNN	T1,1B1			;PHYSICAL TTY
	STDEV				;IF NOT, GET LOGICAL DESIG
	  HRRZI	S2,-1			;CONTROLLING DESIGNATOR
	MOVEM	S2,TRMUDX		;PUT IT PROPER PLACE
	$RET				;AND RETURN
	> ; END TOPS 20 CONDITIONAL

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 <
;**;[57]REVAMP K%SUET			24-OCT-83/NT
K%SUET:	PUSHJ	P,.SAVE1		;[57]Save P1
	MOVEM	S1,UESCTB		;SAVE THE ESCAPE TABLE ADDRESS
	SETZM	CURESC			;CLEAR CURRENT STATE
	MOVE	S1,TRMTY		;[57]Get the terminal type
	MOVE	P1,[XWD -<.TIMAX+1>,TTTAB] ;[57]Point to the terminal table
SUET.1:	HLRZ	S2,(P1)			;[57]Get the entry
	CAME	S1,S2			;[57]Is it what we have?
	 AOBJN	P1,SUET.1		;[57]No, loop for the whole table
	SKIPL	P1			;[57]Did we find one
	$RETT				;[57]No, MAke belive we did
	HRRZ	S2,(P1)			;[57]Get the table address
	MOVE	S1,.TCKBA(S2)		;[57]Assume we're setting it
	SKIPN	UESCTB			;[57]Are we?
	 MOVE	S1,.TCKBN(S2)		;[57]No, we're clearing
	PUSHJ	P,K%SOUT		;[57]Output the string
	$RETT				;[57]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
	HRRZ	S1,(S1)			;[62] See if hardcopy
	MOVE	S1,@(S1)		;[62]  .  .  .
	JUMPN	S1,STYP.4		;[62] It isn't
	MOVEI	S1,[0]			;[62] It is, point to a zero
	HRRZM	S1,TRMPTR		;[62]  .  .  .
STYP.4:	SKIPN	S2			;[62] 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
;**;[57]REVAMP CODE			24-OCT-83/NT
	.TCKBA==.TCEOL+1		;[57]Set keypad application
	.TCKBN==.TCKBA+1		;[57]Set keypad numeric

;DEFINE THE EXPANDER MACRO

DEFINE X(PARNAM,SIXNAM,SUF,INIT,EOLSEQ,KBDSET,KBDCLR),<
DEFINE EOLGEN<
IFNB <EOLSEQ>,<BYTE (7)'EOLSEQ>
IFB  <EOLSEQ>,<EXP 0>
>
DEFINE SETGEN<
IFNB <KBDSET>,<BYTE (7)'KBDSET>
IFB  <KBDSET>,<EXP 0>
>
DEFINE CLRGEN<
IFNB <KBDCLR>,<BYTE (7)'KBDCLR>
IFB  <KBDCLR>,<EXP 0>
>
$SET	(.TI'SUF,,<.TT'SUF,,[[EOLGEN]
			     [SETGEN]
			     [CLRGEN]]>)
>

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

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

DEFINE X(PARNAM,SIXNAM,SUF,INIT,EOLSEQ,KBDSET,KBDCLR),<
	$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***

DEFINE X(PARNAM,SIXNAM,SUF,INIT,EOLSEQ,KBDSET,KBDCLR),<
$SET	(.TI'SUF,,INIT)
>

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

;TERMINAL SETUP ROUTINES
SETTLC:	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:	PUSHJ	P,.SAVE3
	MOVE	P3,S1
	MOVEI	P1,.TOOUC
	MOVE	P2,TRMUDX
	MOVE	S1,[3,,P1]
	TRMOP.	S1,
	 OUTCHR	P3			;TYPE THE CHARACTER
	MOVE	S1,P3
	$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:	PUSHJ	P,.SAVE3
	MOVE	P3,S1
	MOVEI	P1,.TOOUS
	MOVE	P2,TRMUDX
	MOVE	S1,[3,,P1]
	TRMOP.	S1,
	 OUTSTR	(P3)			;Do it the old fashioned way
	$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:	SKIPN	CHREAD			;READING BY CHARACTER?
	 JRST	BIN.10			;NO, READ BY LINE THEN
	SKPINC				;CHECK FOR CHARACTER
	SKIPE	BATFLG			;NONE..SLEEP IF NOT BATCH
	JRST	BIN.2			;ELSE GET THE CHARACTER
	MOVX	S1,HB.RTC!HB.DIN	;SLEEP FOR CHARACTER, DEMAND INPUT
	JRST	BIN.11			;GOTO SLEEP
BIN.10:	SKPINL				;CHECK FOR CHARACTER
	SKIPE	BATFLG			;NONE..SLEEP IF NOT BATCH
	JRST	BIN.2			;ELSE GET THE CHARACTER
	MOVX	S1,HB.RTL!HB.DIN	;SLEEP FOR CHARACTER, DEMAND INPUT
BIN.11:	$CALL	I%SLP			;SLEEP TILL CHARACTER INPUT
	JRST	BIN.1			;TRY AGAIN
BIN.2:	SKIPL	INTCHR			;DO WE HAVE A CHARACTER YET?
	 JRST	BIN.4			;YES, GO GET IT
IFN FTFLBK,<
	SKIPG	BATFLG			;MIC CONTROLLED?
	JRST	BIN.21			;NO, GO READ A CHARACTER
	MOVE	TF,[XWD 2,S1]		;YES, SEE IF MIC STILL THERE
	MOVX	S1,.TOGMS		;"GET" MIC STATUS FUNCTION
	MOVE	S2,TRMUDX		;UDX OF TTY
	TRMOP.	TF,			;ASK ABOUT MIC STATUS
	SETZM	TF			;SHOULD NEVER HAPPEN
	JUMPN	TF,BIN.21		;JUMP IF MIC STILL IN CONTROL
	SETZM	BATFLG			;MIC NO LONGER IN CONTROL
	JRST	BIN.1			;DON'T GO INTO TI STATE
BIN.21:> ;END OF FTFLBK
	SKIPN	CHREAD			;IN AN ESCAPE SEQUENCE?
	 JRST	BIN.3			;NO, CONINUE
	INCHRW	INTCHR			;GET CHARACTERS ONE AT A TIME
	 TRNA
BIN.3:	INCHWL	INTCHR			;GET THE CHARACTER
BIN.4:	MOVE	S1,INTCHR		;GET THE CHARACTER
	MOVEM	S1,LSTCHR		;REMEMBER IT
	SETOM	INTCHR			;WILL NEED ANOTHER CHARACTER
	$RETT				;AND RETURN

GETBIN:	SETOM	CHREAD			;Tell that we want a single char
	PUSHJ	P,K%BIN			;And go get it
	SETZM	CHREAD			;Clear the location again
	$RETT
>  ;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%ECHO	--  Control Terminal Echo

;This routine is used to enable or disable the echoing of terminal input.
;It is called with S1 containing 0 to disable echo, 1 to enable.

TOPS10 <
K%ECHO:	$SAVE	<T1,T2,T3>	; Save T1, T2, and T3
	MOVEM	S1,ECHFLG	; Save echo flag
	MOVX	T1,.TOSET+.TOECH; TRMOP. function to set echo state
	SETO	T2,		; UDX for principal terminal
	MOVE	T3,ECHFLG	; Echo state to set
	MOVE	S1,[3,,T1]	; TRMOP. argument pointer
	TRMOP.	S1,		; Set echo status
	  $STOP	(CSE,<Cannot set echo on terminal>)
	$RETT			; And return
>; End TOPS10
TOPS20 <
K%ECHO:	MOVEM	S1,ECHFLG	; Save echo flag
	MOVX	S1,.PRIIN	; JFN for principal terminal
	RFMOD			; Read current echo setting
	ERJMP	.RETF		; Error?
	TXO	S2,TT%ECO	; Set echo flag
	SKIPN	ECHFLG		; Disable echoing?
	  TXZ	S2,TT%ECO	; Yes, clear echo flag
	SFMOD			; Set new terminal mode
	ERJMP	.RETF		; Error?
	$RETT			; Return
>; End TOPS20
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..
	MOVE	S1,ARGLOC		;Get the address of arg block
	PUSHJ	P,SETMSK		;Set the break mask
	PUSHJ	P,GETESC		;Go see if we have an escape sequence
	JUMPT	.RETT			;Got something, return it
	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

	PUSHJ	P,K%BIN			;NO, GET A CHARACTER
	MOVE	C,S1			;PUT THE CHARACTER IN C

TXTL.2:	JUMPE	C,TXTL			;IGNORE NULLS

	PUSHJ	P,CONVRT		;CONVERT LOWER TO UPPER, ETC.
	MOVE	S1,[XWD -SCTBLL,SCTBL]	;Get the address of dispatch table
	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,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
	SUBTTL	SETMSK -- Set input stream break mask

;	This routine will set up the break mask so that we may use the
;.TOSBS TRMOP. on TOPS10. If the user does not sent a break mask,
;a default one will be used.
; Call with:
;	S1/	Address of TEXTI arg block

SETMSK:	$SAVE	<P1,P2>			;Get some scratch ACs
	MOVE	P1,S1			;Save the block address
	MOVE	S2,.RDCWB(P1)		;Get the lenght of the block
	CAIGE	S2,.RDBRK		;Does he send a break set
	 JRST	SMSK.1			;No, Go set the default one
	SKIPN	P2,.RDBRK(P1)		;Get the block
	 JRST	SMSK.1			;Empty block, go set default
	DMOVE	S1,0(P2)		;Get the first two words of the set
	DMOVEM	S1,BRKBLK+3		;Store them in the TRMOP. block
	DMOVE	S1,2(P2)		;Like-wise the last 2 words
	DMOVEM	S1,BRKBLK+5		; .  .  .
	JRST	SMSK.2			;Go join common code

;Here to build a break mask if the user didn't give one.
;Note: it returns the BRKBLK area all set up
SMSK.1:	SETZB	S1,S2			;Clear the mask from the TRMOP. block
	DMOVEM	S1,BRKBLK+3		; .  .  .
	DMOVEM	S1,BRKBLK+5		;  .  .  .
SMSK.2:	MOVE	P2,.RDFLG(P1)		;Get the flag word
	TXNE	P2,RD%BEL		;Only break on EOL?
	 TLO	S1,200			;Just want two bits on
	TXNE	P2,RD%BRK		;CTRL/Z and ESC ?
	 TRO	S1,1400			;Turn them on
	TXNE	P2,RD%TOP		;TOPS10 break set?
	 TDOA	S1,[XWD 2360,1400]	;Turn them on
	  TDO	S1,[XWD 1000,450000]	;No, then we need editing characters
	IORM	S1,BRKBLK+3		;Store this mask
	MOVEI	S1,20			;GEt the delete bit
	TXNN	P2,RD%TOP		;TOPS10 on?
	 IORM	S1,BRKBLK+6		;No, We must handle delete as well
	TXNN	P2,RD%PUN		;Does he want all punctuation?
	 JRST	SMSK.3			;No, don't bother then
	DMOVE	S1,PUNMSK		;Get the first half of the punctuation
	IORM	S1,BRKBLK+3		;Include previously set bits
	IORM	S2,BRKBLK+4		;We have to do this in case user
	DMOVE	S1,PUNMSK+2		;  his own mask, we don't want
	IORM	S1,BRKBLK+5		;  to overwrite his bits
	IORM	S2,BRKBLK+6
SMSK.3:	MOVEI	S1,BUFFUL		;GEt lenght of internal buffer
	MOVEM	S1,BRKBLK+2		;This number is as good as any
	MOVE	S2,TRMUDX		;GEt the terminal's UDX
	MOVEM	S2,BRKBLK+1		;Save it
	MOVEI	S2,.TOSBS		;GEt the function type
	MOVEM	S2,BRKBLK
	MOVE	S1,[XWD 7,BRKBLK]	;Point to the break character block
	TRMOP.	S1,			;Set up the break mask
	 SKIPF				;Couldn't?
	$RETT
	SETO	S1,			;Get a negative one
	TRMNO.	S1,			;Get the terminal number
	 $RETT				;Assume we're detached
	$STOP (CSB,<Can't set terminal break mask>)

;The mask for the punctuation characters, note that Editing characters are
;included.
;	      000000000011111111112222222222333333
;	      012345678901234567890123456789012345
PUNMSK:	EXP ^B011011101100001110000010111111110000
	EXP ^B111111111111101100000000001111110000
	EXP ^B100000000000000000000000000111110000
	EXP ^B100000000000000000000000000111100000
	SUBTTL	GETESC -- Get escape sequence

;	This routine will accept and process the user escape sequence
;for the SET TERMINAL KEYPAD command from OPR (for example). It must
;be called only at the beginning of a line.

GETESC:	SKIPN	UESCTB			;Did the user set up a table?
	 $RETF				;Nope
	HLRZ	S1,RD+.RDIOJ		;Input JFN
	CAXE	S1,.PRIIN		;Primary input JFN?
	 $RETF				;No, input not terminal
	MOVE	T3,RD+.RDDBP		;Get the current pointer into buffer
	MOVE	T4,RD+.RDBFP		;Get pointer to the beginning
	PUSHJ	P,CMPPTR		;Compare them
	 TRNA				;The same
	$RETF				;Don't process in middle of line
	SKIPA	S1,[-1]			;Get the first time through flag
GETE.9:	MOVEI	S1,-1			;Tell we're just looping through
	MOVEM	S1,CURESC		;Remember it
	PUSHJ	P,GETBIN		;Just get one character
	CAIE	S1,.CHESC		;Is it an ESCAPE
	 JRST	GETE.0			;No, back up and return
	SKIPG	CURESC			;First time through?
	SETZ	S1,			;Turn off echo
	PUSHJ	P,K%ECHO		;...
GETE90:	MOVE	S1,UESCTB		;Get address of table
	MOVEM	S1,CURESC		;Save it as current state

;Here with a table address in CURESC. Not that the first node in the
;tree must be a table address.
GETE.1:	PUSHJ	P,GETBIN		;Get another character
	MOVE	C,S1			;Transfer it for safety
	MOVE	T1,CURESC		;Get the node address
	MOVE	S2,(T1)			;Get the lenght of the table
	TXZN	S2,EF.TBL		;This bit must be on if we are here
	 JRST	GETE.8
	HRRZ	S1,1(T1)		;Get adress of character table
GETE10:	CAMN	C,(S1)			;Is the character in the table
	 JRST	GETE11			;Yes, found then
	SOJLE	S2,GETE.8		;Loop for all and exit if no found
	AOBJP	S1,GETE10		;No, try for all
GETE11:	HLRZ	S1,S1			;Get the index into the char table
	MOVE	S2,2(T1)		;Get the next node address
	ADD	S1,S2			;Add the dispatch offset
	MOVE	S1,(S1)			;Get the next node
	MOVEM	S1,CURESC		;Save it as the current state
	MOVE	S1,(S1)			;Get the node descriptor
	TXNE	S1,EF.TBL		;Another address?
	 JRST	GETE.1			;Yes, read another character
	TXNE	S1,EF.LST		;A list to process?
	 JRST	GETE.2			;Yes, go set up for it
	MOVEI	T2,1			;Otherwise we make believe it's a list
	MOVE	T4,S1			; lenght 1, starting at T4
	MOVEI	T1,T4			;Address of table
	JRST	GETE.3			;Skip set up for real list
GETE.2:	MOVE	T2,(S1)			;Get the lenght of the list
	SUBI	T2,1			;Account for the word count
	AOS	S1			;Point to the arguements
	MOVE	T1,S1			;Store the address for safety
GETE.3:	MOVE	S1,(T1)			;Get me an instruction
	TXNN	S1,EF.IST		;Is it an input string
	 TXNE	S1,EF.OST		;Or output string?
	  TRNA				;Yes, continue
	$STOP	(IEI,<Illegal escape sequence instruction>)
	MOVE	T3,S1			;Save it so we can build a BP
	LOAD	S2,(T1),ES.SIZ		;Get the byte size
	HRLI	T3,(POINT 7,0)		;Get a word aligned byte pointer
	DPB	S2,[POINT 6,T3,11]	;Insert the size
	TXNN	S1,EF.IST		;Input string
	 JRST	GETE.5			;Yes, go handle it
GETE.4:	ILDB	C,T3			;Get a character
	JUMPE	C,GETE.6		;All done
	PUSHJ	P,CONVRT		;Convert to upper case
	MOVE	S1,[XWD -ECTBLL,ECTBL]	;GEt the dispatch table
	PUSHJ	P,SPCHK			;See if it is a special char
	JUMPF	GETE40			;Not special, no problem
	PUSHJ	P,(S1)			;Call the routine
	JRST	GETE.4			;Keep reading
	JRST	GETE.4			;Same for the skip return
GETE40:	PUSHJ	P,STOC			;Store it into the buffer
	SETOM	CURESC			;Flag that we've done input
	MOVE	S1,C			;Transfer the character
	PUSHJ	P,ECHOUT		;Echo it
	PUSHJ	P,CBRK			;Go see if break
	JUMPT	GETE.7			;There was, go finish up
	SKIPE	RD+.RDDBC		;Any more room
	JRST	GETE.4			;Yes, keep processing
	$STOP	(IBO,<Input buffer overflow on escape sequence processing>)
GETE.5:	ILDB	S1,T3			;Get a character
	JUMPE	S1,GETE.6		;No more, go finish up
	PUSHJ	P,TXTOUT		;Type it
	JRST	GETE.5			;Loop for them all
GETE.6:	AOS	T1			;Point to the next instruction
	SOJG	T2,GETE.3		;Keep going if not finished
GETE.7:	SKIPN	CURESC			;Did we do input?
	JRST	GETE.9			;No, nothing to return to caller
	MOVX	S1,RD%BTM		;Yes, say we're terminated by break
	PUSHJ	P,FINTXT		;Go set up pointers and buffers etc.
	SETZM	CURESC			;No longer in an escape sequence
	MOVEI	S1,1			;Go finish up
	JRST	K%ECHO			;...
GETE.8:	MOVEI	S1,.CHBEL		;Otherwise get a bell
	PUSHJ	P,TXTOUT		;Tell him he's mistaken
	JRST	GETE.9			;And try again
GETE.0:	PUSHJ	P,K%BACK		;Backup the terminal
	MOVEI	S1,1			;Turn echo back on
	PUSHJ	P,K%ECHO		;...
	SETZM	CURESC			;No longer in an escape sequence
	$RETF				;REturn false

CLSDEL:	SETZM	CURESC			;No longer in an escape sequence
	$RETT				;Return

	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
	SKIPE	ECHFLG			;CHECK ECHO DISABLE FLAG
	TDNE	S1,RD+.RDFLG		;TEST TEXTI NO ECHO FLAG
	$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,ECHOUT		;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	ECHOUT -- TYPE CHARACTERS AS ECHOED

ECHOUT:	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

SUBTTL	ECHO    --  HANDLE CHARACTER ECHOING

ECHO:	MOVX	S1,RD%NEC		;GET NO ECHO BIT
	TDNE	S1,RD+.RDFLG		;TEST IT
	$RETT				;RETURN IF SET
	MOVE	S1,C			;Get the character
	IDIVI	S1," "			;Seperate into word and bit
	MOVE	S1,BRKBLK+3(S1)		;Get the correct word from the 4wd mask
	LSH	S1,(S2)			;Bring the bit over to the sign bit
	SKIPL	S1			;It's set so we must echo it
	 $RETT				;No need to echo it
	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:	$SAVE	<P1>			;GEt a scratch reg
	ILDB	P1,S2			;GET BYTE
	JUMPE	P1,CBRK.4		;IF NULL, WE HAVE A NO MATCH
	CAMN	P1,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
;		S1/ -Table lenght,,table address
;
;TRUE RETURN:	S1/ Address of routine to call
;FALSE RETURN:	Character was not special

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

	HRRZ	S1,(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

ECTBL:	.CHDEL,,DELETE			;DELETE (177)
	$C(H),,DELETE			;^H
	$C(U),,DELINE			;^U
	$C(R),,RETYPE			;^R
	$C(W),,DELWRD			;^W
ECTBLL==.-SCTBL
SUBTTL	CCU     --  Handle ^U (Rubout entire line)

;HERE TO PROCESS ^U (RESTART INPUT)

CCU:	PUSHJ	P,DELINE		;Delete the line
	JRST	TXTL			;Go back to the main routine

DELINE:	PUSHJ	P,CLSDEL		;Close possible delete set
	PUSHJ	P,FNDLIN		;RESET BEGINNING OF LINE
CDX:	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
	POPJ	P,
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
	POPJ	P,
SUBTTL	CCR     --  Handle ^R (Re-type the line)


CCR:	PUSHJ	P,RETYPE		;Do the retype
	JRST	TXTL			;Go get another character

RETYPE:	PUSHJ	P,CLSDEL		;CLOSE POSSIBLE DELETE SET
	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
	POPJ	P,			;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:	PUSHJ	P,ISLASH		;Type a backslash if appropriate
	 TRNA				;Done, continue
	JRST	CCDL00			;At beginning, handle it
	PUSHJ	P,DELETE		;Delete the character
	JRST	CCDL.0			;At the beginning, go handle it
CCDL00:	PUSHJ	P,BEGBUF		;Go process beginning of buffer
	 JRST	FINTXT			;User wants return
CCDL.0:	SETZ	S1,			;Turn off echo
	SKIPE	ECHFLG			;If echo already off, don't bother
	 PUSHJ	P,K%ECHO		;...
CCDL.1:	PUSHJ	P,GETBIN		;Read the next character
	CAIE	S1,.CHDEL		;Is it a delete character?
	 CAIN	S1,.CHBSP		;Or a backspace?
	  JRST	CCDL.2			;Yes, delete another
	MOVE	C,S1			;Get the character
	SKIPN	PMPTNG			;We're prompting, don't type slash
	PUSHJ	P,TYPSLS		;Close off set with a backslash
	 JFCL				;Beginning doesn't matter
	SETZM	PMPTNG			;No longer prompting
	PUSHJ	P,ECHOUT		;Echo the character
	CAIE	C,.CHCRT		;Was character a carriage return?
	 JRST	CCDL10			;No, onward
	MOVEI	C,.CHLFD		;Get a line feed
	PUSHJ	P,ECHOUT		;Echo it out
CCDL10:	SETO	S1,			;Turn echo back on
	PUSHJ	P,K%ECHO		; ...
	PUSHJ	P,K%BACK		;Else back up a character
	JRST	TXTL			;And go process it
CCDL.2:	PUSHJ	P,DELETE		;Go delete this character
	 JRST	CCDL.1			;Process another
	PUSHJ	P,ATPMPT		;See if back to prompt
	 TRNA				;User wants return
	JRST	CCDL.1			;Process until no more deletes
	SETO	S1,			;Turn echo back on
	PUSHJ	P,K%ECHO		; .  .  .
	PJRST	FINTXT			;End it

ISLASH:	MOVE	S1,RD+.RDDBP		;GET CURRENT POINTER
	CAMN	S1,BGBUFR		;At the beginning?
	 JRST	.POPJ1			;Yes, return now
TYPSLS:	HRRZ	S1,@TRMPTR		;Get pointer to control code
	JUMPN	S1,.POPJ		;If video, no need to type backslash
	MOVX	S1,.CHBSL		;GEt a backslash character
	PJRST	TXTOUT			;No, start it then

;The worker routine to delete. Returns +1 if at beginning of
;buffer, and +2 if character deleted.

IFNDEF TABWDT,<TABWDT==10>		;Number of columns in a TAB

DELETE:	MOVE	S1,RD+.RDDBP		;GET CURRENT POINTER
	CAMN	S1,BGBUFR		;ARE WE BACK UP TO BEGINNING?
	 JRST	.POPJ1

	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,DELE.1		;IF THERE IS CODE,DO IT
	CAIL	C," "			;A printing character?
	 PJRST	ECHOUT			;Yes, echo what has been deleted
	CAIE	TF,$C(H)		;WAS IT ^H
	 JRST	DELE.0			;Echo the character
	MOVEI	S1,$C(H)		;GET ^H
	PJRST	TXTOUT			;ECHO IT
DELE.0:	CAIE	C,.CHCRT		;A line feed character?
	 PJRST	ECHOUT			;No, echo the character
	MOVEI	S1,.CHCRT		;Echo a carriage return
	PUSHJ	P,TXTOUT		; .  .  .
	MOVEI	S1,.CHLFD		;And a line feed
	PJRST	TXTOUT
	POPJ	P,
	PUSHJ	P,RETYPE		;Retype the line on a linefeed
	PJRST	TYPSLS			;And delimit old from new
DELE.1:	CAIGE	C," "			;WAS DELETED CHARACTER PRINTING?
	JRST	DELE.2			;NO, NEED FURTHER ANALYSIS
	MOVEI	S1,[BYTE (7).CHBSP," ",.CHBSP,.CHNUL] ;OUTPUT BACK,SPACE,BACK
	PJRST	STROUT			;TYPE IT

DELE.2:	CAIN	C,.CHTAB		;Is this a tab character?
	 JRST	DELE.3			;Yes, special handling
	PUSHJ	P,GETCOC		;GET COC FOR THIS CHARACTER
	JUMPE	S1,.POPJ		;IF CODE 0 , NOTHING THERE AT ALL
	CAXE	S1,1			;IF ITS A ONE, JUST RUBOUT 2 CHARACTERS
	PJRST	RETYPE			;ELSE FORCE A RETYPE OF THE LINE
	MOVEI	S1,[BYTE (7).CHBSP,.CHBSP," "," ",.CHBSP,.CHBSP,.CHNUL]
	PJRST	STROUT			;TYPE IT

DELE.3:	PUSHJ	P,FNDLIN		;Find the beginning of the line
	MOVE	T3,BGLINE		;Get the pointer
	MOVE	T4,RD+.RDBFP		;Does it begin the buffer?
	PUSHJ	P,CMPPTR		;Compare them
	 TRNA				;The same, must calculate prompt
	JRST	DELE30			;No, so don't worry about prompt
	SKIPN	S1,RD+.RDRTY		;Otherwise get the prompt text
	JRST	DELE30			;If no prompt, continue
	SETZB	S2,T1			;Say it's an ASCIZ string,,column 0
	PUSHJ	P,STRPOS		;Find out where it ends
	SKIPA	T1,S1			;Start the count there
DELE30:	 SETZ	T1,			;Clear the position counter
	MOVE	S1,BGLINE		;GEt the character we're checking
	MOVE	S2,RD+.RDDBP		;And the last character
	PUSHJ	P,STRPOS		;Calculate the position
	MOVE	T1,S1			;Save the position
	IDIVI	S1,TABWDT		;Calculate last tab stop
	ADDI	S1,1			;We want position for the next one
	IMULI	S1,TABWDT		;So calculate it
	SUBM	S1,T1			;Now the difference in spaces
DELE31:	MOVEI	S1,.CHBSP		;Get a backspace character
	PUSHJ	P,TXTOUT		;Output it
	SOJG	T1,DELE31		;And do it for all
	POPJ	P,
SUBTTL	STRPOS -- Calculate prompt position

;	This routine will calculate the end position of the cursor when a
;string is typed out. It accepts the starting pointer in S1, and the
;ending point in S2. If the string is ASCIZ, then S2 should be 0.
;T1 contains the beginning column.

STRPOS:	PUSHJ	P,.SAVET		;Get a scratch reg
	DMOVE	T3,S1			;Keep the pointer safe
STRP.1:	JUMPE	T4,STRP10		;An ASCIZ string, just looks for null
	PUSHJ	P,CMPPTR		;Compare the pointers
	 JRST	STRP.9			;We're at the end
STRP10:	ILDB	C,T3			;Get a character
	JUMPE	C,STRP.9		;End of string, go finish up
	CAIL	C," "			;Printing character?
	 AOJA	T1,STRP.1		;Yes, add one and process another char
	PUSHJ	P,GETCOC		;Get the echo mask
	JRST	@[EXP STRP.1,STRP.2,STRP.3,STRP.4](S1) ;Process the character
STRP.2:	ADDI	T1,2			;Account for the ^char
	JRST	STRP.1			;And continue
STRP.3:	CAIE	C,.CHTAB		;Tab character?
	 JRST	STRP30			;No, check for next character then
	MOVE	S1,T1			;Get current position
	IDIVI	S1,TABWDT		;Calculate last tab stop
	ADDI	S1,1			;We want position for the next one
	IMULI	S1,TABWDT		;So calculate it
	MOVE	T1,S1			;Put it in its proper place
	JRST	STRP.1			;And continue
STRP30:	CAIN	C,.CHCRT		;Is this a carriage return then?
	 SETZ	T1,			;Yes, starting over then
	JRST	STRP.1			;Continue
STRP.4:	CAIN	C,.CHESC		;Escape?
	 AOJA	T1,STRP.1		;Yes, then account for "$"
	JRST	STRP.1			;The only one we know of, so continue
STRP.9:	MOVE	S1,T1			;Return value to caller
	POPJ	P,
SUBTTL	CCW     --  Handle ^W (Delete back to punctuation character)


CCW:	PUSHJ	P,ISLASH		;Print first slash
	 TRNA				;Continue
	JRST	CCW.00			;At beginning, go handle it
	PUSHJ	P,DELWRD		;Delete a word
	 JRST	CCW.0			;Done continue
CCW.00:	PUSHJ	P,BEGBUF		;Else process beginning of buffer
	 JRST	FINTXT			;User wants return
CCW.0:	SETZ	S1,			;Turn off echo
	PUSHJ	P,K%ECHO		;...
CCW.1:	PUSHJ	P,GETBIN		;Get the next character
	CAIN	S1,$C(W)		;Control W?
	 JRST	CCW.2			;Yes, delete the previous word
	MOVE	C,S1			;Else, Save the character
	SKIPN	PMPTNG			;We're prompting, don't type slash
	PUSHJ	P,TYPSLS		;Close off set with a backslash
	 JFCL				;Beginning doesn't matter
	SETZM	PMPTNG			;No longer prompting
	PUSHJ	P,ECHOUT		;Echo it
	CAIE	C,.CHCRT		;Was character a carriage return?
	 JRST	CCDL10			;No, onward
	MOVEI	C,.CHLFD		;Get a line feed
	PUSHJ	P,ECHOUT		;Echo it out
CCW.10:	SETO	S1,			;Turn echo back on
	PUSHJ	P,K%ECHO		; .  .  .
	PUSHJ	P,K%BACK		;Back up the character
	JRST	TXTL			;And go process it
CCW.2:	PUSHJ	P,DELWRD		;Delete the word
	 JRST	CCW.1			;Process another character
	PUSHJ	P,ATPMPT		;Process beginning of buffer
	 TRNA				;USer wants to return
	JRST	CCW.1			;Else process until no more deleters
	SETO	S1,			;Turn echo back on
	PUSHJ	P,K%ECHO		; .  .  .
	PJRST	FINTXT			;End it

DELWRD:	PUSHJ	P,FNDLIN		;RESET BEGINNING OF LINE PTR
	MOVE	T3,RD+.RDDBP		;SEE IF WE'RE AT TOP OF BUFFER
	MOVE	T4,BGBUFR		;..
	PUSHJ	P,CMPPTR		;AT TOP OF BUFFER?
	 TRNA				;YUP, SPECIAL HANDLE
	JRST	DELW.1			;No, we can delete something
	AOS	(P)			;Give a skip from now on
	POPJ	P,

DELW.1:	PUSHJ	P,CURCHR		;Get current character
	CAIE	C,.CHTAB		;A spacing character?
	 CAIN	C," "			; .  .  .
	  TRNA				;Yes, get rid of it
	JRST	DELW.2			;Else go delete the word
	PUSHJ	P,DELETE		;Always delete the first character
	 JRST	DELW.1			;Loop for all spaces
	POPJ	P,			;At the beginning

DELW.2:	PUSHJ	P,CHKEOL		;An end of line character
	JUMPT	DELW20			;Yes, go delete it
	PUSHJ	P,CHKPUN		;Is this a punctuation character
	JUMPF	DELW.4			;No, then go delete the word
DELW20:	PUSHJ	P,DELETE		;Otherwise just delete this character
	 POPJ	P,			;And go get another
	POPJ	P,
DELW.3:	PUSHJ	P,CURCHR		;Get the current character
	PUSHJ	P,CHKEOL		;Check for end of line
	JUMPT	.POPJ			;Yes, all done
	PUSHJ	P,CHKPUN		;Go see if it is a puctuation character
	JUMPT	.POPJ			;Yes it is, finished
DELW.4:	PUSHJ	P,DELETE		;Go delete the character
	 JRST	DELW.3			;Go try again
	POPJ	P,			;We're at the beginning

CURCHR:	LDB	C,RD+.RDDBP		;Get the last byte input
	JUMPN	C,.POPJ			;Have something, proper pointer
	MOVE	S1,RD+.RDDBP		;Get the pointer
	SUBI	S1,1			;Adjust it by backing back by 5 and
	MOVEI	S2,5			; incrementing back up
	ILDB	C,S1
	SOJG	S2,.-1
	POPJ	P,

CHKEOL:	CAIE	C,.CHCRT		;A carriage return
	 CAIN	C,.CHLFD		;  or line feed
	  $RETT				;Give a skip return
	$RETF

CHKPUN:	MOVE	S1,[POINT 7,PUNTAB]	;POINT TO PUNCTUATION TABLE
PUN.2:	ILDB	S2,S1			;GET A PUNCTUATION CHARACTER
	JUMPE	S2,.RETF		;IF AT END, DELETE ANOTHER CHARACTER
	CAME	S2,C			;IS NEXT CHAR A PUNCTUATION CHAR?
	 JRST	PUN.2			;NO, TRY NEXT IN LIST
	$RETT
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
		     POPJ P, ]		;TO CALLER
	MOVX	S1,.CHBEL		;LOAD A "BELL"
	PUSHJ	P,TXTOUT		;AND SEND IT
	AOS	(P)			;Skip return
	POPJ	P,

ATPMPT:	LOAD	S1,RD+.RDFLG,RD%RND	;GET FLAG FOR RETURN HERE
	JUMPN	S1,[ MOVX S1,RD%BFE	;FLAG IS LIT, RETURN BUFFER EMPTRY NOW
		     POPJ P, ]		;TO CALLER
	MOVX	S1,.CHBEL		;LOAD A "BELL"
	PUSHJ	P,TXTOUT		;AND SEND IT
	AOS	(P)			;Skip return
	HRRZ	S1,@TRMPTR		;Get pointer to control code
	JUMPN	S1,.POPJ		;If video, no need to type backslash
	SETOM	PMPTNG			;Tell we're prompting
	JRST	RETYPE


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