[net.sources] A Teco source, of sorts

eric@tekadg.UUCP (eric) (12/13/84)

Well, since everyone wanted to see my teco source, I guess I will go right ahead
and puke it out here.  On my system, a 4.1BSD (it claims), when I want to
create teco, I type
	compat macro -xs:3 teco
	compat macro -xs:3 tecoio
	compat linkr teco tecoio
	mv teco.out teco
and when I am ready to teco something, I type
	compat teco  ARGS

All I am going to put out here are teco.m11, tecoio.m11, and some miscellaneous
(random formatting program) input which makes a (vain) attempt to document teco.
From my use of it, it seems a lot like the first teco I laid hands on on a
DEC10 about eight years ago, i.e., it doesn't know what ey means.

Anyway, part 1 will be teco.m11, part 2 will be tecoio.m11, and part 3 will be
some dorkuments.  I haven't figured out what to feed all of them to in order to
make them readable and a question to the originator resulted in a "Oh, it
shouldn't be hard to modify it so ms will format it."  Right.  Here is teco.m11!
--------------------------------------------------------------------------------
.TITLE	TECO	TECO-11
.NLIST	TTM
.SBTTL	TECO-11

;	PDP-11 TECO
;	A BRUTE FORCE TRANSLATION BY HANK MAURER
;	(  1-JUNE-1973  THROUGH  4-JUNE-1973  )
;	(WITH I/O ARRANGEMENTS BY BOB HARTMAN)
;	(AT FORD OF COLOGNE, WEST GERMANY)
;	[SLIGHT MODIFICATIONS BY MARK BRAMHALL OF DEC]
;	[FOR CORE EXPANSION AND HIGH/LOW SEGS]
;	<PDP-10 COMPATIBILITY, ETC. BY ANTON CHERNOFF>
;	OF OS-8 TECO WHICH COMES FROM A PROGRAM
;	ORIGINALLY WRITTEN BY RUSSELL HAMM, WAY BACK WHEN
;	MODIFIED FOR OS/8 BY THE O.M.S.I. CREW
;	SPEEDED UP, SHORTENED AND MADE PDP-10
;	COMPATIBLE BY RICHARD LARY OF DEC
;	WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S

VERSON	=	11.		;VERSION NUMBER

.RADIX	10
.IRP	N,<\VERSON>
.RADIX	8
.LIST
.IDENT	/V'N/
.NLIST
.ENDM
.SBTTL	INTERNAL GLOBALS

; ENTRY POINT AND VERSION NUMBER

.GLOBL	TECO,	VERSON

; READ/WRITE (R5 OFFSET) AREA SIZE

.GLOBL	RWSIZE

; SPECIAL ACCESS TO LINE-FINDING ROUTINE

.GLOBL	.VVV.V

; SPECIAL ACCESS FOR CCL USAGE

.GLOBL	DOCCL

;special access for yank (ccl usage)

.globl	yank

;special access for exit
.globl	.eeex


; VARIOUS GLOBAL OFFSETS ARE DEFINED LATER...
.SBTTL	EXPLAINING THINGS...

; ASSEMBLY PARAMETER
;
; IF THE SYMBOL "ERRTXT" IS DEFINED AS NON-ZERO, THEN ALL ERROR
;	CALLS (INCLUDING THOSE FROM 'TECOIO') PASS AN ASCIZ
;	STRING TO EXPLAIN THE ERROR. IF THE SYMBOL "ERRTXT" IS
;	DEFINED AS ZERO, THEN NO ASCIZ STRINGS NEED BE PASSED
;	AND NO EXPLANATIONS ARE EVER GIVEN.
;
; THE DEFAULT IS FOR "ERRTXT" TO BE DEFINED AS NON-ZERO.

.IIF	NDF	ERRTXT	ERRTXT=1	;DO THE DEFAULT
; 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 ZEROS
;		EXCEPT FOR THE FOLLOWING ITEMS:
;			TECOSP (SEE AREA #2)
;			TECOPD, PDL, SCHBUF (SEE AREA #3)
;			TXSTOR, QRSTOR, ZMAX, QMAX, CURFRE
;				(SEE AREA #4)
;		[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 AND SEARCH BUFFER
;
;	LENGTH:	WHATEVER SEEMS REASONABLE (100(8) BYTES FOR
;		THE PUSH-DOWN LIST AND ANOTHER 100(8) BYTES FOR
;		THE SEARCH BUFFER SEEM GOODLY NUMBERS).
;		NOTE THAT THESE TWO AREAS ARE COMBINED INTO ONE
;		AREA. TECO DEPENDS ON THE FACT THAT THIS IS
;		TRUE! FURTHERMORE, THE PUSH-DOWN LIST MUST BE
;		THE LOWER IN ADDRESS SPACE OF THESE TWO COMBINED
;		AREAS.
;		'TECOIO' MUST GLOBALIZE THE SEARCH BUFFER'S
;		LENGTH VIA THE SYMBOL "SCHSIZ".
.GLOBL	SCHSIZ
;	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).
;	SETUP:	THE BYTE POINTED TO BY "SCHBUF" MUST BE SETUP
;		TO BE -1. ALL OTHER BYTES NEED NOT BE SET UP.
;
; 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 ENVIORNMENT ALLOWS IT). 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.
;		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.
; DOCUMENTATION OF 'TECOIO' SUBROUTINES
;
; NOTE THAT, UNLESS A REGISTER IS SPECIFICALLY MENTIONED AS
; OUTPUT FROM A SUBROUTINE, IT MUST BE PRESERVED!

.GLOBL	LISTEN	;JSR PC,LISTEN
; IN:	R0 =  0 MEANS DELIMITERS ARE: ALTMODE, RUBOUT, 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)

.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)

.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)

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

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

.GLOBL	GEXIT	;JMP GEXIT
; NOTE:	THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM TO
;	"GO"

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

.GLOBL	SIZER	;JSR PC,SIZER
; IN:	R1 = AMOUNT 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	SWITCH	;JSR PC,SWITCH
; OUT:	R0 = VALUE OF process number

.GLOBL	EIOFF	;JSR	PC,EIOFF
; NOTE:	TURNS OFF EI FILE (DONE IN ERROR ROUTINE)

.GLOBL	GETFLS	;JSR PC,GETFLS
; IN:	R0 = POINTER TO A "DEV:[P,PN]FILE.EXT" STRING
;	R1 = 0 FOR ER CALL
;	   < 0 FOR EB CALL
;	   > 0 FOR EW CALL
;	   = 256. for EI call
;	R4 = LENGTH OF "DEV:[P,PN]FILE.EXT" STRING
;
; OUT:	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	SEE ERROR NOTES IF ERROR.

.GLOBL	GETBUF	;JSR PC,GETBUF
; IN:	R0 = POINTER TO BUFFER START
;	R1 = MAXIMUM SIZE OF BUFFER
;
; OUT:	IF NO ERROR THEN CARRY BIT IS CLEAR AND
;	R1 = ACTUAL NUMBER OF CHARACTERS TRANSFERED INTO BUFFER
;	R2 = -1 IF BUFFER ENDED WITH A FORM FEED
;	   =  0 IF BUFFER DIDN'T END WITH A FORM FEED
;	IF END-OF-FILE, THEN "EOFLAG" IS SET TO -1 AND
;	BOTH R1 AND R2 ARE RETURN AS ZERO (THIS IS NOT AN ERROR).
;	SEE ERROR NOTES IF ERROR.
;
; NOTE:	BUFFER IS FILLED UNTIL:
;	1) FORM FEED FOUND (R2=-1) (THE FORM FEED IS NOT PUT IN BUFFER)
;	2) LESS THAN 128 CHARACTERS ARE FREE IN BUFFER AND
;		LINE FEED FOUND OR END OF FILE FOUND (R2=0)
;	3) BUFFER IS FULL (R2=0)

.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	CLSFIL	;JSR PC,CLSFIL
; NOTE:	CLOSES OUTPUT FILE AND DOES THE EB RENAMING IF NEEDED.
;
;	IF NO ERROR THEN CARRY BIT IS CLEAR.
;	SEE ERROR NOTES IF ERROR.

.GLOBL	CLOSIN	;JSR PC,CLOSIN
; NOTE:	CLOSES THE INPUT FILE

.GLOBL	DELOUT	;JSR PC,DELOUT
; NOTE:	DELETES THE OUTPUT FILE.
;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)
;	SPECIAL (CHECKED FOR BY TECO) ERROR CODES ARE:
.GLOBL		NI	;NO INPUT FILE CURRENTLY OPEN
.GLOBL		NO	;NO OUTPUT FILE CURRENTLY OPEN
;		THE VALUE OF "NI" AND "NO" AS RETURNED IN R0
;		MUST BE GLOBALIZED BY 'TECOIO'.
;	THE ASCIZ ERROR MESSAGE TEXT ON AN ERROR RETURN FROM "GETFLS"
;	MAY OPTIONALLY CONTAIN A BYTE OF -2 TO SIGNAL PRINTING THE
;	FAILING FILE NAME STRING AT THAT POINT. E.G.
;		.ASCIZ	"FILE '"<-2>"' IS ILLEGAL"
.globl	run,norun	;fix for unix problems
.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

NULL	=	000	;ASCII NULL
BELL	=	007	;ASCII BELL (CONTROL/G)
BS	=	010	;ASCII BACKSPACE
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
ALTMOD	=	033	;ASCII ESCAPE (ALSO CALLED ALTMODE)
SPACE	=	040	;ASCII SPACE
LAB	=	'<	;ASCII LEFT ANGLE BRACKET
RAB	=	'>	;ASCII RIGHT ANGLE BRACKET
VBAR	=	174	;ASCII VERTICAL BAR
RUBOUT	=	177	;ASCII RUBOUT (ALSO CALLED DEL)

.SBTTL	COMMAND Q-REG VALUE

QSTKRG	=	<'Z-'A+1>+<'9-'0+1>+1
CMDQRG	=	QSTKRG+1
.SBTTL	MACROS

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

.MACRO	PUSH	ARGS
	 JSR	R4,PUSH
.IRP	ARG,<ARGS>
	 .WORD	ARG
.ENDM
	 .WORD	-1
.ENDM	PUSH

.MACRO	POP	ARGS
	 JSR	R4,POP
.IRP	ARG,<ARGS>
	 .WORD	ARG
.ENDM
	 .WORD	-1
.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
.MEXIT
.ENDC
.IF	IDN	<AREA>,<QREGS>
	 .WORD	QMAX
.MEXIT
.ENDC
.ERROR	; AREA IS ILLEGAL IN SIZE CALL
.ENDM	SIZE
.MACRO	OFFSET	LABEL,AMT
LABEL	=	$$$$$$
.GLOBL	LABEL
.LIST
		LABEL	=	LABEL
.NLIST
.IF	NB	<AMT>
$$$$$$	=	AMT*2+$$$$$$
.IFF
$$$$$$	=	1*2+$$$$$$
.ENDC
.ENDM	OFFSET

.MACRO	.TABLE	KIND
.'KIND:
.MACRO	.ENTRY	CHR,DSP
.IF	B	<DSP>
	 .WORD	''CHR,	KIND''CHR
.IFF
	 .WORD	''CHR,	DSP
.ENDC
.ENDM	.ENTRY
.ENDM	.TABLE

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

.MACRO	MESSAG	TEXT
.PSECT	TECOER
.NLIST
$$$$$$	=	.
	 .ASCIZ	TEXT
.LIST
.PSECT	TECORO
.ENDM	MESSAG
.MACRO	ERROR	NUM,TEXT
.IF	NDF	$E$'NUM
$E$'NUM:
.ENDC
$$$$$$	=	.-$E$'NUM
.IF	GE	$$$$$$-400
	 JMP	$E$'NUM
.MEXIT
.ENDC
.IF	NE	$$$$$$
	 BR	$E$'NUM
.MEXIT
.ENDC
.IF	NE	ERRTXT
$$$$$$	=	0
.IRPC	CHR,<NUM>
$$$$$$	=	$$$$$$*40+<''CHR-<'A-1>>
.ENDM
.IF	EQ	$$$$$$&077740-<'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	$$$$$$&076037-<'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
.ENDC
	 JSR	R4,ERRMSG
	 .RAD50	/NUM/
.IF	NE	ERRTXT
	 MESSAG	<TEXT>
	 .WORD	$$$$$$
.ENDC
.ENDM	ERROR
.SBTTL	INITIALIZE THE .PSECTS'S, ETC.

; THIS ORDERS THE .PSECT'S (USE /SQ IF NEEDED...)

.PSECT	TECORO,SHR
.PSECT	TECOCH,SHR
.PSECT	TECOER,SHR

; THIS INITIALLY LOADS THE COMMAND CHARACTER TABLE

.PSECT	TECOCH
TECOCH:
.REPT	'_+1+5		;additional 5 for high characters
.NLIST
	.WORD	ERROR
.LIST
.ENDR

; NOW BACK TO THE MAIN .PSECT

.PSECT	TECORO
.SBTTL	DEFINE THE OFFSETS FROM R5

$$$$$$	=	0;OFFSETS START AT ZERO...

CLRSRT	=	$$$$$$;START OF EACH COMMAND CLEAR AREA

OFFSET	SCANP	;COMMAND LINE EXECUTION POINTER
OFFSET	NFLG	;NUMBER FLAG
OFFSET	N	;NUMBER
OFFSET	M	; ARGUMENTS
OFFSET	OFLG	;OPERATOR FLAG
OFFSET	CFLG	;COMMA FLAG
OFFSET	MPDL	;MACRO FLAG (SAVED "PDL")
OFFSET	ITRST	;ITERATION START
OFFSET	CLNF	;COLON FLAG
OFFSET	TFGTMP	;BACKUP FOR "TFLG"
OFFSET	QFLG	;QUOTED STRING FLAG
OFFSET	SCHAR	;LAST SORTED CHARACTER
OFFSET	OSCANP	;BACKUP FOR "SCANP"
OFFSET	QCMND	;COMMAND LINE OR MACRO Q REG NUMBER
OFFSET	QUOTE	;QUOTE CHARACTER (NORMALLY 33)
OFFSET	QNMBR	;CURRENT Q REG NUMBER
OFFSET	QLENGT	;COMMAND LINE LENGTH
OFFSET	CNDN	;COUNTER FOR " NESTING
OFFSET	NP	;VALUE OF CURRENT NUMBER
OFFSET	NACC	;EXPRESSION ACCULMULATOR
OFFSET	PST	;CHARACTER POSITION AT SEARCH START
OFFSET	ITRCNT	;ITERATION COUNT
OFFSET	NOPR	;ARITHMETIC OPERATOR
OFFSET	TEMP	;GENERAL TEMPORARY READ/WRITE WORD
OFFSET	TFLG	;TRACE FLAG
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	EDFLAG	;EDIT LEVEL FLAG
OFFSET	XFLAG	;SEARCH CASE FLAG (0-ANY, ELSE-EXACT)
OFFSET	EHELP	;EDIT HELP LEVEL
OFFSET	ESFLAG	;EDIT SEARCH FLAG
OFFSET	EVFLAG	;EDIT VERIFY FLAG
OFFSET	ETYPE	;EDIT TYPEOUT FLAG
OFFSET	EIFLAG	;INSTRUCTION FILE FLAG (=0 FOR TERMINAL I/O)
OFFSET	EOFLAG	;END-OF-FILE FLAG
OFFSET	OFLAG	;EDIT OPEN PROTECT CODE
OFFSET	ROFLAG	;NON-ZERO IF RUBOUT OR CTRL/U (FOR SCOPE)
OFFSET	ABEND	;ABORT EXECUTION FLAG

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

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

