.TITLE	TECO	TECO-11
.NLIST	TTM
.LIST	TOC,MEB,BEX
.SBTTL	TECO-11

;	PDP-11 TECO
;
; PDP-11 TECO STARTED OUT AS A BRUTE FORCE TRANSLATION OF OS/8
;	TECO BY HANK MAURER AND BOB HARTMAN AT FORD OF COLOGNE,
;	WEST GERMANY. OS/8 TECO CAME FROM A PROGRAM ORIGINALLY
;	WRITTEN BY RUSSELL HAMM, WAY BACK WHEN... IT WAS MODIFIED
;	FOR OS/8 BY THE O.M.S.I. CREW, SPEEDED UP, SHORTENED, AND
;	MAKE PDP-10 COMPATIBLE BY RICHARD LARY OF DEC WITH ASSISTANCE
;	FROM MARIO DENOBLI OF THE P?S. THE BRUTE FORCE TRANSLATION
;	WAS FURTHER MUNGED AND ALTERED BY MARK BRAMHALL OF DEC TO
;	BRING IT INTO MORE STANDARD PDP-11 CODE AND MAKE A HIGH/LOG
;	SEGMENT SPLIT. MEMORY SIZE EXPANSION WAS ADDED. FURTHER PDP-10
;	COMPATIBILITY WAS DONE BY ANTON CHERNOFF. VARIOUS NEW COMMANDS
;	AND FEATURES WERE ADDED AGAIN. FINALLY HERE WE ARE... TECO-11!

; LAST EDIT ON 15-NOV-77 BY MARK BRAMHALL

VERSON	=	29.		;VERSION NUMBER

.RADIX	10
.IRP	N,<\VERSON>
.RADIX	8
.LIST

.IDENT	/V'N/
.NLIST
.ENDM

.SBTTL	INTERNAL GLOBALS

; MAIN ENTRY POINT AND GLOBAL EQUATES

.GLOBL	VERSON	;TECO'S VERSION NUMBER (SEE FIRST LISTING PAGE)

.GLOBL	TECO	;"DEAD START" ENTRY POINT
; NOTE:	ENTER TECO HERE WITH THE READ/WRITE AREA ALL SET UP AND
;	POINTED TO BY R5. TECO WILL SET (RESET) THE SP STACK ITSELF.

.GLOBL	RWSIZE	;SIZE OF TECO'S READ/WRITE AREA IN BYTES

.GLOBL	TECOCH	;LOCATION OF THE DEFAULT COMMAND JUMP DISPATCH TABLE
; NOTE:	THIS IS THE DEFAULT COMMAND JUMP DISPATCH TABLE FOR TECO
;	COMMANDS. IT IS 300(8) BYTES IN LENGTH CORRESPONDING TO A
;	WORD ENTRY FOR EVERY ASCII CODE BETWEEN 000(8) AND 137(8)
;	INCLUSIVE. THE ADDRESS "TECOCH" IS THE NORMAL ADDRESS STORED
;	IN "TECOJP(R5)" FOR USE AS THE COMMAND JUMP DISPATCH TABLE.

.GLOBL	ERROR	;LOCATION OF THE GENERAL "ILLEGAL COMMAND" ERROR
; NOTE:	PATCHING THE JUMP DISPATCH TABLE (WHICH STARTS AT "TECOJP(R5)",
;	INDEXED BY ASCII CHARACTER CODE IN RANGE 0 TO 137 TIMES 2
;	FOR WORD ADDRESSING) TO POINT TO THIS LOCATION WILL DISABLE
;	THE CORRESPONDING COMMAND IN TECO. FOR EXAMPLE, PATCHING
;	OFFSET 262(8), WHICH IS 131(8) TIMES 2 WHICH IS THE ASCII CODE
;	FOR 'Y', TO POINT TO THE LOCATION "ERROR" WILL DISABLE THE
;	YANK COMMAND.

; SPECIAL ACCESS TO SOME OF TECO'S ROUTINES

.GLOBL	CRLF	;JSR PC,CRLF
; NOTE:	THIS ROUTINE WILL PRINT <CR>/<LF> ON THE TERMINAL. R0 IS
;	CLOBBERED BY THIS ROUTINE.

.GLOBL	CRLFNO	;JSR PC,CRLFNO
; NOTE:	THIS ROUTINE WILL CANCEL ANY CONTROL/O AND THEN PRINT
;	<CR>/<LF> ON THE TERMINAL. R0 IS CLOBBERED BY THIS
;	ROUTINE.

.GLOBL	DIVD	;JSR PC,DIVD
; IN:	R0 = DIVIDEND (UNSIGNED)
;	R2 = DIVISOR (UNSIGNED)
;
; OUT:	R0 = ANSWER (UNSIGNED)
;	R1 = REMAINDER (UNSIGNED)
;	R3 IS CLOBBERED

.GLOBL	IOERR	;JMP IOERR
; IN:	R0 =  RAD50 OF AN ERROR CODE (3 ALPHANUMERICS)
;	R2 -> AN ASCIZ STRING EXPLAINING THE ERROR
;	   =  0 IF NO EXPLANATION STRING
;
; NOTE:	THIS IS AN ERROR CALL AND NO RETURN TO THE CALLER IS MADE.

.GLOBL	IOERRS	;JMP IOERRS
; IN:	R0 =  RAD50 OF AN ERROR CODE (3 ALPHANUMERICS)
;	R2 -> AN ASCIZ STRING EXPLAINING THE ERROR
;	   =  0 IF NO EXPLANATION STRING
;	R4 =  0 AS A SIGNAL TO ALSO PRINT THE FILENAME BUFFER
;
; NOTE:	THIS IS AN ERROR CALL AND NO RETURN TO THE CALLER IS MADE.

.GLOBL	PRTLIN	;JSR PC,PRTLIN
; OUT:	R0, R1, R3, R4 ARE CLOBBERED
;
; NOTE:	THIS ROUTINE WILL (RE-)PRINT THE MOST RECENT TECO COMMAND
;	LINE USING THE 'TECOIO' ROUTINES "TYPE" AND "PRINT".

.GLOBL	SIZE	;JSR R4,SIZE
; IN:	R1 = DESIRED SIZE IN BYTES OF THE SPECIFIED AREA (TEXT OR
;	Q-REGS) 0<=R1<=077777
;
; OUT:	IF CALL SUCCEEDED THEN THE CARRY IS SET.
;
; NOTE:	THIS CALL IS MADE AS FOLLOWS:
;		... SET UP R1 ...
;		JSR	R4,SIZE		;SIZE THE
;		 .WORD	ZMAX		; TEXT AREA
;	- OR -
;		... SET UP R1 ...
;		JSR	R4,SIZE		;SIZE THE
;		 .WORD	QMAX		; Q-REGISTER AREA

.GLOBL	ZEROD	;JSR R3,ZEROD
; IN:	N(R5) = NUMBER TO CONVERT TO ASCII
;	NMRBAS(R5)  = 0 FOR DECIMAL CONVERSION (WITH OPTIONAL MINUS SIGN)
;		   <> 0 FOR OCTAL CONVERSION (NO MINUS SIGN EVER)
;
; OUT:	R0, R1, R2, R3, R4 ARE CLOBBERED
;
; NOTE:	THE FORMAT OF THIS CALL IS:
;
;	JSR	R3,ZEROD
;	 .WORD	SUBR
;
;	WHERE THE "SUBR" IS THE CHARACTER OUTPUT ROUTINE. "SUBR" WILL
;	BE CALLED FOR EVERY CHARACTER OF THE CONVERSION VIA A
;	'JSR PC,' WITH THE CHARACTER IN R0. "SUBR" CAN CLOBBER
;	ALL REGISTERS EXCEPT R4 AND R5.

;.GLOBL	$E$???	;JMP $E$???
; NOTE:	THE VARIOUS ERRORS THAT TECO ISSUES ARE ALL GLOBALIZED
;	WITH A SYMBOL OF THE FORM $E$??? WHERE THE ??? IS THE
;	THREE CHARACTER ERROR ABBREVIATION. $E$MEM IS THE
;	MEMORY OVERFLOW ERROR FOR EXAMPLE.
;
;	THESE ARE ERROR CALLS AND NO RETURN TO THE CALLER IS MADE.

.GLOBL	.VVV.V	;JSR PC,.VVV.V
; IN:	R0 = THE NUMBER OF LINES (PLUS OR MINUS) TO MOVE "DOT" (WHICH
;	IS P(R5)) FROM WHERE "DOT" CURRENTLY STANDS. (NOTE: THE
;	ARGUMENT BEHAVES JUST LIKE THE L COMMAND TO TECO.)
;
; OUT:	R1 = THE NEW "DOT" AS A RELATIVE VALUE (I.E. 0<=R1<=ZZ(R5)).
;	P(R5) HAS ALSO BEEN UPDATED TO THE SAME VALUE.
;	R0, R2, AND R3 HAVE BEEN CLOBBERED.
;
; NOTE:	THIS ROUTINE IS USED BY TECO FOR THE L COMMAND. IF IT IS NOT
;	DESIRED THAT "DOT" SHOULD BE ALTERED, THEN THE CALLER MUST
;	SAVE P(R5) BEFORE THE CALL AND RESTORE IT UPON RETURN.

.GLOBL	.YYY.Y	;JSR PC,.YYY.Y
; NOTE:	THIS IS SPECIAL ACCESS TO TECO'S ROUTINE FOR THE Y (YANK)
;	COMMAND. IF SOME ERROR OCCURS DURING THE YANK NO RETURN WILL
;	BE MADE TO THE CALLER. NO REGISTERS ARE GUARENTEED RETURNED.

.SBTTL	ASSEMBLY PARAMETERS

; IF THE SYMBOL "E$$TXT" IS DEFINED AS NON-ZERO, THEN ALL ERROR
;	CALLS (INCLUDING THOSE FROM 'TECOIO') PASS AN ASCIZ
;	STRING TO EXPLAIN THE ERROR. IF THE SYMBOL "E$$TXT" IS
;	DEFINED AS ZERO, THEN NO ASCIZ STRINGS NEED BE PASSED
;	AND NO EXPLANATIONS ARE EVER GIVEN.
;
; FURTHERMORE, IF THE SYMBOL "E$$TXT" IS DEFINED AS 1, THEN ALL
;	ERROR MESSAGES IN TECO WILL BE UPPER AND LOWER CASE. IF
;	THE SYMBOL "E$$TXT" IS DEFINED AS -1, THEN ALL MESSAGES
;	WILL BE UPPER CASE ONLY.
;
; THE DEFAULT IS FOR "E$$TXT" TO BE DEFINED AS 1.

.IIF	NDF	E$$TXT,	E$$TXT=1	;DO THE DEFAULT
E$$TXT	=	E$$TXT			;LIST THE SYMBOL
.GLOBL	E$$TXT				;AND GLOBALIZE IT

.IF	GT	E$$TXT
.ENABL	LC				;ONLY IF REQUESTED...
.ENDC

.SBTTL	READ/WRITE AREAS USED BY TECO

; THERE ARE FOUR DIFFERENT READ/WRITE AREAS:
;
; 1) THE MAIN READ/WRITE AREA (TECO'S CRITICAL DATA)
;
;	LENGTH:	DEFINED (FOR 'TECOIO') BY THE TECO DEFINED
;		GLOBAL "RWSIZE". THIS IS THIS AREA'S SIZE
;		IN BYTES.
;	WHERE:	'TECOIO' DETERMINES WHERE THIS AREA IS AND
;		POINTS TO IT BY SETTING R5 TO POINT TO ITS START.
;	SETUP:	THIS WHOLE AREA MUST BE CLEARED TO ALL ZERO
;		EXCEPT FOR THE FOLLOWING ITEMS:
;			TECOSP (SEE AREA #2)
;			TECOPD, PDL, SCHBUF (SEE AREA #3)
;			TXSTOR, QRSTOR, ZMAX, QMAX, CURFRE
;				(SEE AREA #4)
;			INPNTR, OUPNTR (SEE 'TECOIO' SUBROUTINES)
;			TECOJP (SEE INTERNAL GLOBALS)
;		[NOTE: THE ABOVE ITEMS ARE DEFINED BY TECO AS
;			GLOBAL OFFSET VALUES FROM R5.]
;
; 2) THE SP STACK AREA (FOR TECO AND 'TECOIO' USAGE)
;
;	LENGTH:	WHATEVER SEEMS REASONABLE (200(8) BYTES SEEMS
;		A GOOD GUESS).
;	WHERE:	'TECOIO' INITIALLY SETS THE STACK POINTER (SP)
;		TO POINT TO THE END OF THIS AREA +2. IN ADDITION,
;		'TECOIO' SETS "TECOSP" TO ALSO POINT TO THE END
;		OF THIS AREA +2 (I.E. SP STACK RESET VALUE).
;	SETUP:	NONE NEEDED.
;
; 3) THE PUSH-DOWN LIST, SEARCH BUFFER, AND FILENAME BUFFER
;
;	LENGTH:	WHATEVER SEEMS REASONABLE (100(8) BYTES FOR
;		THE PUSH-DOWN LIST AND ANOTHER 100(8) BYTES EACH FOR
;		THE SEARCH AND FILENAME BUFFERS SEEM GOODLY NUMBERS).
;		NOTE THAT THESE THREE AREAS ARE COMBINED INTO ONE
;		AREA. TECO DEPENDS ON THE FACT THAT THIS IS
;		TRUE! FURTHERMORE, THE PUSH-DOWN LIST MUST BE
;		THE LOWEST IN ADDRESS SPACE, THE SEARCH BUFFER
;		IS NEXT, AND THE FILENAME BUFFER MUST BE THE
;		HIGHEST IN ADDRESS SPACE.
;	WHERE:	'TECOIO' POINTS TO THIS AREA BY SETTING:
;			"TECOPD" AND "PDL" TO POINT TO THE AREA'S
;				START (PUSH-DOWN LIST).
;			"SCHBUF" TO POINT INTO THE MIDDLE OF THE
;				AREA (SEARCH BUFFER START).
;			"FILBUF" TO POINT INTO THE MIDDLE OF THE
;				AREA (FILENAME BUFFER START).
;	SETUP:	THIS WHOLE AREA IS CLEARED TO ALL ZERO EXCEPT
;		FOR THE LAST BYTE OF THE SEARCH BUFFER AND THE
;		LAST BYTE OF THE FILENAME BUFFER WHICH ARE SET
;		TO -1.
;
; 4) THE TEXT AND Q-REGISTER DATA AREA
;
;	LENGTH:	'TECOIO' INITIALLY DEFINES THE LENGTH OF THIS
;		AREA, BUT THIS AREA'S SIZE IS CAPABLE OF BEING
;		EXPANDED (IF YOUR ENVIRONMENT ALLOWS IT) AND
;		EVEN SHUFFLED AROUND IN MEMORY. THE AREA'S
;		LENGTH IS REFLECTED BY THE SUM OF "ZMAX"
;		PLUS "QMAX" PLUS "CURFRE". THE AREA IS ORGANIZED
;		SUCH THAT TEXT STORAGE COMES FIRST (LOWEST IN
;		ADDRESS SPACE), THE Q-REGISTER STORAGE COMES
;		NEXT, AND THE FREE SPACE (IF ANY) COMES LAST.
;		"ZMAX", "QMAX", AND "CURFRE" REFLECT THE SIZES
;		OF THESE AREAS RESPECTIVELY.
;	WHERE:	'TECOIO' SETS UP TWO POINTERS TO THIS AREA:
;			"TXSTOR" POINTS TO AREA'S START
;				(TEXT START).
;			"QRSTOR" POINTS TO AREA'S MIDDLE
;				(Q-REGISTER START).
;		NOTE THAT TECO MAY SHUFFLE THE TEXT AND Q-REGISTER
;		AREAS WITHIN THIS WHOLE AREA THUS CHANGING "QRSTOR"
;		AS WELL AS THE MAXIMUMS.
;		'TECOIO' MAY ALSO SHUFFLE THE TEXT AND Q-REGISTER
;		AREA AS A WHOLE TO ANOTHER ADDRESS. THIS AREA AND
;		ITS SUB-AREAS ARE RELATIVE AT ALL 'TECOIO' SUBROUTINE
;		CALLS (EXCEPT THE "SIZER" CALL!!). 'TECOIO' NEED
;		ONLY UPDATE THE POINTERS ("TXSTOR" AND "QRSTOR")
;		WHEN IT DOES ITS SHUFFLES.
;		ONE OF THE 'TECOIO' SUBROUTINE CALLS IS FOR
;		EXPANDING THIS AREA. WHEN 'TECOIO' EXPANDS THE
;		AREA (BY ADDING TO ITS END), 'TECOIO' MUST UPDATE
;		(BY ADDING TO) "CURFRE" TO REFLECT THE ADDITION.
;	SETUP:	NONE NEEDED.

.SBTTL	DOCUMENTATION OF 'TECOIO' SUBROUTINES

; TECO WATCHES THE SIGN BIT (BIT 15) OF THE GLOBAL R5 OFFSET "TFLG"
;	AS A 'STOP SOON' INDICATOR. THIS FLAG IS CLEARED EACH
;	TIME TECO COMES BACK TO THE MAIN COMMAND LEVEL. IF, DURING THE
;	EXECUTION OF TECO, 'TECOIO' WANTS TO STOP TECO (THE RESULT OF A
;	CONTROL/C BEING TYPED FOR INSTANCE), ALL 'TECOIO' HAS TO DO IS SET
;	BIT 15 INTO THE FLAG. FOR EXAMPLE:
;
;		MOVB	#-1,TFLG+1(R5)
;			-OR-
;		BIS	#100000,TFLG(R5)
;
; WHEN TECO DETECTS THE SIGN BIT IN THE FLAG IT CALLS THE 'TECOIO'
;	SUBROUTINE "STOPON" (SEE BELOW) FOR ANY FURTHER ACTION.

; NOTE THAT, UNLESS A REGISTER IS SPECIFICALLY MENTIONED AS
;	OUTPUT FROM A SUBROUTINE, IT MUST BE PRESERVED!

.GLOBL	ALLERR	;JSR PC,ALLERR
; IN:	R0 = RAD50 OF THE ERROR CODE
;
; NOTE:	THIS CALL IS MADE EVERY TIME TECO DETECTS AN ERROR. IT
;	ALLOWS FOR 'TECOIO' TO TAKE ANY NEEDED CLEANUP ACTION
;	REQUIRED SUCH AS RE-ENABLING ECHO AND/OR DISABLING ANY
;	INDIRECT COMMAND FILE CURRENTLY ACTIVE.
;
;	IN ADDITION, IF 'TECOIO' EXITS FROM THIS ROUTINE WITH
;	A JSR PC,@(SP)+ (I.E. A CO-ROUTINE RETURN), THEN IT WILL
;	GET CONTROL BACK AFTER THE ERROR MESSAGE HAS BEEN PRINTED
;	BY TECO (LESS THE TRAILING CR/LF).

.GLOBL	CLSFIL	;JSR PC,CLSFIL
; NOTE:	CLOSES THE CURRENTLY SELECTED INPUT FILE AND OUTPUT
;	FILE AND DOES ANY EB RENAMING NEEDED.
;
;	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	SEE ERROR NOTES IF ERROR.

.GLOBL	CLSOUT	;JSR PC,CLSOUT
; NOTE:	CLOSES THE CURRENTLY SELECTED OUTPUT FILE AND DOES ANY
;	EB RENAMING NEEDED.
;
;	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	SEE ERROR NOTES IF ERROR.

.GLOBL	DELCHR	;JSR PC,DELCHR
; IN:	R0 = DELETED CHARACTER
;
; OUT:	R0, R1, R2, R3, R4 CAN BE CLOBBERED
;
; NOTE:	THIS ROUTINE IS CALLED FOR EVERY CHARACTER "RUBBED OUT". THE
;	MOST SIMPLE (AND TTY COMPATIBLE) IMPLEMENTATION IS TO MAKE
;	THIS ROUTINE IDENTICAL TO THE 'TECOIO' "TYPE" ROUTINE.

.GLOBL	DELLIN	;JSR PC,DELLIN
; OUT:	R0, R1, R2, R3, R4 CAN BE CLOBBERED
;
; NOTE:	THIS ROUTINE IS CALLED EVERY TIME A LINE IS "CONTROL/U'D". THE
;	MOST SIMPLE (AND TTY COMPATIBLE) IMPLEMENTATION IS TO MAKE
;	THIS ROUTINE IDENTICAL TO THE TECO "CRLF" ROUTINE.

.GLOBL	FLAGRW	;JSR PC,FLAGRW
; IN:	R0 = VALUE ABOUT TO BE SET INTO THE FLAG (IF R3=-1)
;	R2 = R5 OFFSET TO THE FLAG
;	R3 =  -1 => SETTING THE FLAG (FROM VALUE IN R0)
;	   <> -1 => READING THE FLAG (FROM C(R2+R5))
;
; NOTE:	THIS ROUTINE ALLOWS 'TECOIO' DO DETECT WHEN THE USER SETS AND/OR
;	READS TECO FLAG VALUES.

.GLOBL	DATE	;JSR PC,DATE
; OUT:	R0 = TODAY'S DATE IN SYSTEM INTERNAL FORM

.GLOBL	GETBUF	;JSR PC,GETBUF
; IN:	R0 = POINTER TO BUFFER START
;	R1 = MAXIMUM SIZE OF TRANSFER
;	R2 = AMOUNT OF FREE SPACE TO LEAVE
;
; OUT:	IF NO ERROR THEN CARRY BIT IS CLEAR AND:
;	ZZ(R5) HAS BEEN UPDATED (ADDED TO) TO INDICATE THE AMOUNT
;		TRANSFERED INTO THE BUFFER
;	FFFLAG(R5) HAS BEEN SET TO:
;		-1 IF BUFFER ENDED WITH A FORM FEED
;		 0 IF BUFFER ENDED WITHOUT A FORM FEED
;		NOTE: THE FORM FEED IS NOT STORED IN THE BUFFER OR
;			COUNTED IN ZZ(R5).
;	EOFLAG(R5) HAS BEEN SET TO:
;		-1 IF FURTHER CALLS WOULD BE FUTILE (I.E. EOF)
;		 0 IF FURTHER CALLS MIGHT OBTAIN MORE DATA
;	SEE ERROR NOTES IF ERROR.
;
; NOTE:	THIS CALL IS MADE FOR 'YANKS' AND 'APPENDS'.
;
;	IF THE CALL IS FOR 'YANK' THEN:
;		R0 -> START OF TEXT BUFFER
;		R1 =  CURRENT SIZE OF TEXT BUFFER
;		      NOTE: THE TEXT BUFFER HAS BEEN ENLARGED AS MUCH
;				AS POSSIBLE WITHOUT CALLING FOR THE
;				ADDITION OF MORE MEMORY.
;		R2 =  (1/4) OF THE SIZE OF THE ENLARGED TEXT BUFFER
;
;	IF THE CALL IS FOR 'APPEND' THEN:
;		R0 -> FREE TEXT BUFFER AREA
;		R1 =  REMAINING SPACE IN THE ENLARGED TEXT BUFFER
;		      NOTE: R1 IS ALWAYS AT LEAST 256. FOR THIS CALL.
;		R2 =  (1/4) OF THE SIZE OF THE ENLARGED TEXT BUFFER
;		   =  R1 FOR ':APPEND' (I.E., APPEND ONLY 1 LINE)
;
;	THE BUFFER IS FILLED UNTIL:
;
;	 1) FORM FEED FOUND.
;	 2) LINE FEED FOUND AND (R1 - (# CHARS STORED)) < R2.
;	 3) (R1 - (# CHARS STORED)) <= 128.

.GLOBL	GETFLS	;JSR PC,GETFLS
; IN:	R2 = 'B-'R FOR EB CALL
;	   = 'I-'R FOR EI CALL
;	   = 'N-'R FOR EN CALL
;	   = 'R-'R FOR ER CALL
;	   = 'W-'R FOR EW CALL
;	THE FILE SPECIFICATION STRING IS IN THE FILENAME
;		BUFFER (STARTING AT FILBUF(R5)) AND IS TERMINATED
;		WITH A BYTE OF 0.
;
; OUT:	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	IF ERROR IS "THAT FILE DOESN'T EXIST" THEN
;		1) CARRY BIT IS SET
;		2) CODE IN R0 IS RAD50 FOR "FNF"
;		3) OPTIONAL ASCIZ STRING POINTER IN R2
;	SEE ERROR NOTES FOR OTHER ERRORS.
;
; NOTE:	BY CONVENTION AN ER OR EW CALL WITH A NULL LENGTH FILE
;	SPECIFICATION STRING MEANS THAT A SWITCH BACK TO THE
;	PRIMARY INPUT OR OUTPUT FILE IS DESIRED. NO ACTUAL I/O
;	CALLS NEED BE MADE; ONLY A POINTER SWITCH.
;
;	THE R5 OFFSET LOCATIONS "INPNTR" AND "OUPNTR" ARE USED
;	BY TECO TO DETERMINE WHETHER THE CURRENTLY SELECTED INPUT
;	OR OUTPUT FILE IS OPEN. IF THE DATA POINTED TO BY THE
;	ADDRESS IN "INPNTR" OR "OUPNTR" IS 0, THAT INPUT OR OUTPUT
;	FILE IS ASSUMED NOT OPEN. ANY NON-ZERO VALUED DATA WORD
;	MEANS THE INPUT OR OUTPUT FILE IS OPEN. IT IS THE JOB OF
;	'GETFLS' (AND 'CLSFLS',  'INPSAV', ETC.) TO KEEP THESE
;	POINTERS MEANINGFUL.

