Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/cpakbd.mac
There are 7 other files named cpakbd.mac in the archive. Click here to see a list.
TITLE	CPAKBD  --  Keyboard Interface for CMDPAR
SUBTTL	AUTHOR: Irwin Goverman/ILG/LSS/MLB/WLH/DC     19-Sept-79

;
;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975, 1986.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.
;


		SEARCH	CPASYM		;OPEN SYMBOLS NEEDED
		PROLOG(CPAKBD)

;This module provides the TEXTI JSYS implemented in the TOPS20 monitor.
SUBTTL	Table of Contents


;               TABLE OF CONTENTS FOR CPAKBD
;
;
;                        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. Utilities for text handling...............................  20
;   18. STOC    --  Store an input character......................  20
;   19. USTOC   --  Unstore a character...........................  20
;   20. CONVRT  --  Do case conversion as necessary...............  21
;   21. CONVBP  --  Convert default byte pointers.................  21
;   22. MAKBP   --  Un-default a byte pointer.....................  22
;   23. IMGSTR  --  Output a string as it was echoed..............  22
;   24. CLINE   --  Clear current video line......................  22
;   25. GETCOC  --  Fetch COC for a given character...............  22
;   26. ECHO    --  HANDLE CHARACTER ECHOING......................  23
;   27. CBRK    --  Check to see if character is a break..........  24
;   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
; 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
SUBTTL	Local Definitions

; Special Accumulator definitions

	C==16				;GLOBAL CHARACTER REGISTER

; Special characters

	.CHBSL=="\"			;BACKSLASH

; Control character former

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

$IMPURE

	$DATA	RD,.RDSIZ		;INTERNAL ARGUMENT BLOCK
	$DATA	COCTAB,2		;CHARACTER OUTPUT CONTROL TABLE
	$DATA	TRMPTR			;POINTER TO TERMINAL CONTROL
	$DATA	RUBFLG			;-1 WHEN LAST CHAR WAS RUBOUT
	$DATA	ARGLOC			;LOCATION OF CALLER'S ARGUMENT BLOCK
	$DATA	BCKFLG			;-1 WHEN BACKUP LIMIT HAS BEEN PASSED
	$DATA	UESCTB			;ADDRESS OF USER ESCAPE TABLE
	$DATA	CURESC			;CURRENT STATE OF ESCAPE SEQ PROCESSOR
	$DATA	TRMTY			;TERMINAL TYPE
	$DATA	TRMUDX			;UDX FOR TERMINAL
	$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

$PURE
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: No arguments
;
;TRUE RETURN:	No arguments are returned

TOPS10 <
K%INIT:	$SAVE	<T1,T2,T3,T4>		;SAVE SOME REGS
	MOVE	T1,[EXP FO.ASC+.FORED]	;ASSIGN EXTENDED CHAN, READ ONLY
	MOVE	T2,[IO.LEM+IO.SUP+IO.TEC+.IOASC] ;SET ALL THE FUNNY MODES
	MOVSI	T3,'TTY'		;ON THE CONTROLLING TERMINAL
	SETZ	T4,			;NO BUFFERS
	MOVE	S1,[XWD 4,T1]		;LENGTH, ADR OF ARG BLOCK
	FILOP.	S1,			;OPEN UP THE TERMINAL FOR SCANNING
	  $STOP(COT,Cannot OPEN terminal)
	DMOVE	S1,[BYTE (2) 0,1,1,1,1,1,1,2,3,2,2,1,1,2,1,1,1,1
		    BYTE (2) 0,0,0,0,0,0,1,1,1,3,2,2,2,2,0,0,0,0] ;LOAD COCTAB
	PUSHJ	P,K%WCOC		;WRITE THE TABLE
	SETZM	UESCTB			;NO ESCAPE SEQUENCES
	SETZM	CURESC			;CLEAR ESCAPE MACHINE
	MOVSI	T2,'TTY'		;LOAD TTY NAME
	IONDX.	T2,			;GET IO INDEX
	  JFCL				;IGNORE ERROR
	MOVEM	T2,TRMUDX		;STORE FOR VARIOUS TRMOPS
	MOVX	T1,.TOTRM		;FUNCTION CODE TO GET TERMINAL TYPE
	MOVE	S1,[XWD 2,T1]		;ARG LIST FOR TRMOP.
	TRMOP.	S1,			;ASK FOR TERMINAL TYPE
	JRST	KINI.2			;NO? ASSUME A DEFAULT
	MOVSI	T1,-<.TIMAX+1>		;IOWD PTR TO SIXBIT NAME TABLE