OFFSET	CURFRE	;CURRENT FREE SPACE IN BYTES

OFFSET	QARRAY,<<<'Z-'A+1>+<'9-'0+1>>*2>;Q REGISTER ARRAY
OFFSET	QSTK 2	;Q REGISTER STACK Q REGISTER!
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

RWSIZE	=	$$$$$$	;SIZE OF AREA IN BYTES
.SBTTL	SCAN

.CMD.R:	DEC	QZ(R5)			;REMOVE LAST CHARACTER
	DEC	QPNTR(R5)		; ENTERED INTO COMMAND
	MOV	QZ(R5),R3		;GET POINTER TO END+1
	ADD	QRSTOR(R5),R3		; AND MAKE IT ABSOLUTE
	MOV	QPNTR(R5),R4		;NOW GET SIZE OF THE COMMAND
	RTS	PC			;AND EXIT

.ENABL	LSB

CMDCHR	<'?>				;"?" IS THE TRACE FLIP/FLOP
	COM	TFLG(R5)		;SO FILP THE FLOP
2$:	RTS	PC			;AND EXIT

3$:	CMP	(SP),#.CMD.C		;END OF COMMAND; MAIN CALL?
	BNE	4$			;NOPE, SO MUST BE AN ERROR
ABORT:	CMP	MPDL(R5),PDL(R5)	;YES, IN MACRO?
	BNE	4$			;NO (OR UNTERMINATED MACRO)
	POP	<SCANP,ITRST,MPDL,QCMND>;YES, RESTORE ALL ITEMS
	MOV	QCMND(R5),R0		;GET COMMAND Q REG NUMBER
	JSR	PC,SETCMD		;AND (RE)SET COMMAND
SCAN:	MOV	(R5),R0			;GET CURRENT COMMAND POINTER
	CMP	R0,QLENGT(R5)		;END OF THIS COMMAND?
	BHIS	3$			;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
	TST	TFLG(R5)		;TRACING?
	BEQ	2$			;NOPE
	JMP	TYPE			;YES, SO ANNOUNCE CHARACTER

4$:	TST	(SP)+			;PURGE THE RETURN ADDRESS
	TST	MPDL(R5)		;WITHIN MACRO?
	BEQ	.CMD.D			;NO, BACK TO MAIN EDIT LEVEL
	ERROR	UTM,<"UNTERMINATED MACRO">;YES, MUST BE UNTERMINATED

.DSABL	LSB
.SBTTL	COMMAND INPUT

.ENABL	LSB

.CMDSP:	CMP	TEMP(R5),#BELL		;PRECEEDED BY A BELL?
	BNE	13$			;NO, SO NORMAL
	JSR	PC,.CMD.R		;REMOVE 1ST BELL AND GET POINTER, COUNT
	BEQ	TECO			;NOTHING, SO RESTART US
REPRI:	JSR	PC,CRLF			;SOMETHING, SO RETURN CARRIAGE
10$:	DEC	R4			;ONE LESS IN COUNT NOW
	BMI	11$			;ONLY ONE LINE WAS IN COMMAND
	CMPB	-(R3),#LF		;BACKED UP TO A LINE FEED?
	BNE	10$			;NO, KEEP GOING
	INC	R3			;YES, SO CORRECT POINTER
	br	12$
11$:	mov	#'*,r0			;print prompt
	jsr	pc,type
12$:	COM	R4			;NEGATE AND DECREMENT COUNT
	ADD	QPNTR(R5),R4		;FORM THE POSITIVE PRINT COUNT
	JSR	PC,PRINT		;PRINT THE LINE
	JMP	.CMD.W			;AND CONTINUE

.CMDBL:	MOV	#100000,ERRPOS(R5)	;FLAG THIS AS A BELL
	CMP	R0,TEMP(R5)		;2ND BELL?
	BEQ	.+6			;BRANCH AROUND JUMP
	JMP	.CMD.Z
	JSR	PC,.CMD.R		;REMOVE 1ST BELL AND GET COUNT
ctrlc:	MOV	R4,QLCMD(R5)		;NOW SAVE THE COUNT AS LAST COMMAND COUNT
	BR	TECO			;AND RESTART US
.CMDQM:	MOV	ERRPOS(R5),R4		;GET ERROR POSITION
	BLE	13$			;IF NONE, THEN NORMAL CHARACTER
	JSR	PC,CRLF			;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 "?"
	bit	#200,etype(r5)		;error condition?
	beq	teco			;no--RESTART US
	jsr	pc,crlf			;print crlf and die
	jmp	texit
13$:	BR	.CMD.Y

.CMDST:	TST	QPNTR(R5)		;WAS THIS THE 1ST THING TYPED?
	BNE	16$			;NOPE, SO NORMAL
	JSR	PC,LISTEN		;YES, SO GET NEXT AS Q REG NAME
	JSR	PC,.CMD.S		;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
	BEQ	TECO			;MOVE NOTHING?
15$:	MOVB	(R2)+,(R3)+		;MOVE THE DATA
	DEC	R1			;MORE?
	BGT	15$			;YEP...
	BR	TECO			;NOPE...GET NEXT COMMAND
16$:	CMP	#BELL,TEMP(R5)		;NOT AFTER BELL?
	BNE	.CMD.Y			;THEN NORMAL CHARACTER "*"
	JSR	PC,CRLF			;DO CRLF
	mov	#'*,r0			;print the "prompt"
	jsr	pc,type
	JSR	PC,.CMD.R		;DELETE BELL,GET COUNT	
	SUB	R4,R3			;SUB SIZE FROM END POINTER
	JSR	PC,PRINT		;WHICH IS IN FORMAT TO PRINT
	BR	.CMD.W			;CLEAN UP AND CONTINUE

.DSABL	LSB
.ENABL	LSB

TECO:	MOV	TECOSP(R5),SP		;SET UP OUR SP STACK
	JSR	PC,NOCTLO		;NO CONTROL/O PLEASE
	JSR	PC,CRLF			;RESTORE CARRIAGE
	MOV	TECOPD(R5),PDL(R5)	;NOW SET UP THE PUSH-DOWN LIST
.CMD.D:	CMP	SP,TECOSP(R5)		;IS SP STACK OK?
	BNE	90$			;NOPE
	CMP	PDL(R5),TECOPD(R5)	;WAS LAST COMMAND UNTERMINATED?
	BNE	90$			;YEP, GO GIVE ERROR
	JSR	PC,NORUN		;entering command mode
	MOV	#CMDQRG,R0		;INDICATE THE COMMAND Q REG
	JSR	PC,QREFR0		;REFERENCE IT
	JSR	PC,QADJ			; AND ADJUST TO 0 SIZE
	MOV	R5,R1			;GET OFFSET POINTER
	ADD	#CLREND,R1		;AND INDEX TO CLEAR AREA (+2)
	MOV	#CLREND-CLRSRT/2,R2	;LOAD A COUNT OF HOW MANY TO CLEAR
22$:	CLR	-(R1)			;NOW CLEAR OUR VARIABLES
	DEC	R2			;MORE?
	BGT	22$			;YEP...
	JSR	PC,IREST		;RESTORE QUOTE TO 33 (ALTMODE)
	MOV	EVFLAG(R5),r4		;EDIT VERIFY?
	BEQ	21$			;NO
	CLR	NFLG(R5)		;YES
	jsr	pc,.sch.v		;call special entry to verify
$24$:	CLR	N(R5)
21$:	TST	EIFLAG(R5)		;EI FILE?
	BNE	.CMD.W			;THEN DONT PRINT CHARACTER
	MOV	#'*,R0			;SET UP TO ANNOUNCE US
	bic	#10200,etype(r5)	;clear interupt bit
	JSR	PC,NOCTLO		;NO CONTROL/O PLEASE
$23$:	clr	abend(R5)		;dont abort print
	JSR	PC,TYPE			;AND TYPE A CHARACTER
.CMD.W:	CLR	TEMP(R5)		;AVOID DOUBLE CHARACTER INDICATIONS
.CMD.X:	MOV	ERRPOS(R5),R0		;SELECT INPUT MODE
	JSR	PC,LISTEN		;AND GET A CHARACTER
	TST	EIFLAG(R5)		;NOT FROM FILE
	BEQ	1$			;THEN ALLOW ALL IMMEDIATE CHARS
	CMP	#ALTMOD,R0		;ALTMODE IS ONLY SPECIAL
	bne	.cmd.y			;stuff all characters but
	jmp	.cmdam
1$:	tst	abend(r5)		;do we restart?
	beq	.+6
	jmp	ctrlc
	SORT	..CMD			;SORT OUT SPECIAL CHARACTERS
.CMD.Y:	CLR	ERRPOS(R5)		;NO ERROR POSITION IF STORING
.CMD.Z:	CLR	QLCMD(R5)		;NO LAST COMMAND IF STORING ANYTHING
	MOV	#.CMD.X,-(SP)		;SET THRETURN ADDRESS
	MOV	R0,TEMP(R5)		;SAVE CHARACTER ABOUT TO BE STORED
.CMDAX:	MOV	QZ(R5),R1		;GET OUR CURRENT SIZE
	MOV	QMAX(R5),R2		;AND OUR MAXIMUM SIZE
	DEC	R2			;ADJUSTED FOR NEW CHARACTER
	CMP	R1,R2			;CAN WE DO THIS?
	BHIS	91$			;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	31$			;ALL IS STILL O.K.
	MOV	#BELL,R0		;IF NOT, THEN RING THE BELL
	JMP	TYPE			;FOR A WARNING, THEN CONTINUE
31$:	RTS	PC

90$:	ERROR	UTC,<"UNTERMINATED COMMAND">

91$:	ERROR	MEM,<"MEMORY OVERFLOW">	
.DSABL	LSB
.ENABL	LSB
.CMDBS:	tst	qpntr(r5)	;nothing on line?
	beq	.cmdro		;then do -1lt!
	MOV	#$23$,-(SP)
	BIT	#2,ETYPE(R5)		;TTY MODE?
	BEQ	30$
	MOV	#32$,(SP)		;SET RETURN ADDRESS FROM RUBBING OUT
30$:	INC	ROFLAG(R5)		;IF IT ALL VANISHES, DO NOT WATCH
	TST	QPNTR(R5)		;ANYTHING LEFT TO REMOVE?
	bne	.+6
	jmp	teco			;none left so restart us.
	JSR	PC,.CMD.R		;REMOVE A CHARACTER AND GET POINTER
	MOVB	(R3),R0			;PUT CHAR IN R0
	RTS	PC			;NOW EXIT
32$:	CMPB	#SPACE,R0		;ARE WE DELETING A PRINTING CHARACTER
	BLE	33$			;
	CMPB	#LF,R0			;IF a line feed then reprint previous
	beq	34$
	mov	r3,-(sp)		;save registers
	mov	r4,-(sp)
	mov	#Delst2,r3		;print bs bs bs space space space vt
	mov	#7,r4
	jsr	pc,print
	mov	(sp)+,r4		;restore registers
	mov	(sp)+,r3
	jmp	REPRI
33$:	bit	#10,etype(R5)		;local echo?
	bne	.cmd.w
	Mov	#Delstr,r3		;print bs space bs
	Mov	#3,r4
	Jsr	Pc,print
	Br	.cmd.w			;and continue
34$:	mov	#213,r0			;print 2 vts
	jsr	pc,type
	jsr	pc,type
	jmp	repri

.CMDCU:	JSR	PC,30$			;REMOVE 1 CHARACTER FROM BUFFER
	CMP	R0,#LF			;LINE FEED JUST REMOVED?
	BNE	.CMDCU			;NOPE, KEEP REMOVING
	INC	QZ(R5)			;YEP, SO PUT IT
	INC	QPNTR(R5)		; BACK IN COMMAND
	JSR	PC,CRLF			;RESTORE CARRIAGE
	JMP	.CMD.W			;AND CONTINUE

.CMDRO:	JSR	PC,CRLF			;GOTO NEW LINE
	MOV	#-1,R0			;DO -1LT
1$:	JSR	PC,.VVV.V		;"-1L"
	mov	evflag(R5),r4	;are we in autoverify mode?
	bne	2$
	dec	r4		;make negative to do 0tt
2$:	jsr	pc,.sch.v
	JMP	$24$

.CMDLF:	TST	QPNTR(R5)		;FIRST THING TYPED?
	beq	.+6
	jmp	.cmd.y			;no--treat normally
	MOV	#1,R0			;DO "1LT"
	BR	1$
.DSABL	LSB

.SBTTL	INTERPRETER

.ENABL	LSB

.CMDAM:	CMP	R0,TEMP(R5)		;2ND ALTMODE?
	beq	.+6
	jmp	.CMD.Y			;NOPE, SO NORMAL CHARACTER
	jsr	pc,run			;now we are running!
	JSR	PC,.CMDAX		;YES, SO STORE THE FINAL ALTMODE
	MOV	QPNTR(R5),QLCMD(R5)	; AND SAVE COMMAND AS LAST
	tst	eiflag(r5)		;shall we restore carriage?
	bne	39$			;not if we are ei-ing!
	JSR	PC,CRLF			; AND RESTORE CARRIAGE
39$:	MOV	#CMDQRG,R0		;SET UP TO REFERENCE
	JSR	PC,SETCMD		; THE COMMAND REGISTER
40$:	JSR	PC,SCAN			;SCAN THE COMMAND
.CMD.C:	JSR	PC,UPPERC		; AND FORCE UPPER CASE
	CMPB	#173,R0
	BHI	42$
	SUB	#'[-'@,r0		;put into acceptable range
42$:	MOV	R0,R1			;COPY THE CHARACTER
	CLR	R0			;LEAVE R0 (THE AC...) CLEAR
	ASL	R1			;WE NEED A WORD INDEX
	TST	ABEND(R5)		;MAKE SURE NOT ABORTED
	BNE	45$
	JSR	PC,@TECOCH(R1)		;DISPTACH TO COMMAND
	TST	NFLG(R5)		;NUMBER?
	BMI	40$			;YES, SO JUST CONTINUE
	CLR	N(R5)			;NO, SO CLEAR THE ARGUMENT
	CLR	NFLG(R5)		;AND RESET NUMBER FLAG
	BR	40$			;AND CONTINUE

CMDCHR	<'^>				;^ MEANS NEXT IS CONTROL/CHARACTER
	TST	(SP)+			;POP THE RETURN ADDRESS
	JSR	PC,SCNUPP		;AND GET NEXT FORCING UPPER CASE
	BIC	#-77-1,R0		;BUT MAKE IT A CONTROL/CHARACTER
	BR	42$			;AND CONTINUE WITH IT

45$:	CLR	ABEND(R5)
	ERROR	XAB,<"EXECUTION ABORTED">
.DSABL	LSB
DELSTR:	.Byte	bs+200,space,bs+200
DELST2:	.Byte	bs+200,bs+200,bs+200,space,space,space,213
	.even
CMDCHR	<'L>				;"L" IS THE LINE MOVER
	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	#LF,R3			;SPEED UP THE COMPARES
	TST	R0			;WHICH DIRECTION
	BLE	15$			;<=0 IS BACKWARDS
	ADD	ZZ(R5),R2		;>0 IS FORWARDS; SO GET END OF TEXT
11$:	CMP	R1,R2			;PAST END OF TEXT YET?
	BHIS	13$			;YES, SO STOP THE MOVE
	CMPB	R3,(R1)+		;NOPE, IS THIS A LINE FEED?
	BNE	11$			;NO, KEEP MOVING
	DEC	R0			;YES, MORE TO GO?
	BGT	11$			;KEEP GOING