.GLOBL	GEXIT	;JMP GEXIT
; NOTE:	THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM TO
;	"GO".
;	THE STRING ARGUMENT TO EG IS PASSED IN THE FILENAME
;	BUFFER TERMINATED WITH A BYTE OF 0.

.GLOBL	INPSAV	;JSR PC,INPSAV
; IN:	R3 =  -1 => NUMERIC ARGUMENT SPECIFIED (IT IS IN N(R5))
;	   <> -1 => NO NUMERIC ARGUMENT SPECIFIED
;
; NOTE:	SWITCH TO THE SECONDARY INPUT FILE. THIS SWITCH SHOULD ONLY
;	INVOLVE SWITCHING THE "INPNTR" POINTER.

.GLOBL	KILFIL	;JSR PC,KILFIL
; NOTE: CLOSES AND KILLS THE CURRENTLY SELECTED OUTPUT FILE.
;	'KILFIL' ALSO UNDOES ANY EB RENAMING THAT MIGHT BE PENDING
;	ON THE CURRENTLY SELECTED OUTPUT FILE.
;
;	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	SEE ERROR NOTES IF ERROR.

.GLOBL	LISTEN	;JSR PC,LISTEN
; IN:	R0 =  0 MEANS DELIMITERS ARE: ESCAPE, DELETE, CTRL/U, CTRL/G
;	R0 <> 0 MEANS ANYTHING IS A DELIMITER (SINGLE CHARACTER MODE)
;
; OUT:	R0 = RETURNED CHARACTER (001 <= CHARACTER <= 177)
;
; NOTE:	IT IS THE RESPONSIBILITY OF 'LISTEN' TO APPEND A LINE
;	FEED TO A CARRIAGE RETURN (IF THE SYSTEM DOESN'T).
;	IT IS ALSO THE RESPONSIBILITY OF 'LISTEN' TO ECHO
;	THE TYPED CHARACTERS (IF THE SYSTEM DOESN'T).
;	'LISTEN' MAY IMPLEMENT ANY OF THE STANDARD BITS OF THE GLOBAL
;	R5 OFFSET "ETYPE" THAT ARE MEANINGFUL TO IT.

.GLOBL	NOCTLO	;JSR PC,NOCTLO
; NOTE:	'NOCTLO' CANCELS ANY CTRL/O EFFECT CURRENTLY IN PROGRESS.

.GLOBL	OUTSAV	;JSR PC,OUTSAV
; IN:	R3 =  -1 => NUMERIC ARGUMENT SPECIFIED (IT IS IN N(R5))
;	   <> -1 => NO NUMERIC ARGUMENT SPECIFIED
;
; NOTE:	SWITCH TO THE SECONDARY OUTPUT FILE. THIS SWITCH SHOULD ONLY
;	INVOLVE SWITCHING THE "OUPNTR" POINTER.

.GLOBL	PRINT	;JSR PC,PRINT
; IN:	R3 = POINTER TO STRING OF CHARACTERS TO PRINT
;	R4 = NUMBER OF CHARACTERS TO PRINT (0 <= R4 <= 32767.)
;
; NOTE:	JUST LIKE 'TYPE', 'PRINT' IS RESPONSIBLE FOR ANY CHARACTER
;	CONVERSIONS (IF SYSTEM DOESN'T DO IT FOR YOU).
;	'PRINT' MAY IMPLEMENT ANY OF THE STANDARD BITS OF THE GLOBAL
;	R5 OFFSET "ETYPE" THAT ARE MEANINGFUL TO IT.

.GLOBL	PRINTF	;JSR PC,PRINTF
; IN:	R3 = POINTER TO STRING OF CHARACTERS TO PRINT
;	R4 = NUMBER OF CHARACTERS TO PRINT (0 <= R4 <= 32767.)
;
; NOTE:	JUST LIKE 'TYPE', 'PRINTF' IS RESPONSIBLE FOR ANY CHARACTER
;	CONVERSIONS (IF SYSTEM DOESN'T DO IT FOR YOU).
;	'PRINTF' MAY IMPLEMENT ANY OF THE STANDARD BITS OF THE GLOBAL
;	R5 OFFSET "ETYPE" THAT ARE MEANINGFUL TO IT.
;	'PRINTF' IS ALSO SPECIFICALLY RESPONSIBLE FOR ANY CASE
;	FLAGGING (AS CONTROLED BY OFFSET "EUFLAG") DESIRED.

.GLOBL	PUTBUF	;JSR PC,PUTBUF
; IN:	R0 = POINTER TO BUFFER START
;	R1 = NUMBER OF CHARACTERS TO OUTPUT
;	R2 = -1 MEANS END BUFFER WITH FORM FEED
;	   =  0 MEANS DON'T ADD FORM FEED TO BUFFER
;
; OUT:	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	SEE ERROR NOTES IF ERROR.

.GLOBL	SIZER	;JSR PC,SIZER
; IN:	R1 = AMOUNT IN BYTES TO EXPAND THE TEXT & Q-REG AREA
;
; OUT:	IF AREA CAN (AND HAS BEEN) EXPANDED THE AMOUNT DESIRED,
;	THEN EXIT WITH THE CARRY CLEAR AND "CURFRE" UPDATED. IF
;	THE AREA CANNOT BE EXPANDED THAT AMOUNT, THEN EXIT WITH
;	THE CARRY SET AND "CURFRE" UNTOUCHED.
;
.GLOBL	SIZERB
; NOTE:	THIS IS THE AMOUNT TO CALL SIZER WITH WHEN A 'GETBUF' CALL
;	DOES NOT RETURN WITH THE FORM FEED FLAG SET (I.E. THE DEFAULT
;	AMOUNT TO EXPAND MEMORY IN BYTES).

.GLOBL	STOPON	;JSR PC,STOPON
; NOTE:	WHENEVER TECO DETECTS THE SIGN BIT (BIT 15) IN "TFLG(R5)" IT CALLS
;	THIS SUBROUTINE. IF NO FURTHER ACTION IS NEEDED, AS IS THE CASE
;	FOR CTRL/C AST SYSTEMS, THE SUBROUTINE CAN SIMPLY EXIT. IF MORE
;	PROCESSING IS NEEDED, AS IS THE CASE FOR NON-AST CTRL/C INDICATION
;	SYSTEMS, THE SUBROUTINE CAN EITHER:
;
;		1) SIMPLY RETURN - THIS CAUSES THE ?XAB ERROR TO OCCUR.
;
;		2) RETURN TO THE CALLER'S CALLER (E.G. TST (SP)+; RTS PC) -
;			THIS CAUSES THE CONTINUED EXECUTION OF TECO.

.GLOBL	SWITCH	;JSR PC,SWITCH
; OUT:	R0 = VALUE OF SWITCH REGISTER

.GLOBL	TEXIT	;JMP TEXIT
; NOTE:	THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM.

.GLOBL	TIME	;JSR PC,TIME
; OUT:	R0 = TIME OF DAY IN SYSTEM INTERNAL FORM

.GLOBL	TLISTN	;JSR PC,TLISTN
; OUT:	R0 = RETURNED CHARACTER (001 <= CHARACTER <= 177)
;
; NOTE:	IT IS THE RESPONSIBILITY OF 'TLISTN' TO APPEND A LINE
;	FEED TO A CARRIAGE RETURN (IF THE SYSTEM DOESN'T).
;	IT IS ALSO THE RESPONSIBILITY OF 'TLISTN' TO ECHO
;	THE TYPED CHARACTERS (IF THE SYSTEM DOESN'T).
;	'TLISTN' MAY IMPLEMENT ANY OF THE STANDARD BITS OF THE GLOBAL
;	R5 OFFSET "ETYPE" THAT ARE MEANINGFUL TO IT.

.GLOBL	TYPE	;JSR PC,TYPE
; IN:	R0 = CHARACTER TO OUTPUT TO TERMINAL
;
; NOTE:	ANY CHARACTER CONVERSIONS (TAB'S, ETC.) ARE TO BE DONE BY
;	'TYPE' (IF THE SYSTEM DOESN'T).
;	'TYPE' MAY IMPLEMENT ANY OF THE STANDARD BITS OF THE GLOBAL
;	R5 OFFSET "ETYPE" THAT ARE MEANINGFUL TO IT.

.GLOBL	TYPEF	;JSR PC,TYPEF
; IN:	R0 = CHARACTER TO OUTPUT TO TERMINAL
;
; NOTE:	ANY CHARACTER CONVERSIONS (TAB'S, ETC.) ARE TO BE DONE BY
;	'TYPEF' (IF THE SYSTEM DOESN'T).
;	'TYPEF' MAY IMPLEMENT ANY OF THE STANDARD BITS OF THE GLOBAL
;	R5 OFFSET "ETYPE" THAT ARE MEANINGFUL TO IT.
;	'TYPEF' IS ALSO SPECIFICALLY RESPONSIBLE FOR ANY CASE
;	FLAGGING (AS CONTROLED BY OFFSET "EUFLAG") DESIRED.

.GLOBL	WATCH	;JSR PC,WATCH
; IN:	R0 = NWATCH(R5) FOR THE DEFAULT CALL
;	   = ARGUMENT VALUE FOR THE EXPLICIT CALL
;
; OUT:	R0 = WHAT TO PUT IN NWATCH(R5) FOR THE EXPLICIT CALL
;
; NOTE:	YOU CAN ALSO KEEP SCOPE BUSY AT ANY STALL TIME OF COURSE.
;       THE NUMBER OF LINES TO WATCH IS ALWAYS AVAILABLE IN NWATCH(R5).

.GLOBL	XITNOW	;JSR PC,XITNOW
; NOTE:	IF 'TECOIO' CONDITIONED THE TERMINAL NON-NORMALLY FOR
;	TECO, THEN THIS IS THE TIME TO UNCONDITION IT. SHOULD
;	INPUT AND/OR OUTPUT BE REQUESTED AGAIN BY TECO (ONLY
;	HAPPENS IN CASE OF AN I/O ERROR), YOU MUST DETECT THE
;	FACT THAT YOU UNCONDITIONED THE TERMINAL AND RE-CONDITION
;	IT.

; ERROR NOTES:
;	ON ERROR EXITS SET:
;		CARRY BIT ON (I.E. "BCS" BRANCHES)
;		R0 = RAD50 OF ERROR CODE
;		R2 = POINTER TO ASCIZ TEXT OF ERROR (OR 0 FOR NO TEXT)

.SBTTL	GENERAL PDP-11 DEFINITIONS

; GENERAL REGISTERS

R0	=	%0
R1	=	%1
R2	=	%2
R3	=	%3
R4	=	%4
R5	=	%5
SP	=	%6
PC	=	%7

.SBTTL	CHARACTER DEFINITIONS

NUL	=	000	;ASCII NULL
BEL	=	007	;ASCII BELL (CONTROL/G)
TAB	=	011	;ASCII HORIZONTAL TAB
LF	=	012	;ASCII LINE FEED
VT	=	013	;ASCII VERTICAL TAB
FF	=	014	;ASCII FORM FEED
CR	=	015	;ASCII CARRIAGE RETURN
ESC	=	033	;ASCII ESCAPE (ALSO CALLED ALTMODE)
SPACE	=	040	;ASCII SPACE
LAB	=	'<	;ASCII LEFT ANGLE BRACKET
RAB	=	'>	;ASCII RIGHT ANGLE BRACKET
DEL	=	177	;ASCII DELETE (ALSO CALLED RUBOUT)

.SBTTL	SPECIAL Q-REGISTERS

; AUXILIARY REGISTER FOR Q-REG PUSH/POP

AUXQRG	=	<'Z-'A+1>+<'9-'0+1>+1

; COMMAND REGISTER

CMDQRG	=	AUXQRG+1

.SBTTL	MACROS

.MACRO	SORT	TABLE,ENTRY
	 JSR	R4,SORT'ENTRY
	  .WORD	TABLE
.ENDM	SORT

.MACRO	PUSH	A,B,C,D,E
	 JSR	R4,PUSH
.NARG	$$$$$$
	  .BYTE	$$$$$$,A
$$$$$$	=	A-2
.IRP	OFFSET,<A,B,C,D,E>
.IF	NB	<OFFSET>
$$$$$$	=	$$$$$$+2
.IF	NE	$$$$$$-OFFSET
.ERROR	; OFFSET IS OUT OF ORDER
.ENDC
.ENDC
.ENDM
.ENDM	PUSH

.MACRO	PUSHP	A,B,C,D,E
	 JSR	R4,PUSHP
.NARG	$$$$$$
	  .BYTE	$$$$$$,A
$$$$$$	=	A-2
.IRP	OFFSET,<A,B,C,D,E>
.IF	NB	<OFFSET>
$$$$$$	=	$$$$$$+2
.IF	NE	$$$$$$-OFFSET
.ERROR	; OFFSET IS OUT OF ORDER
.ENDC
.ENDC
.ENDM
.ENDM	PUSHP

.MACRO	POP	A,B,C,D,E
	 JSR	R4,POP
.NARG	$$$$$$
	  .BYTE	$$$$$$,A+2
$$$$$$	=	A+2
.IRP	OFFSET,<A,B,C,D,E>
.IF	NB	<OFFSET>
$$$$$$	=	$$$$$$-2
.IF	NE	$$$$$$-OFFSET
.ERROR	; OFFSET IS OUT OF ORDER
.ENDC
.ENDC
.ENDM
.ENDM	POP

.MACRO	SKPSET	CHR
	 JSR	R4,SKPSET
	  .WORD	CHR
.ENDM	SKPSET

.MACRO	TSTNXT	CHR
	 JSR	R4,TSTNXT
	  .WORD	CHR
.ENDM	TSTNXT

.MACRO	SIZE	AREA
	 JSR	R4,SIZE
.IF	IDN	<AREA>,<TEXT>
	  .WORD	ZMAX
.IFF
.IF	DIF	<AREA>,<QREGS>
.ERROR	; AREA IS ILLEGAL IN SIZE CALL
.ENDC
	  .WORD	QMAX
.ENDC
.ENDM	SIZE

.MACRO	OFFSET	LABEL,AMT
LABEL:	.BLKW	AMT
.GLOBL	LABEL
.ENDM	OFFSET

.MACRO	.TABLE	KIND,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T
.IF	NB	<A>
.NARG	$$$$$$
.IF	NE	$$$$$$&1
.LIST
	 .ODD
.NLIST
.ENDC
	 .BYTE	-1
.ENDC
.IRP	CHR,<T,S,R,Q,P,O,N,M,L,K,J,I,H,G,F,E,D,C,B,A>
.IF	NB	<CHR>
.IF	IDN	<CHR>,<LAB>
	 .BYTE	CHR
.IFF
.IF	IDN	<CHR>,<RAB>
	 .BYTE	CHR
.IFF
	 .BYTE	''CHR
.ENDC
.ENDC
.ENDC
.ENDM
.LIST
.'KIND:
.NLIST
.IRP	CHR,<A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T>
.IF	NB	<CHR>
	 .WORD	KIND''CHR
.ENDC
.ENDM
.ENDM	.TABLE

.MACRO	CMDCHR	VAL
.SBTTL	COMMAND CHARACTER VAL
.IRP	NUM,<\<VAL+1000>>
$$'NUM:
.CSECT	TECOCH
.	=	VAL*2+TECOCH
.NLIST
	 .WORD	$$'NUM
.LIST
.ENDM
.CSECT	TECORO
.ENDM	CMDCHR

.MACRO	MESSAG	TEXT
.CSECT	TECOER
$$$$$$	=	.
.CSECT	TECORO
	  .WORD	$$$$$$
.CSECT	TECOER
.NLIST	BEX
	   .ASCIZ TEXT
.LIST	BEX
.CSECT	TECORO
.ENDM	MESSAG

.MACRO	ERROR	NUM,TEXT,STRING
.IF	NDF	$E$'NUM
$E$'NUM:
.ENDC
.GLOBL	$E$'NUM
$$$$$$	=	.-$E$'NUM
.IF	GE	$$$$$$-400
	 JMP	$E$'NUM
.MEXIT
.ENDC
.IF	NE	$$$$$$
	 BR	$E$'NUM
.MEXIT
.ENDC
.IF	NE	E$$TXT
.IF	NB	<STRING>
	 JSR	R4,ERRORS
	  .RAD50 /NUM/
	MESSAG	<TEXT>
$$$$$$	=	0
.MEXIT
.ENDC
$$$$$$	=	0
.IRPC	CHR,<NUM>
$$$$$$	=	$$$$$$*40+<''CHR-<'A-1>>
.ENDM
.IF	EQ	$$$$$$&177740-<'N-<'A-1>*40+'A-<'A-1>*40+0>
	 JSR	R4,ERRORA
$$$$$$	=	1.
.IRPC	CHR,<NUM>
.IF	EQ	$$$$$$-3.
	  .BYTE	''CHR-<'A-1>
.ENDC
$$$$$$	=	$$$$$$+1.
.ENDM
.NCHR	$$$$$$,<TEXT>
.IF	EQ	$$$$$$-17.
.IRPC	CHR,<TEXT>
.IF	EQ	$$$$$$-2.
	  .BYTE	''CHR
.ENDC
$$$$$$	=	$$$$$$-1.
.ENDM
.MEXIT
.ENDC
.IF	EQ	$$$$$$-24.
.IRPC	CHR,<TEXT>
.IF	EQ	$$$$$$-6.
	  .BYTE	''CHR-100
.ENDC
$$$$$$	=	$$$$$$-1.
.ENDM
.MEXIT
.ENDC
.ERROR	; NUM ERROR IN ILLEGAL FORMAT!!
	  .BYTE	'?
.MEXIT
.ENDC
.IF	EQ	$$$$$$&176037-<'I-<'A-1>*40+0*40+'C-<'A-1>>
	 JSR	R4,ERRORC
$$$$$$	=	1.
.IRPC	CHR,<NUM>
.IF	EQ	$$$$$$-2.
	  .BYTE	''CHR-<'A-1>*5
.ENDC
$$$$$$	=	$$$$$$+1.
.ENDM
.NCHR	$$$$$$,<TEXT>
.IF	EQ	$$$$$$-21.
.IRPC	CHR,<TEXT>
.IF	EQ	$$$$$$-12.
	  .BYTE	''CHR
.ENDC
$$$$$$	=	$$$$$$-1.
.ENDM
.MEXIT
.ENDC
.IF	EQ	$$$$$$-30.
.IRPC	CHR,<TEXT>
.IF	EQ	$$$$$$-18.
	  .BYTE	''CHR-100
.ENDC
$$$$$$	=	$$$$$$-1.
.ENDM
.MEXIT
.ENDC
.ERROR	; NUM ERROR IN ILLEGAL FORMAT!!
	  .BYTE	'?
.MEXIT
.ENDC
.IFTF
	 JSR	R4,ERRMSG
	  .RAD50 /NUM/
.IFT
	MESSAG	<TEXT>
.ENDC
.ENDM	ERROR

.SBTTL	DEFINE THE OFFSETS FROM R5

.ASECT
.	=	0 ;OFFSETS START AT ABSOLUTE ZERO...

OFFSET	SCANP	;COMMAND LINE EXECUTION POINTER
.IIF	NE	SCANP, .ERROR ;"SCANP" MUST BE AT OFFSET 0!!
OFFSET	MPDL	;MACRO FLAG (SAVED "PDL")
OFFSET	QCMND	;COMMAND LINE OR MACRO Q-REG NUMBER
OFFSET	ITRST	;ITERATION START
OFFSET	ITRCNT	;ITERATION COUNT
OFFSET	NOPR	;ARITHMETIC OPERATOR
OFFSET	NACC	;EXPRESSION ACCULMULATOR
OFFSET	NFLG	;NUMBER FLAG
OFFSET	N	;NUMBER
OFFSET	M	; ARGUMENTS
OFFSET	OFLG	;OPERATOR FLAG
OFFSET	CFLG	;COMMA FLAG
OFFSET	CLNF	;COLON FLAG
OFFSET	QFLG	;QUOTED STRING FLAG
OFFSET	OSCANP	;BACKUP FOR "SCANP"
OFFSET	QUOTE	;QUOTE CHARACTER (NORMALLY ESCAPE)
OFFSET	QNMBR	;CURRENT Q-REG NUMBER
OFFSET	QLENGT	;COMMAND LINE LENGTH
OFFSET	CNDN	;COUNTER FOR " NESTING
OFFSET	NP	;VALUE OF CURRENT NUMBER
OFFSET	PST	;CHARACTER POSITION AT SEARCH START
OFFSET	TEMP	;GENERAL TEMPORARY READ/WRITE WORD
OFFSET	TFLG	;TRACE FLAG AND STOP INDICATOR
OFFSET	PCNT	;PAREN PUSH COUNTER
OFFSET	REPFLG	;REPLACE FLAG

CLREND:		;END OF EACH COMMAND CLEAR AREA

OFFSET	FFFLAG	;FORM FEED FLAG
OFFSET	P	;CURRENT TEXT POINTER (.)
OFFSET	QBASE	;COMMAND LINE Q-REG BASE OFFSET
OFFSET	NMRBAS	;RADIX
OFFSET	ERRPOS	;ERROR POSITION
OFFSET	PDL	;PUSH-DOWN LIST POINTER
OFFSET	LSCHSZ	;-(LENGTH) OF LAST SKIPPED QUOTED STRING
OFFSET	EVFLAG	;EDIT VERIFY FLAG
OFFSET	EUFLAG	;CASE FLAGGING FLAG
OFFSET	ETYPE	;EDIT TYPEOUT FLAG
OFFSET	ESFLAG	;EDIT SEARCH FLAG
OFFSET	EHELP	;EDIT HELP LEVEL
OFFSET	EDIT	;EDIT LEVEL FLAG
OFFSET	SFLG	;SEARCH MODE FLAG
OFFSET	EOFLAG	;END-OF-FILE FLAG
OFFSET	NWATCH	;NUMBER OF LINES TO DISPLAY ON SCOPE
OFFSET	INDIR	;NON-ZERO IF PROCESSING INDIRECT COMMAND FILE
OFFSET	INPNTR	;@INPNTR(R5) IS NON-ZERO IF INPUT FILE ACTIVE
OFFSET	OUPNTR	;@OUPNTR(R5) IS NON-ZERO IF OUTPUT FILE ACTIVE

OFFSET	TXSTOR	;TEXT BUFFER BIAS
OFFSET	ZMAX	;TEXT BUFFER SIZE
OFFSET	ZZ	;TEXT BUFFER SIZE IN USE

OFFSET	QRSTOR	;Q-REG BUFFER BIAS
OFFSET	QMAX	;Q-REG BUFFER SIZE
OFFSET	QZ	;Q-REG BUFFER SIZE IN USE

OFFSET	CURFRE	;CURRENT FREE SPACE IN BYTES

OFFSET	QARRAY,<AUXQRG*2> ;Q-REGISTER ARRAY
OFFSET	QPNTR	;COMMAND Q-REGISTER OFFSET
OFFSET	QLCMD	;SIZE OF LAST COMMAND

OFFSET	TECOSP	;SP STACK RESET VALUE
OFFSET	TECOPD	;PDL RESET VALUE
OFFSET	SCHBUF	;SEARCH BUFFER POINTER
OFFSET	FILBUF	;FILENAME BUFFER POINTER
OFFSET	TECOJP	;COMMAND JUMP DISPATCH TABLE VALUE

RWSIZE:		;SIZE OF TOTAL READ/WRITE AREA IN BYTES

.SBTTL	INITIALIZE TECO'S CODE, DISPATCH, MESSAGE SECTIONS

; INITIALLY DEFINE THE SECTIONS

.CSECT	TECORO
.CSECT	TECOCH
.CSECT	TECOER

; THIS INITIALLY LOADS THE COMMAND DISPATCH TABLE

.CSECT	TECOCH

TECOCH:				;WE NEED A LABEL AT OFFSET=0

.REPT	'_+1			;FOR WHOLE COMMAND SET...
.NLIST
	.WORD	ERROR		;DISPATCH TO "ILLEGAL COMMAND"
.LIST
.ENDR

; NOW BACK TO THE CODE SECTION

.CSECT	TECORO

ERROR:	ERROR	ILL,<"Illegal command">

.ENABL	LSB

10$:	TST	QPNTR(R5)		;ANYTHING LEFT TO REMOVE?
	BEQ	30$			;NOPE, SO EXIT Z=1 AND C=0
	DEC	QZ(R5)			;YEP, REMOVE LAST CHARACTER
	DEC	QPNTR(R5)		; ENTERED INTO COMMAND
20$:	MOV	QZ(R5),R3		;GET POINTER TO END+1
	ADD	QRSTOR(R5),R3		; AND MAKE IT ABSOLUTE
	MOVB	(R3),R0			;  THEN SET THE REMOVED CHARACTER
	SEC				;SET C=1 TO SAY SOMETHING DONE
	MOV	QPNTR(R5),R4		;NOW GET SIZE OF THE COMMAND
30$:	RTS	PC			; AND EXIT WITH Z=1 IF NO COMMAND

CHKSTP:	TST	TFLG(R5)		;SOMEONE TRYING TO STOP US?
	BPL	50$			;NO, CONTINUE
40$:	CLRB	TFLG+1(R5)		;CLEAR THE STOP SOON INDICATOR
	JSR	PC,STOPON		; AND ALERT 'TECOIO' ABOUT IT
	ERROR	XAB,<"Execution aborted">

CMDCHR	<'?>				;"?" IS THE TRACE FLIP/FLOP
	COMB	TFLG(R5)		;SO FLIP THE FLOP
50$:	RTS	PC			; AND EXIT

.SBTTL	SCAN

.CSMDQ:	INC	CNDN(R5)		;INTO ONE MORE CONDITIONAL LEVEL
	BR	SCAN			; AND CONTINUE SCANNING

60$:	CMP	(SP),#290$		;END OF COMMAND; MAIN CALL?
	BNE	70$			;NOPE, SO MUST BE AN ERROR
	CMP	MPDL(R5),PDL(R5)	;YES, IN MACRO?
	BNE	70$			;NO (OR UNTERMINATED MACRO)
	POP	ITRST,QCMND,MPDL,SCANP	;YES, RESTORE ALL ITEMS
	MOV	QCMND(R5),R0		;GET COMMAND Q-REG NUMBER
	JSR	PC,SETCMD		; AND (RE)SET COMMAND
.CSMD:					;JUST SKIP NEXT CHARACTER
SCAN:	MOV	(R5),R0			;GET CURRENT COMMAND POINTER
	CMP	R0,QLENGT(R5)		;END OF THIS COMMAND?
	BHIS	60$			;YES, CHECK FOR A MACRO
	ADD	QBASE(R5),R0		;NO, ADD BASE OF COMMAND Q-REG
	ADD	QRSTOR(R5),R0		; AND MAKE ABSOLUTE POINTER
	MOVB	(R0),R0			;GET NEXT CHARACTER
	INC	(R5)			;THEN BUMP POINTER ONE AHEAD
TRACE:	TST	TFLG(R5)		;TRACING?
	BEQ	50$			;NOPE
	BMI	40$			;NO, BUT TRY TO STOP US NOW
	JMP	TYPE			;YES, SO ANNOUNCE CHARACTER

70$:	TST	(SP)+			;PURGE THE RETURN ADDRESS
	TST	MPDL(R5)		;WITHIN MACRO?
	BEQ	100$			;NO, BACK TO MAIN EDIT LEVEL
	ERROR	UTM,<"Unterminated macro">

CMDCHR	<'C-100>			;"CTRL/C" IS EXIT FROM MACRO/TECO
	CMP	QCMND(R5),#CMDQRG	;ARE WE WITHIN A MACRO NOW?
	BNE	TECOCR			;YES, JUST ABORT TECO EXECUTION
	JMP	TEXIT			;NO, TOP LEVEL, SO EXIT RIGHT NOW

.SBTTL	COMMAND INPUT - STAR

.CMDST:	MOV	#-1,R1			;GUARENTEE NO COMPARES
	TST	QPNTR(R5)		;WAS THIS THE 1ST THING TYPED?
	BNE	90$			;NOPE, CHECK FOR PRECEEDING BEL
	JSR	PC,LISTEN		;YES, SO GET NEXT AS Q-REG NAME
	JSR	PC,QREFST		; AND VALIDATE IT AND SUM IT
	MOV	QLCMD(R5),R0		;GET LAST COMMAND'S SIZE
	ADD	R0,QZ(R5)		;INCREASE Q-REG AREA SIZE BY THAT
	MOV	R0,QPNTR(R5)		; AND PLACE IT IN COMMAND Q-REG
	JSR	PC,QADJ			;NOW ADJUST SELECTED REG TO THAT SIZE
	MOV	R2,R3			;SAVE OFFSET TO SELECTED Q-REG
	MOV	#CMDQRG,R0		;NOW SET TO SUM THE
	JSR	PC,QSUMX		; COMMAND Q-REG
	ADD	QRSTOR(R5),R3		;ABS POINTER TO SELECTED Q-REG
	ADD	QRSTOR(R5),R2		;ABS POINTER TO COMMAND Q-REG
	MOV	(R1),R1			;GET SIZE OF DATA TO MOVE
80$:	DEC	R1			;MORE TO MOVE?
	BMI	TECOCR			;NO, RESTART US
	MOVB	(R2)+,(R3)+		;YES, MOVE A BYTE
	BR	80$			; AND LOOP FOR MORE

.SBTTL	COMMAND INPUT - SPACE

.CMDSP:	MOV	#LF,R1			;COMPARE CHARACTER IS LINE FEED
90$:	CMP	TEMP(R5),#BEL		;PRECEEDED BY A BELL?
	BNE	170$			;NO, SO NORMAL
	JSR	PC,CRLFNO		;YES, RETURN THE CARRIAGE
	JSR	PC,10$			;REMOVE 1ST BELL AND GET POINTER, COUNT
	BEQ	110$			;NOTHING, SO RE-PROMPT
	JSR	PC,240$			;RE-PRINT THE COMMAND LINE(S)
	BR	140$			; AND CONTINUE

.SBTTL	COMMAND INPUT - BELL

.CMDBL:	MOV	#100000,ERRPOS(R5)	;FLAG THIS AS A BELL
	CMP	R0,TEMP(R5)		;2ND BELL?
	BNE	180$			;NOPE, SO NORMAL
	JSR	PC,10$			;REMOVE 1ST BELL AND GET COUNT
	MOV	R4,QLCMD(R5)		;NOW SAVE THE COUNT AS LAST COMMAND COUNT
	BR	TECOCR			; AND RESTART US

.SBTTL	COMMAND INPUT - QUESTION MARK

.CMDQM:	MOV	ERRPOS(R5),R4		;GET ERROR POSITION
	BLE	170$			;IF NONE, THEN NORMAL CHARACTER
	JSR	PC,CRLFNO		;NO CTRL/O AND RESTORE CARRIAGE
	MOV	QBASE(R5),R3		;GET BASE OF LAST COMMAND
	ADD	QRSTOR(R5),R3		;NOW MAKE POINTER ABSOLUTE
	JSR	PC,PRINT		; AND PRINT THE ERRING LINE
	MOV	#'?,R0			;END LINE WITH
	JSR	PC,TYPE			; A "?"
.IIF	NE	.-TECOCR, .ERROR	;  AND RESTART US

.SBTTL	MAIN ENTRY/RE-ENTRY POINT

TECOCR:	JSR	PC,CRLFNO		;NO CTRL/O AND RESTORE CARRIAGE
TECO:	MOV	TECOSP(R5),SP		;SET UP OUR SP STACK
	MOV	TECOPD(R5),PDL(R5)	;NOW SET UP THE PUSH-DOWN LIST
100$:	CMP	SP,TECOSP(R5)		;IS SP STACK OK?
	BNE	210$			;NOPE
	CMP	PDL(R5),TECOPD(R5)	;WAS LAST COMMAND UNTERMINATED?
	BNE	210$			;YEP, GO GIVE ERROR
	MOV	#CMDQRG,R0		;INDICATE THE COMMAND Q-REG
	JSR	PC,QREFR0		;REFERENCE IT
	JSR	PC,QADJ			; AND ADJUST TO 0 SIZE
	MOV	NWATCH(R5),R0		;GET AMOUNT TO SCOPE WATCH
	JSR	PC,WATCH		; AND REFRESH THE SCREEN
	JSR	PC,NOCTLO		;NO CONTROL/O PLEASE
	TST	INDIR(R5)		;PROCESSING INDIRECT COMMANDS?
	BNE	120$			;YES, SO NO ANNOUNCEMENTS
	BIC	#200,ETYPE(R5)		;NO, SAY PROMPT LEVEL REACHED
	MOV	EVFLAG(R5),R0		;GET THE EDIT VERIFY FLAG
	BEQ	110$			;=0, NONE, NO VERIFY
	JSR	PC,.SCH.V		;ELSE VERIFY AROUND CURRENT .
110$:	MOV	#'*,R0			;SET UP TO ANNOUNCE US
	JSR	PC,TYPE			; AND DO IT
120$:	MOV	QCMND(R5),R0		;SAVE (POSSIBLE ERRING) COMMAND Q-REG
	MOV	R5,R1			;GET OFFSET POINTER
	ADD	#CLREND,R1		; AND INDEX TO CLEAR AREA END (+2)
130$:	CLR	-(R1)			;NOW CLEAR OUR VARIABLES
	CMP	R1,R5			;MORE TO CLEAR?
	BHI	130$			;YES, CONTINUE
	MOV	R0,QCMND(R5)		;NO, RESTORE COMMAND Q-REG NUMBER
	JSR	PC,IREST		;RESTORE QUOTE TO DEFAULT (ESCAPE)
140$:	CLR	TEMP(R5)		;AVOID DOUBLE CHARACTER INDICATIONS
150$:	MOV	ERRPOS(R5),R0		;SELECT INPUT MODE
	TST	QPNTR(R5)		;IS THIS THE FIRST INPUT REQUEST?
	BNE	160$			;NO
	INC	R0			;YES, FIRST IS ALWAYS SINGLE
160$:	JSR	PC,LISTEN		;NOW GET A CHARACTER
	SORT	..CMD			;SORT OUT SPECIAL CHARACTERS

170$:	CLR	ERRPOS(R5)		;NO ERROR POSITION IF STORING
180$:	CLR	QLCMD(R5)		;NO LAST COMMAND IF STORING ANYTHING
	MOV	#150$,-(SP)		;SET THE RETURN ADDRESS
	MOV	R0,TEMP(R5)		;SAVE CHARACTER ABOUT TO BE STORED
190$:	MOV	QZ(R5),R1		;GET OUR CURRENT SIZE
	CMP	R1,QMAX(R5)		;CAN WE DO THIS?
	BHIS	220$			;NO, GO GIVE ERROR
	INC	QZ(R5)			;INDICATE 1 MORE IN COMMAND
	INC	QPNTR(R5)		; Q-REGISTER
	ADD	QRSTOR(R5),R1		;GET POSITION TO STORE IN
	MOVB	R0,(R1)			; AND STORE CHARACTER
	SUB	QRSTOR(R5),R1		;BACK TO RELATIVE AGAIN
	ADD	#100.,R1		;FUDGE BY 100. MORE CHARACTERS
	SIZE	QREGS			;GET ROOM FOR THOSE CHARACTERS
	BCS	200$			;ALL IS STILL O.K.
	MOV	#BEL,R0			;IF NOT, THEN RING THE BELL
	JSR	PC,TYPE			; FOR A WARNING
200$:	RTS	PC			;NOW CONTINUE

210$:	ERROR	UTC,<"Unterminated command">

220$:	ERROR	MEM,<"Memory overflow">	

.SBTTL	COMMAND INPUT - DELETE

.CMDEL:	JSR	PC,10$			;REMOVE A CHARACTER
	BCC	TECOCR			;NONE TO REMOVE, RESTART US
	JSR	PC,DELCHR		;ONE REMOVED, SO SAY SO
	BR	140$			; AND CONTINUE

.SBTTL	COMMAND INPUT - CONTROL/U

.CMDCU:	JSR	PC,10$			;REMOVE A CHARACTER
	BCC	230$			;NONE TO REMOVE, QUIT
	CMP	R0,#LF			;ONE, WAS IS LINE FEED?
	BNE	.CMDCU			;NOT LINE FEED, KEEP REMOVING
	JSR	PC,190$			;LINE FEED, SO RESTORE IT
230$:	JSR	PC,DELLIN		;SAY 1 LINE WAS DELETED
	MOV	#140$,-(SP)		;SET CONTINUATION RETURN ADDRESS
PRTLIN:	JSR	PC,20$			;FIND LINE'S START/LENGTH
	MOV	#LF,R1			;COMPARE CHARACTER IS LINE FEED
240$:	DEC	R4			;ONE LESS IN COUNT NOW
	BMI	260$			;ONLY ONE LINE WAS IN COMMAND
	CMPB	R1,-(R3)		;BACKED UP ENOUGH?
	BNE	240$			;NO, KEEP GOING
	INC	R3			;YES, SO CORRECT POINTER
250$:	COM	R4			;NEGATE AND DECREMENT COUNT
	ADD	QPNTR(R5),R4		;FORM THE POSITIVE PRINT COUNT
	JMP	PRINT			;PRINT THE LINE AND EXIT

260$:	MOV	#'*,R0			;(RE-)TYPE
	JSR	PC,TYPE			; THE ASTERISK
	BR	250$			;NOW GO PRINT THE LINE

.SBTTL	COMMAND INPUT - ESCAPE

.CMDES:	CMP	R0,TEMP(R5)		;2ND ESCAPE?
	BNE	170$			;NOPE, SO NORMAL CHARACTER
	JSR	PC,190$			;YES, SO STORE THE FINAL ESCAPE
	MOV	QPNTR(R5),QLCMD(R5)	; AND SAVE COMMAND AS LAST
	TST	INDIR(R5)		;PROCESSING INDIRECT OCMMANDS?
	BNE	270$			;YES, SO NO CARRIAGE RESTORE
	JSR	PC,CRLFNO		;NO, SO RESTORE THE CARRIAGE
270$:	MOV	#CMDQRG,R0		;SET UP TO REFERENCE
	JSR	PC,SETCMD		; THE COMMAND REGISTER

.SBTTL	INTERPRETER

280$:	JSR	PC,SCAN			;SCAN THE COMMAND
290$:	JSR	PC,UPPERC		; AND FORCE UPPER CASE
300$:	MOV	R0,R1			;COPY THE CHARACTER
	CLR	R0			;LEAVE R0 (THE AC...) CLEAR
	MOV	R1,R2			;COPY THE CHARACTER AGAIN
	ASL	R2			; AND DOUBLE FOR A WORD INDEX
	ADD	TECOJP(R5),R2		;NOW FORM THE JUMP DISPATCH ADDRESS
	JSR	PC,@(R2)+		; AND GO OFF TO THAT COMMAND...
	TST	NFLG(R5)		;NUMBER?
	BMI	280$			;YES, SO JUST CONTINUE
	CLR	N(R5)			;NO, SO CLEAR THE ARGUMENT
	CLR	NFLG(R5)		; AND RESET NUMBER FLAG
	BR	280$			;THEN CONTINUE

CMDCHR	<'^>				;"^" MEANS NEXT IS CONTROL CHARACTER
	JSR	PC,SCNCTL		;GET NEXT AS CONTROL CHARACTER
	BR	300$			; AND CONTINUE WITH IT

.DSABL	LSB

CMDCHR	<'L>				;"L" IS THE LINE MOVER
.VVV.N:	JSR	PC,GETN			;GET THE NUMBER OF LINES
.VVV.V:	MOV	TXSTOR(R5),R2		;GET TEXT POINTER BIAS
	MOV	P(R5),R1		;GET THE CURRENT .
	ADD	R2,R1			; AND MAKE THAT ABSOLUTE
	MOV	#FF,R3			;SPEED UP THE COMPARES
	TST	R0			;WHICH DIRECTION
	BLE	30$			;<=0 IS BACKWARDS
	ADD	ZZ(R5),R2		;>0 IS FORWARDS; SO GET END OF TEXT
10$:	CMP	R1,R2			;PAST END OF TEXT YET?
	BHIS	20$			;YES, SO STOP THE MOVE
	CMPB	R3,(R1)+		;NOPE, IS THIS A FORM FEED?
	BLO	10$			;NO, HIGHER, KEEP MOVING
	CMPB	-1(R1),#LF		;YES, OR LOWER, SO CHECK IT
	BLO	10$			;CONTINUE ON LOWER THAN LINE FEED
	DEC	R0			;GOT ONE, MORE TO GO?
	BGT	10$			;KEEP GOING
20$:	SUB	TXSTOR(R5),R1		;GET THE NEW .
	MOV	R1,P(R5)		; AND STORE IT
	RTS	PC			;THEN EXIT

30$:	CMP	R1,R2			;TOO LOW?
	BLOS	20$			;YES, SO QUIT
	CMPB	R3,-(R1)		;NO, IS THIS A FORM FEED?
	BLO	30$			;NOPE, HIGHER, KEEP GOING
	CMPB	(R1),#LF		;YEP, OR LOWER, SO CHECK IT
	BLO	30$			;CONTINUE ON LOWER THAN LINE FEED
	INC	R0			;GET ONE, MORE?
	BLE	30$			;STILL ARE MORE TO GO
	INC	R1			;DONE, CORRECT .
	BR	20$			; AND GO SET NEW .

.ENABL	LSB

CMDCHR	<LAB>				;"<" STARTS AN ITERATION
.CSMI:	PUSH	ITRST,ITRCNT		;SAVE ITERATION START AND COUNT
	MOV	(R5),ITRST(R5)		;SET ITERATION START POINT
	CLR	ITRCNT(R5)		;GUESS AT "INFINITE" ITERATION
	INC	NFLG(R5)		;WAS THERE A NUMBER?
	BNE	20$			;NO, SO IT IS "INFINITE"
	MOV	N(R5),ITRCNT(R5)	;YES, USE THAT VALUE THEN
	BLE	.SCH.I			;UNLESS <=0, WHICH IS A NOP
	BR	20$			;EXIT RESTORING QUOTE

CMDCHR	<RAB>				;">" ENDS AN ITERATION
	TST	ITRCNT(R5)		;"INFINITE" ITERATION?
	BEQ	10$			;YES, MAKE IT REALLY INFINITE
	DEC	ITRCNT(R5)		;GO AROUND AGAIN?
	BEQ	.CSMO			;YES, SO END US
10$:	MOV	ITRST(R5),R4		;NO, SO GET RESET SCAN POINTER
	BEQ	30$			;ERROR IF NO PLACE TO RESTART
	MOV	R4,(R5)			;ELSE REALLY RESET SCAN POINTER
CMDCHR	<ESC>				;"ESC" SIMPLY EATS A NUMBER
CMDCHR	<''>				;"'" IS END OF A CONDITIONAL
20$:	CLR	NFLG(R5)		;USE UP ANY NUMBER
	JMP	IREST			; AND RESTORE NORMAL QUOTE

30$:	ERROR	BNI,<<RAB>" not in iteration">

CMDCHR	<';>				;";" IS SPECIAL ITERATION END
	TST	ITRST(R5)		;ARE WE IN ITERATION?
	BEQ	50$			;NO, ERROR
	INC	NFLG(R5)		;ARGUMENT?
	BNE	60$			;GIVE ERROR IF NONE
	TST	N(R5)			;SUCCESSFUL?
	BMI	20$			;YES, SO JUST CONTINUE
.SCH.I:	MOV	ITRST(R5),-(SP)		;SAVE ITERATION START POINT
40$:	SKPSET	'>			;GO TO MATCHING >
	MOV	#40$,-(SP)		;GUESS AT RE-CALLING SKPSET
	CMP	2(SP),ITRST(R5)		;MATCH THIS START POINT?
	BNE	.CSMO			;NO, POP AND CONTINUE
	CMP	(SP)+,(SP)+		;YES, POP START AND ADDRESS
	JSR	PC,TRACE		; BUT TRACE THE > IF TRACING
.CSMO:	POP	ITRCNT,ITRST		;POP THE COUNT AND START
	BR	20$			;GO RESET QUOTE CHARACTER

50$:	ERROR	SNI,<"; not in iteration">

60$:	ERROR	NAS,<"No arg before ;">

.DSABL	LSB

CMDCHR	<'M>				;"M" IS THE MACRO COMMAND
	JSR	PC,QREF			;REFERENCE A Q-REGISTER
	PUSH	SCANP,MPDL,QCMND,ITRST	;NOW PUSH ALL OLD DATA
	MOV	R2,MPDL(R5)		;SAVE PDL AT MACRO'S START
	CLR	(R5)			;START MACRO OFF AT RELATIVE 0
	CLR	ITRST(R5)		;NOT INTO ANY ITERATION YET
	MOV	QNMBR(R5),R0		;THIS IS THE Q-REG WITH THE MACRO IN IT
	JMP	SETCMD			;GO OFF AND START THE MACRO

.ENABL	LSB

CMDCHR	<'=>				;"=" IS THE NUMBER PRINTER
	INC	NFLG(R5)		;ANY NUMBER?
	BNE	20$			;AN ERROR IF NOT
	MOV	NMRBAS(R5),-(SP)	;SAVE CURRENT RADIX
	CLR	NMRBAS(R5)		;SET RADIX=DECIMAL INITIALLY
	TSTNXT	'=			;IS IT REALLY "=="?
	ADC	NMRBAS(R5)		;C=1 IF SO, SET RADIX=OCTAL
	JSR	R3,ZEROD		;THIS DOES THE REAL WORK
	 .WORD	TYPE			;OUTPUT TO TERMINAL
	MOV	(SP)+,NMRBAS(R5)	;RESTORE THE PREVIOUS RADIX
	TST	CLNF(R5)		;IS THE = COLON MODIFIED?
	BMI	10$			;YES, SO NO CR/LF
	JSR	PC,CRLF			;NO, SO TYPE CR/LF
10$:	CLR	CLNF(R5)		;NOW CLEAR THE COLON FLAG
	RTS	PC			; AND EXIT

20$:	ERROR	NAE,<"No arg before =">

.DSABL	LSB

CMDCHR	<'U>				;"U" IS Q-REG NUMBER SETTER
	JSR	PC,QREF			;REFERENCE THE Q-REG
	INC	NFLG(R5)		;ANY NUMBER?
	BNE	10$			;THERE MUST BE
	MOV	N(R5),2(R1)		;NOW SET THE NUMBER
	RTS	PC			;THEN EXIT

10$:	ERROR	NAU,<"No arg before U">

.ENABL	LSB

CMDCHR	<'\>				;"\" IS NUMBER INSERTER/GETTER
	CLR	LSCHSZ(R5)		;PRE-CLEAR INSERT/GET SIZE
	INC	NFLG(R5)		;WAS THERE AN ARGUMENT?
	BNE	20$			;NO, SO GET A NUMBER FROM TEXT
	JSR	R3,ZEROD		;YES, INSERT NUMBER INTO TEXT
	 .WORD	.BSL.I
10$:	RTS	PC			;NOW EXIT

20$:	JSR	PC,NCOM			;SET UP NUMBER PROCESSOR
	JSR	PC,GETXTP		;GET CHAR FROM TEXT
	BCC	10$			;NOTHING THERE
	SUB	#'+,R0			;PLUS SIGN?
	BEQ	30$			;YES, IGNORE IT
	CMP	R0,#'--'+		;MINUS SIGN?
	BNE	40$			;NOPE
	MOV	R0,NOPR(R5)		;YES, SET MINUS OPERATOR
30$:	JSR	PC,.BSL.P		;BUMP . AND COUNT IT
40$:	JSR	PC,GETXTP		;GET CHARACTER FROM TEXT
	BCC	10$			;EXIT IF NO MORE
	JSR	PC,NUMER		;CHECK FOR NUMERIC
	BCC	10$			;NOT A NUMBER
	TST	NMRBAS(R5)		;WHAT IS THE RADIX?
	BEQ	50$			;IT IS DECIMAL
	CMP	R0,#'8			;IT IS OCTAL, VALID DIGIT?
	BHIS	10$			;NOT AN OCTAL DIGIT
50$:	MOV	R0,R1			;MOVE DIGIT OVER TO HERE
	JSR	PC,.BSL.N		;NUMBER, SO USE IT
	BR	30$			; AND CONTINUE

CMDCHR	<'!>				;"!" IS THE COMMENT DELIMITER
	CMP	(R0)+,(R0)+		;MAKE R0 = 4 (SKIP 2 WORDS)
CMDCHR	<'A-100>			;"CTRL/A" IS THE TEXT PRINTER
	MOV	R0,R2			;SAVE DETERMINATION
	CLR	NFLG(R5)		;USE UP ANY NUMBER
	MOV	R1,QUOTE(R5)		;END CHARACTER IS SAME AS STARTING
	JSR	PC,QSKPR0		;SKIP STRING AND RESTORE QUOTE
	MOV	R0,R4			;MOVE STRING SIZE TO CORRECT PLACE
	ADD	QBASE(R5),R3		;MAKE THE START POINTER
	ADD	QRSTOR(R5),R3		; FULLY ABSOLUTE
	ADD	R2,PC			;SKIP PRINT IF REALLY A COMMENT
	JSR	PC,PRINT		; ELSE PRINT THE STRING
	BR	10$			;NOW EXIT

.DSABL	LSB

.ENABL	LSB

CMDCHR	<'">				;'"' IS THE CONDITIONAL
	INC	NFLG(R5)		;ANY ARGUMENT?
	BNE	10$			;THERE HAD BETTER BE
	SORT	..CND,C			; AND SPECIAL SORT
	ERROR	IQC,<'Illegal " character'>

10$:	ERROR	NAQ,<'No arg before "'>

.CNDV:	ADD	#ALPHAL-ALPHAU,R2	;"V" IS LOWER CASE A-Z
.CNDW:	ADD	#ALPHAU-RAD50,R2	;"W" IS UPPER CASE A-Z
.CNDC:	ADD	#RAD50-NUMER,R2		;"C" IS A-Z,0-9,.,$
.CNDD:	ADD	#NUMER-ALPHA,R2		;"D" IS 0-9
.CNDA:	ADD	#ALPHA-ALPHAN,R2	;"A" IS A-Z
.CNDR:	ADD	#ALPHAN,R2		;"R" IS A-Z,0-9
	MOV	R3,R0			;SET UP TEST CHARACTER
	JSR	PC,(R2)			; AND GO CHECK IT
	BCS	40$			;CARRY SET IS SUCCESS
	BR	20$			;ELSE FAILURE

.CNDN:	TST	R3			;SET CC'S
	BNE	40$			;"N" IS OK IF <>
	BR	20$			;ELSE NOT OK

.CNDRAB:				;">" IS OK IF >
.CNDG:	NEG	R3			;"G" IS OK IF >
	BVS	20$			;TRAP -32768. CASE
.CNDS:					;"S" IS SUCCESSFUL (-1)
.CNDT:					;"T" IS TRUE (-1)
.CNDLAB:				;"<" IS OK IF <
.CNDL:	TST	R3			;SET CC'S
	BMI	40$			;"L" IS OK IF <
	BR	20$			;ELSE NOT OK

.CNDF:					;"F" IS FALSE (0)
.CNDU:					;"U" IS UNSUCCESSFUL (0)
.CNDE:	TST	R3			;SET CC'S
	BEQ	40$			;"E" IS OK IF =
20$:	CLR	CNDN(R5)		;INTO 1 LEVEL OF CONDITIONAL SKIP
30$:	SKPSET	''			;SKIP TO A '
	DEC	CNDN(R5)		;DID IT MATCH OUR "?
	BPL	30$			;NO, SKIPSOME MORE
	JSR	PC,TRACE		;YES, TRACE FINAL ' IF TRACING
40$:	JMP	IREST			;RESTORE QUOTE AND EXIT

.DSABL	LSB

.ENABL	LSB

CMDCHR	<'U-100>			;"CTRL/U" IS Q-REG TEXT INSERT
	JSR	R4,70$			;REFERENCE THE Q-REG AND GET BIAS
	JSR	PC,QSKPR0		;NOW SKIP THE QUOTED STRING
	BNE	10$			;INSERT STRING EXISTS
	INC	NFLG(R5)		;NO STRING, IS THERE AN ARGUMENT?
	BNE	20$			;NO ARGUMENT EITHER, DO A NULL INSERT
	INC	R0			;ARGUMENT EXISTS, SET SIZE=1
	MOV	(SP),-(SP)		;RE-STACK THE APPEND SIZE
	MOV	#50$,2(SP)		; SO WE CAN SET A RETURN ADDRESS
10$:	INC	NFLG(R5)		;ARGUMENT WITH NON-NULL STRING?
	BEQ	90$			;YES, THAT'S AN ERROR
20$:	ADD	(SP),R0			;UPDATE SIZE AS NEEDED
	JSR	PC,QADJ			;ADJUST Q-REG TO ITS NEW SIZE
	CLR	NFLG(R5)		;USE UP ANY NUMBER
	MOV	OSCANP(R5),R0		;GET INSERT STRING START
	ADD	QBASE(R5),R0		; AND ADD IN OFFSET
	ADD	QRSTOR(R5),R0		;NOW MAKE IT ABSOLUTE
	BR	30$			; AND GO INSERT IT IN Q-REG

CMDCHR	<'X>				;"X" IS Q-REG TEXT INSERT
	JSR	R4,70$			;REFERENCE THE Q-REG
	JSR	PC,NLINES		;GET NUMBER OF CHARACTERS
	ADD	(SP),R0			;UPDATE SIZE AS NEEDED
	JSR	PC,QADJ			;ADJUST Q-REG TO ITS NEW SIZE
	MOV	M(R5),R0		;GET START OF TEXT
	ADD	TXSTOR(R5),R0		; AND MAKE IT ABSOLUTE
30$:	ADD	(SP),R2			;BIAS THE POINTER AS NEEDED
	ADD	QRSTOR(R5),R2		;MAKE POINTER TO Q-REG ABSOLUTE
	MOV	(R1),R1			;NOW GET SIZE OF Q-REG
	SUB	(SP)+,R1		; LESS THE BIAS SIZE
40$:	DEC	R1			;MORE TO MOVE?
	BMI	60$			;NO, DONE
	MOVB	(R0)+,(R2)+		;YES, MOVE A BYTE
	BR	40$			; AND LOOP FOR MORE

50$:	MOVB	N(R5),-(R2)		;PUT ARGUMENT VALUE THERE INSTEAD
	BICB	#^C<177>,(R2)		; TRIMMING IT TO 7 BITS
60$:	RTS	PC			;EXIT

70$:	JSR	PC,QREF			;REALLY REFERENCE THE Q-REG
	MOV	(R1),(SP)		;SAVE ITS CURRENT SIZE
	TST	CLNF(R5)		;APPEND TO Q-REG?
	BMI	80$			;YES, LEAVE THE OLD SIZE AS BIAS
	CLR	(SP)			;NO, SO NO BIAS
80$:	CLR	CLNF(R5)		;TURN OFF THE COLON FLAG
	JMP	(R4)			; AND EXIT

90$:	ERROR	IIA,<"Illegal insert arg">

.DSABL	LSB

.ENABL	LSB

CMDCHR	<'F>				;"F" IS PREFIX FOR SPECIAL SEARCHES
	SORT	..FFF,S			; AND SORT ON IT
	ERROR	IFC,<"Illegal F character">

.FFFS:	MOV	#-1,REPFLG(R5)		;SET REPLACE FLAG
CMDCHR	<'S>				;"S" IS SEARCH
	JSR	PC,SEARCH		;SEARCH FOR THE STRING
10$:	TST	REPFLG(R5)		;REPLACEMENT?
	BEQ	30$			;NOPE
	MOVB	R1,-(SP)		;YES, SO SAVE SUCCESS/FAILURE FLAG
	JSR	PC,QSKP			; AND SKIP THE 2ND STRING
	MOVB	(SP)+,R1		;RESTORE SUCCESS/FAILURE FLAG
	BEQ	20$			;NO REPLACEMENT IF FAILURE
	MOV	PST(R5),R0		;GET START OF FOUND STRING
	SUB	P(R5),R0		; AND NOW ITS -(LENGTH)
	MOV	PST(R5),P(R5)		;THEN UPDATE .
	JSR	PC,.SCH.R		;DO REPLACEMENT
	MOV	#-1,R1			;RESTORE SUCCESS FLAG
20$:	CLR	REPFLG(R5)		;CLEAR REPLACE FLAG
30$:	JSR	PC,IREST		;RESTORE ESCAPE AS QUOTE
	MOVB	R1,R0			;GET REAL NUMBER IN R0
	JSR	PC,NCOM			;INIT THE NUMBER PROCESSOR
	TST	CLNF(R5)		;WAS THERE A ":" THERE?
	BMI	70$			;YES, SO JUST RETURN FLAG
	CLR	CLNF(R5)		;ELSE SET FLAG TO FALSE
	MOV	ITRST(R5),R4		;IN AN ITERATION?
	BEQ	40$			;NOPE
	TSTNXT	<';>			;YES, IS SEARCH CHECKED FOR?
	BCS	60$			;CHECKED FOR, SO RETURN VALUE
	CLR	NFLG(R5)		;NOT CHECKED, EAT UP THE NUMBER
	TST	N(R5)			;WAS SEARCH SUCCESSFUL
	BMI	80$			;ALL O.K., SO JUST CONTINUE

.IF	NE	E$$TXT

	JSR	PC,CRLFNO		;NO CTRL/O AND RESTORE CARRIAGE
	MOV	(PC)+,R3		;GET MESSAGE POINTER
	MESSAG	<"%Search fail in iter"<CR><LF>>

.CSECT	TECOER
.	=	.-1			;BACK OVER ZERO BYTE
$$$$$$	=	.-$$$$$$		;NOW FIND THE MESSAGE LENGTH
.CSECT	TECORO

	MOV	#$$$$$$,R4		;GET MESSAGE SIZE
	JSR	PC,PRINT		;SO WE CAN PRINT A WARNING

.ENDC

	JMP	.SCH.I			;ELSE GET OUT OF ITERATION

40$:	CLR	NFLG(R5)		;USE UP THE NUMBER
	TST	N(R5)			;SUCCESSFUL?
	BPL	50$			;NOPE
	MOV	ESFLAG(R5),R0		;YES, GET EDIT SEARCH FLAG
	BEQ	70$			;=0, SO EXIT
	JMP	.SCH.V			;ELSE GO PRINT SOMETHING

50$:	ERROR	SRH,<"Search failure"<-1>>,STRING

60$:	DEC	(R5)			;MAKE SURE WE SEE THE ";"
70$:	CLR	CLNF(R5)		;CLEAR COLON FLAG
80$:	RTS	PC			;THEN EXIT

.FFFN:	TST	(PC)+			;SET C=0 (AND SKIP 'SEC') FOR "FN"
.FFFU:	SEC				;SET C=1 FOR "F_"
	MOV	#-1,REPFLG(R5)		;INDICATE A REPLACE
	BIC	R0,R0			;INDICATE "N" TYPE SEARCH
	BCC	90$			;NOW JOIN UP IF "FN"
CMDCHR	<'_>				;"_" IS DESTRUCTIVE SEARCH
	CMP	(R0)+,(R0)+		;SET TO SKIP BUFFER DUMP
CMDCHR	<'N>				;"N" IS THE PAGING SEARCH
90$:	MOV	R0,TEMP(R5)		;SAVE DETERMINATION
	JSR	PC,SEARCH		; AND SEARCH
100$:	BMI	10$			;SUCCESS(-1) OR BACKWARDS FAIL(177400)
	MOV	R2,-(SP)		;SAVE THE SEARCH COUNTER
	ADD	TEMP(R5),PC		;CHECK DETERMINATION
	JSR	PC,.PPP.P		;DUMP THIS TEXT BUFFER
	JSR	PC,.YYY.V		;CHECK THEN YANK IN A PAGE OF TEXT
	MOV	(SP)+,R2		;RESTORE SEARCH COUNTER
	BIC	R1,R1			;PRE-INDICATE A FAILURE
	BCS	10$			;NO DATA READ, SAY FAILURE
	JSR	PC,CHKSTP		;CHECK FOR STOP FLAG NOW ON
	JSR	PC,.SURCH		;CONTINUE THE SEARCH
	BR	100$			;NOW CHECK FOR FAILURE

.DSABL	LSB

.FFFR:	JSR	PC,QSKPR0		;SKIP THE INSERT STRING
	MOV	LSCHSZ(R5),R0		;GET -(LENGTH) OF LAST FOUND STRING
	JSR	PC,.FFF.R		; AND BACK UP . TO THERE
	MOV	LSCHSZ(R5),R0		;GET -(LENGTH) AGAIN
	BR	.SCH.R			; AND DO THE INSERT

.ENABL	LSB

CMDCHR	<'G>				;"G" IS GET Q-REG INTO TEXT
	CLR	NFLG(R5)		;USE UP ANY NUMBER
	JSR	PC,GETQRG		;GET Q-REG OR "_" OR "*"
	BCC	20$			;IT WAS "_" OR "*"
	INC	CLNF(R5)		;COLON MODIFIED?
	BEQ	50$			;YES, SO REALLY PRINT IT
10$:	MOV	R2,-(SP)		;SAVE OFFSET TO Q-REG
	MOV	R0,-(SP)		;SAVE INSERT LENGTH
	COM	(SP)			;MAKE IT -(LENGTH)-1
	BR	100$			;NOW REALLY INSERT IT

20$:	MOV	R2,R4			;SAVE POINTER TO DATA
	ADD	R0,R4			; MAKING IT POINT TO END+1
	INC	CLNF(R5)		;COLON MODIFIED?
	BEQ	60$			;YES, SO REALLY PRINT IT
	CLR	R2			;NO, DUMMY AN INSERT OFFSET
	JSR	PC,10$			;NOW DO THAT DUMMY INSERT
	MOV	LSCHSZ(R5),R3		;GET BACK THE -(LENGTH)
	BEQ	40$			;LENGTH=0, EXIT
30$:	MOVB	-(R4),-(R1)		;ELSE REALLY INSERT THE
	BICB	#^C<177>,(R1)		; DATA WITH A PARITY TRIM
	INC	R3			;MORE?
	BNE	30$			;YES, LOOP
40$:	RTS	PC			;NO, DONE

50$:	ADD	QRSTOR(R5),R2		;MAKE THE POINTER ABSOLUTE
60$:	MOV	R0,R4			;SET THE PRINT COUNT
	MOV	R2,R3			; AND POINTER
	JMP	PRINTF			;  THEN PRINT IT AND EXIT

CMDCHR	<'I-100>			;"TAB" IS SPECIAL FORM OF "I"
	CLR	QFLG(R5)		;ENSURE NO QUOTE SPECIALS
	DEC	(R5)			; AND INCLUDE THE TAB IN TEXT
	JSR	PC,70$			;DO THE STRING INSERTION NOW
	ADD	LSCHSZ(R5),R1		;GET ABS POINTER TO START OF INSERTION
	MOVB	#TAB,(R1)		; AND ENSURE TAB AS STARTING CHARACTER
	RTS	PC			;EXIT ALL DONE

CMDCHR	<'I>				;"I" IS INSERT TEXT
70$:	JSR	PC,QSKPR0		;SKIP THE QUOTED STRING
	BNE	80$			;<>0 LENGTH, A REAL INSERT
	INC	NFLG(R5)		;NUMBER TO INSERT?
	BNE	90$			;NOPE, THE NULL INSERT...
	MOV	N(R5),R0		;YEP, SO GET THE NUMBER
	CLR	LSCHSZ(R5)		;PRE-CLEAR THE INSERT SIZE
.BSL.I:	BIC	#^C<177>,R0		;MAKE INTO A VALID CHARACTER
	MOV	R0,-(SP)		; AND SAVE IT
	MOV	#1,R0			;ADJUST TEXT UP BY
	JSR	PC,ADJ			; 1 CHARACTER
	MOV	P(R5),R1		;GET .
	ADD	TXSTOR(R5),R1		;MAKE ABSOLUTE
	MOVB	(SP)+,(R1)		; AND STORE NEW CHARACTER
.BSL.P:	INC	P(R5)			;BUMP .
	DEC	LSCHSZ(R5)		; AND CORRECT INSERT SIZE
	RTS	PC			;  THEN EXIT

80$:	INC	NFLG(R5)		;WAS THERE AN ARGUMENT?
	BEQ	130$			;YES, ERROR
90$:	CLR	R0			;INDICATE NO BIAS
.SCH.R:	MOV	OSCANP(R5),R3		;GET STRING START
	MOV	R3,-(SP)		; AND SAVE START
	ADD	QBASE(R5),(SP)		;START NOW REAL
	SUB	(R5),R3			;NOW HAVE -(LENGTH)-1
	SUB	R3,R0			;NOW HAVE (LENGTH)+1+(BIAS)
	DEC	R0			;NOW HAVE (LENGTH)+(BIAS)
	MOV	R3,-(SP)		;SAVE INSERT -(LENGTH)-1
100$:	JSR	PC,ADJ			;ADJUST TEXT BUFFER SIZE
	MOV	(SP)+,R3		;RESTORE INSERT -(LENGTH)-1
	INC	R3			;NOW MAKE INTO -(LENGTH)
	MOV	(SP)+,R2		;RESTORE STARTING POINT
	ADD	QRSTOR(R5),R2		;MAKE THE START ABSOLUTE
	MOV	R3,LSCHSZ(R5)		;SAVE TEXTUAL -(LENGTH)
	BEQ	120$			;EXIT RIGHT NOW IF NO LENGTH
	MOV	P(R5),R1		;NOW GET .
	SUB	R3,P(R5)		;THEN UPDATE . TO INSERT'S END
	ADD	TXSTOR(R5),R1		; AND MAKE . ABOLUTE
110$:	MOVB	(R2)+,(R1)+		;DO THE REAL INSERTION
	INC	R3			; FOR THE
	BNE	110$			;  WHOLE LENGTH
120$:	RTS	PC			;THEN EXIT

130$:	ERROR	IIA,<"Illegal insert arg">

.DSABL	LSB

.ENABL	LSB

10$:	MOV	#-1,R2			;GUESS AT ALWAYS A FINAL FORM FEED
	TSTB	TEMP(R5)		;GOOD GUESS ("PW")?
	BMI	20$			;YES
.PPP.P:	MOV	FFFLAG(R5),R2		;NO, OPTIONAL FORM FEED ("P")
20$:	MOV	TXSTOR(R5),R0		;FROM THE BEGINNING TO
	MOV	ZZ(R5),R1		; THE END (ALL OF TEXT)
	BR	80$			;NOW GO DO IT...

CMDCHR	<'P>				;"P" IS PAGE WRITER
.SBTTL	COMMAND CHARACTER "PW
	TSTNXT	'W			;REALLY "PW"?
	RORB	TEMP(R5)		;SAVE THE DETERMINATION
	TST	CFLG(R5)		;M,N??
	BMI	70$			;YES
	JSR	PC,GETN			;NOPE, GET A NUMBER
	MOV	R0,R4			; AND SAVE IT
30$:	JSR	PC,10$			;DUMP THE TEXT BUFFER
	TSTB	TEMP(R5)		;"PW"?
	BMI	40$			;YES, SO NO YANK
	JSR	PC,.YYY.Y		;SIMULATE THE YANK
40$:	JSR	PC,CHKSTP		;CHECK FOR STOP FLAG NOW ON
	DEC	R4			;AGAIN?
	BNE	30$			;YES
50$:	CLC				;ENSURE CARRY=0 ON EXIT
60$:	RTS	PC			;NO, EXIT

70$:	JSR	PC,NLINES		;MAKE M,N INTO CHARACTERS
	MOV	R0,R1			;COUNT GOES HERE
	MOV	M(R5),R0		;START FROM HERE
	ADD	TXSTOR(R5),R0		; MAKE IT ABSOLUTE
	CLR	R2			;NEVER A FORM FEED
80$:	JSR	PC,PUTBUF		;NOW PUT IT
	BCC	60$			;ALL O.K., EXIT
IOERR:					;I/O ERRORS COME HERE

.IF	NE	E$$TXT

	MOV	SP,R4			;INDICATE NO STRING

.ENDC

IOERRS:					;I/O ERROR WITH STRING COMES HERE
	JSR	R2,ERRMIO		;SAVE TEXT POINTER AND SAY ERROR

CMDCHR	<'Y>				;"Y" IS YANK IN A BUFFER
	INC	NFLG(R5)		;ANY ARGUMENT?
	BEQ	110$			;YES, SOMEONE MADE AN ERROR
	MOVB	(PC),TEMP(R5)		;INDICATE CHECKING IS FOR REAL
	TST	ZZ(R5)			;ANYTHING TO BE CLOBBERED IN TEXT?
	BEQ	.YYY.Y			;NO, SO DO IT
.YYY.V:	TST	@OUPNTR(R5)		;ACTIVE OUTPUT FILE?
	BEQ	.YYY.Y			;NO, SO DO IT
	TSTB	TEMP(R5)		;SHOULD WE BE CHECKING AT ALL?
	BEQ	.YYY.Y			;NO, GO AHEAD AND DO IT
	BIT	EDIT(R5),#2		;DOES USER REALLY WANT THIS??
	BEQ	120$			;NO, GIVE AN ERROR
.YYY.Y:	JSR	PC,.YYY.C		;SIZE UP THE TEXT BUFFER
	CLRB	TEMP+1(R5)		; AND ALWAYS DO A FULL BUFFER LOAD
90$:	CMP	#0,EOFLAG(R5)		;SET CARRY=1 IF "EOFLAG"=-1
	BCS	60$			;EXIT C=1 IF END-OF-FILE
	MOV	ZZ(R5),R0		;GET END OF CURRENT BUFFER
	MOV	ZMAX(R5),R1		;GET MAX SIZE
	DEC	R1			; LESS 1 FOR SAFETY
	MOV	R1,R2			;COPY THE MAX VALUE
	ASR	R2			; AND FIND THE
	ASR	R2			;  MAX*(1/4) VALUE
	SUB	R0,R1			;FIND REAL ROOM LEFT
	TSTB	TEMP+1(R5)		;LOADING THE FULL BUFFER?
	BPL	100$			;YES
	MOV	R1,R2			;NO, SET DESIRED FREE AS AMOUNT LEFT
100$:	ADD	TXSTOR(R5),R0		;MAKE POINTER ABSOLUTE
	JSR	PC,GETBUF		;GET SOME DATA
IO.ERR:	BCS	IOERR			;I/O TYPE ERROR, DIE
	TST	FFFLAG(R5)		;O.K., DID IT END WITH FORM FEED?
	BNE	50$			;YES, ALL DONE, EXIT CARRY=0
	TST	EOFLAG(R5)		;NO, ANY POINT IN TRYING FOR MORE?
	BNE	50$			;NO POINT, SO DONE
	TSTB	TEMP+1(R5)		;LOADING FULL BUFFER?
	BMI	50$			;NOPE, SO EXIT NOW
	MOV	#SIZERB,R1		;YEP, GET (TRIAL) AMOUNT TO EXPAND
	CMP	R1,CURFRE(R5)		;HAVE WE ALREADY GOT THAT AMOUNT?
	BLOS	50$			;IF SO THEN NO POINT IN ASKING FOR MORE
	JSR	PC,SIZER		;ELSE CALL THE MEMORY SIZING ROUTINE
	BCS	50$			;IT FAILED, SO JUST EXIT
.AAA.A:	JSR	PC,.YYY.S		;WE GOT IT, RE-SHUFFLE THE AREAS
	BR	90$			; AND RECALL OURSELVES

110$:	ERROR	NAY,<"No arg before Y">

120$:	ERROR	YCA,<"Y command aborted">

.DSABL	LSB

CMDCHR	<'E>				;"E" IS SPECIAL COMMANDS
	MOV	NFLG(R5),R3		;SAVE THE NUMBER FLAG
	CLR	NFLG(R5)		;THEN NO MORE NUMBER
	SORT	..EEE,Z			;NOW SORT
	ERROR	IEC,<"Illegal E character">

.ENABL	LSB

.EEEB:					;R0 GETS <0 FOR EB ('B-'R)
.EEEG:					;SPECIAL HANDLING FOR "EG"
.EEEI:					;R0 GETS <0 FOR EI ('I-'R)
.EEEN:					;R0 GETS <0 FOR EN ('N-'R)
.EEER:					;R0 GETS =0 FOR ER
.EEEW:	SUB	#'R,R0			;R0 GETS >0 FOR EW
	MOV	FILBUF(R5),R4		;GET POINTER TO FILENAME BUFFER
	JSR	PC,GETFIL		;GET STRING AS ARGUMENT
	CLRB	(R4)			;FORCE NULL STRINGS TO NULL
	CMP	R2,#'G-'R		;IS IT REALLY "EG"?
	BEQ	70$			;YES
	JSR	PC,CHKCLN		;NO, CHECK FOR A COLON MODIFIER
	JSR	PC,GETFLS		;GET THE FILE STUFF DONE
	BCC	10$			;NO ERROR, JUST EXIT
	CLR	R4			;ERROR, CLEAR R4 TO PRINT STRING
	CMP	R0,#^RFNF		;IS THE ERROR "FNF"?
	BNE	IOERRS			;OTHER ERROR, FATAL
	TST	NFLG(R5)		;WERE WE REALLY RETURNING A VALUE?
	BPL	IOERRS			;NO, SO DIE IN ANY CASE
	CLR	N(R5)			;ELSE RETURN VALUE OF 0
10$:	JMP	IREST			;RESTORE QUOTE AND EXIT

20$:	JSR	PC,.YYY.Y		;CLEAR OUT AND READ MORE TEXT
	BCS	50$			;END-OF-FILE, CLOSE OUTPUT
30$:	MOV	TXSTOR(R5),R0		;SET START OF TEXT
	MOV	ZZ(R5),R1		; AND AMOUNT OF TEXT TO WRITE
	BNE	40$			;THERE IS TEXT TO WRITE, DO IT
	TST	@OUPNTR(R5)		;NO TEXT, IS THERE AN OUTPUT FILE?
	BEQ	10$			;NO TEXT AND NO FILE, JUST EXIT
40$:	MOV	FFFLAG(R5),R2		;SET THE OPTIONAL FORM FEED FLAG
	JSR	PC,PUTBUF		; AND WRITE OUT THE TEXT
	BCS	IO.ERR			;DIE ON ANY I/O TYPE ERROR
	TST	@INPNTR(R5)		;DOES AN INPUT FILE EXIST?
	BNE	20$			;YES, GET SOMETHING FROM IT
50$:	JSR	PC,CLSFIL		;CLOSE THE INPUT AND OUTPUT FILES
60$:	BCS	IO.ERR			;DIE ON ANY ERROR
	BR	10$			; ELSE GO RESTORE QUOTE AND EXIT

.EEEK:	JSR	PC,KILFIL		;CLOSE AND KILL OUTPUT FILE
	BR	60$			; AND ERROR CHECK

.EEEP:	JSR	PC,INPSAV		;SAVE INPUT FILE STATUS
	BR	60$			; AND ERROR CHECK

.EEEA:	JSR	PC,OUTSAV		;SAVE OUTPUT FILE STATUS
	BR	60$			; AND ERROR CHECK

70$:	MOV	#GEXIT,-(SP)		;EXIT FROM TECO SOON
	BR	80$			; AFTER FINISHING UP

.EEEX:	MOV	#TEXIT,-(SP)		;EXIT FROM TECO SOON
80$:	JSR	PC,XITNOW		;WE WILL BE EXITING SOON
.EEEC:	JSR	PC,30$			;PAGE OUT THE REST OF THE FILE
	JMP	.YYY.C			;THEN EXIT CLEARING BUFFER

.EEEF:	JSR	PC,CLSOUT		;CLOSE THE OUTPUT FILE
	BR	60$			; AND ERROR CHECK

.DSABL	LSB

.ENABL	LSB

CMDCHR	<'A>				;"A" IS APPEND
	INC	NFLG(R5)		;UNLESS THERE IS A NUMBER
	BNE	10$			; AND THERE IS NOT
	MOV	N(R5),R0		;GET THE NUMBER
	ADD	P(R5),R0		;INDEXED BY .
	JSR	PC,BZCHK		;CHECK IT
	BEQ	20$			;AT Z, SO ERROR
	ADD	TXSTOR(R5),R0		;THEN MAKE IT ABSOLUTE
	MOVB	(R0),R0			; AND GET THE CHARACTER
	JMP	NCOM			;NOW COMPUTE AS IF NUMBER

10$:	MOVB	CLNF+1(R5),TEMP+1(R5)	;SAVE STATE OF THE COLON FLAG
	CLR	CLNF(R5)		; THEN CLEAR THE FLAG
	MOV	ZZ(R5),R1		;GET CURRENT TEXT SIZE
	ADD	#256.,R1		;ENSURE ADDITION OF ONE LINE
	SIZE	TEXT			; INTO TEXT BUFFER
	BCS	.AAA.A			;O.K., SO READ IT IN
	ERROR	MEM,<"Memory overflow">

20$:	ERROR	POP,<"Pointer off page">

.DSABL	LSB

.SCH.V:	CLR	NFLG(R5)		;ENSURE NO NUMERIC ARGUMENT
CMDCHR	<'V>				;"V" IS VERIFY
	MOV	R0,-(SP)		;SAVE TYPEOUT DETERMINATION
	MOVB	1(SP),R0		;GET NUMBER OF LINES FROM "ES" AND "EV"
	BGT	10$			;NUMBER WAS EXPLICIT
	MOV	#1,R0			;ELSE DEFAULT TO ONE LINE
10$:	INC	NFLG(R5)		;IS THERE A NUMERIC ARGUMENT?
	BNE	20$			;NOPE
	MOV	N(R5),R0		;YEP, SO USE IT
20$:	MOV	R0,-(SP)		;SAVE THE FINAL ARGUMENT
	NEG	R0			;CALCULATE THE (1-N)T
	INC	R0			; PART OF VERIFY
	JSR	PC,NCOM			;  AND USE THAT FIRST
	JSR	PC,50$			;NOW DO THE (1-N)T PART
	MOVB	2(SP),R0		;GET TYPEOUT DETERMINATION
	BLE	40$			;NOTHING SPECIAL
	CMP	R0,#SPACE		;USE LINE FEED?
	BHIS	30$			;NOPE
	MOV	#LF,R0			;YES
30$:	JSR	PC,TYPEF		;NOW TYPE THE CHARACTER WITH CASE FLAGGING
40$:	MOV	(SP)+,R0		;SET ARGUMENT FOR (N)T PART OF V
	JSR	PC,NCOM			; AND USE THAT
	TST	(SP)+			;NOW POP THAT TYPEOUT DETERMINATION
50$:					;FALL INTO THE T COMMAND
CMDCHR	<'T>				;"T" IS THE PRINTER
	JSR	PC,NLINES		;FIND NUMBER OF CHARACTERS
	MOV	M(R5),R3		;GET STARTING POINT
	ADD	TXSTOR(R5),R3		; AND MAKE ABSOLUTE
	MOV	R0,R4			;MOVE COUNT INTO HERE
	JMP	PRINTF			; AND PRINT IT WITH CASE FLAGGING

CMDCHR	<'W>				;"W" IS SCOPE WATCH
	MOV	NWATCH(R5),R0		;PRESET THE OLD ARGUMENT
	INC	NFLG(R5)		;ARGUMENT THIS TIME?
	BNE	10$			;NOPE
	MOV	N(R5),R0		;YES, SO SET IT
10$:	JSR	PC,WATCH		;WATCH THE SCOPE
	MOV	R0,NWATCH(R5)		;REMEMBER THE LAST ARGUMENT
	RTS	PC			;THEN EXIT

CMDCHR	<'O-100>			;"CTRL/O" MEANS OCTAL RADIX
	INC	R0			;MAKE A NON-ZERO
CMDCHR	<'D-100>			;"CTRL/D" MEANS DECIMAL RADIX
	MOV	R0,NMRBAS(R5)		;SET THE RADIX
	RTS	PC

.ENABL	LSB

CMDCHR	<'N-100>			;"CTRL/N" IS EOF FLAG
	MOV	EOFLAG(R5),R0		;GET END-OF-FILE FLAG
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'B-100>			;"CTRL/B" IS TODAY'S DATE
	JSR	PC,DATE			;GET DATE
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'S-100>			;"CTRL/S" IS -(LENGTH) OF LAST STRING
	MOV	LSCHSZ(R5),R0		;GET -(LENGTH) OF LAST
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'F-100>			;"CTRL/F" IS SWITCH REGISTER VALUE
	JSR	PC,SWITCH		;GET SWITCH REGISTER
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'H-100>			;"CTRL/H" IS TIME OF DAY
	JSR	PC,TIME			;GET TIME OF DAY
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'H>				;"H" MEANS ALL (0,Z)
	CLR	N(R5)			;SIMULATE THE "B" (OR 0)
	JSR	PC,20$			;NOW SIMULATE THE COMMA
CMDCHR	<'Z>				;"Z" MEANS END OF TEXT
	MOV	ZZ(R5),R0		;GET END OF TEXT VALUE
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'Y-100>			;"CTRL/Y" MEANS .+^S,.
	JSR	PC,10$			;SET NUMBER TO .
	ADD	LSCHSZ(R5),N(R5)	; NOW ADD IN ^S
	JSR	PC,20$			;FAKE THE COMMA
CMDCHR	<'.>				;"." IS CURRENT POSITION
10$:	MOV	P(R5),R0		;GET .
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<',>				;"," IS THE M,N SEPARATOR
	INC	NFLG(R5)		;WAS THERE A "M"?
	BNE	30$			;THERE SHOULD HAVE BEEN
20$:	MOV	N(R5),M(R5)		;SAVE "M"
	CLR	N(R5)			;NOW CLEAR "N" AGAIN
	MOV	#-1,CFLG(R5)		; AND INDICATE A COMMA
CMDCHR	<NUL>				;"NUL" IS IGNORED
CMDCHR	<LF>				;"LF" IS IGNORED
CMDCHR	<CR>				;"CR" IS IGNORED
CMDCHR	<SPACE>				;"SPACE" IS IGNORED
	RTS	PC			;NOW RETURN

30$:	ERROR	NAC,<"No arg before ,">

CMDCHR	<'T-100>			;"CTRL/T" MEANS VALUE OF NEXT INPUT CHARACTER
	INC	NFLG(R5)		;IS THERE AN ARGUMENT?
	BNE	40$			;NO, SO GET INPUT AS NUMERIC VALUE
	MOV	N(R5),R0		;YES, GET THE ARGUMENT
	JMP	TYPE			; AND TYPE ITS VALUE ON TERMINAL

40$:	JSR	PC,TLISTN		;GET A CTRL/T CHARACTER
	BR	50$			; AND COMPUTE AS A NUMBER

CMDCHR	<'^-100>			;"CTRL/^" MEANS VALUE OF NEXT CHARACTER
	JSR	PC,SCAN			;GET NEXT CHARACTER
50$:	BR	NCOM			; AND COMPUTE AS A NUMBER

.EEEO:	MOV	#VERSON,R0		;"EO" IS VERSION NUMBER
	BR	NCOM			;GO COMPUTE AS A NUMBER

CMDCHR	<'Z-100>			;"CTRL/Z" MEANS SIZE OF Q-REGS
	MOV	QZ(R5),R0		;GET SIZE OF Q-REGS
	BR	NCOM			; AND COMPUTE AS A NUMBER

CMDCHR	<'E-100>			;"CTRL/E" MEANS FORM FEED FLAG
	MOV	FFFLAG(R5),R0		;GET FORM FEED FLAG VALUE
	BR	NCOM			; AND COMPUTE AS A NUMBER

CMDCHR	<'Q>				;"Q" IS VALUE/SIZE IN Q-REGISTER
	JSR	PC,QREF			;REFERENCE Q-REG AS SPECIFIED
	INC	CLNF(R5)		;COLON MODIFIED?
	BEQ	70$			;YES, VALUE IS Q-REG SIZE
	BR	60$			;NOPE, VALUE IS VALUE IN Q-REG

CMDCHR	<'%>				;"%" IS ADD TO Q-REG VALUE
	JSR	PC,QREF			;REFERENCE Q-REG AS SPECIFIED
	JSR	PC,GETN			;GET THE NUMBER ALSO
60$:	TST	(R1)+			;SKIP THE SIZE WORD
70$:	ADD	(R1),R0			; AND ADD FOR A NEW VALUE
	MOV	R0,(R1)			;THEN STORE IT AWAY
	BR	NCOM			; AND COMPUTE AS A NUMBER

CMDCHR	<'&>				;"&" IS LOGICAL 'AND'
	MOV	#OP$AND-OP$OR,R0	;SET FOR 'AND'
CMDCHR	<'#>				;"#" IS LOGICAL OR
	ADD	#OP$OR-OP$DIV,R0	;SET FOR 'OR'
CMDCHR	<'/>				;"/" IS DIVISION
	ADD	#OP$DIV-OP$MUL,R0	;SET FOR DIVIDE
CMDCHR	<'*>				;"*" IS MULTIPLICATION
	ADD	#OP$MUL-OP$SUB,R0	;SET FOR MULTIPLY
CMDCHR	<'->				;"-" IS SUBTRACTION
	TST	(R0)+			;SET FOR SUBTRACT
CMDCHR	<'+>				;"+" IS ADDITION
80$:	MOV	R0,NOPR(R5)		;SAVE THE OPERATOR DISPTACH
	MOV	N(R5),NACC(R5)		;SAVE CURRENT NUMBER IN ACCULMULATOR
	CLR	NP(R5)			;NO DIGITS FOUND NOW
	MOV	#-1,OFLG(R5)		;INDICATE OPERATOR PENDING
	CLR	NFLG(R5)		;BUT NO NUMBER PENDING
	RTS	PC			; AND RETURN

CMDCHR	<'(>				;"(" IS START OF NEW EXPRESSION
	TST	OFLG(R5)		;OPERATOR PENDING?
	BNE	90$			;YES
	JSR	PC,NCOM			;NO, INITIALIZE US
90$:	INC	PCNT(R5)		;COUNT AS ANOTHER PAREN PUSH
	PUSHP	NOPR,NACC		;SAVE ACCULMULATOR
	BR	80$			;THEN SET UP AS IF "+"

.DSABL	LSB

.ENABL	LSB

CMDCHR	<')>				;")" IS END OF EXPRESSION
	TST	NFLG(R5)		;ANYTHING BEFORE THIS?
	BPL	10$			;BADNESS IF NOT
	DEC	PCNT(R5)		;CAN WE POP A PAREN?
	BMI	10$			;NO, ERROR
	POP	NACC,NOPR		;RESTORE OPERATOR
	MOV	N(R5),R0		;GET VALUE INSIDE PARENS
	BR	40$			; AND TREAT AS A NUMBER

10$:	ERROR	NAP,<"No arg before )">

20$:	ERROR	ILN,<"Illegal number">

CMDCHR	<'9>				;"9" IS A NUMERIC DIGIT
CMDCHR	<'8>				;"8" IS A NUMERIC DIGIT
	TST	NMRBAS(R5)		;IS RADIX DECIMAL?
	BNE	20$			;NO, OCTAL, SO ERROR
CMDCHR	<'7>				;"7" IS A NUMERIC DIGIT
CMDCHR	<'6>				;"6" IS A NUMERIC DIGIT
CMDCHR	<'5>				;"5" IS A NUMERIC DIGIT
CMDCHR	<'4>				;"4" IS A NUMERIC DIGIT
CMDCHR	<'3>				;"3" IS A NUMERIC DIGIT
CMDCHR	<'2>				;"2" IS A NUMERIC DIGIT
CMDCHR	<'1>				;"1" IS A NUMERIC DIGIT
CMDCHR	<'0>				;"0" IS A NUMERIC DIGIT
.BSL.N:	SUB	#'0,R1			;MAKE INTO BINARY DIGIT
	INC	NFLG(R5)		;ANY DIGIT BEFORE THIS?
	BNE	70$			;NO, SO INITIALIZE US
	MOV	NP(R5),R0		;YES, SO GET OLD NUMBER
	ASL	R0			;TIMES 2
	ASL	R0			;TIMES 4 NOW
	TST	NMRBAS(R5)		;RADIX?
	BNE	30$			;OCTAL
	ADD	NP(R5),R0		;DECIMAL
30$:	ASL	R0			;TIMES 8. OR 10. BY NOW
	ADD	R1,R0			; AND ADD IN NEW DIGIT
	MOV	R0,NP(R5)		;SAVE THE NUMBER
40$:	ADD	NOPR(R5),PC		;DISPATCH ON OPERATOR
	BR	50$			;+
OP$SUB:	NEG	R0			;-
50$:	ADD	NACC(R5),R0		;FORM RESULT
60$:	MOV	R0,N(R5)		;SAVE THE RESULT
	MOV	#-1,NFLG(R5)		; AND INDICATE A NUMBER
	CLR	OFLG(R5)		;  BUT NO OPERATOR
	RTS	PC			;THEN EXIT

70$:	MOV	R1,R0			;COPY FIRST DIGIT
	MOV	R1,NP(R5)		;SAVE IT IN NUMBER ACCUMULATOR
	BR	80$			;ENTER PROCESSING

CMDCHR	<'B>				;"B" IS ZERO
NCOM:	CLR	NP(R5)			;USUALLY WE SET NP TO 0
80$:	TST	OFLG(R5)		;OPERATOR?
	BNE	40$			;YES
	CLR	NACC(R5)		;NO, SO INITIALIZE US
	CLR	NOPR(R5)
	BR	40$			; AND CONTINUE

OP$AND:	MOV	NACC(R5),R1		;GET MASK
	COM	R1			;MAKE INTO AN 'AND' MASK
	BIC	R1,R0			; AND DO THE 'AND'
	BR	60$			;THEN FINISH UP

OP$OR:	BIS	NACC(R5),R0		;DO THE 'OR'
	BR	60$			;THEN FINISH UP

OP$MUL:	CLR	R1			;CLEAR THE HIGH ORDER
	MOV	#16.+1,R2		;NUMBER OF BITS(+1) IN A WORD
90$:	CLC				;CLEAR THE DUMB CARRY
	ROR	R1			;SHIFT HIGH ORDER INTO
	ROR	R0			; LOW ORDER
	BCC	100$			;NO NEED TO ADD HERE...
	ADD	NACC(R5),R1		;ADD INTO HIGH ORDER
100$:	DEC	R2			;MORE?
	BGT	90$			;YES
	BR	60$			;NO

OP$DIV:	MOV	R0,R2			;SET THE DIVISOR
	MOV	NACC(R5),R0		; AND THE DIVIDEND
	MOV	#60$,-(SP)		;STACK RETURN ADDRESS
DIVD:	CLR	R1			;CLEAR THE REMAINDER
	MOV	#16.,R3			;NUMBER OF BITS IN A WORD
110$:	ASL	R0			;SHIFT THE DIVIDEND
	ROL	R1			; INTO THE REMAINDER
	CMP	R2,R1			;CAN WE SUBTRACT?
	BHI	120$			;NOPE
	SUB	R2,R1			;YEP
	INC	R0			; AND COUNT IN ANSWER
120$:	DEC	R3			;MORE?
	BGT	110$			;YES
	RTS	PC			;NO, EXIT

.DSABL	LSB

CMDCHR	<'_-100>			;"CTRL/_" IS THE UNARY COMPLEMENT OPERATOR
	TST	NFLG(R5)		;IS THERE A NUMBER?
	BPL	10$			;THERE SHOULD HAVE BEEN
	COM	N(R5)			;DO A COMPLEMENT
	RTS	PC			; AND LEAVE

10$:	ERROR	NAB,<"No arg before "<'_-100>>

CMDCHR	<'X-100>			;"CTRL/X" IS SEARCH MODE FLAG
	MOV	NFLG(R5),R3		;SET ARGUMENT DETERMINATION
	CLR	NFLG(R5)		; AND USE UP ANY NUMBER
	MOV	#SFLG-EDIT,R2		;SET OFFSET POINTER TO FLAG
.EEED:	TST	(R2)+			;"ED" IS EDITOR LEVEL
.IIF	NE	EDIT-EHELP-2,	.ERROR	;ORDER IS IMPORTANT!
.EEEH:	TST	(R2)+			;"EH" IS EDIT HELP LEVEL
.IIF	NE	EHELP-ESFLAG-2,	.ERROR	;ORDER IS IMPORTANT!
.EEES:	TST	(R2)+			;"ES" IS EDIT SEARCH FLAG
.IIF	NE	ESFLAG-ETYPE-2,	.ERROR	;ORDER IS IMPORTANT!
.EEET:	TST	(R2)+			;"ET" IS EDIT TYPEOUT FLAG
.IIF	NE	ETYPE-EUFLAG-2,	.ERROR	;ORDER IS IMPORTANT!
.EEEU:	TST	(R2)+			;"EU" IS CASE FLAGGING FLAG
.IIF	NE	EUFLAG-EVFLAG-2, .ERROR	;ORDER IS IMPORTANT!
.EEEV:	ADD	#EVFLAG,R2		;"EV" IS EDIT VERIFY FLAG
	MOV	N(R5),R0		;PRESET (POSSIBLE) NEW VALUE
	JSR	PC,FLAGRW		;NOW ALERT 'TECOIO'
	ADD	R5,R2			;MAKE POINTER ABSOLUTE
	INC	R3			;ARGUMENT?
	BEQ	10$			;YES
	MOV	(R2),R0			;NO, RETURN VALUE
	BR	NCOM			; AND COMPUTE AS A NUMBER

10$:	MOV	R0,(R2)			;SET THE NEW VALUE
	RTS	PC			; AND EXIT

CMDCHR	<'Q-100>			;"^Q" CONVERTS 'L' COMMANDS TO 'C' COMMANDS
	MOV	P(R5),-(SP)		;SAVE .
	JSR	PC,.VVV.N		;NOW MOVE . ACCORDING TO 'L' COMMAND
	MOV	(SP),P(R5)		;RESTORE ORIGINAL .
	MOV	R1,R0			;COPY THE NEW .
	SUB	(SP)+,R0		; AND FIND DELTA-DOT
	BR	NCOM			;USE THAT AS A NUMBER

CMDCHR	<':>				;":" IS THE SEARCH MODIFIER
	MOV	#-1,CLNF(R5)		;SET COLON FLAG
	TSTNXT	':			;DOUBLE COLON?
	SBC	CLNF(R5)		;YES MEANS FLAG=-2
	RTS	PC			; AND EXIT

.ENABL	LSB

CMDCHR	<'J>				;"J" IS MOVE POINTER
	CLR	NFLG(R5)		;USE UP THE NUMBER
	MOV	N(R5),R0		;NOW GET THE NUMBER
	BR	10$			; AND GO SET .

CMDCHR	<'R>				;"R" IS MOVE POINTER CHARACTERS
	JSR	PC,GETN			;GET THE NUMBER OF CHARACTERS
	NEG	R0			;THIS IS THE REVERSE MOVE
	BR	.FFF.R			;GO JOIN COMMON CODE

CMDCHR	<'C>				;"C" IS MOVE POINTER CHARACTERS
	JSR	PC,GETN			;GET THE NUMBER OF CHARACTERS
.FFF.R:	ADD	P(R5),R0		;CALCULATE NEW .
10$:	JSR	PC,BZCHK		;CHECK FOR VALIDITY
	MOV	R0,P(R5)		;SET NEW .
	RTS	PC			; AND EXIT

CMDCHR	<'D>				;"D" IS DELETE CHARACTERS
	TST	CFLG(R5)		;IS FORM M,ND ?
	BMI	20$			;YES, SO PRETEND IT IS M,NK
	JSR	PC,GETN			;GET THE NUMBER OF CHARACTERS
	MOV	R0,R1			; AND SAVE THAT NUMBER
	BPL	30$			;>0 IS FORWARD DELETE
	JSR	PC,.FFF.R		;<0 IS BACKWARD (-ND = -NC ND)
	MOV	R1,R0			;RESTORE THE DELETE COUNT
	BR	ADJ			;NOW DELETE

CMDCHR	<'K>				;"K" IS THE LINE DELETER
20$:	JSR	PC,NLINES		;GET THE NUMBER OF LINES
	MOV	M(R5),P(R5)		;STARTING FROM HERE
30$:	NEG	R0			;DELETE THIS MANY (<0 IS DELETE)
.IIF	NE	.-ADJ,	.ERROR		;NOW DO IT

.DSABL	LSB

.SBTTL	ADJUST TEXT AREA ROUTINE
; R0 = 0 MEANS NO ADJUSTMENT
; R0 < 0 MEANS SHRINK AREA BY ABS(R0)
; R0 > 0 MEANS ENLARGE AREA BY R0
; (R0,R1,R2,R3 ARE CLOBBERED)

.ENABL	LSB

ADJ:	MOV	P(R5),R2		;GET .
	MOV	ZZ(R5),R3		; AND GET END OF TEXT
	MOV	R0,R1			;COPY THE CHANGE AMOUNT
	BMI	40$			;<0 MEANS SHRINK AREA
	BEQ	20$			;=0 MEANS NO CHANGE
	ADD	R3,R1			;NOW HAVE NEW SIZE
	SIZE	TEXT			;CHECK OUT THE SIZE
	BCC	30$			;WE CAN'T DO IT
	MOV	R1,ZZ(R5)		;UPDATE THE BUFFER SIZE
	MOV	TXSTOR(R5),R0		;GET ABSOLUTE POINTER BIAS
EXPAND:	CMP	R2,R3			;ANYTHING TO DO?
	BEQ	20$			;NO, FAST EXIT
	ADD	R0,R1			;MAKE NEW ZZ ABSOLUTE
	ADD	R0,R2			;MAKE . ABSOLUTE
	ADD	R0,R3			;MAKE OLD ZZ ABSOLUTE
	MOVB	(R2),R0			;SAVE CHARACTER AT .
	CLRB	(R2)			;THEN FLAG THAT SPOT
10$:	MOVB	-(R3),-(R1)		;MOVE A BYTE UP FROM END
	BNE	10$			;CANNOT BE END OF NON-ZERO
	CMP	R3,R2			;REACHED . YET?
	BHI	10$			;NOPE, SO CONTINUE
	MOVB	R0,(R2)			;YES, RESTORE CHARACTER AT .
	MOVB	R0,(R1)			; AND RESTORE MOVED NULL BYTE
20$:	RTS	PC			;NOW EXIT

30$:	ERROR	MEM,<"Memory overflow">

40$:	MOV	R2,R1			;COPY . TO HERE
	SUB	R0,R2			;NOW FIND END OF THE DELETE
	CMP	R2,R3			;IS DELETE TOO BIG?
	BHI	70$			;YEP
	ADD	R0,ZZ(R5)		;SET NEW DATA SIZE
	MOV	TXSTOR(R5),R0		;GET BUFFER BIAS
SHRINK:	CMP	R2,R3			;ANYTHING TO DO?
	BEQ	60$			;NO, FAST EXIT
	ADD	R0,R1			;MAKE . ABSOLUTE
	ADD	R0,R2			;MAKE END OF DELETE ABSOLUTE
	ADD	R0,R3			;MAKE END OF BUFFER ABSOLUTE
	MOVB	-(R3),R0		;SAVE END OF BUFFER BYTE
	CLRB	(R3)			;THEN FLAG END OF BUFFER
50$:	MOVB	(R2)+,(R1)+		;MOVE A BYTE DOWN
	BNE	50$			;CANNOT BE END IF NON-ZERO
	CMP	R2,R3			;END OF BUFFER REACHED?
	BLOS	50$			;NOT YET
	MOVB	R0,-(R1)		;RESTORE END OF BUFFER BYTE
	MOVB	R0,(R3)			; AND RESTORE THIS ALSO
60$:	RTS	PC			;NOW EXIT

70$:	ERROR	DTB,<"Delete too big">

.DSABL	LSB

.SBTTL	SORT
; INVOKED VIA "SORT" MACRO
; R0 = CHARACTER TO SORT
; (R1 IS CLOBBERED)

SORTC:	MOV	N(R5),R3		;GET ARGUMENT
SORTZ:	CLR	R2			;SET UP FOR THE "ADD" CHAIN
SORTS:	JSR	PC,SCNUPP		;GET CHARACTER TO SORT ON
SORT:	MOV	(R4)+,R1		;GET TABLE ADDRESS
10$:	CMPB	R0,-(R1)		;GET A MATCH?
	BHI	10$			;NO, KEEP GOING
	BLO	20$			;NO, TOO FAR
	SUB	-(R4),R1		;YES, FIND NET CHANGE (<0)
	COM	R1			;MAKE THAT 0,1,2, ETC.
	ASL	R1			;NOW TIMES 2 FOR WORD ADDRESSING
	ADD	(R4),R1			;FIND POINTER INTO THE TABLE
	MOV	(R1),R4			;SET A NEW RETURN ADDRESS
20$:	RTS	R4			;NOW EXIT

CMDCHR	<'O>				;"O" IS GOTO LABEL
	CLR	NFLG(R5)		;USE UP ANY NUMBER
	JSR	PC,QSKP			;SKIP THE QUOTED STRING
	MOV	QUOTE(R5),-(SP)		;SAVE ENDING QUOTE CHARACTER
	MOV	OSCANP(R5),-(SP)	;SAVE TAG'S POINTER
	MOV	ITRST(R5),(R5)		;START SEARCH AT ITERATION START
10$:	SKPSET	'!			;SKIP UNTIL A !
	JSR	PC,TRACE		;TRACE THE ! IF TRACING
	MOV	R0,QUOTE(R5)		;SET ! AS TERMINATING QUOTE
	JSR	PC,QCHK			;UNLESS SOMETHING ELSE ENDS IT
	MOV	(SP),R4			;GET BACK THE TAG'S START
	ADD	QBASE(R5),R4		; AND ADD IN Q-REG OFFSET
	ADD	QRSTOR(R5),R4		;THEN MAKE ABSOLUTE
20$:	JSR	PC,SCNQST		;SCAN FOR END OF TAG
	BEQ	30$			;BR OUT IF END OF TAG FOUND
	CMPB	R0,(R4)+		;NOT END, MATCH?
	BEQ	20$			;CONTINUE UNTIL END IF MATCH
	JSR	PC,QSKPE		;SCAN UNTIL TAG'S END IF NO MATCH
	BR	10$			; THEN FIND NEXT TAG

30$:	CMPB	(R4)+,2(SP)		;BOTH ENDS MATCH?
	BNE	10$			;NOPE, SO FIND NEXT TAG
	CMP	(SP)+,(SP)+		;YES, DUMP START & QUOTE
	BR	IREST			; AND EXIT RESTORING QUOTE

.SBTTL	SKIP OVER COMMAND
; (R0,R1,R2,R3,"TEMP" ARE CLOBBERED)

.ENABL	LSB

SKPSET:	JSR	PC,IREST		;RESTORE ESCAPE AS QUOTE
	MOV	(R4)+,TEMP(R5)		;SAVE SPECIAL CHARACTER
	MOVB	TFLG(R5),TEMP+1(R5)	;SAVE TRACE FLAG
	CLRB	TFLG(R5)		;THEN DISABLE TRACE DURING SKIP
10$:	JSR	PC,SCNUPP		;GET NEXT CHARACTER
20$:	CMPB	R0,TEMP(R5)		;IS IT THE SPECIAL CHARACTER?
	BEQ	70$			;YES, SO EXIT
	MOV	#10$,-(SP)		;STACK A RETURN ADDRESS
	SORT	..CSM			;SORT ON SPECIAL SKIPPERS
	RTS	PC			;NON-SPECIALS ARE IGNORED

.CSMU:	JSR	PC,SCAN			;IGNORE NEXT CHARACTER
	BR	.CSMQ			; AND 1 QUOTED STRING

.CSMF:	JSR	PC,SCNUPP		;GET "F" MODIFIER
	CMP	R0,#'R			;"FR"?
	BEQ	.CSMQ			;YES, ONLY SKIP 1 STRING
.CSM2Q:	JSR	PC,QSKP			;IGNORE 1 QUOTED STRING
.CSMQ:	JSR	PC,QSKP			;IGNORE 1 QUOTED STRING
IREST:	MOV	#ESC,R0			;SET TO RESTORE QUOTE AS ESCAPE
	BR	30$			;GO DO IT

QCHK:	TST	QFLG(R5)		;QUOTE FLAG?
	BEQ	50$			;NOPE
	JSR	PC,SCAN			;YES, SO GET THE QUOTE CHARACTER
30$:	CLR	QFLG(R5)		;NOW CLEAR THE QUOTE FLAG
40$:	MOV	R0,QUOTE(R5)		; AND SET QUOTE CHARACTER
50$:	RTS	PC			;NOW EXIT

.CSMY:	MOV	#.CSMQ,-(SP)		;IGNORE A STRING QUOTED ON
	BR	40$			; THIS CHARACTER

.CSME:	JSR	PC,SCNUPP		;GET NEXT CHARACTER AS UPPER CASE
	MOV	#..CSME,R1		;GET TABLE OF EB, EG, EI, ER, EW
60$:	CMPB	R0,-(R1)		;IS IT IN THE TABLE?
	BHI	60$			;NO, KEEP GOING
	BEQ	.CSMQ			;YES, SKIP A STRING
	RTS	PC			;NO, JUST EXIT

CMDCHR	<'@>				;"@" IS QUOTE FLAG SETTER
.CSMA:	MOV	#-1,QFLG(R5)		;@ FOUND; SET QUOTE FLAG
	RTS	PC			;EXIT

.CSMUA:	JSR	PC,SCNCTL		;GET NEXT AS CONTROL CHARACTER
	BR	20$

70$:	MOVB	TEMP+1(R5),TFLG(R5)	;RESTORE THE TRACE FLAG
	RTS	R4			; AND EXIT

.DSABL	LSB

.SBTTL	ERROR MESSAGE PROCESSOR

.IF	NE	E$$TXT

.ENABL	LSB

ERRORA:	MOVB	(R4)+,R0		;GET 3RD RAD50 CHARACTER
	ADD	(PC)+,R0		;NOW FORM "NA?"
	 .RAD50	/NA /
	MOV	(PC)+,-(SP)		;STACK MESSAGE POINTER
	MESSAG	<"No arg before "<-1>>
	BR	10$			; AND GO TO COMMON PROCESSING

ERRORC:	MOVB	(R4)+,R0		;GET 2ND RAD50 CHARACTER
	ASL	R0			;MAKE INTO
	ASL	R0			; REAL
	ASL	R0			;  2ND CHARACTER
	ADD	(PC)+,R0		;NOW FORM "I?C"
	 .RAD50	/I C/
	MOV	(PC)+,-(SP)		;STACK MESSAGE POINTER
	MESSAG	<"Illegal "<-1>" character">
10$:	MOVB	(R4)+,R4		;GET LAST/MIDDLE CHARACTER
	BR	ERRMIO			; AND GO TO COMMON PROCESSING

.DSABL	LSB

ERRORS:	MOV	(R4)+,R0		;GET RAD50 OF ERROR CODE
	MOV	(R4)+,-(SP)		;SAVE THE TEXT POINTER
	CLR	R4			;THEN FLAG FOR FOLLOWING STRING
	BR	ERRMIO			;NOW DO IT

.ENDC

ERRMSG:	MOV	(R4)+,R0		;GET RAD50 OF ERROR CODE

.IF	NE	E$$TXT

	MOV	(R4)+,-(SP)		;SAVE THE TEXT POINTER

.IFTF

ERRMIO:	MOV	(R5),ERRPOS(R5)		;SAVE ERRING "SCANP"

.IFT

	MOV	EHELP(R5),R2		;GET EDIT HELP LEVEL
	BIC	#^C<3>,R2		; MASKED TO BITS <1-0>
	DEC	R2			;  AND LESS 1
	BNE	10$			;NOT "EH"=1, SO KEEP STRING POINTER
	CLR	(SP)			;"EH"=1, SO NO MORE STRING POINTER
10$:	MOV	(SP)+,TEMP(R5)		;NOW SAVE THE STRING POINTER

.ENDC

	MOV	#TECOCR,-(SP)		;SET THE RESTART RETURN ADDRESS
	BIT	EHELP(R5),#4		;DESIRE FAILING COMMAND AUTO-PRINT?
	BEQ	20$			;NOPE
	MOV	#.CMDQM,(SP)		;YEP, PRINT FAILING COMMAND LINE ON EXIT
20$:	JSR	PC,ALLERR		;TELL 'TECOIO' ABOUT THE ERROR
	MOV	#50,R2			;SET TO DIVIDE BY 50
	CLR	-(SP)			;FLAG END OF CHARACTERS
30$:	JSR	PC,DIVD			;DIVIDE BY 50
	MOV	R1,-(SP)		; AND SAVE REMAINDER
	TST	R0			;  ANY ANSWER LEFT?
	BNE	30$			;   LOOP IF SO...
	JSR	PC,CRLFNO		;NO CTRL/O AND RESTORE CARRIAGE
	MOV	#'?-<'A-1>,R0		;NOW SET FOR PRINTING A "?"
40$:	ADD	#'A-1,R0		;MAKE A CHARACTER
	CMP	R0,#'Z			;REALLY ALPHABETIC?
	BLOS	50$			;YES, SO TYPE IT
	ADD	#'0-36-<'A-1>,R0	;NO, SO CONVERT TO NUMERIC
50$:	JSR	PC,TYPE			; AND TYPE IT
	MOV	(SP)+,R0		;GET NEXT
	BNE	40$			; IF ANY...

.IF	NE	E$$TXT

	MOV	TEMP(R5),R1		;GET THE STRING POINTER
	BEQ	100$			;IF ANY...
	MOV	FILBUF(R5),R2		;PRESET FOR PRINTING A FILENAME
	MOV	#TAB,R0			;START WITH A TAB
60$:	JSR	PC,TYPE
70$:	MOVB	(R1)+,R0		;GET STRING CHARACTER
	BGT	60$			; IF MORE...
	BEQ	80$			;  OR THE STRING'S END
	MOV	R4,R0			;ELSE GET LAST/MIDDLE CHARACTER
	BNE	60$			; IF ANY...
	MOV	SCHBUF(R5),R2		;ELSE DO THE SEARCH BUFFER
80$:	TST	R4			;IS A QUOTED STRING TO COME?
	BNE	100$			;NO, FINAL END
	MOV	#SPACE,R0		;YES, START WITH A
	JSR	PC,TYPE			; SPACE
	MOV	#'",R0			;THEN THE LEADING "
90$:	BIC	#^C<177>,R0		;ENSURE NO PARITY BIT ON
	JSR	PC,TYPEF		;NOW TYPE A CHARACTER WITH CASE FLAGGING
	MOVB	(R2)+,R0		;THEN FETCH A STRING CHARACTER
	BNE	90$			; AND PRINT IT
	MOV	#'",R0			;SET THE CLOSING "
	JSR	PC,TYPE			; AND THEN TYPE THAT
100$:

.ENDC

	RTS	PC			;NOW EXIT

.SBTTL	Q-REGISTER REFERENCE
; RETURNS:	R0 = 0
; 		R1 = POINTER TO Q-REG SIZE
; 		R2 = OFFSET TO BASE OF Q-REG
; 		"QNMBR" SET AS SPECIFIED

.ENABL	LSB

QREF:	JSR	PC,SCNUPP		;GET NEXT CHARACTER
QREFST:	JSR	PC,ALPHAN		;MUST BE ALPHANUMERIC
	BCC	50$			; BUT IT IS NOT
QREFCH:	CMP	R0,#'A			;IS IT ALPHA?
	BLO	10$			;NOPE, IT IS NUMERIC
	ADD	#13-'A-<1-'0>,R0	;YEP, RANGE IS 13-44
10$:	ADD	#1-'0,R0		;RANGE IS 1-12
QREFR0:	MOV	R0,QNMBR(R5)		;SAVE THE Q-REG NUMBER

.SBTTL	GET SUM OF Q-REGISTER IN "QNMBR" (QSUMY)

QSUMY:	MOV	QNMBR(R5),R0		;GET THE Q-REG NUMBER

.SBTTL	GET SUM OF Q-REGISTER IN R0 (QSUMX)

QSUMX:	MOV	#QARRAY,R1		;GET OFFSET TO Q-REG ARRAY
	ADD	R5,R1			;NOW FIND IT FOR REAL
	CLR	R2			;START OFFSET OF REG AT 0
	BR	30$			; AND ENTER COUNTING LOOP

20$:	ADD	(R1)+,R2		;SUM THE TOTAL OFFSE
	TST	(R1)+			; AND SKIP THE VALUE SPOT
30$:	DEC	R0			;MORE?
	BGT	20$			;YES, LOOP
40$:	RTS	PC			;NO, EXIT

50$:	ERROR	IQN,<"Illegal Q-reg name">

CMDCHR	<'[>				;"[" IS Q-REG PUSH
	JSR	PC,QREF			;REFERENCE THE Q-REGISTER
	MOV	QNMBR(R5),-(SP)		;SAVE NUMBER OF THAT REGISTER
	MOV	(R1),R4			;SAVE SIZE OF THAT REGISTER
	MOV	#AUXQRG,QNMBR(R5)	;NOW SET THE AUX Q-REG'S NUMBER
	JSR	PC,QSUMY		;SUM UP THE AUX Q-REG
	MOV	(R1),R0			;GET ITS CURRENT SIZE
	ADD	R4,R0			;ADD IN THE REF'D Q-REG'S SIZE
	ADD	#4,R0			; AND ADD IN 4 FOR GOODNESS
	JSR	PC,QADJ			;NOW ADJUST(UP) ITS SIZE
	ADD	(R1),R2			;GET POINTER TO ITS END+1
	MOV	R2,R4			; AND SAVE THAT POINTER
	MOV	(SP)+,R0		;GET BACK REF'D Q-REG NUMBER
	JSR	PC,QSUMX		; AND SUM UP THAT Q-REG
	ADD	QRSTOR(R5),R2		;ABS PTR TO REF'D Q-REG
	ADD	QRSTOR(R5),R4		;ABS PTR TO AUX Q-REG END+1
	CMP	(R1)+,(R1)+		;SKIP OVER THE SIZE/VALUE
	MOVB	-(R1),-(R4)		;SAVE MSB OF VALUE AND
	MOVB	-(R1),-(R4)		; LSB OF VALUE
	MOVB	-(R1),-(R4)		;SAVE MSB OF SIZE AND
	MOVB	-(R1),-(R4)		; LSB OF SIZE
	MOV	(R1),R1			;NOW GET SIZE INTO HERE
60$:	DEC	R1			;MORE TO MOVE?
	BMI	40$			;NO, DONE
	MOVB	(R2)+,-(R4)		;YES, MOVE A BYTE
	BR	60$			; AND LOOP FOR MORE

.DSABL	LSB

.ENABL	LSB

10$:	TST	NFLG(R5)		;RETURNING A VALUE?
	BPL	20$			;NOPE, SO ERROR
	MOV	(SP)+,N(R5)		;YEP, RETURN 0 AS THE VALUE
	RTS	PC			; AND EXIT

20$:	ERROR	CPQ,<"Can't pop Q-reg">

CMDCHR	<']>				;"]" IS Q-REG POP
	JSR	PC,CHKCLN		;CHECK FOR OPTIONAL COLON MODIFIER
	JSR	PC,QREF			;REFERENCE THE Q-REGISTER
	MOV	#AUXQRG,R0		;GET NUMBER OF AUX Q-REG
	JSR	PC,QSUMX		; AND SUM IT UP
	MOV	(R1),-(SP)		;SAVE ITS CURRENT SIZE
	BEQ	10$			;NO SIZE, TOO MANY POP'S
	ADD	(R1),R2			;ELSE INDEX TO ITS END+1
	ADD	QRSTOR(R5),R2		;MAKE THE POINTER ABSOLUTE
	MOVB	-(R2),-(SP)		;SET MSB OF REG'S VALUE
	SWAB	(SP)			;NOW PUT IT UP TO MSB
	MOVB	-(R2),(SP)		; AND SET LSB OF REG'S VALUE
	MOVB	-(R2),R0		;SET MSB OF REG'S NEW SIZE
	SWAB	R0			; SWITCH IT TO HIGH BYTE
	BISB	-(R2),R0		;  AND GET LSB OF SIZE
	JSR	PC,QADJ			;ADJUST REF'D Q-REG TO THAT SIZE
	SUB	(R1)+,2(SP)		;FIND NEW SIZE FOR AUX Q-REG
	MOV	(SP)+,(R1)		;SET REF'D Q-REG'S NEW VALUE
	MOV	-(R1),R3		;GET NEW SIZE INTO HERE
	MOV	R2,R4			;SAVE POINTER TO ITS START
	MOV	#AUXQRG,QNMBR(R5)	;GET AUX Q-REG # AGAIN
	JSR	PC,QSUMY		; AND SUM IT UP NOW
	ADD	(R1),R2			;INDEX TO ITS END+1
	ADD	QRSTOR(R5),R2		;MAKE POINTER ABSOLUTE
	ADD	QRSTOR(R5),R4		;MAKE REF'D Q-REG PTR ABS ALSO
	SUB	#4,R2			;BACK OVER SAVED VALUE/SIZE
30$:	DEC	R3			;MORE DATA?
	BMI	40$			;NO, ALMOST DONE
	MOVB	-(R2),(R4)+		;YES, MOVE 1 DATA BYTE
	BR	30$			; AND LOOP...

40$:	MOV	(SP)+,R0		;GET NEW AUX Q-REG SIZE
	SUB	#4,R0			; CORRECTING FOR THE FUDGE
.IIF	NE	.-QADJ,	.ERROR		;ADJUST IT (DOWN) AND EXIT

.DSABL	LSB

.SBTTL	Q-REGISTER SIZE ADJUST ROUTINE
; R0 = NEW SIZE OF Q-REGISTER IN "QNMBR"
; RETURNS:	R0 = 0
; 		R1 = POINTER TO NEW Q-REG SIZE
; 		R2 = OFFSET TO THIS Q-REG
; 		(R3,R4 ARE CLOBBERED)

.ENABL	LSB

QADJ:	MOV	R0,R4			;COPY THE NEW Q-REG SIZE
	JSR	PC,QSUMY		; AND SUM CURRENT Q-REG OFFSET
	MOV	QZ(R5),R3		;GET END OF ALL Q-REGS
	MOV	R1,R0			;COPY Q-REG SIZE POINTER
	MOV	R4,R1			; AND GET WORKING COPY OF NEW SIZE
	ADD	(R0),R2			;POINTER TO CURRENT END OF Q-REG
	SUB	(R0),R1			;SIZE CHANGE (NEW-OLD)
	BLO	20$			;NEW < OLD
	BEQ	10$			;NEW = OLD
	ADD	R3,R1			;NEW > OLD; GET NEW QZ
	SIZE	QREGS			;CHECK OUT THE SIZE
	BCC	30$			;WE CAN'T DO IT
	MOV	R4,(R0)			;SET NEW Q-REG SIZE
	MOV	R1,QZ(R5)		;SET NEW TOTAL Q-REG SIZE
	MOV	QRSTOR(R5),R0		;GET Q-REG AREA POINTER
	JSR	PC,EXPAND		;NOW EXPAND THE Q-REGS
10$:	MOV	QCMND(R5),R0		;GET COMMAND Q-REG NUMBER
	MOV	#QSUMY,-(SP)		;SET FOR COMMAND SETUP JUST IN CASE
SETCMD:	MOV	R0,QCMND(R5)		;SET COMMAND Q-REG NUMBER
	JSR	PC,QSUMX		; AND SUM UP FOR THAT REGISTER
	MOV	R2,QBASE(R5)		;STORE THE BASE OFFSET
	MOV	(R1),QLENGT(R5)		; AND THE LENGTH
	RTS	PC			;THEN EXIT

20$:	MOV	R4,(R0)			;SET NEW Q-REG SIZE
	ADD	R1,QZ(R5)		;LOWER THE TOTAL Q-REG SIZE
	ADD	R2,R1			;POINT TO THE END OF DELETE
	MOV	QRSTOR(R5),R0		;GET Q-REG AREA POINTER
	JSR	PC,SHRINK		;NOW SHRINK THE Q-REGS
	BR	10$			;ALL DONE

30$:	ERROR	MEM,<"Memory overflow">

.DSABL	LSB

.SBTTL	GENERAL SUBROUTINES

GETXTP:	MOV	P(R5),R0		;GET .
	CMP	R0,ZZ(R5)		;TOO FAR?
	BHIS	10$			;YES [BHIS=BCC]
	ADD	TXSTOR(R5),R0		;NO, MAKE ABSOLUTE
	MOVB	(R0),R0			; AND GET CHARACTER
	SEC				;OK [CARRY SET]
10$:	RTS	PC			;EXIT

SCNUPP:	JSR	PC,SCAN			;SCAN FIRST
UPPERC:	CMP	R0,#140			;ALREADY OK?
	BLO	10$			;YES
	BIC	#40,R0			;NO, SO CORRECT IT
10$:	RTS	PC			;NOW EXIT

.ENABL	LSB

10$:	MOV	R0,-(SP)		;MOVE CO-ROUTINE RETURN TO STACK
	MOVB	(R4)+,R0		;GET ITEM COUNT
	MOVB	(R4)+,R1		;GET STARTING OFFSET
	ADD	R5,R1			;MAKE THAT ABSOLUTE
	MOV	PDL(R5),R2		;GET THE CURRENT PUSH-DOWN POINTER
	JSR	PC,@(SP)+		; AND CO-ROUTINE IT
	MOV	R2,PDL(R5)		;UPDATE THE PUSH-DOWN POINTER
	MOV	(SP)+,R0		;RESTORE R0 FROM THE 'JSR R0'
	RTS	R4			; AND FINAL EXIT

PUSH:	TST	PCNT(R5)		;HAVE PAREN'S BEEN PUSHED?
	BNE	50$			;YES, ERROR
PUSHP:	JSR	R0,10$			;DO THE COMMON THING
20$:	CMP	R2,SCHBUF(R5)		;OVERFLOW?
	BHIS	40$			;YES, ERROR
	MOV	(R1)+,(R2)+		;NO, SO PUSH AN ITEM
	DEC	R0			; AND
	BNE	20$			;  LOOP
	RTS	PC			;THEN CO-ROUTINE RETURN

POP:	JSR	R0,10$			;DO THE COMMON THING
30$:	MOV	-(R2),-(R1)		;POP AN ITEM
	DEC	R0			; AND
	BNE	30$			;  LOOP
	RTS	PC			;THEN CO-ROUTINE RETURN

40$:	ERROR	PDO,<"Push-down list overflow">

50$:	ERROR	MRP,<"Missing )">

.DSABL	LSB

.ENABL	LSB

QSKP:	JSR	PC,QCHK			;CHECK FOR A QUOTE CHARACTER
	MOV	(R5),OSCANP(R5)		; AND SAVE "SCANP"
QSKPE:	JSR	PC,SCNQST		;SCAN CHECKING THE QUOTE CHARACTER
	BNE	QSKPE			;NOT A MATCH, CONTINUE SCANNING
10$:	RTS	PC			;EXIT

BZCHK:	CMP	R0,ZZ(R5)		;TOO BIG?
	BLOS	10$			;NOPE
	ERROR	POP,<"Pointer off page">

.DSABL	LSB

.ENABL	LSB

10$:	MOV	#1,R0			;PRETEND WE SAW A ONE
	JSR	PC,NCOM			; AND COMPUTE ON IT
GETN:	MOV	N(R5),R0		;GET THE NUMBER
	INC	NFLG(R5)		;REALLY THERE?
	BNE	10$			;NOPE
	RTS	PC			;YES

.DSABL	LSB

QSKPR0:	JSR	PC,QSKP			;SKIP THE QUOTED STRING
	JSR	PC,IREST		;THEN RESTORE ESCAPE AS THE QUOTE
	MOV	OSCANP(R5),R3		;GET ORIGINAL SCAN POINTER
	MOV	(R5),R0			;GET ENDING (THE QUOTE) POINTER
	DEC	R0			;BACK UP OVER THE QUOTE
	SUB	R3,R0			; AND FIND THE STRING'S LENGTH
	RTS	PC			;EXIT WITH CC'S AS INDICATION

CHKCLN:	TST	CLNF(R5)		;IS COLON MODIFIER PENDING?
	BPL	10$			;NO
	MOV	#-1,R0			;YES, SET UP RESULT
	JSR	PC,NCOM			; AS A -1
10$:	CLR	CLNF(R5)		;NOW TURN OFF PENDING COLON
	RTS	PC			; AND EXIT

SCNCTL:	MOV	(SP)+,(SP)		;POP ONE STACK ITEM
	JSR	PC,SCAN			;SCAN A CHARACTER
MAKCTL:	JSR	PC,UPPERC		;FORCE CHARACTER TO UPPER CASE
	BIC	#^C<77>,R0		; THEN MAKE A CONTROL CHARACTER
	RTS	PC			;  AND EXIT

SCNQST:	JSR	PC,SCAN			;SCAN A CHARACTER
	CMP	R0,QUOTE(R5)		;SET CC'S AGAINST MATCHING THE QUOTE
	RTS	PC			; AND EXIT WITH CC'S SET

.ENABL	LSB

TERMS:	CMP	R0,#FF+1		;TERMINATOR TEST
	BHIS	20$			;TOO BIG, RETURN C=0
10$:	CMP	#LF-1,R0		;SET CARRY ON LOW RANGE
20$:	RTS	PC			;NOW EXIT

NUMER:	CMP	R0,#'9+1		;NUMERIC TEST
	BHIS	30$			;RETURN CARRY CLEAR IF HIGH
	CMP	#'0-1,R0		;SET CARRY ON LOW RANGE
30$:	RTS	PC			;NOW EXIT

RAD50:	CMP	R0,#'.			;.?
	BEQ	10$			;YES
	CMP	R0,#'$			;$?
	BEQ	10$			;YES
ALPHAN:	JSR	PC,NUMER		;CHECK FOR NUMERIC FIRST
	BCS	40$			;EXIT IF SO
ALPHA:	JSR	PC,UPPERC		;FORCE LOWER CASE INTO UPPER CASE
ALPHAU:	CMP	R0,#'Z+1		;ALPHABETIC TEST
	BHIS	40$			;RETURN C=0 IF TOO HIGH
	CMP	#'A-1,R0		;SET CARRY ON LOW RANGE
40$:	RTS	PC			;NOW EXIT

ALPHAL:	SUB	#40,R0			;MAKE LOWER CASE INTO UPPER CASE
	BR	ALPHAU			; THEN GO CHECK FOR UPPER CASE

.DSABL	LSB

TSTNXT:	MOV	(R4)+,-(SP)		;SAVE THE ARGUMENT CHARACTER
	MOV	(R5),R0			;GET COMMAND POINTER
	CMP	R0,QLENGT(R5)		;END OF COMMAND?
	BHIS	10$			;YES, SO EXIT (C=0)
	ADD	QBASE(R5),R0		;NO, ADD COMMAND OFFSET
	ADD	QRSTOR(R5),R0		; AND MAKE ABSOLUTE
	MOVB	(R0),R0			;FETCH CHARACTER
	JSR	PC,UPPERC		; AND MAKE UPPER CASE
	CMP	R0,(SP)			;MATCH?
	BNE	10$			;NO, EXIT (C=0)
	INC	(R5)			;YES, BUMP POINTER
	JSR	PC,TRACE		;TRACE THE CHARACTER
	COM	(SP)			;INDICATE FOUND (C=1)
10$:	ASL	(SP)+			;SET C-BIT IF FOUND
	RTS	R4			; AND EXIT

.ENABL	LSB

CRLFNO:	JSR	PC,NOCTLO		;CANCEL ANY CONTROL/O
CRLF:	MOV	#CR,R0			;NOW SET RETURN
	JSR	PC,TYPE			; AND TYPE IT
	MOV	#LF,R0			;NOW SET LINE FEED
10$:	JMP	TYPE			; AND TYPE IT

CMDCHR	<FF>				;"FF" TYPES OUT A FORM FEED
	MOV	#FF,R0			;SET THE FORM FEED
	BR	10$			; AND GO TYPE IT OUT

.DSABL	LSB

NLINES:	INC	CFLG(R5)		;WAS THERE A COMMA?
	BEQ	10$			;YES
	MOV	P(R5),M(R5)		;NO, SO SAVE . IN "M"
	JSR	PC,.VVV.N		; AND MOVE . FORWARD "N" LINES
	MOV	P(R5),N(R5)		;"N" IS THE NEW .
	MOV	M(R5),P(R5)		;RESTORE THE ORIGINAL .
10$:	CLR	NFLG(R5)		;USE UP THE NUMBER
	MOV	N(R5),R0		;GET NTH CHARACTER POSITION
	CMP	R0,M(R5)		;IS IT AFTER MTH CHARACTER?
	BHIS	20$			;YES
	MOV	M(R5),N(R5)		;NO, SO SWITCH
	MOV	R0,M(R5)		; N AND M
	MOV	N(R5),R0		;NOW GET NTH POSITION AGAIN
20$:	JSR	PC,BZCHK		;IN RANGE?
	SUB	M(R5),R0		;FIND DISTANCE BETWEEN N AND M
	RTS	PC			;THEN EXIT

ZEROD:	MOV	(R3)+,R4		;PICKUP OUTPUT ROUTINE ADDRESS
	MOV	R3,(SP)			;THEN SET THE RETURN ADDRESS
	MOV	N(R5),-(SP)		;GET NUMBER
	BPL	10$			;IT IS +
	TST	NMRBAS(R5)		;IT IS -, BUT IS RADIX OCTAL?
	BNE	10$			;IF OCTAL, THEN NO SIGN
	MOV	#'-,R0			;IF DECIMAL, THEN SIGNED
	JSR	PC,(R4)			;OUTPUT MINUS SIGN
	NEG	(SP)			; AND MAKE +
10$:	MOV	(SP)+,R0		;RESTORE THE NUMBER
	MOV	#8.,R2			;RADIX = 8?
	TST	NMRBAS(R5)		;THIS TELLS US...
	BNE	20$			;YES
	TST	(R2)+			;NO, RADIX = 10.
20$:	JSR	PC,DIVD			;NOW DIVIDE
	MOV	R1,-(SP)		;SAVE REMAINDER
	TST	R0			;MORE TO GO?
	BNE	20$			;YES
30$:	MOV	(SP)+,R0		;GET BACK A DIGIT
	CMP	R0,#9.			;DIGIT OR RETURN ADDRESS?
	BHI	40$			;RETURN ADDRESS
	ADD	#'0,R0			;DIGIT
	JSR	PC,(R4)			;OUTPUT IT
	BR	30$			; AND LOOP

40$:	JMP	(R0)			;EXIT

.ENABL	LSB

GETSCH:	MOV	SCHBUF(R5),R4		;GET SEARCH BUFFER START
GETFIL:	MOV	R0,-(SP)		;NOW SAVE THE ARGUMENT
	MOV	R4,-(SP)		; AND THE STARTING POINT
	JSR	PC,QCHK			;SET UP FOR ANY QUOTED STRING
10$:	CLR	R2			;GET INPUT FROM SCAN
20$:	TST	R2			;WHERE DO THEY COME FROM?
	BNE	70$			;A Q-REG IF NON-ZERO
	JSR	PC,SCNQST		;GET A CHARACTER CHECKING FOR QUOTE
	BEQ	120$			;END OF SEARCH STRING IF QUOTE MATCH
	CMP	R0,#'^			;THE CONTROL CHARACTER PREFIX?
	BNE	30$			;NOPE
	BIT	EDIT(R5),#1		;YEP, BUT ARE WE ALLOWING IT??
	BNE	30$			;SKIP CONVERSION IF NOT ALLOWED
	JSR	PC,SCNQST		;GET CHARACTER TO MAKE A CONTROL CHAR
	BEQ	50$			;WHOOPS, IT IS OUR QUOTE CHARACTER
	JSR	PC,MAKCTL		;ELSE MAKE CHARACTER INTO CONTROL CHAR
30$:	CLR	R1			;SIGNAL NO SPECIAL MODIFICATIONS
	CMP	R0,#'Q-100		;CTRL/Q?
	BEQ	40$			;YES, GET NEXT LITERALLY
	COM	R1			;NO, SIGNAL FORCE LOWER CASE
	CMP	R0,#'V-100		;CTRL/V?
	BEQ	40$			;YES, NEXT BECOMES LOWER CASE
	CMP	R0,#'W-100		;CTRL/W?
	BNE	80$			;NOPE
	NEG	R1			;YES, SIGNAL FORCE UPPER CASE
40$:	JSR	PC,SCNQST		;GET THE CHARACTER TO MODIFY
	BEQ	50$			;WHOOPS, IT IS OUR QUOTE CHARACTER
	ASL	R1			;WHAT SHOULD WE DO WITH IT??
	BEQ	100$			;NOTHING (CTRL/Q)
	BIT	R0,#100			;IS IT REALLY A CONTROL CHARACTER?
	BEQ	100$			;YES, DON'T ALTER IT
	BIS	#40,R0			;FORCE INTO LOWER CASE
	BCS	100$			;LOWER CASE IT IS (CTRL/V)
	BIC	#40,R0			;ELSE FORCE UPPER CASE (CTRL/W)
	BR	100$			; THEN STORE IT IN SEARCH BUFFER

50$:	ERROR	ISS,<"Illegal search string">

60$:	TST	R2			;^E - ARE WE IN Q-REG FETCH?
	BNE	90$			;YES, USE AS NORMAL ^E
	TSTNXT	'Q			;NO, IS IT Q-REG FETCH?
	MOV	#'E-100+200,R0		;RESTORE IT AS CTRL/E
	BCC	100$			;NOT Q, ENTER CTRL/E AS SPECIAL
	JSR	PC,GETQRG		;Q, SO FIND Q-REG OR "_" OR "*"
	MOV	R0,R1			;MOVE THE SIZE OVER TO HERE
	BCC	70$			;"_" OR "*", ALL SET
	ADD	QRSTOR(R5),R2		;Q-REG, FIND THE ABSOLUTE START

70$:	DEC	R1			;ANYTHING LEFT IN Q-REG?
	BMI	10$			;NO, GO CLEAR FLAG
	MOVB	(R2)+,R0		;YES, GET A BYTE
	BIC	#^C<177>,R0		; AND TRIM OFF ANY PARITY BIT
80$:	CMP	R0,#'E-100		;CTRL/E?
	BEQ	60$			;YES
	CMP	R0,#'N-100		;CTRL/N?
	BEQ	90$			;YES, THAT IS SPECIAL
	CMP	R0,#'S-100		;CTRL/S?
	BEQ	90$			;YES, THAT IS SPECIAL
	CMP	R0,#'X-100		;CTRL/X?
	BNE	100$			;NOPE, SO NORMAL SEARCH CHARACTER
90$:	BIS	#200,R0			;FLAG THE SPECIAL CHARACTERS
100$:	MOVB	R0,(R4)+		;STORE IN SEARCH BUFFER
	BNE	110$			;NON-NULL IS ALRIGHT
	MOVB	#200,-1(R4)		;ELSE STORE NULLS WITH PARITY
110$:	CMPB	1(R4),#-1		;MORE ROOM?
	BNE	20$			;YES, SO CONTINUE
	CLRB	(R4)			;NO, ENSURE A MARKED END...
	ERROR	STL,<"String too long">

120$:	CMP	R4,(SP)+		;DID WE STORE ANYTHING?
	BEQ	130$			;NOPE, USE PREVIOUS STRING
	CLRB	(R4)			;YEP, ENSURE A MARKED END
130$:	MOV	(SP)+,R2		;RESTORE THE ARGUMENT
	RTS	PC			;EXIT WITH CC'S SET

.DSABL	LSB

GETQRG:	MOV	SCHBUF(R5),R2		;GUESS AT "_" (SEARCH BUFFER)
	TSTNXT	'_			;SPECIAL CASE OF "_"?
	BCS	10$			;YES
	TSTNXT	'*			;SPECIAL CASE OF "*"?
	BCC	30$			;NO, NORMAL Q-REG REFERENCE
	MOV	FILBUF(R5),R2		;YES, GET FILENAME BUFFER POINTER
10$:	MOV	R2,R0			;COPY THE START OF DATA POINTER
20$:	TSTB	(R0)+			;END OF DATA YET?
	BNE	20$			;NOPE, LOOP
	SUB	R2,R0			;YEP, FIND SIZE+1 (THE NULL...)
	DEC	R0			; AND, THEN, THE REAL SIZE
	;CLC				;C=0 FROM THE 'SUB' ABOVE
	RTS	PC			;EXIT C=0 FOR "_" OR "*"

30$:	JSR	PC,QREF			;REFERENCE THE Q-REG
	MOV	(R1),R0			;PICKUP SIZE OF THE Q-REG
	SEC				;SET C=1 FOR NORMAL REFERENCE
	RTS	PC			; AND EXIT

.ENABL	LSB

SEARCH:	CLR	-(SP)			;SET FAILURE RETURN VALUE (0)
	MOV	M(R5),-(SP)		;SET (TRIAL) DOT MOVEMENT BOUND
	BPL	10$			;ENSURE THE BOUND LIMIT
	NEG	(SP)			; IS POSITIVE
10$:	INC	CFLG(R5)		;REALLY A BOUNDED SEARCH?
	BEQ	20$			;YES, BOUND ALL SET UP
	CLR	(SP)			;NO, SET INFINITE (65536) BOUND LIMIT
	CMP	CLNF(R5),#-2		;OLD STYLE 'NO MOVE' SEARCH??
	BNE	30$			;NOPE
	INC	(SP)			;YEP, SET BOUND FOR NO MOVEMENT
20$:	COMB	3(SP)			;SET FAILURE RETURN VALUE (177400)
30$:	JSR	PC,GETN			;GET THE HIT NUMBER
	JSR	PC,GETSCH		;NOW BUILD THE SEARCH ARGUMENT
	BNE	40$			;NON-ZERO ARGUMENT, SO PROCEED
	ERROR	ISA,<"Illegal search arg">

.SURCH:	CLR	-(SP)			;SET FAILURE RETURN VALUE (0)
	CLR	-(SP)			;ALLOW INFINITE (65536) DOT MOVEMENTS
40$:	MOV	#1,-(SP)		;GUESS AT FORWARDS MOVEMENT (+1)
	MOV	R2,-(SP)		;SAVE HIT COUNTER, CHECK ITS SIGN
	BPL	50$			;POSITIVE, MOVE . BY +1 EACH FAILURE
	NEG	2(SP)			;NEGATIVE, MOVE . BY -1 EACH FAILURE
	;SEC				; (C=1 FROM THE 'NEG' ABOVE)
	RORB	7(SP)			;INDICATE NO PAGING DESIRED
	NEG	(SP)			;NOW GET A POSITIVE HIT COUNTER
50$:	CLR	LSCHSZ(R5)		;SET LAST STRING SIZE TO 0
	MOV	P(R5),R1		;GET .
	ADD	TXSTOR(R5),R1		; AND MAKE IT ABSOLUTE
	ADD	TXSTOR(R5),ZZ(R5)	;NOW MAKE END OF TEXT ABSOLUTE ALSO
60$:	MOV	R1,R3			;GET STARTING POINT
	MOV	SCHBUF(R5),R4		; AND SEARCH STRING START
	MOV	#-1,R2			;SET CTRL/N INDICATOR INITIALLY
.SUR.N:	INC	R2			;FAILURE, BUT REVERSE SENSE?
	BNE	90$			;O.K., A REAL FAILURE
.SUR.C:	CMP	R3,ZZ(R5)		;END OF TEXT?
	BLO	80$			;NOPE
	TSTB	(R4)			;YEP, BUT DOES IT MATCH END OF STRING?
	BEQ	110$			;YES, SO ALL DONE (FOUND)
	TST	2(SP)			;NO, SEARCHING BACKWARDS??
	BMI	90$			;IF BACKWARDS THEN MOVE . IF POSSIBLE
70$:	ASRB	7(SP)			;IS THIS A BOUNDED SEARCH?
	BCS	140$			;YES, SO KEEP .
	CLR	R3			;NO, SO .=0
	BR	130$			; AND EXIT

80$:	MOVB	(R4)+,R0		;GET A STRING CHARACTER
	BMI	.SUR.S			;PARITY BIT MEANS SPECIAL
	BEQ	110$			;NULL MEANS END OF STRING
.SUR.M:	CMPB	R0,(R3)+		;MATCH?
	BNE	150$			;NO, MIGHT BE A FAILURE
.SUR.Y:	INC	R2			;SUCCESS, BUT REVERSE SENSE?
	BNE	.SUR.C			;O.K., SO CONTINUE
90$:	ADD	2(SP),R1		;NOPE, MOVE . ONE POSITION
	DEC	4(SP)			;ALLOWED TO MOVE DOT THIS FAR?
	BEQ	70$			;NOPE, END THIS SEARCH
100$:	CMP	R1,TXSTOR(R5)		;IS . TOO SMALL NOW??
	BHIS	60$			;. IS O.K., KEEP SEARCHING
	BR	70$			;. IS TOO SMALL, SEARCH FAILS

110$:	MOV	R1,PST(R5)		;SAVE (ABS) STARTING POSITION
	MOV	R1,R4			;COPY (ABS) START AGAIN TO
	SUB	R3,R4			; GET "START"-"END" = -("LENGTH")
	MOV	R3,R1			;SET NEXT START IF FORWARDS
	TST	2(SP)			;IS SEARCH GOING FORWARDS??
	BPL	120$			;YES, SO NEW START IS SET
	ADD	R4,R1			;NO, BACKWARDS, SO GO BACK AND
	ADD	R4,R1			; BACK AGAIN FOR NEW START
120$:	DEC	(SP)			;SEARCH ANOTHER TIME??
	BGT	100$			;YES, SO SEARCH AGAIN ALREADY
	MOV	R4,LSCHSZ(R5)		;NO, DONE, STORE -("LENGTH")
	SUB	TXSTOR(R5),R3		;MAKE ENDING . RELATIVE
	SUB	TXSTOR(R5),PST(R5)	;MAKE STARTING . RELATIVE
	MOV	#-1,6(SP)		;INDICATE SUCCESS (-1)
130$:	MOV	R3,P(R5)		;SET . CORRECTLY
140$:	SUB	TXSTOR(R5),ZZ(R5)	;MAKE END OF TEXT RELATIVE
	MOV	(SP)+,R2		;RESTORE THE HIT COUNTER
	CMP	(SP)+,(SP)+		;DUMP DIRECTION AND DELTA-DOT COUNTER
	MOV	(SP)+,R1		;SET CC'S AND RETURN INDICATOR
	RTS	PC			; AND EXIT

150$:	TST	SFLG(R5)		;EXACT MODE SEARCHES?
	BNE	.SUR.N			;YES, SO A REAL FAILURE
	CMPB	-1(R3),#100		;NO, IS IT ALPHA TYPE RANGE?
	BLO	.SUR.N			;NON-ALPHA, SO FAILURE
	CMP	R0,#100			;IS IT ALPHA TYPE RANGE?
	BLO	.SUR.N			;NON-ALPHA, SO FAILURE
	ADD	#40,R0			;ALPHA, COMPLEMENT THE LOWER CASE BIT
	TSTB	R0			;OVERFLOW?
	BPL	160$			;NO
	SUB	#100,R0			;YES, SO CORRECT IT INTO UPPER CASE
160$:	CMPB	R0,-1(R3)		;NOW IS IT REALLY A FAILURE?
	BEQ	.SUR.Y			;NO, SUCCESS
	BR	.SUR.N			;YES, A REAL FAILURE

.DSABL	LSB

.SUR.S:	CMPB	R0,#'S-100+200		;WAS SPECIAL CTRL/S?
	BEQ	60$			;YES (IT IS CTRL/S)
	BHI	20$			;NO (IT IS CTRL/X)
	CMPB	R0,#'E-100+200		;NO, IS IT CTRL/E?
	BEQ	80$			;YES (IT IS CTRL/E)
	BHI	30$			;NO (IT IS CTRL/N)
	CLR	R0			;NO, A NULL, MAKE A NULL
10$:	BR	.SUR.M			; AND GO CHECK FOR A MATCH

20$:	INC	R3			;CTRL/X IS ANY MATCH
	BR	.SUR.Y			;INDICATE SUCCESS

30$:	MOV	#-1,R2			;SET REVERSE FLAG
	BR	.SUR.C			; AND CONTINUE

40$:	MOV	(R0),(SP)		;SET THE CORRECT DISPATCH ADDRESS
	MOVB	(R3)+,R0		;GET A TEXT CHATACTER
	JSR	PC,@(SP)+		;GO TEST CHARACTER
50$:	BCS	.SUR.Y			;MADE IT
	BR	.SUR.N			;NO GO

60$:	MOVB	(R3)+,R0		;GET A TEXT CHARACTER
	JSR	PC,ALPHAN		;ALPHANUMERIC?
70$:	BCC	.SUR.Y			;NO, SO OK
	BR	.SUR.N			;YES, SO NO

80$:	MOVB	(R4)+,R0		;GET THE CTRL/E MODIFIER CHARACTER
	JSR	PC,UPPERC		; AND FORCE IT TO UPPER CASE
	CMPB	R0,#'S			;CTRL/E AND "S"?
	BEQ	110$			;YES, MATCH NON-NULL SPACE/TAB
	CMPB	R0,#'X			;X?
	BEQ	20$			;YES, MATCH ANYTHING
	CMPB	R0,#'G			;G?
	BEQ	140$			;YES, DO Q-REG MATCHING
	MOV	R0,-(SP)		;SAVE ^E CHARACTER ON THE STACK
	MOV	#170$,R0		;GET THE CHARACTER TABLE POINTER
90$:	CMP	(SP),(R0)+		;CHARACTER MATCH TABLE?
	BEQ	40$			;YES, WE HAVE A MATCH, GO DISPATCH
	TST	(R0)+			;NO, SKIP THE DISPATCH ADDRESS
	BNE	90$			;MORE IN TABLE, KEEP CHECKING
	TST	(SP)+			;NOT IN TABLE, POP STACK
100$:	DEC	R4			;OTHER, POINT BACK AGAIN
	MOVB	#'E-100,R0		; AND RESTORE THE CTRL/E
	BR	10$			;NOW TRY FOR A CTRL/E MATCH

110$:	MOV	R3,-(SP)		;SAVE POINTER TO TEXT
120$:	CMP	R3,ZZ(R5)		;END OF TEXT?
	BHIS	130$			;YES, QUIT
	MOVB	(R3)+,R0		;NO, GET CHARACTER
	CMP	R0,#SPACE		;SPACE?
	BEQ	120$			;YES
	CMP	R0,#TAB			;TAB?
	BEQ	120$			;YES
	DEC	R3			;NEITHER, CORRECT TEST POINTER
130$:	CMP	(SP)+,R3		;CHECK FOR NON-NULL
	BLO	50$			;NON-NULL, CONTINUE ('BLO'=>C=1)
	INC	R3			;NULL, SKIP SOMETHING
	BR	50$			; AND CONTINUE ('BEQ'=>'BHIS'=>C=0)

140$:	MOVB	(R4),R0			;GET Q-REG
	JSR	PC,ALPHAN		;IS IT LEGAL?
	BCC	100$			;NOPE, NOT GROUP REFERENCE
	INC	R4			;YEP, EAT THE Q-REG CHARACTER
	MOV	R1,-(SP)		;SAVE R1
	MOV	R2,-(SP)		; AND R2
	JSR	PC,QREFCH		;REFERENCE Q-REG BY CHARACTER
	MOVB	(R3)+,R0		;GET THE CHARACTER TO MATCH
	MOV	(R1),R1			;GET THE Q-REGISTER'S SIZE
	ADD	QRSTOR(R5),R2		;POINT ABSOLUTELY TO Q-REG
150$:	SUB	#1,R1			;MORE CHARACTERS IN Q-REG?
	BLO	160$			;NOPE, FAILURE (C=1 ALREADY)
	CMPB	R0,(R2)+		;CHECK THIS CHARACTER FOR A AMTCH
	BNE	150$			;NOT A MATCH, LOOP
	;CLC				;A MATCH, SUCCESS (C=0 ALREADY)
160$:	MOV	(SP)+,R2		;RESTORE R2
	MOV	(SP)+,R1		; AND R1
	BR	70$			;NOW EXIT WITH AN INDICATION

170$:	.WORD	'A,ALPHA		;^EA MATCHES ALPHABETICS
	.WORD	'C,RAD50		;^EC MATCHES RAD50
	.WORD	'D,NUMER		;^ED MATCHES NUMERICS
	.WORD	'L,TERMS		;^EL MATCHES TERMINATORS
	.WORD	'R,ALPHAN		;^ER MATCHES ALPHANUMERICS
	.WORD	'V,ALPHAL		;^EV MATCHES LOWER CASE ALPHAS
	.WORD	'W,ALPHAU		;^EW MATCHES UPPER CASE ALPHAS
	.WORD	100377,0		;DUMMY TO TERMINATE THE LIST

.SBTTL	SIZING (SHUFFLING) ROUTINE

.ENABL	LSB

SIZE:	MOV	R0,-(SP)		;SAVE R0
	MOV	(R4)+,R0		;GET OFFSET TO MAX TO CHANGE
	TST	R1			;IS REQUEST AT ALL REASONABLE?
	BMI	80$			;NOPE ['TST' => C=0 => FAILURE]
	MOV	R1,-(SP)		;SAVE R1
	MOV	R2,-(SP)		; AND SAVE R2
	MOV	R3,-(SP)		;  AND SAVE R3
	MOV	R0,-(SP)		;SAVE THE MAX'S OFFSET VALUE
	ADD	R5,R0			;MAKE R0 ABS PTR TO MAX
	BIS	#37,R1			;FUDGE UP REQUEST A LITTLE
	SUB	(R0),R1			;FIND CHANGE AMOUNT
	BLO	60$			;ALREADY DONE
	MOV	#ZMAX,R2		;GET TEXT AREA'S MAX OFFSET
	MOV	ZZ(R5),R3		; AND TEXT CURRENT INUSE
	SUB	R2,(SP)			;0=>TEXT CHANGE; <>0=>Q-REG CHANGE
	BNE	10$			;Q-REG CHANGE, WE HAVE TEXT MAX, INUSE
	MOV	#QMAX,R2		;TEXT CHANGE, GET Q-REG MAX OFFSET
	MOV	QZ(R5),R3		; AND Q-REG CURRENT INUSE
10$:	JSR	R4,50$			;SEE IF CURRENT FREE DOES IT
	NEG	R3			;GET -(IN USE)
	ADD	R5,R2			;ABS PTR TO OTHER MAX
	ADD	(R2),R3			;FREE = MAX -(IN USE)
	SUB	#400.,R3		;FIND THE PUNISH AMOUNT
	BLOS	30$			;NOT ENOUGH FREE TO PUNISH
	SUB	R3,(R2)			;ELSE PUNISH THE OTHER MAX
	ADD	R3,CURFRE(R5)		; AND UPDATE FREE SPACE
	TST	(SP)			;WHICH AREA ARE WE CHANGING
	BEQ	20$			;IF TEXT, THEN JUST PUNISHED QREGS
	MOV	R0,-(SP)		;SAVE MAX POINTER
	MOV	R1,-(SP)		;SAVE DELTA AMOUNT
	MOV	QRSTOR(R5),R0		;GET THE REGION'S BIAS
	SUB	R3,QRSTOR(R5)		;CORRECT THE BASE ADDRESS
	CLR	R2			;START OF 0 OFFSET
	NEG	R3			;FIND -(PUNISH)
	MOV	R3,R1			; AND MOVE DATA TO THERE
	MOV	QMAX(R5),R3		;SET THE UPPER LIMIT
	JSR	PC,SHRINK		;NOW SHRINK IT
	MOV	(SP)+,R1		;RESTORE DELTA AMOUNT
	MOV	(SP)+,R0		;RESTORE MAX POINTER
20$:	JSR	R4,50$			;WILL FREE SPACE DO IT NOW?
30$:	CMP	R4,#100$		;IS THIS THE SPECIAL CALL?
	BEQ	40$			;YES, DON'T REALLY SIZE
	JSR	PC,SIZER		;ASK WHOEVER FOR MORE PLEASE
	BCC	20$			;WE GOT IT!
	TST	(SP)+			;DUMP THE AREA DETERMINATION
	BR	70$			; AND EXIT (C=0 => FAILURE)

40$:	MOV	CURFRE(R5),R1		;CHANGE REQUEST AMOUNT TO THIS
	BR	20$			; AND TRY AGAIN (WON'T FAIL!)

50$:	CMP	R1,CURFRE(R5)		;DO WE HAVE ENOUGH FREE?
	BHI	90$			;NO, SO RETURN
	SUB	R1,CURFRE(R5)		;YES, CORRECT FREE COUNT
	MOV	(SP)+,R4		;RESTORE THE R4 VALUE
	ADD	R1,(R0)			; AND CORRECT THE MAX
	TST	(SP)			;WHICH AREA IS CHANGING?
	BNE	60$			;QREGS, SO VERY EASY
	MOV	QRSTOR(R5),R0		;TEXT, SO GET OLD BEG PTR
	ADD	R1,QRSTOR(R5)		;UPDATE QREG PTR
	MOV	QMAX(R5),R3		;GET MAX VALUE
	ADD	R3,R1			;FIND THE NEW MAX
	CLR	R2			;START MOVE AT OFFSET 0
	JSR	PC,EXPAND		;NOW GO DO THE EXPANSION
60$:	COM	(SP)+			;DUMP AREA FLAG AND CARRY=1
70$:	MOV	(SP)+,R3		;RESTORE R3
	MOV	(SP)+,R2		; AND R2
	MOV	(SP)+,R1		;  AND R1
80$:	MOV	(SP)+,R0		;   AND R0
90$:	RTS	R4			;FINALLY EXIT

.YYY.C:	CLR	P(R5)			;.=0
	CLR	ZZ(R5)			;NO MORE TEXT
	CLR	FFFLAG(R5)		; AND NO MORE FORM FEED
.YYY.S:	MOV	#077777,R1		;SET A VERY HIGH REQUEST VALUE
	SIZE	TEXT			; AND SIZE UP TEXT
100$:	RTS	PC			;THIS ALWAYS WORKS!!

.DSABL	LSB

.SBTTL	CHARACTER LIST FOR " COMMANDS

.TABLE	.CND,LAB,RAB,A,C,D,E,F,G,L,N,R,S,T,U,V,W

.SBTTL	CHARACTER LIST FOR E COMMANDS

.TABLE	.EEE,A,B,C,D,F,G,H,I,K,N,O,P,R,S,T,U,V,W,X

.SBTTL	COMMAND CHARACTER LIST

	.BYTE	-1
	.BYTE	DEL
	.BYTE	'?
	.BYTE	'*
	.BYTE	SPACE
	.BYTE	ESC
	.BYTE	'U-100
	.BYTE	BEL
.TABLE	.CMD
	.WORD	.CMDBL
	.WORD	.CMDCU
	.WORD	.CMDES
	.WORD	.CMDSP
	.WORD	.CMDST
	.WORD	.CMDQM
	.WORD	.CMDEL

.SBTTL	CHARACTER LIST FOR "SKPSET"

	.ODD
	.BYTE	-1
	.BYTE	'_
	.BYTE	'^
	.BYTE	']
	.BYTE	'[
	.BYTE	'X
	.BYTE	'U
	.BYTE	'S
	.BYTE	'Q
	.BYTE	'O
	.BYTE	'N
	.BYTE	'M
	.BYTE	'I
	.BYTE	'G
	.BYTE	'F
	.BYTE	'E
	.BYTE	'@
	.BYTE	'>
	.BYTE	'<
	.BYTE	'%
	.BYTE	'"
	.BYTE	'!
	.BYTE	'^-100
	.BYTE	'U-100
	.BYTE	'R-100
	.BYTE	'I-100
	.BYTE	'A-100
.TABLE	.CSM
	.WORD	.CSMY	;CTRL/A
	.WORD	.CSMQ	;TAB
	.WORD	.CSM2Q	;CTRL/R
	.WORD	.CSMU	;CTRL/U
	.WORD	.CSMD	;CTRL/^
	.WORD	.CSMY	;!
	.WORD	.CSMDQ	;"
	.WORD	.CSMD	;%
	.WORD	.CSMI	;<
	.WORD	.CSMO	;>
	.WORD	.CSMA	;@
	.WORD	.CSME	;E (EB, EG, EI, EN, ER, EW)
	.WORD	.CSMF	;F (FR, FS, FN, F_)
	.WORD	.CSMD	;G
	.WORD	.CSMQ	;I
	.WORD	.CSMD	;M
	.WORD	.CSMQ	;N
	.WORD	.CSMQ	;O
	.WORD	.CSMD	;Q
	.WORD	.CSMQ	;S
	.WORD	.CSMD	;U
	.WORD	.CSMD	;X
	.WORD	.CSMD	;[
	.WORD	.CSMD	;]
	.WORD	.CSMUA	;^
	.WORD	.CSMQ	;_

	.ODD
	.BYTE	-1
	.BYTE	'W
	.BYTE	'R
	.BYTE	'N
	.BYTE	'I
	.BYTE	'G
	.BYTE	'B
.TABLE	.CSME

.SBTTL	CHARACTER LIST FOR F COMMANDS

	.ODD
	.BYTE	-1
	.BYTE	'_
	.BYTE	'S
	.BYTE	'R
	.BYTE	'N
.TABLE	.FFF
	.WORD	.FFFN
	.WORD	.FFFR
	.WORD	.FFFS
	.WORD	.FFFU

.SBTTL	FINAL FIXUPS...

.CSECT	TECOER
.EVEN

.END