KINI.1:	CAME	S1,TSTAB(T1)		;MATCH THIS ENTRY?
	AOBJN	T1,KINI.1		;NO, TRY AGAIN
	SKIPL	T1			;HIT ONE?
KINI.2:	MOVX	T1,.TI33		;NO, ASSUME THIS IS A 33
	HRRZS	S1,T1			;GET ONLY ITS INDEX
	PJRST	STYP.3			;SET TYPE AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
K%INIT:	$RETT				;ASSUME ALL O.K.
>;END TOPS20 CONDITIONAL
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 CPASYM)
;
;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)
	$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:	MOVX	S1,.CHESC		;LOAD AN ESCAPE
	PUSHJ	P,K%BOUT		;AND TYPE IT
	MOVEI	S1,"="			;TO SET ALTERNATE MODE
	SKIPN	UESCTB			;DID PROGRAM SET IT
	MOVEI	S1,76			;NOPE.
	PUSHJ	P,K%BOUT		;AND PUT IT OUT
	MOVE	S1,[3,,P1]		;GET TRMOP ARG POINTER
	MOVX	P1,.TOLCT+.TOSET	;SET TT LC
	MOVE	P2,TRMUDX		;GET THE UDX
	SETZ	P3,			;SET A FLAG?
	TRMOP.	S1,			;DO THE TRMOP
	  JFCL				;IGNORE ERROR
	$RETT				;AND RETURN
>  ;END 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%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:	INCHRW	LSTCHR			;GET A CHARACTER
	MOVE 	S1,LSTCHR		;PUT IN AC
	$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
	SETOM	S2			;SET S2 FOR THIS TERMINAL
	TRMNO.	S2,			;GET UDX FOR TERMINAL
	  $RETF				;ERROR..RETURN FALSE
	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:	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?
	TXO	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+.RDFLG	;ELSE, GET A CHARACTER
		 JUMPN C,TXTL.2		;AND CONTINUE IF NOT NULL
		 MOVX S1,RD%BTM		;LOAD "BREAK TERMINATOR" FLAG
		 JRST FINTXT]		;AND RETURN
	HLRZ	S1,RD+.RDIOJ		;GET PRIMARY INPUT JFN
	CAXE	S1,.PRIIN		;TERMINAL?
	JRST	TXTL.4			;NO

	SKIPE	CURESC			;ARE WE IN AN ESCAPE SEQUENCE?
	JRST	TXTL.5			;YES, GET NEXT CHARACTER
	PUSHJ	P,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	.POPJ			;ERROR..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
	$CALL	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
	$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
	PUSHJ	P,MAKBP			;CONVERT IT
	MOVEM	S1,RD+.RDDBP		;AND RE-STORE IT
	AOS	RD+.RDDBC		;ONE MORE BYTE AVAILABLE
	$RETT				;THEN RETURN
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) $C(G),$C(L),$C(Z),.CHESC,.CHLFD,.CHCRT,0]
	RD%PUN+PUNTAB
	RD%BEL+[BYTE(7) .CHLFD,0]
	
	BTBLL==.-BTBL


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

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

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

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

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


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

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

;HERE TO PROCESS ^U (RESTART INPUT)

CCU:	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
	ILDB	C,S1			;THEN GET DELETED CHARACTER

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

	SKIPL	RUBFLG			;WAS PREVIOUS CHAR A RUBOUT?
	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.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