13$:	SUB	TXSTOR(R5),R1		;GET THE NEW .
	MOV	R1,P(R5)		;AND STORE IT
	RTS	PC			;THEN EXIT

15$:	CMP	R1,R2			;TOO LOW?
	BLOS	13$			;YES, SO QUIT
	CMPB	R3,-(R1)		;NO, IS IT LINE FEED?
	BNE	15$			;NOPE, KEEP GOING
	INC	R0			;YEP, MORE?
	BLE	15$			;STILL ARE MORE TO GO
	INC	R1			;DONE, CORRECT .
	BR	13$			;AND GO SET NEW .
.ENABL	LSB

CMDCHR	<LAB>				;"<" STARTS AN ITERATION
	MOV	(R5),R4			;in case we need it
.CSMI:	PUSH	<ITRST,ITRCNT>		;SAVE ITERATION START AND COUNT
	MOV	(R5),ITRST(R5)		;AND SET ITERATION START
	TST	NFLG(R5)		; NO NUMBER?
	BEQ	1$
	CLR	NFLG(R5)		; USING UP THE NUMBER
	TST	N(R5)			;DONT ITERATE?
	BLE	.SCH.I
1$:	MOV	N(R5),ITRCNT(R5)	;SET THE NEW ITERATION COUNT
	RTS	PC			;NOW EXIT

CMDCHR	<RAB>				;">" ENDS AN ITERATION
	TST	ITRCNT(R5)		;FOREVER REPEAT?
	BEQ	3$
	DEC	ITRCNT(R5)		;GO AROUND AGAIN?
	BEQ	.CSMO			;YES, SO END US
3$:	TST	ITRST(R5)		;ERROR IF NOT IN LOOP
	BEQ	90$
	MOV	ITRST(R5),(R5)		;RESET SCAN POINTER
	BR	5$
CMDCHR	<ALTMOD>			;ALTMODES COME HERE
	TSTNXT	ALTMOD			;ESC-ESC (ABORT MACRO) COMMAND?
	BCC	5$			;NO
2$:	tst	itrst(r5)		;get out of any iterations
	beq	10$			;not in one
	pop	<itrcnt,itrst>		;pop count and start of next loop
	br	2$
10$:	MOV	#.CMD.C,(SP)		;FAKE DIFFERENT RETURN ADDRESS
	JMP	ABORT			;AND ABORT MACRO
CMDCHR	<''>				;END OF CONDITIONALS COME HERE
5$:	CLR	NFLG(R5)		;USE UP ANY NUMBER
	JMP	IREST			;AND RESTORE NORMAL QUOTE

90$:	ERROR	BNI,<<RAB>" NOT IN ITERATION">

.fffla:					;"F<" command
	mov	itrst(r5),(r5)		;move to beginning of whatever
	clr	nflg(r5)		;snarf any number
	rts	pc			;done!

.fffra:					;"F>" command
	clr	nflg(r5)		;snarf any number
	tst	itrst(r5)		;not in iteration?
	beq	2$			;then same as "$$" command (almost)
	tst	itrcnt(R5)		;forever loop?
	beq	.fffla
	dec	itrcnt(r5)		;decrement counter
	bne	.fffla			;loop back if not zero
	mov	itrst(R5),r4		;else go to end of loop
	br	.sch.i
CMDCHR	<';>				;";" IS SPECIAL ITERATION END
	MOV	ITRST(R5),R4		;GET ITERATION START POINTER
	BEQ	91$			;IF ANY...
	INC	NFLG(R5)		;ARGUMENT?
	BNE	92$			;NO--ILLEGAL NOW
	TST	N(R5)			;SUCCESSFUL?
	BMI	5$			;YES, SO JUST CONTINUE
.SCH.I:	MOV	R4,-(SP)		;SAVE ITERATION START POINT
	SKPSET	'>			;GO TO MATCHING >
	JSR	PC,ENTRCE		;RE-ENABLE TRACE IF NEEDED
	MOV	(SP)+,R4		;RESTORE ITERATION START
	CMP	R4,ITRST(R5)		;MATCH THIS START?
	BEQ	.CSMO			;YES, SO EXIT
	MOV	#.SCH.I,-(SP)		;NO, SO POP LEVEL AND CONTINUE
.CSMO:	POP	<ITRCNT,ITRST>		;POP THE COUNT AND START
	BR	5$			;GO RESET QUOTE CHARACTER

91$:	ERROR	SNI,<"; NOT IN ITERATION">

92$:	ERROR	NAS,<"NO ARG BEFORE ;">

.DSABL	LSB
CMDCHR	<'M>				;"M" IS THE MACRO COMMAND
	JSR	PC,QREF			;REFERENCE A Q REGISTER
	PUSH	<QCMND,MPDL,ITRST,SCANP>;NOW PUSH ALL OLD DATA
	CLR	(R5)			;START MACRO OFF AT RELATIVE 0
	CLR	ITRST(R5)		;NOT INTO ANY ITERATION YET
	MOV	PDL(R5),MPDL(R5)	;SAVE PDL AT MACRO'S START
	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
	MOV	NMRBAS(R5),-(SP)	;SAVE BASE
	INC	NFLG(R5)		;ANY NUMBER?
	BNE	90$			;HE'S IN ERROR IF NOT
	CLR	NMRBAS(R5)		;ASSUME RADIX 10
	TSTNXT	'=			;IS IT REALLY "=="?
	ADC	NMRBAS(R5)		;C=1 IF SO, SET RADIX=OCTAL
	JSR	R4,ZEROD		;THIS DOES THE REAL WORK
	.WORD	TYPE			;OUTPUT TO TERMINAL
	MOV	(SP)+,NMRBAS(R5)	;RESTORE BASE
	TST	CLNF(R5)		;COLON NUMBER OUT?
	BEQ	CRLF			;NO
	CLR	CLNF(R5)		;YES--SNARF COLON
	RTS	PC			;NO CRLF
CRLF:	bit	#4,etype(R5)		;if rt mode then we need to send cr
	beq	1$
	mov	#cr,r0
	jsr	pc,type
1$:	MOV	#LF,R0			;  TYPE ONLY
	JMP	TYPE			;   LINE FEED

90$:	ERROR	NAE,<"NO ARG BEFORE =">

.DSABL	LSB
.ENABL	LSB

CMDCHR	<'\>				;"\" IS NUMBER INSERTER/GETTER
	INC	NFLG(R5)		;WAS THERE AN ARGUMENT?
	BNE	2$			;NO, SO GET A NUMBER FROM TEXT
	JSR	R4,ZEROD		;YES, SO INSERT IT INTO TEXT
	.WORD	.BSL.I
1$:	RTS	PC			;AND EXIT

2$:	JSR	PC,NCOM			;SET UP NUMBER PROCESSOR
	JSR	PC,GETXTP		;GET CHAR FROM TEXT
	BCC	1$			;NOTHING THERE
	SUB	#'-,R0			;MINUS SIGN?
	BNE	3$			;NOPE
	JSR	PC,@'-*2+TECOCH		;YES, SO DO THE MINUS OPERATOR
	BR	4$			;AND CONTINUE

3$:	CMP	R0,#'+-'-		;PLUS SIGN?
	BNE	5$			;NOPE
4$:	INC	P(R5)			;BUMP .
5$:	JSR	PC,GETXTP		;GET CHARACTER FROM TEXT
	BCC	1$			;EXIT IF NO MORE
	JSR	PC,NUMER		;CHECK FOR NUMERIC
	BCC	1$			;NOT A NUMBER
	TST	NMRBAS(R5)		;DECIMAL?
	BEQ	6$
	CMPB	#'8,R0			;OCTAL--8 AND 9 AREN'T NUMBERS
	BLOS	1$
6$:	MOV	R0,R1			;MOVE DIGIT OVER TO HERE
	JSR	PC,.BSL.N		;NUMBER, SO USE IT
	BR	4$			;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,R4			;GET CHARACTER (*2) THAT CALLED US
	ASR	R4			;NOW MAKE NORMAL CHARACTER
10$:	JSR	PC,SCAN			;SCAN TEXT
	CMP	R0,R4			;END?
	BEQ	1$			;YES, SO EXIT
	ADD	R2,PC			;CHECK DETERMINATION
	JSR	PC,TYPE			;CTRL/A CHARS GET TYPED
	BR	10$			;AND LOOP

.DSABL	LSB
.ENABL	LSB

CMDCHR	<'">				;'"' IS THE CONDITIONAL
	INC	NFLG(R5)		;ANY ARGUMENT?
	BNE	90$			;THERE HAD BETTER BE
	SORT	..CND,C			;AND SPECIAL SORT
	ERROR	ICC,<'ILLEGAL " CHARACTER'>

90$:	ERROR	NAQ,<'NO ARG BEFORE "'>	;NO

.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	4$			;CARRY SET IS SUCCESS
	BR	2$			;ELSE FAILURE

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

.CNDG:	NEG	R3			;"G" IS OK IF >
	BVS	2$			;TRAP -32768. CASE
.CNDS:					;"S" IS SUCCESSFUL (-1)
.CNDT:					;"T" IS TRUE (-1)
.CNDL:	TST	R3			;SET CC'S
	BPL	2$			;"L" IS NO GOOD IF >=
	BR	4$			;ELSE OK

.CNDF:					;"F" IS FALSE (0)
.CNDU:					;"U" IS UNSUCCESSFUL (0)
.CNDE:	TST	R3			;SET CC'S
	BEQ	4$			;"E" IS OK IF =
	BR	2$

.fffvb:	clr	nflg(R5)		;"F<vbar>" command
2$:	MOV	#-1,CNDN(R5)		;INTO 1 LEVEL OF CONDITIONAL SKIP
3$:	jsr	pc,notrce		;disable trace
10$:	jsr	pc,scnupp		;get next character
11$:	mov	r0,schar(r5)		;save as sorted character
	cmp	#VBAR,r0		;else clause?
	beq	5$
	cmp	#'',r0			;end of conditional?
	beq	6$
	cmp	#'^,r0			;uparrow is special case
	bne	12$
	jsr	pc,scnupp		;get next character
	bic	#-77-1,r0		;as a control character
	br	11$			;and try again
12$:	mov	#10$,-(sp)		;stack a return address
	sort	..csm			;sort on skip characters
	rts	pc			;non specials ignored (br 10$)
5$:	jsr	pc,entrce		;enable trace
	cmp	#-1,cndn(R5)		;match our level?
	bne	3$			;no--continue scanning
	br	4$			;yes--done
6$:	jsr	pc,entrce		;enable trace
	inc	cndn(R5)		;match our level?
	bne	3$			;no--continue scanning
4$:	JMP	IREST			;YES, RESTORE QUOTE AND EXIT

.DSABL	LSB
cmdchr	<VBAR-27.>			;"VBAR" is conditional else clause
.fffq:					;F' goes here too
	clr	nflg(R5)		;snarf any number
	mov	#-1,cndn(R5)		;into one level of conditional skip
3$:	skpset	''			;search for end of conditional
	jsr	pc,entrce		;enable tracing
	inc	cndn(r5)		;same level?
	bne	3$
	rts	pc			;yes--finished
CMDCHR	<'O>
	MOV	(R5),-(SP)		;SAVE CURRENT POINTER
	CLR	NFLG(R5)		;USE UP ANY NUMBER
	CLR	QFLG(R5)		;AND USE ALTMODE AS QUOTE
	JSR	PC,QSKP			;SKIP THE QUOTED STRING
	MOV	ITRST(R5),(R5)		;START SEARCH AT ITERATION START
1$:	SKPSET	'!			;SKIP UNTIL A !
	JSR	PC,ENTRCE		;REENABLE TRACE
	MOV	(SP),R4			;GET BACK THE TAG'S START
	ADD	QBASE(R5),R4		;AND ADDIN Q REG OFFSET
	ADD	QRSTOR(R5),R4		;THEN MAKE ABSOLUTE
2$:	JSR	PC,SCAN			;SCAN THE FOUND TAG
	CMP	R0,#'!			;END OF TAG?
	BEQ	4$			;YES
	CMPB	R0,(R4)+		;NO, MATCH?
	BEQ	2$			;CONTINUE UNTIL END IF MATCH
3$:	JSR	PC,SCAN			;SCAN FOR TAG'S END IF NO MATCH
	CMP	R0,#'!			;END OF TAG?
	BNE	3$			;NOT YET...
	BR	1$			;YES, SO FIND NEXT TAG

4$:	CMPB	(R4)+,#ALTMOD		;BOTH ENDS MATCH?
	BNE	1$			;NOPE, SO FIND NEXT TAG
	TST	(SP)+			;YES, SO DUMP SAVED TAG POINTER
	RTS	PC			;AND EXIT

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
CMDCHR	<'[>			;PUSH INTO QUEUE STACK
	JSR	PC,QREF			;REFERENCE QUEUE REGISTER
	MOV	QNMBR(R5),-(SP)		;SAVE Q REGISTER NUMBER
	MOV	(R1),R4			;SAVE LENGTH
	MOV	#QSTKRG,R0		;LOOK UP QUEUE STACK REGISTER
	JSR	PC,QREFR0		;REFERENCE IT TO GET SIZE
	MOV	R4,R0			;SIZE OF NEW ENTRY
	ADD	#4,R0			;ADD 4 BYTES FOR HEADER STUFF
	ADD	(R1),R0			;+ OLD SIZE
	MOV	(R1),-(SP)		;SAVE OLD SIZE ON STACK
	JSR	PC,QADJ			;ADJUST SIZE
	ADD	QRSTOR(R5),R2		;MAKE POINTER TO IT ABSOLUTE
	MOV	R2,R3			;COPY
	ADD	(R1),R2			;POINT TO END
	MOV	(SP)+,R1		;OLD LENGTH
	BEQ	2$			;ZERO
	ADD	R1,R3			;POINT TO END OF OLD
1$:	MOVB	-(R3),-(R2)		;MOVE OVER TO GIVE ROOM
	DEC	R1
	BNE	1$
2$:	MOV	R2,R4
	MOV	(SP)+,R0		;NAME OF QUEUE REGISTER
	JSR	PC,QSUMX		;GET STUFF ABOUT IT
	ADD	QRSTOR(R5),R2		;MAKE POINTER ABSOLUTE
	MOV	(R1),R0			;LENGTH OF IT
	BEQ	4$			;ZERO--SKIP MOVING
	ADD	R0,R2			;POINT TO END OF DATA
3$:	MOVB	-(R2),-(R4)
	DEC	R0
	BNE	3$
4$:	ADD	#4,R1			;POINT TO END OF LENGTH/VALUE
	.REPT	4
	MOVB	-(R1),-(R4)	;MOVE IT
	.ENDR
	RTS	PC				;DONE

CMDCHR	<']>					;POP QUEUE REGISTER STACK
	MOV	#QSTKRG,R0			;SEE WHAT IS THERE
	JSR	PC,QSUMX
	TST	(R1)				;ANY LENGTH?
	BNE	2$
	TST	CLNF(R5)			;CANNOT POP
	BGE	1$				;AND NO COLON!
	INC	(R5)			;THROW OUT Q NUMBER
7$:	CLR	CLNF(R5)
	JMP	NCOM				;RETURN NUMERIC RESULT

2$:	ADD	QRSTOR(R5),R2			;ABS ADDRESS
	CLR	R0				;FETCH LENGTH OF ENTRY
	BISB	(R2)+,R0
	SWAB	R0
	BISB	(R2)+,R0
	SWAB	R0
	MOV	R0,R3				;SAVE LENGTH
	JSR	PC,QREF				;GET QREG ARGUMENT
	MOV	R3,R0				;SIZE REGISTER
	JSR	PC,QADJX
	MOV	R1,R3				;SAVE STATISTICS IN R3,4
	MOV	R2,R4
	ADD	QRSTOR(R5),R4			;CORRECT POINTER
	MOV	#QSTKRG,R0			;FETCH QSTACK AGAIN
	JSR	PC,QREFR0
	ADD	QRSTOR(R5),R2			;MAKE ADDR ABSOLUTE
	MOV	R2,-(SP)			;SAVE THAT ADDRESS
	ADD	#2,R2				;POINT BEYOND SIZE
	MOVB	(R2)+,2(R3)			;GET VALUE INTO PLACE
	MOVB	(R2)+,3(R3)
	MOV	(R3),R0				;LENGTH OF ENTRY (QREG)
	BEQ	4$				;NONE--SKIP MOVE
3$:	MOVB	(R2)+,(R4)+			;MOVE THE BYTES
	DEC	R0
	BNE	3$
4$:	MOV	(SP)+,R4			;GET START OF QREG STACK
	MOV	(R1),R0				;ORIGINAL LENGTH
	SUB	(R3),R0				;LESS SIZE OF JUST POPPED
	SUB	#4,R0				;LESS A HEADER
	MOV	R0,R1
	BEQ	6$				;NOTHING LEFT?
5$:	MOVB	(R2)+,(R4)+			;MOVE STUFF OVER
	DEC	R1
	BNE	5$
6$:	JSR	PC,QADJ				;ADJUST Q STACK SIZE
	TST	CLNF(R5)			;CHECK COLON
	BGE	8$				;NONE
	DEC	R0				;RETURN A -1
	BR	7$
8$:	RTS	PC				;RETURN NOTHING

1$:	ERROR	CPQ,<%CANT POP INTO Q-REGISTER%>
.ENABL	LSB

CMDCHR	<'U-100>			;CTRL/U IS Q REG TEXT INSERT
	CLR	-(SP)			;PUSH A ZERO
	JSR	PC,QREF			;REFERENCE THE Q REG
	JSR	PC,COLCHK		;CHECK FOR COLON TYPE
	JSR	PC,QSKP			;NOW SKIP THE QUOTED STRING
	INC	NFLG(R5)		;IS THERE ANUMBER
	BEQ	1$
	MOV	(R5),R0			;GET SCAN POINTER
	DEC	R0			;LESS 1 FOR QUOTE CHAR
	SUB	OSCANP(R5),R0		;NOW HAVE LENGTH
	ADD	(SP),R0			;CORRECT LENGTH IF APPEND
	JSR	PC,QADJX		;ADJUST Q REG TO ITS NEW SIZE
	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	15$			;AND GO INSERT IT IN Q REG

1$:	JSR	PC,NULSTR		;MAKE SURE STRING IS ZERO LENGTH
	MOV	(SP),R0			;ORIGINAL SIZE (IF APPEND)
	INC	R0			;SPACE FOR NEW CHARACTER
	JSR	PC,QADJX		;ADJUST QREG SIZE
	ADD	(SP)+,R2		;POINT TO POSITION TO INSERT
	ADD	QRSTOR(R5),R2		;ABSOLUTE IT
	BICB	#200,N(R5)		;GET RID OF PARITY BIT
	MOVB	N(R5),(R2)		;STUFF IT IN
	RTS	PC

CMDCHR	<'U>				;"U" IS Q REG NUMBER SETTER
	JSR	PC,QREF			;REFERENCE THE Q REG
	INC	NFLG(R5)		;ANY NUMBER?
	BNE	90$			;THERE MUST BE
	TST	(R1)+			;SKIP THE SIZE
	MOV	N(R5),(R1)		;AND SET THE NUMBER
	MOV	CFLG(R5),NFLG(R5)	;MOVE M TO N (IF ANY)
	CLR	CFLG(R5)
	MOV	M(R5),N(R5)
	RTS	PC			;THEN EXIT

90$:	ERROR	NAU,<"NO ARG BEFORE U">	;NOPE
CMDCHR	<'X>				;"X" IS Q REG TEXT INSERT
	CLR	-(SP)			;PUSH A ZERO (SIZE IF APPEND)
	JSR	PC,QREF			;REFERENCE THE Q REG
	JSR	PC,COLCHK		;CHECK FOR COLON (APPEND)
	JSR	PC,NLINES		;GET NUMBER OF CHARACTERS
	ADD	(SP),R0			;MAKE BIGGER IF APPEND
	JSR	PC,QADJX		;ADJUST Q REG TO ITS NEW SIZE
	MOV	M(R5),R0		;GET START OF TEXT
	ADD	TXSTOR(R5),R0		;AND MAKE IT ABSOLUTE
15$:	ADD	QRSTOR(R5),R2		;MAKE POINTER TO Q REG ABSOLUTE
	ADD	(SP),R2			;POINT PAST CURRENT DATA (APPEND)
	MOV	(R1),R1			;NOW GET SIZE OF Q REG
	SUB	(SP)+,R1		;LESS ORIGINAL SIZE
	BEQ	21$			;NO SIZE IS FAST EXIT
20$:	MOVB	(R0)+,(R2)+		;ELSE MOVE BYTES INTO Q REG
	DEC	R1			;MORE?
	BGT	20$			;YEP
21$:	JMP	IREST			;RESTORE THE ALTMODE AS QUOTE

.DSABL	LSB

COLCHK:	TST	CLNF(R5)		;COLON?
	BEQ	1$			;DONE IF NOT
	CLR	CLNF(R5)		;SNARF IT UP
	MOV	(R1),2(SP)		;STASH AWAY ORIGINAL QREG SIZE
1$:	RTS	PC
.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
SRCHJN:	JSR	PC,SEARCH		;SEARCH FOR THE STRING
1$:	CLR	CFLG(R5)
	TST	REPFLG(R5)		;REPLACEMENT?
	BEQ	3$			;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	2$			;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
2$:	CLR	REPFLG(R5)		;CLEAR REPLACE FLAG
3$:	MOVB	R1,R0			;GET REAL NUMBER IN R0
	JSR	PC,NCOM			;INIT THE NUMBER PROCESSOR
	TST	CLNF(R5)		;WAS THERE A ":" THERE?
	BMI	10$			;YES, SO JUST RETURN FLAG
	CLR	CLNF(R5)		;ELSE SET FLAG TO FALSE
	MOV	ITRST(R5),R4		;IN AN ITERATION?
	BNE	11$			;GO CHECK FOR FOLLOWING SEMICOLON
	CLR	NFLG(R5)		;USE UP THE NUMBER
	TST	N(R5)			;SUCCESSFUL?
	BPL	5$			;NOPE
	MOV	ESFLAG(R5),R4		;YES, GET EDIT SEARCH FLAG
	BEQ	10$			;=0, SO EXIT
	cmp	mpdl(R5),pdl(r5)	;are we in a macro?
	beq	10$			;then no verify!
	JMP	.SCH.V			;ELSE GO PRINT SOMETHING

5$:	ERROR	SRH,<%SEARCH FAILURE FOR "%<-1>%"%>

9$:	DEC	(R5)			;MOVE BACK BEFORE SEMICOLON
10$:	CLR	CLNF(R5)		;CLEAR COLON FLAG
	JMP	IREST			;RESTORE QUOTE AND EXIT
11$:	TSTNXT	<';>			;SEE IF THERE IS 
	BCS	9$			;YES--TREAT AS : SEARCH
	CLR	NFLG(R5)		;GET RID OF NUMBER
	TST	N(R5)			;SEARCH SUCCESSFUL?
	BMI	10$			;YES--CONTINUE NORMALLY
	JSR	PC,NOCTLO		;RESET CONTROL-O
	MOV	#12$,R3			;STRING TO PRINT
	MOV	#13$-12$,R4		;LENGTH OF STRING
	JSR	PC,PRINT
	MOV	ITRST(R5),R4		;GO TO IT!
	JMP	.SCH.I			;AND LEAVE ITERATION LOOP
12$:	.ASCII	/%SEARCH FAIL IN ITER/<LF>
13$:
	.EVEN
.FFFN:	CLR	R0			;INSURE "N" TYPE SEARCH
	MOV	#-1,REPFLG(R5)		;AND DO A REPLACE
	BR	17$			;NOW JOIN UP

CMDCHR	<'_>				;"_" IS DESTRUCTIVE SEARCH
;**********kludge ahead--WARNING!!!!!
	MOV	#32,R0		;SET TO SKIP BUFFER DUMP
CMDCHR	<'N>				;"N" IS THE PAGING SEARCH
17$:	CLR	CFLG(R5)		;MAKE INTO 1 ARGUMENT
	MOV	R0,TEMP(R5)		;SAVE DETERMINATION
	JSR	PC,SEARCH		;AND SEARCH
$18$:	BMI	1$			;SUCCESS(-1) OR BACKWARDS FAIL(177400)
19$:	MOV	R2,-(SP)		;SAVE THE SEARCH COUNTER
	ADD	TEMP(R5),PC		;CHECK DETERMINATION
20$:	MOV	TXSTOR(R5),R0		;GET BUFFER START
	MOV	ZZ(R5),R1		; AND ITS LENGTH
	MOV	FFFLAG(R5),R2		;  AND FORM FEED FLAG
	JSR	PC,PUTBUF		;PUT OUT THE BUFFER
	BCC	.+6
	JMP	IOERR			;ERROR FROM 'TECOIO'
	CLR	ZZ(R5)			;MAKE BUFFER EMPTY
$21$:	JSR	PC,@'Y*2+TECOCH		;NOW YANK IN A PAGE OF TEXT
	MOV	(SP)+,R2		;RESTORE SEARCH COUNTER
	TST	ZZ(R5)			;ANYTHING WORTH SEARCHING FOR?
	BNE	$22$			;YES, SO SEARCH SOME MORE
	TST	FFFLAG(R5)		;NOPE, IS THIS IS TRUE NULL PAGE?
	BNE	19$			;DON'T BOTHER TO SEARCH NULL
	CLR	R1			;IF REAL END, THEN SIGNAL
	JMP	1$			; FAILURE, AND QUIT

.DSABL	LSB
$22$:	MOV	#$18$,-(SP)		;CONTINUE SEARCHING
	MOV	XFLAG(R5),-(SP)		;THIS IS CALL TO ENTRY POINT
	JMP	.SURCH			;WILL RETURN TO 18$


.FFFR:	JSR	PC,QSKP			;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

CMDCHR	<'G>				;"G" IS GET Q REG INTO TEXT
	JSR	PC,QREF			;REFERENCE THE Q REG
	CLR	NFLG(R5)		;USE UP ANY NUMBER
	TST	CLNF(R5)		;TO DISPLAY?
	BNE	1$
	MOV	R2,-(SP)		;SAVE OFFSET TO Q REG
	MOV	(R1),R0			;AND GET Q REG'S SIZE
	MOV	R0,-(SP)		;SAVE INSERT LENGTH
	COM	(SP)			;MAKE IT -(LENGTH)-1
	BR	.GGG.I			;NOW REALLY INSERT IT
1$:	CLR	CLNF(R5)		;GET RID OF COLLON
	MOV	(R1),R4			;LENGTH
	MOV	QRSTOR(R5),R3		;BASE ADDRESS
	ADD	R2,R3			;OFFSET TO STRING
	JMP	PRINT			;PRINT IT AND RETURN
.FFFC:	MOV	#-1,REPFLG(R5)		;FC COMMAND
.FFFB:	TST	CFLG(R5)		;FB COMMAND, COMMA?
	BMI	1$
	MOV	P(R5),M(R5)		;SAVE START IN "M"
	JSR	PC,@'L*2+TECOCH		;MOVE "N" LINES
	MOV	P(R5),N(R5)		;FINAL POSITION
	MOV	M(R5),P(R5)		;RESTORE POSITION
	MOV	N(R5),R0		;COMPUTE LENGTH
	SUB	M(R5),R0
	BLE	2$			;NEGATIVE OR ZERO--NO PROBLEM
	DEC	N(R5)			;ONE LESS
1$:	MOV	N(R5),R0		;COMPUTE LENGTH
	SUB	M(R5),R0
2$:	MOV	#1,R1			;SEARCH DIRECTION
	TST	R0			;DIRECTION?
	BGE	3$
	NEG	R0			;NEG SEARCH->POSITIVE DISTANCE
	NEG	R1			;NEG SEARCH FLAG
3$:	INC	R0			;MUST ADD ONE
	MOV	R1,N(R5)		;DIRECT ION TO SEARCH
	MOV	R0,R1
	MOV	M(R5),R0		;START POSITION
	MOV	R1,M(R5)		;DISTANCE TO SEARCH
	MOV	#-1,CFLG(R5)		;SAY COMMA EXISTS
	MOV	#-1,NFLG(R5)		;SAY WE HAVE NUMBER
	JSR	PC,BZCHK		;IN RANGE?
	MOV	R0,P(R5)		;SET POINTER TO START
	JMP 	SRCHJN			;AND START SEARCHING!
.ENABL	LSB

CMDCHR	<'I>				;"I" IS INSERT TEXT
	INC	NFLG(R5)		;NUMBER TO INSERT?
	BNE	1$			;NOPE
	JSR	PC,QSKP			;SCAN PAST STRING (BETTER BE 0LEN)
	JSR	PC,NULSTR		; CHECK FOR ZERO LENGTH
	MOV	N(R5),R0		;YES, SO GET THE NUMBER
.BSL.I:	BIC	#-177-1,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
	INC	P(R5)			;BUMP .
	RTS	PC			;AND EXIT

CMDCHR	<'I-100>			;TAB IS SPECIAL FORM OF "I"
	CLR	QFLG(R5)		;INSURE NO QUOTE SPECIALS
	DEC	(R5)			;AND INCLUDE THE TAB IN TEXT
1$:	JSR	PC,QSKP			;SKIP THE QUOTED STRING
	CLR	R0			;AND 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
.GGG.I:	JSR	PC,ADJ			;ADJUST TEXT BUFFER SIZE
	MOV	(SP)+,R3		;RESTORE INSERT -(LENGTH)-1
	MOV	R3,LSCHSZ(R5)		;SAVE TEXTUAL LENGTH
	INC	LSCHSZ(R5)		;  AS -(LENGTH)
	MOV	(SP)+,R2		; AND START
	ADD	QRSTOR(R5),R2		;MAKE THE START ABSOLUTE
	MOV	P(R5),R1		;GET .
	ADD	TXSTOR(R5),R1		;AND MAKE . ABSOLUTE ALSO
	BR	20$			;ENTER INSERT LOOP

10$:	MOVB	(R2)+,(R1)+		;INSERT A BYTE
20$:	INC	R3			;DONE?
	BLT	10$			;NOPE
	SUB	TXSTOR(R5),R1		;MAKE NEW . RELATIVE
	MOV	R1,P(R5)		;AND SET THE NEW .
	JMP	IREST			;RESTORE QUOTE AS ALTMODE AND EXIT

.DSABL	LSB

NULSTR:	MOV	(R5),R3		;END OF STRING
	SUB	OSCANP(R5),R3	;LENGTH+1
	DEC	R3
	BNE	1$		;LENGTH NOT ZERO IS BAD
	RTS	PC
1$:	ERROR	IIA,<"ILLEGAL INSERT ARG">
.ENABL	LSB

CMDCHR	<'P>				;"P" IS PAGE WRITER
.SBTTL	COMMAND CHARACTER "PW
	TSTNXT	'W			;REALLY "PW"?
	ROR	-(SP)			;SAVE THE DETERMINATION
	TST	CFLG(R5)		;M,N??
	BMI	30$			;YES
	JSR	PC,GETN			;NOPE, GET A NUMBER
	MOV	R0,R4			;AND SAVE IT
5$:	MOV	TXSTOR(R5),R0		;WRITE FROM HERE
	MOV	ZZ(R5),R1		; AND WRITE THIS MUCH
	BEQ	10$			; (UNLESS THAT IS ZERO...)
	MOV	FFFLAG(R5),R2		;  AND WRITE WITH OPTIONAL FORM FEED
	TST	(SP)			;"P" OR "PW" COMMAND?
	BPL	6$			;IF "P", THEN FORM FEED IS OPTIONAL
	MOV	#-1,R2			;IF "PW", THEN ALWAYS A FORM FEED
6$:	JSR	PC,PUTBUF		;DUMP THE BUFFER
IO.ERR:	BCS	IOERR			;ERROR FROM 'TECOIO'
10$:	TST	(SP)			;"PW"?
	BMI	22$			;YES, SO NO YANK
	JSR	PC,YANK			;SIMULATE FORCED YANK (NO ERRORS)
22$:	DEC	R4			;AGAIN?
	BGT	5$			;YES
25$:	TST	(SP)+			;DUMP "PW" DETERMINATION
	RTS	PC			;NO, EXIT

30$:	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
	JSR	PC,PUTBUF		;AND PUT IT
	BCC	25$			;EXIT IF NO ERROR
IOERR:					;I/O ERRORS COME HERE
.IF	NE	ERRTXT
	MOV	R2,-(SP)		;SAVE TEXT POINTER IF ANY
.ENDC
	JMP	ERRMIO			;AND CALL ERROR PROCESSOR

.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 .
	CMP	R0,ZZ(R5)		;ARE WE IN RANGE?
	BHIS	2$			;NO--THEN RETURN -1
	ADD	TXSTOR(R5),R0		;THEN MAKE IT ABSOLUTE
	MOVB	(R0),R0			;AND GET THE CHARACTER
1$:	JMP	NCOM			;AND COMPUTE AS IF NUMBER
2$:	MOV	#-1,R0
	BR	1$

CMDCHR	<'Y>				;"Y" IS YANK IN A BUFFER
	CLR	NFLG(R5)		;USE UP A NUMBER
	BIT	#2,EDFLAG(R5)		;CHECK TURNED OFF?
	BNE	YANK
	TST	ZZ(R5)			;ANYTHING IN BUFFER?
	BEQ	YANK			;NO--OK
	.GLOBL	OBTOP			;PEEK INTO TINAIO
	TST	OBTOP			;OUTPUT FILE OPEN?
	BEQ	YANK			;NOT OPENED--YANK OK
	ERROR	YCA,</Y COMMAND ABORTED/>
YANK:	CLR	P(R5)			;AND ERASE THE
	CLR	ZZ(R5)			; OLD BUFFER
10$:	MOV	ZZ(R5),R0		;GET END OF CURRENT BUFFER
	MOV	R0,R1			;SAVE VALUE
	ADD	#1024.,R1		;INCREASE SIZE BY A KAY
	SIZE	TEXT
	BCS	15$			;SUCCESSFULL--EVERYTHING IS OK
	SUB	#1024.-128.,R1		;LAST DITCH EFFORT
	SIZE	TEXT
	BCC	12$			;IF THIS FAILS--QUIT
15$:	mov	zmax(r5),r1		;get max size
	DEC	R1			;LESS 1 FOR SAFETY
	SUB	R0,R1			;FIND REAL ROOM LEFT
	Cmp	R1,#5000.		;More than 5k chars ?	
	Ble	20$
	Mov	#5000.,R1		;If so, only use 5000 of them.
20$:	ADD	TXSTOR(R5),R0		;MAKE POINTER ABSOLUTE
	JSR	PC,GETBUF		;GET GET SOME DATA
	BCS	IOERR			;ERROR
	ADD	R1,ZZ(R5)		;INCREASE DATA SIZE IN BUFFER
	MOV	R2,FFFLAG(R5)		;AND SAVE FORM FEED FLAG
	BNE	12$			;IF FORM FEED FOUND, THEN EXIT
	TST	EOFLAG(R5)		;ELSE WAS END-OF-FILE FOUND?
	bne	12$			;if so then quit
	bit	#4.,edflag(r5)		;shall we continue?
	beq	10$			;yes--lets!
12$:	RTS	PC			;NOW EXIT

.DSABL	LSB
ioerrx:	br	ioerr
.ENABL	LSB

CMDCHR	<'E>				;"E" IS SPECIAL COMMANDS
	MOV	NFLG(R5),R2		;SAVE THE NUMBER FLAG
	CLR	NFLG(R5)		;NO NUMBER
	SORT	..EEE,S			;AND SORT
	ERROR	IEC,<"ILLEGAL E CHARACTER">

.eeesh:	mov	#'R-256.,r0	;r0 will get =-256 for E!
	br	.eeew
.EEEI:	MOV	#256.+'R,R0		;R0 WILL GET =256 FOR EI
.EEEB:					;R0 GETS <0 FOR EB
.EEER:					;R0 GETS =0 FOR ER
.EEEW:	SUB	#'R,R0			;R0 GETS >0 FOR EW
	MOV	R0,-(SP)		;SAVE DETERMINATION
	JSR	PC,QSKP			;AND SKIP QUOTED STRING
	MOV	OSCANP(R5),R0		;GET STRING START
	MOV	R0,R4			;SAVE START
	SUB	(R5),R4			;FIND -(LENGTH)-1
	COM	R4			;NOW HAVE LENGTH
	ADD	QBASE(R5),R0		;ADD OFFSET TO START
	ADD	QRSTOR(R5),R0		;AND MAKE ABSOLUTE
	MOV	(SP)+,R1		;RESTORE DETERMINATION
DOCCL:	MOV	R0,TEMP(R5)		;THEN SAVE START FOR ERRORS
	JSR	PC,GETFLS		;AND DO THE CORRECT THING
5$:	bit	#-1,clnf(r5)		;colon set?
	beq	6$			;no
	mov	#0,r0			;shift in carry
	rol	r0
	dec	r0			;-1 is success, 0 is failure
	clr	clnf(r5)		;no colon anymore
	jmp	ncom			;numeric result
6$:	BCS	IOERRx			;ERROR
	JMP	IREST			;RESTORE QUOTE AND EXIT

.EEEX:	MOV	#TEXIT,-(SP)		;EXIT FROM TECO SOON
	BR	7$			;AFTER FINISHING UP

.EEEG:	MOV	#GEXIT,-(SP)		;EXIT FROM TECO SOON
7$:	BR	15$			;NOW FINISH UP

.EEEQ:	JMP	TEXIT			;QUIT

.EEEK:	JMP	DELOUT			;DELETE OUTPUT FILE
10$:	MOV	ZMAX(R5),R1		;GET BUFFER SIZE
	DEC	R1			;LESS 1 FOR SAFETY
	JSR	PC,GETBUF		;NOW DO THE INPUT
	BCC	12$			;ALL OK
	CMP	R0,#NI			;NO INPUT?
11$:	BNE	IOERRX			;NO, REAL ERROR
.EEEF:	JSR	PC,CLSFIL		;CLOSE THE OUTPUT FILE
	BR	5$			;AND ERROR CHECK

12$:	MOV	R2,FFFLAG(R5)		;SAVE FORM FEED FLAG
	MOV	R1,ZZ(R5)		;AND DATA SIZE
	BNE	15$			;CONTINUE IF GET SOMETHING
	TST	R2			;NULL TYPE PAGE?
	BEQ	.EEEF			;NOPE, TRUE END OF FILE
15$:	MOV	TXSTOR(R5),R0		;FROM BEGINNING
	MOV	ZZ(R5),R1		; TO END
	MOV	FFFLAG(R5),R2		;  WITH OPTIONAL FORM FEED
	JSR	PC,PUTBUF		;WRITE BUFFER
	BCC	10$			;AROUND AGAIN
	CMP	R0,#NO			;NO OUTPUT?
	BNE	11$			;NO, REAL ERROR
	TST	ZZ(R5)			;NO OUTPUT IS ERROR IF NONEMPTY BUFFER
	BNE	11$
	clr	p(r5)			;in case of failing ex
	RTS	PC			;EMPTY BUFFER, SO QUIT

.EEEC:	JSR	PC,15$			;PAGE OUT THE REST OF THE FILE
	CLR	ZZ(R5)			;NOW CLEAR TEXT BUFFER
	CLR	FFFLAG(R5)		;AND SAY NO FORM FEED IN BUFFER
	JSR	PC,CLOSIN		;CLOSE INPUT FILE (IF ANY)
	RTS	PC			;NOW EXIT

.DSABL	LSB
.SCH.V:	JSR	PC,IREST		;RESTORE QUOTE CHARACTER
	MOV	R4,R0			;AND LOAD TYPEOUT FLAG
	.ENABL	LSB
	BR	1$
CMDCHR	<'V>				;"V" IS VERIFY (1-NTNT)
	JSR	PC,GETN			;GET NUMBER
	DEC	R0			;SHRINK IT
	SWAB	R0
	CLRB	R0
1$:	INC	R0			;NASTY TRICK
	MOV	R0,-(SP)		;SAVE ARGUMENT
	SWAB	R0			;GET BACK COUNT (UPPER BYTE)
	BIC	#177400,R0		;CLEAN IT UP
	NEG	R0			;WANT MINUS OF IT
	MOV	R0,N(R5)		;BECOMES AN ARGUMENT!
	DEC	NFLG(R5)		;SAY NUMBER IS THERE
	JSR	PC,10$			;CALL "T" ROUTINE
	MOV	(SP),R0			;LOOK AT CHARACTER
	BIC	#177400,R0		;STRIP AWAY THE GRUNGE
	BEQ	2$			;NO CHARACTER
	DEC	R0
	BEQ	2$			;NO CHARACTER
	CMP	R0,#SPACE		;USE A LINE FEED?
	BHIS	3$			;NO-USE GIVEN CHARACTER
	MOV	#LF+200,R0		;USE LINEFEED (that doesnt convert!)
3$:	JSR	PC,TYPE			;TYPE IT OUT
2$:	DEC	NFLG(R5)		;SAY WE HAVE AN ARGUMENT
	CLR	CFLG(R5)		;ONLY ONE
	MOV	(SP)+,R0		;GET ARGUMENT
	SWAB	R0
	BIC	#177400,R0
	INC	R0			;CORRECT FOR FORWARD PRINT
	MOV	R0,N(R5)
	CLR	R0
10$:					;PRINT STUFF OUT
	.DSABL	LSB

CMDCHR	<'T>				;"T" IS THE PRINTER
	JSR	PC,NLINES		;FIND NUMBER OF CHARACTERS
1$:	MOV	M(R5),R3		;GET STARTING POINT
	ADD	TXSTOR(R5),R3		;AND MAKE ABSOLUTE
	MOV	R0,R4			;MOVE COUNT INTO HERE
	JMP	PRINT			;AND PRINT IT
CMDCHR	<'O-100>			;CTRL/O MEANS OCTAL RADIX
	INC	NMRBAS(R5)		;SET RADIX TO OCTAL
	RTS	PC			;FINISHED!

CMDCHR	<'D-100>			;CTRL/D MEANS DECIMAL RADIX
	CLR	NMRBAS(R5)
	RTS	PC

ERROR:	ERROR	ILL,<"ILLEGAL COMMAND">	;ILLEGAL COMMANDS COME HERE
.ENABL	LSB

CMDCHR	<'Q-100>
	MOV	P(R5),-(SP)		;CONVERT LINE TO CHAR ARG
	JSR	PC,@'L*2+TECOCH
	MOV	P(R5),R0		;GET POSITION OF LINE
	MOV	(SP)+,P(R5)		;RESTORE POINTER
	SUB	P(R5),R0		;GET OFFSET
	BR	2$

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

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

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

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

CMDCHR	<'Y-100>		;SAME AS .+^S,.
	MOV	LSCHSZ(R5),N(R5)
	ADD	P(R5),N(R5)
	JSR	PC,1$			;MAKE FIRST ARGUMENT
CMDCHR	<'.>				;"." IS CURRENT POSITION
	MOV	P(R5),R0		;GET .
	BR	3$			;AND COMPUTE AS A NUMBER

CMDCHR	<',>				;"," IS THE M,N SEPARATOR
	INC	NFLG(R5)		;WAS THERE A "M"?
	BNE	90$			;THERE SHOULD HAVE BEEN
1$:	MOV	N(R5),M(R5)		;SAVE "M"
	CLR	N(R5)			;NOW CLEAR "N" AGAIN
	MOV	#-1,CFLG(R5)		;AND INDICATE A COMMA
CMDCHR	<NULL>				;IGNORE NULLS
CMDCHR	<LF>				;IGNORE LINE FEED
CMDCHR	<VT>				;IGNORE VERTICAL TAB
CMDCHR	<FF>				;IGNORE FORM FEED
CMDCHR	<CR>				;IGNORE CARRIAGE RETURN
CMDCHR	<SPACE>				;IGNORE SPACE(S)
	RTS	PC			;NOW RETURN

90$:	ERROR	NAC,<"NO ARG BEFORE ,">	;NO
CMDCHR	<'T-100>			;CTRL/T MEANS VALUE OF NEXT INPUT CHARACTER
	INC	NFLG(R5)		;ANY ARGUMENT?
	BEQ	11$			;THEN PRINT VALUE OF IT
	jsr	pc,norun			;disable all funny characters
	MOV	SP,R0			;SINGLE CHARACTER MODE
	JSR	PC,LISTEN		;GET A CHARACTER
	MOV	R0,-(SP)		;SAVE CHAR
	MOV	(SP)+,R0		;RESTORE AND CONTINUE
	jsr	pc,run			;accept funny characters again
	BR	3$			;AND COMPUTE AS A NUMBER
11$:	MOV	N(R5),R0		;GET ARG
	BIC	#177400,R0		;GET RID OF GRUNGE
	JMP	TYPE			;TYPE IT OUT AND RETURN

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

CMDCHR	<'V-100>			;CTRL/V MEANS VERSION NUMBER
	MOV	#VERSON,R0		;GET VERSION NUMBER
	BR	12$			;AND COMPUTE AS A NUMBER

CMDCHR	<'Z-100>			;CTRL/Z MEANS SIZE OF Q REGS
	MOV	QZ(R5),R0		;GET SIZE OF Q REGS
12$:	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 IN Q REGISTER
	JSR	PC,QREF			;REFERENCE Q REG AS SPECIFIED
	inc	nflg(r5)		;are we getting single char value?
	beq	10$
	TST	CLNF(R5)		;COLON MODE?
	BEQ	4$			;NO--REGULAR Q FETCH
	CLR	CLNF(R5)		;SNARF COLON
	MOV	(R1),R0			;GET VALUE(LENGTH OF Q REG STRING
	BR	NCOM			;A NUMERIC RESULT
10$:	cmp	n(r5),(r1)		;is length too long?
	bhis	13$
	add	qrstor(r5),r2		;get byte
	add	n(r5),r2		;point to it
	movb	(r2),r0			;get it
	br	ncom
13$:	dec	r0			;return "not found"
	br	ncom

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

.DSABL	LSB
.ENABL	LSB
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
9$:	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	10$			;YES
	JSR	PC,NCOM			;NO, INITIALIZE US
10$:	PUSH	<NACC,NOPR>		;SAVE ACCULMULATOR
	BR	9$			;THEN SET UP AS IF "+"

.DSABL	LSB

.ENABL	LSB

CMDCHR	<')>				;")" IS END OF EXPRESSION
	TST	NFLG(R5)		;ANYTHING BEFORE THIS?
	BPL	90$			;BADNESS IF NOT
	POP	<NOPR,NACC>		;RESTORE OPERATOR
	MOV	N(R5),R0		;GET VALUE INSIDE PARENS
	BR	20$			;AND TREAT AS A NUMBER

90$:	ERROR	NAP,<"NO ARG BEFORE )">
CMDCHR	<'8>
CMDCHR	<'9>
	TST	NMRBAS(R5)
	BEQ	1$		;DECIMAL O.K.
	ERROR	ILN,<%ILLEGAL NUMBER%>
CMDCHR	<'0>				;THE DIGITS
CMDCHR	<'1>
CMDCHR	<'2>
CMDCHR	<'3>
CMDCHR	<'4>
CMDCHR	<'5>
CMDCHR	<'6>
CMDCHR	<'7>
1$:	ASR	R1			;FORM NON-WORD-INDEX FROM CHARACTER
.BSL.N:	SUB	#'0,R1			;AND MAKE INTO BINARY DIGIT
	INC	NFLG(R5)		;ANY DIGIT BEFORE THIS?
	BNE	31$			;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	21$			;OCTAL
	ADD	NP(R5),R0		;DECIMAL
21$:	ASL	R0			;TIMES 8. OR 10. BY NOW
	ADD	R1,R0			;AND ADD IN NEW DIGIT
	MOV	R0,NP(R5)		;SAVE THE NUMBER
20$:	ADD	NOPR(R5),PC		;DISPATCH ON OPERATOR
	BR	23$			;+
OP$SUB:	NEG	R0			;-
23$:	ADD	NACC(R5),R0		;FORM RESULT
30$:	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

31$:	MOV	R1,R0			;COPY FIRST DIGIT
	MOV	R1,NP(R5)		;SAVE IT IN NUMBER ACCUMULATOR
	BR	32$			;ENTER PROCESSING
CMDCHR	<'B>				;"B" IS ZERO
NCOM:	CLR	NP(R5)			;USUALLY WE SET NP TO 0
32$:	TST	OFLG(R5)		;OPERATOR?
	BNE	20$			;YES
	CLR	NACC(R5)		;NO, SO INITIALIZE US
	CLR	NOPR(R5)
	BR	30$			;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	30$

OP$OR:	BIS	NACC(R5),R0		;DO THE 'OR'
	BR	30$

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

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


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

90$:	ERROR	NAB,<"NO ARG BEFORE "<'_-100>>
.ENABL	LSB

CMDCHR	<'X-100>
	MOV	#XFLAG,R0
	MOV	NFLG(R5),R2		;"^X" IS CASE MATCH FLAG
	CLR	NFLG(R5)
	BR	1$

.EEEV:	MOV	#EVFLAG,R0		;"EV" IS EDIT VERIFY FLAG
	BR	1$

.EEED:	MOV	#EDFLAG,R0		;"ED" IS EDIT LEVEL
	BR	1$

.EEET:	MOV	#ETYPE,R0		;"ET" IS EDIT TYPEOUT
	BR	1$			;GO TO COMMON CODE

.EEEH:	MOV	#EHELP,R0		;"EH" IS EDIT HELP
	BR	1$			;GO TO COMMON CODE

.EEEO:	MOV	#OFLAG,R0		;"EO" IS EDIT OUTPUT PROTECT
	BR	1$

.EEES:	MOV	#ESFLAG,R0		;"ES" IS EDIT SEARCH
1$:	ADD	R5,R0			;MAKE POINTER ABSOLUTE
	tst	cflg(r5)		;two arguments?
	bmi	3$
	INC	R2			;ARGUMENT?
	BEQ	2$			;YES
	MOV	(R0),R0			;NO, RETURN VALUE
	BR	NCOM			;AND COMPUTE AS A NUMBER

2$:	TST	CFLG(R5)		;COMMA PRESENT?
	BMI	3$
	MOV	N(R5),(R0)		;SET THE NEW VALUE
	RTS	PC			;AND EXIT
3$:	CLR	CFLG(R5)		;M CLEARS BITS, N SETS THEM
	BIC	M(R5),(R0)
	BIS	N(R5),(R0)
	RTS	PC

.DSABL	LSB
.ENABL	LSB

CMDCHR	<'J>				;"J" IS MOVE POINTER
	CLR	NFLG(R5)		;USE UP THE NUMBER
	MOV	N(R5),R0		;NOW GET THE NUMBER
	BR	2$			;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 .
2$:	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	10$			;YES, SO PRETEND IT IS M,NK
	JSR	PC,GETN			;GET THE NUMBER OF CHARACTERS
	MOV	R0,R1			;AND SAVE THAT NUMBER
	BPL	20$			;>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
10$:	JSR	PC,NLINES		;GET THE NUMBER OF LINES
	MOV	M(R5),P(R5)		;STARTING FROM HERE
20$:	NEG	R0			;DELETE THIS MANY (<0 IS DELETE)
	;BR	ADJ			;NOW DO IT

.DSABL	LSB
.SBTTL	ADJUST TEXT AREA ROUTINE
.SBTTL		R0 = 0 MEANS NO ADJUSTMENT
.SBTTL		R0 < 0 MEANS SHRINK AREA BY ABS(R0)
.SBTTL		R0 > 0 MEANS ENLARGE AREA BY R0
.SBTTL		(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	5$			;<0 MEANS SHRINK AREA
	BEQ	4$			;=0 MEANS NO CHANGE
	ADD	R3,R1			;NOW HAVE NEW SIZE
	SIZE	TEXT			;CHECK OUT THE SIZE
	BCC	90$			;WE CAN'T DO IT
	MOV	R1,ZZ(R5)		;UPDATE THE BUFFER SIZE
	MOV	TXSTOR(R5),R0		;GET ABSOLUTE POINTER BIAS
	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
	BR	3$			;AND ENTER MOVE LOOP

2$:	MOVB	-(R3),-(R1)		;MOVE A BYTE UP FROM END
	BNE	2$			;CANNOT BE END OF NON-ZERO
3$:	CMP	R3,R2			;REACHED . YET?
	BHI	2$			;NOPE, SO CONTINUE
	MOVB	R0,(R1)			;YES, RESTORE CHARACTER AT .
4$:	RTS	PC			;AND EXIT

90$:	ERROR	MEM,<"MEMORY OVERFLOW">	;SORRY...
5$:	NEG	R1			;MAKE SHIRNK COUNT POSITIVE
	MOV	R1,R0			;AND SAVE IT
	ADD	R2,R1			;NOW HAVE END OF DELETE
	CMP	R1,R3			;IS DELETE TOO BIG?
	BHI	91$			;YEP
	SUB	R0,ZZ(R5)		;SET NEW DATA SIZE
	MOV	TXSTOR(R5),R0		;GET BUFFER BIAS
	ADD	R0,R1			;MAKE END OF DELETE ABSOLUTE
	ADD	R0,R2			;MAKE . ABSOLUTE
	ADD	R0,R3			;MAKE END OF BUFFER ABSOLUTE
	CLRB	(R3)			;AND FLAG END OF BUFFER
	BR	9$			;NOW ENTER BYTE MOVE LOOP

8$:	MOVB	(R1)+,(R2)+		;MOVE A BYTE DOWN
	BNE	8$			;CANNOT BE END IF NON-ZERO
9$:	CMP	R1,R3			;END OF BUFFER REACHED?
	BLO	8$			;NOT YET
	RTS	PC			;NOW EXIT

91$:	ERROR	DTB,<"DELETE TOO BIG">

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

.ENABL	LSB

SORTC:	MOV	N(R5),R3		;GET ARGUMENT
SORTJ:	CLR	R2			;SET UP FOR THE "ADD" CHAIN
SORTS:	JSR	PC,SCNUPP		;GET CHARACTER TO SORT ON
SORT:	MOV	(R4)+,R1		;GET TABLE ADDRESS (-2)
	MOV	R0,SCHAR(R5)		;SAVE TO BE SORTED CHARACTER
1$:	TST	(R1)+			;SKIP THE DISPATCH ADDRESS
	CMP	R0,(R1)+		;GET A MATCH?
	BHI	1$			;NO, KEEP GOING
	BLO	2$			;NO, TOO AR
	MOV	(R1),R4			;YES, CHANGE RETURN ADDRESS
2$:	RTS	R4			;AND EXIT
.SBTTL	SKIP OVER COMMAND
.SBTTL		INVOKED VIA "SKPSET" MACRO
.SBTTL		(R0,R1,R2,R3,"TEMP" ARE CLOBBERED)

SKPSET:	MOV	(R4)+,TEMP(R5)		;SAVE SPECIAL CHARACTER
	JSR	PC,NOTRCE		;DISABLE TRACE
10$:	JSR	PC,SCNUPP		;GET NEXT CHARACTER
11$:	MOV	R0,SCHAR(R5)		;SAVE AS SORTED CHARACTER
	CMP	R0,TEMP(R5)		;IS IT THE SPECIAL CHARACTER?
	BEQ	2$			;YES, SO EXIT
	MOV	#10$,-(SP)		;STACK A RETURN ADDRESS
	SORT	..CSM			;SORT ON SPECIAL SKIPPERS
	RTS	PC			;NON-SPECIALS ARE IGNORED

.CSMDQ:	DEC	CNDN(R5)		;INTO ONE MORE CONDITIONAL
.CSMD:	JMP	SCAN			;IGNORE NEXT CHARACTER

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

.CSMF:	sort	..csmf,s		;sort on F commands
	rts	pc			;nothing special
.CSM2Q:	JSR	PC,QSKP			;IGNORE 1 QUOTED STRING
.CSMQ:	JSR	PC,QSKP			;IGNORE 1 QUOTED STRING
IREST:	MOV	#ALTMOD,R0		;SET TO RESTORE QUOTE AS ALTMODE
	BR	20$			;GO DO IT

QCHK:	TST	QFLG(R5)		;QUOTE FLAG?
	BEQ	21$			;NOPE
	JSR	PC,SCAN			;YES, SO GET THE QUOTE CHARACTER
20$:	MOV	R0,QUOTE(R5)		;AND SET QUOTE CHARACTER
	CLR	QFLG(R5)		;NOW CLEAR THE QUOTE FLAG
21$:	RTS	PC			;AND EXIT

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

.CSME:	SORT	..CSME,S		;IS IT EB, ER, EW ?
	RTS	PC			;NO

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

.CSMUA:	JSR	PC,SCNUPP		;GET CHARACTER AFTER ^
	BIC	#-77-1,R0		;  THEN FORCE CONTROL CHARACTER
	TST	(SP)+			;JUNK THE RETURN ADDRESS
	BR	11$

.DSABL	LSB
.SBTTL	ERROR MESSAGE PROCESSOR

.IF	NE	ERRTXT

.ENABL	LSB

ERRORA:	MOVB	(R4)+,R0		;GET 3RD RAD50 CHARACTER
	ADD	(PC)+,R0		;NOW FORM "NA?"
	.RAD50	/NA /
	MESSAG	<"NO ARG BEFORE "<-3>>
	MOV	#$$$$$$,-(SP)		;STACK MESSAGE POINTER
	BR	1$			;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/
	MESSAG	<"ILLEGAL "<-3>" CHARACTER">
	MOV	#$$$$$$,-(SP)		;STACK MESSAGE POINTER
1$:	MOVB	(R4)+,R4		;GET LAST/MIDDLE CHARACTER
	BR	ERRMIO			;AND GO TO COMMON PROCESSING

.DSABL	LSB

.ENDC
ERRMSG:
	MOV	(R4)+,R0		;GET RAD50 OF ERROR CODE
.IF	NE	ERRTXT
	MOV	(R4)+,-(SP)		;SAVE THE TEXT POINTER
	MOV	(PC),R4			;SET R4 = 012702
.ENDC
ERRMIO:	MOV	#50,R2			;SET TO DIVIDE BY 50
	CLR	-(SP)			;FLAG END OF CHARACTERS
1$:	JSR	PC,DIVD			;DIVIDE BY 50
	MOV	R1,-(SP)		; AND SAVE REMAINDER
	TST	R0			;  ANY ANSWER LEFT?
	BNE	1$			;   LOOP IF SO...
	JSR	PC,NOCTLO		;CANCEL ANY ^O IF EFFECT
	JSR	PC,CRLF			;RESTORE CARRIAGE
	MOV	#'?-<'A-1>,R0		;NOW PRINT A "?"
2$:	ADD	#'A-1,R0		;MAKE A CHARACTER
	CMP	R0,#'Z			;REALLY ALPHABETIC?
	BLOS	3$			;YES, SO TYPE IT
	ADD	#'0-36-<'A-1>,R0	;NO, SO CONVERT TO NUMERIC
3$:	JSR	PC,TYPE			; AND TYPE IT
	MOV	(SP)+,R0		;GET NEXT
	BNE	2$			; IF ANY...
	MOV	(R5),ERRPOS(R5)		;SAVE ERRING "SCANP"
	MOV	EHELP(R5),R3		;GET EDIT HELP LEVEL
.IF	NE	ERRTXT
	BIC	#^C3,R3			;WANT ONLY LS 2 BITS
	DEC	R3			;LESS 1
	BEQ	9$			;IF "EH"=1 THEN ONLY RAD50
	MOV	(SP)+,R1		;GET THE STRING POINTER
	BEQ	9$			;IF ANY...
	MOV	#TAB,R0			;START WITH A TAB
4$:	JSR	PC,TYPE
5$:	MOVB	(R1)+,R0		;GET STRING CHARACTER
	BGT	4$			; IF MORE...
	BEQ	9$			;  OR THE REAL END
	MOV	SCHBUF(R5),R2		;GUESS AT PRINT SEARCH BUFFER FIRST
	CMPB	R0,#-2			;WHICH TYPE OF SPECIAL WAS IT??
	BGT	7$			;IF -1 (-1.GT.-2) THEN ALL SET UP
	BEQ	6$			;IF -2 (-2.EQ.-2) THEN SET POINTER
	MOVB	R4,R0			;IF -3 (-3.LT.-2) THEN SET CHARACTER
	BR	4$			;AND PRINT IT, THEN JUST CONTINUE

6$:	MOV	TEMP(R5),R2		;THIS IS THE SAVED FILENAME POINTER
7$:	DEC	R4			;MORE TO PRINT IN STRING?
	BMI	5$			;NOPE, SO QUIT NOW
	MOVB	(R2)+,R0		;YEP, SO FETCH NEXT CHARACTER
	BPL	8$			;AND PRINT IT
	CMPB	R0,#-1			;IF SPECIAL, THEN THE END?
	BEQ	5$			;QUIT BEFORE PRINTING END CHARACTER
	BIC	#-177-1,R0		;ELSE TRIM OFF SPECIAL BIT(S)
8$:	JSR	PC,TYPE			;AND PRINT CHARACTER AS NORMAL
	BR	7$			;AROUND AGAIN FOR GOODNESS

.ENDC
9$:	BIT	#4,EHELP(R5)		;TEST TRACE BIT
	BEQ	10$			;IF CLEAR, DONT TRACE
	JSR	PC,EIOFF		;TURN OFF EI
	JMP	.CMDQM			;NOW DO THE ?

10$:	JSR	PC,EIOFF		;TURN OFF EI
	bit	#200,etype(r5)		;abort on error?
	bne	11$
	JMP	TECO			;RESTART TECO
11$:	jsr	pc,crlf			;print crlf
	jmp	texit			;quit!!

.DSABL	LSB
.SBTTL	Q REGISTER REFERENCE
.SBTTL		RETURNS:	R0 = 0
.SBTTL				R1 = POINTER TO Q REG SIZE
.SBTTL				R2 = OFFSET TO BASE OF Q REG
.SBTTL				"QNMBR" SET AS SPECIFIED

.ENABL	LSB

QREF:	JSR	PC,SCNUPP		;GET NEXT CHARACTER
.CMD.S:	JSR	PC,ALPHAN		;MUST BE ALPHANUMERIC
	BCC	90$			; BUT IT IS NOT
	CMP	R0,#'A			;IS IT ALPHA?
	BLO	2$			;NOPE, IT IS NUMERIC
	ADD	#13-'A-<1-'0>,R0	;YEP, RANGE IS 13-44
2$:	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	12$			;AND ENTER COUNTING LOOP

11$:	ADD	(R1)+,R2		;SUM THE TOTAL OFFSE
	TST	(R1)+			;AND SKIP THE VALUE SPOT
12$:	DEC	R0			;MORE TO GO?
	BGT	11$			;YES
	RTS	PC			;NO, EXIT

90$:	ERROR	IQN,<"ILLEGAL Q REG NAME">;BAD Q REG NUMBER

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

.ENABL	LSB

QADJX:	CMP	QNMBR(R5),QCMND(R5)	;ABOUT TO CLOBBER COMMAND?
	BEQ	90$			;YES, BOOT HIM
QADJ:	MOV	R0,R3			;COPY THE NEW Q REG SIZE
	JSR	PC,QSUMY		;AND SUM CURRENT Q REG OFFSET
	MOV	QZ(R5),R0		;GET END OF ALL Q REGS
	MOV	R1,R4			;COPY Q REG SIZE POINTER
	MOV	R3,R1			;AND GET WORKING COPY OF NEW SIZE
	ADD	(R4),R2			;POINTER TO CURRENT END OF Q REG
	SUB	(R4),R1			;SIZE CHANGE (NEW-OLD)
	BLO	25$			;NEW < OLD
	BEQ	QSUMY			;NEW = OLD
	ADD	R0,R1			;NEW > OLD; GET NEW QZ
	SIZE	QREGS			;CHECK OUT THE SIZE
	BCC	91$			;WE CAN'T DO IT
	MOV	R3,(R4)			;SET NEW Q REG SIZE
	MOV	R1,QZ(R5)		;SET NEW TOTAL Q REG SIZE
	MOV	QRSTOR(R5),R3		;GET Q REG AREA POINTER
	ADD	R3,R0			;MAKE ALL
	ADD	R3,R1			; POINTERS
	ADD	R3,R2			;  ABSOLUTE
	MOVB	(R2),R4			;SAVE CHARACTER IN MIDDLE
	CLRB	(R2)			;THEN FLAG THAT BYTE AS NULL
	BR	23$			;AND ENTER MOVE LOOP

22$:	MOVB	-(R0),-(R1)		;MOVE A BYTE UP FROM TOP
	BNE	22$			;CANNOT BE END IF NON-ZERO
23$:	CMP	R0,R2			;DONE?
	BHI	22$			;NOT YET...
	MOVB	R4,(R1)			;RESTORE SAVED CHARACTER
24$:	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
25$:	MOV	R3,(R4)			;SET NEW Q REG SIZE
	ADD	R1,QZ(R5)		;LOWER THE TOTAL Q REG SIZE
	ADD	R2,R1			;POINT TO THE NEW END
	MOV	QRSTOR(R5),R3		;GET Q REG AREA POINTER
	ADD	R3,R0			;MAKE ALL
	ADD	R3,R1			; POINTERS
	ADD	R3,R2			;  ABSOLUTE
	CLRB	(R0)			;FLAG THE END BYTE AS NULL
	BR	27$			;ENTER MOVE LOOP

26$:	MOVB	(R2)+,(R1)+		;MOVE A BYTE DOWN
	BNE	26$			;CANNOT BE END IF NON-ZERO
27$:	CMP	R2,R0			;DONE?
	BLO	26$			;NOT YET...
	BR	24$			;ALL DONE

90$:	ERROR	CCC,<"CAN'T CLOBBER COMMAND">

91$:	ERROR	MEM,<"MEMORY OVERFLOW">	;NO GO

.DSABL	LSB
.SBTTL	GENERAL SUBROUTINES

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

.ENABL	LSB

90$:	ERROR	PDO,<"PUSH-DOWN LIST OVERFLOW">

1$:	CMP	PDL(R5),SCHBUF(R5)	;PUSHING TOO FAR?
	BHIS	90$			;YEP
	ADD	R5,(SP)			;NOPE, MAKE OFFSET ABSOLUTE
	MOV	@(SP)+,@PDL(R5)		;NOW SAVE IT
	ADD	#2,PDL(R5)		;AND GO TO NEXT LOCATION
PUSH:	MOV	(R4)+,-(SP)		;GET THE OFFSET
	BPL	1$			;NOT END OF LIST YET
2$:	TST	(SP)+			;GET RID OF FLAG
	RTS	R4			;AND EXIT

POP:	MOV	(R4)+,-(SP)		;GET THE OFFSET
	BMI	2$			;GET OUT IF END
	SUB	#2,PDL(R5)		;BACK UP THE LIST
	ADD	R5,(SP)			;MAKE ABSOLUTE
	MOV	@PDL(R5),@(SP)+		;RESTORE VALUE
	BR	POP			;AND CONTINUE

.DSABL	LSB

SCNUPP:	JSR	PC,SCAN			;SCAN FIRST
UPPERC:	CMP	R0,#141			;ALREADY OK?
	BLO	1$			;YES
	CMP	R0,#173			;DONT CHANGE HIGH CHARACTERS
	BHIS	1$
	BIC	#40,R0			;NO, SO CORRECT IT
1$:	RTS	PC			;AND EXIT

QSKP:	JSR	PC,QCHK			;CHECK FOR A QUOTE CHARACTER
	MOV	(R5),OSCANP(R5)		;AND SAVE "SCANP"
1$:	JSR	PC,SCAN			;NOW SCAN
	CMP	R0,QUOTE(R5)		;MATCH?
	BNE	1$			;NOPE
	RTS	PC			;NOW EXIT
.ENABL	LSB

BZCHK:	CMP	R0,ZZ(R5)		;TOO BIG?
	BLOS	1$			;NOPE
	ERROR	POP,<"POINTER OFF PAGE">;YEP

NOTRCE:	MOV	TFLG(R5),TFGTMP(R5)	;SAVE TRACE FLAG
	CLR	TFLG(R5)		;THEN TURN OFF TRACE
1$:	RTS	PC			;EXIT

.DSABL	LSB

ENTRCE:	MOV	TFGTMP(R5),TFLG(R5)	;RESTORE TRACE FLAG
	RTS	PC			;AND EXIT

.ENABL	LSB

20$:	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	20$			;NOPE
	RTS	PC			;YES

.DSABL	LSB
.ENABL	LSB

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

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

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

TSTNXT:	MOV	(R5),R0			;GET COMMAND POINTER
	CMP	R0,QLENGT(R5)		;END OF COMMAND?
	BHIS	20$			;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,(R4)			;MATCH?
	BNE	20$			;NO, EXIT (C=0)
	INC	(R5)			;YES, BUMP POINTER
	TST	(R4)+			;SKIP ARGUMENT
	SEC				;INDICATE ALL OK
	RTS	R4			;AND EXIT

20$:	TST	(R4)+			;SKIP ARGUMENT
	RTS	R4			;AND EXIT

.DSABL	LSB
NLINES:	INC	CFLG(R5)		;WAS THERE A COMMA?
	BEQ	1$			;YES
	CLR	CFLG(R5)
	MOV	P(R5),M(R5)		;NO, SO SAVE . IN "M"
	JSR	PC,@'L*2+TECOCH		;AND MOVE . FORWARD "N" LINES
	MOV	P(R5),N(R5)		;"N" IS THE NEW .
	MOV	M(R5),P(R5)		;RESTORE THE ORIGINAL .
1$:	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	2$			;YES
	MOV	M(R5),N(R5)		;NO, SO SWITCH
	MOV	R0,M(R5)		; N AND M
	MOV	N(R5),R0		;AND GET NTH POSITION AGAIN
2$:	JSR	PC,BZCHK		;IN RANGE?
	SUB	M(R5),R0		;FIND DISTANCE BETWEEN N AND M
	RTS	PC			;THEN EXIT

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

4$:	JMP	(R0)			;EXIT
.SBTTL	SEARCH

.ENABL	LSB

SEARCH:	CMP	#-2,CLNF(R5)		;"::" MODE?
	BNE	2$			;NO
	MOV	#-1,CFLG(R5)		;YES--FAKE AN ARG OF "1,"
	MOV	#1,M(R5)
2$:	MOV	XFLAG(R5),-(SP)		;SAVE SEARCH MATCH FLAG
	JSR	PC,GETN			;GET THE NUMBER
	MOV	R0,-(SP)		;NOW SAVE THE NUMBER
	BNE	1$			;MUSTN'T BE ZERO
	ERROR	ISA	<%ILLEGAL SEARCH ARGUMENT%>
1$:	JSR	PC,QCHK			;SET UP FOR ANY QUOTED STRING
	MOV	SCHBUF(R5),R4		;GET SEARCH BUFFER START
	MOV	#SCHSIZ-1,R3		; AND ITS SIZE
5$:	CLR	R2			;GET INPUT FROM SCAN
10$:	TST	R2			;WHERE DO THEY COME FROM?
	BNE	25$			;A Q-REG IF NON-0
	JSR	PC,SCAN			;PICKUP A CHARACTER TO SEARCH FOR
	CMP	R0,QUOTE(R5)		;END OF SEARCH STRING?
	BEQ	50$			;YES
	CMP	R0,#'^			;CARAT?
	BNE	11$			;NO
	BIT	#1,EDFLAG(R5)		;SPECIAL TREATMENT FOR IT?
	BNE	11$			;NO
	JSR	PC,SCNUPP		;GET NEXT AS UPPER CASE
	BIC	#-77-1,R0		;AND CONVERT TO CONTROL CODE
11$:	CMP	R0,#'Q-100		;CTRL/Q?
	BNE	30$			;NOPE
	JSR	PC,SCAN			;YES, SO GET NEXT LITERALLY
	BR	40$			;AND STORE IT IN SEARCH BUFFER

20$:	TST	R2			;^E - ARE WE IN Q-REG FETCH?
	BNE	35$			;YES, USE AS NORMAL ^E
	TSTNXT	'Q			;NO, IS IT Q-REG FETCH?
	MOV	#'E-100+200,R0		;RESTORE IT AS CTRL/E
	BCC	40$			;NO, ENTER IT AS SPECIAL
	JSR	PC,QREF			;YES, REFERENCE THE Q-REG
	ADD	QRSTOR(R5),R2		;MAKE SOURCE ABSOLUTE
	MOV	(R1),R1			;GET THE COUNT IN R1
25$:	DEC	R1			;ANYTHING LEFT IN Q-REG?
	BMI	5$			;NO, GO CLEAR FLAG
	MOVB	(R2)+,R0		;YES, GET A BYTE
30$:	CMP	R0,#' 			;LARGER THAN SPACE?
	BHIS	33$
	CMP	R0,#'E-100		;CTRL/E?
	BEQ	20$			;YES
	CMP	R0,#'N-100		;CTRL/N?
	BEQ	35$			;YES, THAT IS SPECIAL
	CMP	R0,#'S-100		;CTRL/S?
	BEQ	35$			;YES, THAT IS SPECIAL
	CMP	R0,#'X-100		;CTRL/X?
	BEQ	35$			;YES, THAT IS SPECIAL
	CMP	R0,#'\-100		;CTRL-\?
	BNE	40$			;NOPE--NORMAL SEARCH CHARACTER
	TST	XFLAG(R5)		;ANY CASE MODE?
	BEQ	34$
	CLR	XFLAG(R5)		;FORCE ANY CASE MODE
	BR	10$
34$:	INC	XFLAG(R5)		;FORCE EXACT CASE MODE
	BR	10$
33$:	TST	XFLAG(R5)		;EXACT MODE?
	BNE	40$			;GOOD-SAVES TIME
	JSR	PC,ALPHA		;UPCASES IF ALPHA
	BCC	40$			;NOT ALPHA->NOT SPECIAL
	CMPB	#'E+100,-1(R4)		;IS THIS AFTER ^E?
	BEQ	40$			;THEN LEAVE IT ALONE
35$:	BIS	#200,R0			;FLAG THE SPECIAL CHARACTERS
40$:	MOVB	R0,(R4)+		;STORE IN SEARCH BUFFER
	MOVB	#-1,(R4)		; AND MARK END OF BUFFER
	DEC	R3			;MORE ROOM?
	BGT	10$			;YES, SO CONTINUE
	ERROR	STL,<%SEARCH STRING "%<-1>%" TOO LARGE%>

50$:	MOV	(SP)+,R2		;GET THE REPEAT COUNT
	TST	M(R5)			;MAKE M= ABS(M)
	BGE	.SURCH
	NEG	M(R5)

.DSABL	LSB
.ENABL	LSB

.SURCH:	MOV	P(R5),-(SP)		;SAVE POINTER LOCATION
	MOV	#1,-(SP)		;GUESS AT FORWARD TYPE SEARCH
	TST	R2			;GOOD GUESS??
	BPL	30$			;YES, MOVE . BY +1 EACH FAILURE
	NEG	(SP)			;NO, MOVE . BY -1 EACH FAILURE
	NEG	R2			;AND GET A POSITIVE HIT COUNTER
30$:	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
40$:	MOV	R1,R3			;GET STARTING POINT
	MOV	SCHBUF(R5),R4		;AND SEARCH STRING START
.SUR.Y:	CMP	R3,ZZ(R5)		;END OF TEXT?
	BLO	50$			;NOPE
	CMPB	(R4),#-1		;YEP, BUT DOES IT MATCH END OF STRING?
	BEQ	62$			;YES, SO ALL DONE (FOUND)
	TST	(SP)			;NO, SEARCHING BACKWARDS??
	BMI	.SUR.N			;IF BACKWARDS THEN MOVE . IF POSSIBLE
47$:	CLRB	(SP)			;INDICATE FAILURE (0 OR 177400)
	TST	CFLG(R5)		;BOUNDED SEARCH?
	BMI	65$			;YES, SO KEEP .
	BIT	#16.,EDFLAG(R5)		;FAILING SEARCH ALWAYS PRESERVE .?
	BNE	65$			;BRANCH IF SO
	CLR	2(SP)			;NO, SO .=0
	BR	65$			;AND EXIT

50$:	MOVB	(R4)+,R0		;GET A STRING CHARACTER
	BMI	60$			;IT WAS A SPECIAL
	CMPB	R0,(R3)+		;MATCH?
	BEQ	.SUR.Y			;YES, SO CONTINUE
.SUR.N:	ADD	(SP),R1			;NOPE, MOVE . ONE POSITION
	MOV	#-1,R4			;SIZE OF ENTRY
54$:	TST	CFLG(R5)		;SPECIAL SEARCH?
	BGE	55$			;NO--CONTINUE
	TST	M(R5)			;UNLIMITED BOUND?
	BEQ	55$			;YES--CONTINUE
	ADD	R4,M(R5)		;ADJUST LIMIT
	BLE	47$			;LIMIT REACHED--SEARCH FAILS
55$:	CMP	R1,TXSTOR(R5)		;NO, IS . TOO SMALL NOW??
	BHIS	40$			;. IS O.K., KEEP SEARCHING
	BR	47$			;. IS TOO SMALL, SEARCH FAILS

60$:	INCB	R0			;WAS SPECIAL THE END FLAG?
	BNE	.SUR.S			;NOPE, REAL SPECIAL
62$:	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	(SP)			;IS SEARCH GOING FORWARDS??
	BPL	63$			;YES, SO NEW START IS SET
	ADD	R4,R1			;NO, BACKWARDS, SO GO BACK AND
	ADD	R4,R1			; BACK AGAIN FOR NEW START
63$:	DEC	R2			;SEARCH ANOTHER TIME??
	BGT	54$			;YES, SO SEARCH AGAIN ALREADY
	MOV	R4,LSCHSZ(R5)		;NO, DONE, STORE -("LENGTH")
	SUB	TXSTOR(R5),R3		;MAKE ENDING . RELATIVE
	MOV	R3,2(SP)		; AND SET THAT ENDING .
	SUB	TXSTOR(R5),PST(R5)	;MAKE STARTING . RELATIVE
	MOV	#-1,(SP)		;INDICATE SUCCESS (-1)
65$:	SUB	TXSTOR(R5),ZZ(R5)	;MAKE END OF TEXT RELATIVE
	MOV	(SP)+,R1		;SET CC'S AND RETURN INDICATOR
	MOV	(SP)+,P(R5)		;SET POINTER
	MOV	(SP)+,XFLAG(R5)		;RESTORE FLAG
	TST	R1			;SET CC'S
	RTS	PC			;AND EXIT

.DSABL	LSB
SUR.Y:	TST	(SP)+			;ARE WE IN NEG MODE?
	BEQ	.SUR.Y			;NO
	BR	.SUR.N			;YES--SEARCH FAILED!
SUR.N:	TST	(SP)+			;ARE WE IN NEG MODE?
	BEQ	.SUR.N			;NO
	BR	.SUR.Y			;YES--TAKE ALTERNATE EXIT
.SUR.S:	CLR	-(SP)			;NEG FLAG
74$:	CMPB	R0,#'A+200+1		;IS IT ANYCASE ALPHA?
	BHIS	95$
	CMPB	R0,#'S-100+200+1	;WAS SPECIAL CTRL/S?
	BEQ	80$			;YES (IT IS CTRL/S)
	BHI	85$			;NO (IT IS CTRL/X)
	CMPB	R0,#'E-100+200+1	;NO, IS IT CTRL/E?
	BEQ	81$			;YES
	MOVB	(R4)+,R0		;NO (IT IS CTRL/N)
	BMI	75$			;NEXT AS SPECIAL IS VERY SPECIAL
	TST	(SP)+			;GET RID OF RETURN ITEM
	CMPB	R0,(R3)+		;MATCH? (CTRL/N)
	BNE	.SUR.Y			;NO MATCH IS GOOD HERE
	BR	.SUR.N			;MATCH IS BAD...

75$:	COM	(SP)			;REVERSE NEGATE SENSE
	INCB	R0			;TEST VALUE OF COMPARAND	
	BNE	74$			;VALID CHARACTER--GO TO IT
	TST	(SP)+			;END OF STRING
	BR	.SUR.Y			;CALL A MATCH
76$:	MOVB	(R3)+,R0		;GET A TEXT CHATACTER
	JSR	PC,@(SP)+		;GO TEST CHARACTER
78$:	INC	R4			;BUMP SEARCH BUFFER POINTER
	BCS	SUR.Y			;MADE IT
	BR	SUR.N			;NO GO

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

81$:	CMPB	(R4),#'[		;CTRL/E AND "["?
	BEQ	90$
	CMPB	(R4),#'S		;CTRL/E AND "S"?
	BEQ	87$			;YES
	MOV	#ALPHA,-(SP)		;SET FOR A
	CMPB	(R4),#'A		;A?
	BEQ	76$			;YES
	MOV	#RAD50,(SP)		;SET FOR C
	CMPB	(R4),#'C		;C?
	BEQ	76$			;YES
	MOV	#NUMER,(SP)		;SET FOR D
	CMPB	(R4),#'D		;D?
	BEQ	76$			;YES
	MOV	#TERMS,(SP)		;SET FOR L
	CMPB	(R4),#'L		;L?
	BEQ	76$			;YES
	MOV	#ALPHAN,(SP)		;ALPHANUMRIC MATCH?
	CMPB	(R4),#'R
	BEQ	76$
	TST	(SP)+			;NO, POP ADDRESS
	CMPB	(R4),#'X		;X?
84$:	BNE	SUR.N			;NOTHING, SAY NO MATCH
	INC	R4			;CTRL/E & X MEAN ANY MATCH
85$:	INC	R3			;CTRL/X IS ANY MATCH
	BR	SUR.Y			;INDICATE SUCCESS

87$:	MOV	R3,-(SP)		;SAVE POINTER TO TEXT
88$:	CMP	R3,ZZ(R5)		;END OF TEXT?
	BHIS	89$			;YES, QUIT
	MOVB	(R3)+,R0		;NO, GET CHARACTER
	CMP	R0,#SPACE		;SPACE?
	BEQ	88$			;YES
	CMP	R0,#TAB			;TAB?
	BEQ	88$			;YES
89$:	DEC	R3			;CORRECT TEST POINTER
	CMP	(SP)+,R3		;AND CHECK FOR NON-NULL
	BR	78$			;NOW EXIT

90$:	INC	R4
91$:	TSTB	(R4)			;IS THIS AN EXACT CASE MATCH?
	BMI	94$
	CMPB	(R3),(R4)+		;DOES CHAR MATCH?
96$:	BEQ	92$			;YES--GOTO FINISH CODE
	CMPB	#'],(R4)		;NOT FOUND?
	BEQ	97$			;CARRY IS CLEAR
	CMPB	#-1,(R4)		;END OF BUFFER?
	BNE	91$			;NO-CONTINUE
97$:	INC	R3			;FINISHED (POINT PAST CHAR)
	BR	78$			;FINISHED (CARRY CLEAR)
92$:	CMPB	#'],(R4)		;SEARCH FOR END
	BEQ	93$
	CMPB	#-1,(R4)+		;END OF BUFFER
	BNE	92$
	DEC	R4			;CORRECT POINTER
93$:	INC	R4
	BR	85$			;FINISHED (MATCHED)
94$:	MOVB	(R3),R0			;UPCASE COMPARAND
	JSR	PC,UPPERC
	MOVB	(R4)+,-(SP)		;DO SOME STACK ARITHMETIC
	BIC	#200,(SP)		;CLEAR FLAG BIT
	CMPB	R0,(SP)+		;IS THERE A MATCH?
	BR	96$

95$:	SUB	#200+1,R0		;GET BACK AS UC ASCII CHAR
	CMPB	(R3),R0			;IS IT A MATCH?
	BEQ	85$
	BIS	#40,R0			;CHECK FOR UPPERCASE
	CMPB	R0,(R3)+
	BNE	SUR.N			;NO MATCH
	JMP	SUR.Y			;MATCH
.SBTTL	SIZING (SHUFFLING) ROUTINE

SIZE:	MOV	R0,-(SP)		;SAVE R0
	MOV	(R4)+,R0		;GET OFFSET TO MAX TO CHANGE
	CMP	R1,#077740		;IS REQUEST AT ALL REASONABLE?
	BHIS	99$			;NOPE [BHIS=BCC => FAILURE]
	MOV	R1,-(SP)		;SAVE R1
	MOV	R2,-(SP)		; AND SAVE R2
	MOV	R0,R2			;SAVE THE MAX'S OFFSET VALUE
	ADD	R5,R0			;MAKE R0 ABS PTR TO MAX
	SUB	(R0),R1			;FIND CHANGE AMOUNT
	BLO	98$			;ALREADY DONE [BLO=BCS => OK]
	ADD	#40,R1			;FUDGE UP REQUEST A LITTLE
	MOV	R3,-(SP)		;SAVE R3
	SUB	#ZMAX,R2		;GET WHICH AREA IS CHANGING
	MOV	R2,-(SP)		;0=>TEXT; <>0=>QREGS
	MOV	R1,-(SP)		;SAVE ORIGINAL DELTA AMOUNT
	JSR	PC,40$			;SEE IF CURRENT FREE DOES IT
	MOV	#QMAX,R2		;NO, SO GET OTHER AREA'S MAX
	MOV	QZ(R5),R3		; AND CURRENT IN USE
	TST	2(SP)			;QREGS ARE OTHER AREA IF 0
	BEQ	1$			;WE ARE CHANGING TEXT
	MOV	#ZMAX,R2		;ELSE GET REAL OTHER AREA'S
	MOV	ZZ(R5),R3		; MAX AND CURRENT IN USE
1$:	NEG	R3			;GET -(IN USE)
	ADD	R5,R2			;ABS PTR TO OTHER MAX
	ADD	(R2),R3			;FREE = MAX -(IN USE)
	SUB	#200.,R3		;FIND THE PUNISH AMOUNT
	BLOS	10$			;NOT ENOUGH FREE TO PUNISH
	SUB	R3,(R2)			;ELSE PUNISH THE OTHER MAX
	ADD	R3,CURFRE(R5)		;AND UPDATE FREE SPACE
	TST	2(SP)			;WHICH AREA ARE WE CHANGING
	BEQ	3$			;IF TEXT, THEN JUST PUNISHED QREGS
	MOV	QRSTOR(R5),R2		;PTR TO OLD BEG
	NEG	R3			;-(PUNISH)
	ADD	R2,R3			;PTR TO NEW BEG (LOWER)
	MOV	R3,QRSTOR(R5)		;SET NEW BEGINNING
	MOV	R4,-(SP)		;SAVE R4
	MOV	R2,R4			;PTR TO OLD BEG
	ADD	QMAX(R5),R4		;PTR TO OLD END +1
	MOVB	-(R4),-(SP)		;SAVE @ OLD END
	CLRB	(R4)			;THEN FLAG IT AS NULL BYTE
2$:	MOVB	(R2)+,(R3)+		;FROM OLD BEG TO NEW BEG
	BNE	2$			;CANNOT BE END IF NON-NULL
	CMP	R2,R4			;OLD BEG+? CAUGHT OLD END??
	BLOS	2$			;NOT YET
	MOVB	(SP)+,-(R3)		;YES, SO RESTORE @ NEW END
	MOV	(SP)+,R4		;RESTORE R4
3$:	JSR	PC,40$			;WILL FREE SPACE DO IT NOW?
10$:	JSR	PC,SIZER		;ASK WHOEVER FOR MORE PLEASE
	BCC	3$			;WE GOT IT!
	MOV	(SP)+,R3		;GET BACK ORIGINAL DELTA
	SUB	R1,R3			;FIND WHAT WE GAVE OF FREE SPACE
	ADD	R3,CURFRE(R5)		;AND RETURN IT TO FREE SPACE
	TST	(SP)+			;DUMP THE AREA DETERMINATION
	BR	97$			;AND EXIT
40$:	MOV	CURFRE(R5),R3		;GET CURRENT FREE AMOUNT
	CMP	R1,R3			;WILL IT DO THE TRICK?
	BHI	41$			;NOPE, BUT WILL HELP SOME
	MOV	R1,R3			;YEP, SO DON'T USE IT ALL
41$:	SUB	R3,CURFRE(R5)		;WE GAVE AT THE OFFICE
	SUB	R3,R1			;CORRECT DELTA CHANGE AMOUNT
	BEQ	50$			;ALL DONE
	RTS	PC			;ELSE RETURN FOR MORE WORK

50$:	TST	(SP)+			;DUMP THE RETURN ADDRESS
	MOV	(SP)+,R1		;GET ORIGINAL DELTA
	ADD	R1,(R0)			;AND CORRECT THE MAX
	TST	(SP)			;WHICH AREA IS CHANGING?
	BNE	96$			;QREGS, SO VERY EASY
	MOV	QRSTOR(R5),R0		;TEXT, SO GET OLD BEG PTR
	ADD	R1,QRSTOR(R5)		;UPDATE QREG PTR
	MOV	R0,R2			;COPY OLD BEG PTR
	ADD	QMAX(R5),R0		;HAVE OLD END PTR +1
	ADD	R0,R1			;HAVE NEW END PTR +1 (HIGHER)
	MOVB	(R2),R3			;SAVE @ OLD BEG
	CLRB	(R2)			;THEN FLAG AS A NULL BYTE
51$:	MOVB	-(R0),-(R1)		;MOVE OLD END TO NEW END
	BNE	51$			;CANNOT BE END IF NON-NULL
	CMP	R2,R0			;CAUGHT UP YET?
	BLO	51$			;NOPE, SO CONTINUE
	MOVB	R3,(R1)			;RESTORE @ NEW BEG
96$:	COM	(SP)+			;DUMP AREA FLAG AND CARRY=1
97$:	MOV	(SP)+,R3		;RESTORE R3
98$:	MOV	(SP)+,R2		; AND R2
	MOV	(SP)+,R1		;  AND R1
99$:	MOV	(SP)+,R0		;  AND R0
	RTS	R4			;FINALLY EXIT
.SBTTL	CHARACTER LIST FOR " COMMANDS

.TABLE	.CND
.ENTRY	A
.ENTRY	C
.ENTRY	D
.ENTRY	E
.ENTRY	F
.ENTRY	G
.ENTRY	L
.ENTRY	N
.ENTRY	R
.ENTRY	S
.ENTRY	T
.ENTRY	U
.WORD	-1
.SBTTL	CHARACTER LIST FOR E COMMANDS

.TABLE	.EEE
	.word	'!,.eeesh	;ENTRY !
.ENTRY	B
.ENTRY	C
.ENTRY	D
.ENTRY	F
.ENTRY	G
.ENTRY	H
.ENTRY	I
.ENTRY	K
.ENTRY	O
.ENTRY	Q
.ENTRY	R
.ENTRY	S
.ENTRY	T
.ENTRY	V
.ENTRY	W
.ENTRY	X
.WORD	-1
.SBTTL	COMMAND CHARACTER LIST

.TABLE	.CMD
.WORD	BELL,	.CMDBL
.WORD	BS,	.CMDBS
.WORD	LF,	.CMDLF
.WORD	'U-100,	.CMDCU
.WORD	ALTMOD,	.CMDAM
.WORD	SPACE,	.CMDSP
.WORD	'*,	.CMDST
.WORD	'?,	.CMDQM
.WORD	-1
.SBTTL	CHARACTER TABLES FOR "SKPSET"

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

.TABLE	.CSME
.word	'!,	.csmq	;E!
.WORD	'B,	.CSMQ	;EB
.WORD	'I,	.CSMQ	;EI
.WORD	'R,	.CSMQ	;ER
.WORD	'W,	.CSMQ	;EW
.WORD	-1

.TABLE	.CSMF
.WORD	'B,	.CSMQ	;FB
.WORD	'C,	.CSM2Q	;FC
.WORD	'N,	.CSM2Q	;FN
.WORD	'R,	.CSMQ	;FR
.WORD	'S,	.CSM2Q	;FS
.WORD	-1
.SBTTL	F CHARACTER LIST

.TABLE	.FFF
.word	'',.fffq
.word	'<,.fffla
.word	'>,.fffra
.ENTRY	B
.ENTRY	C
.ENTRY	N
.ENTRY	R
.ENTRY	S
.word	vbar,.fffvb
.WORD	-1
.SBTTL	FINAL FIXUPS...

.PSECT	TECOER
.EVEN

.END