Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/sed-for-vms/sed1ex.mar
There are 5 other files named sed1ex.mar in the archive. Click here to see a list.
.TITLE	SED1EX - Sed routines for the Execute Command

.LIBRARY /SEDITB.MLB/
.ENABLE DEBUG
.DISABLE GLOBAL
.PSECT CODE,NOWRT,EXE,LONG

.NOCROSS
FLGDEF		;Define the flag bits
PRMDEF		;  and the SED parameters
$IODEF		;  and the I/O symbols
$XABFHCDEF	;  and the fixed header XAB symbols
.CROSS

.SUBTITLE	Execute Command Processor

EXECUT::BICL	#M_PCM,F	;Cancel the pick-close mark, if any
	BBCC	#V_CMV,F,10$	;Did user use cursor movement?
	MOVAB	PARBUF,R3
	BSBW	PELS.M		;Yes - read parameter from the file
	BRB	20$
10$:	CLRB	@PARPTR		;End buffer with a null
20$:	MOVZBL	PARBUF,R1	;Get first character of parameter
	CMPB	R1,#^A"a"	;Lower case?
	BLSS	30$		;No
	SUBB	#^O40,R1	;Yes - convert to upper
30$:	CMPB	R1,#^A"S"	;Set up a buffer?
	BNEQ	40$		;No
	BRW	XCTSET		;Yes - do it
40$:	CMPB	R1,#^A"K"	;Kill a buffer?
	BNEQ	50$		;No
	BRW	XCTKIL		;Yes - do it
50$:	CMPB	R1,#^A"W"	;Write into a buffer?
	BNEQ	60$		;No
	BRW	XCTWRT		;Yes - do it
60$:	CMPB	R1,#^A"R"	;Read and list a buffer in switch format?
	BNEQ	70$		;No
	BRW	XCTRDL		;Yes - do it
70$:	CMPB	R1,#^A"L"	;Read and list a buffer in write format?
	BNEQ	80$		;No
	BRW	XCTRDW		;Yes - do it
80$:	CMPB	R1,#^A"N"	;List the defined buffer names?
	BNEQ	90$		;No
	BRW	XCTNML		;Yes - do it
90$:	CMPB	R1,#^A"X"	;Write and execute buffer?
	BNEQ	100$		;No
	BRW	XCTXCT		;Yes - do it
100$:	CMPB	R1,#^A"B"	;Link buffer to a keyboard button?
	BNEQ	110$		;No
	BRW	XCTBTN		;Yes - do it
110$:	CMPB	R1,#^A"@"	;Read a file of buffer switches?
	BNEQ	EXCUT0		;No
	BRW	XCTBSW		;Yes - do it
;Here to set up a number of iterations

EXCUT0:	BSBW	PEEL.1		;Read parameter, if any
	TSTL	R1		;Any parameter?
	BNEQ	10$		;Yes
	BRW	EXCOPN		;No - just open execute buffer
10$:	MOVL	PARG1,R4	;Else get number of iterations
	MOVL	R4,R3		;Here, too
	MOVL	XCTITR,R0	;Save as new nominal
	MOVL	R4,XCTITR
	MOVL	R0,R4
EXCUT1:	MOVL	XCTNUM,R0	;and as current number
	MOVL	R3,XCTNUM
	MOVL	R0,R3
	MOVL	XCTACW,R1	;Get buffer pointer
	BGEQ	10$		;Is there one?
	BRW	XCOERR		;No - no-active-buffer error
10$:	MOVL	XCTADR[R1],R1
	BEQL	15$		;Any address there?  No
	TSTB	(R1)		;Make sure there's something there
	BNEQ	20$
15$:	BRW	XCXERR		;If nothing there, error
20$:	TSTB	XSHFLG		;Want to display the execute?
	BEQL	30$		;No
	JSB	ERASPM		;Yes - erase parameter
30$:	BBS	#V_JRC,F1,EXCU1A ;If doing journal restore, it's top lvl xct
	BITL	#M_XCT!M_XBN,F1	;Already executing?
	BEQL	EXCU1A		;No
	BRW	EXCSVX		;Yes - save context (return to EXCU1C)
EXCU1A:	PUSHR	#^M<R1,R2,R3,R4,R5>
	MOVC3	#SAVPML,PARAMS,SAVPRM ;Save all parameters
	POPR	#^M<R1,R2,R3,R4,R5>
	MOVL	F,SAVFGS	;Save flag longword 1
	MOVL	F1,SAVFGS+4	;  and longword 2
	BICL	#M_XCT!M_XBN!M_JRC,F1 ;Clear journal-restore flags
EXCU1B:	TSTB	XSHFLG		;Want to display the execute?
	BEQL	10$		;No
	BISL	#M_XBN,F1	;Yes - set the right flag
	BRB	EXCU1C
10$:	BISL	#M_XCT,F1	;No - set the right flag
EXCU1C:	MOVL	XCTACW,R1	;Get buffer pointer
	MOVL	XCTADR[R1],R1
	MOVL	R1,XCTACR	;Set buffer up for reading
	MOVL	R1,XCTPTR
	BBCC	#V_XSV,F1,10$	;Saving commands?
	BSBB	XCTWIP		;Yes - wipe out the "enter number execute"
10$:	BRW	XCTEND		;Finish off
;Subroutine to wipe out the execute command ("ENTER SOMETHING EXECUTE")
;from the buffer

XCTWIP:	MOVL	XCTPTW,R6	;Get pointer to end of buffer
10$:	MOVZBL	-(R6),R1	;Get character
	CMPB	R1,#^O33	;Enter?
	BNEQ	10$		;No - keep skipping
XCTCLO:	CLRB	-1(R6)		;Yes - save a null over the enter
	MOVB	#-1,(R6)+	;Flag the end of the buffer
	MOVL	R6,XCFPTR	;Save new start-of-free-space pointer
	RSB			;Done

;Here to save current buffer status so another can be executed

EXCSVX:	TSTL	XCTPSV		;Already down a level?
	BEQL	10$
	BRW	XSXERR		;Yes - only one stack allowed
10$:	MOVL	XCTPTR,XCTPSV	;No - save active buffer pointer
	MOVL	XCTACR,XCTASV	;  and active buffer starting pointer
	MOVL	R3,XCTNSV	;Save active number of iterations
	MOVL	R4,XCTISV	;  and nominal number of iterations
	BRB	EXCU1C		;Finish the set-up

;Here for just enter execute: open buffer and start saving commands

EXCOPN:	BISL	#M_XSV,F1	;Set flag to save commands
	MOVL	#1,XCTITR	;Set default number of iterations to 1
	MOVL	#1,XCTNUM
EXCOP1:	MOVL	XCTACW,R1	;Is there an active buffer?
	BGEQ	10$
	BRW	XCOERR		;No - error
10$:	MOVL	XCFPTR,R2	;Yes - get pointer to start of free space
	MOVL	R2,XCTPTW	;Save as write-pointer to buffer data
	MOVL	R2,XCTADR[R1]	;  and as stored pointer to buffer data
XCTEND:	JSB	ERASPM
	JMP	DISCUR		;Re-position cursor and loop
;Here to set up an execute buffer - if given name is not found,
;create buffer with that name

XCTSET::BBCC	#V_XSV,F1,10$	;Was a buffer open?
	BSBW	XCTWIP		;Yes - close it
10$:	BSBW	XCTRED		;Read buffer name and find it
	TSTL	R1		;Found?
	BGEQ	40$		;Yes
	MOVL	#XBFNUM-1,R1	;No - create it.  Find an open slot
20$:	MOVQ	XCTNAM[R1],R2	;Is this one open?
	BEQL	30$		;Yes
	SOBGEQ	R1,20$		;No - step to the next slot
	BRW	XCSERR		;Jump if none open - error
30$:	MOVQ	XCTTMP,XCTNAM[R1] ;Save name in this slot
40$:	MOVL	R1,XCTACW	;Save index of active buffer
	BBSC	#V_FLG ,F,50$	;Want to return (to SWHMNY)?
	BRB	XCTEND		;No
50$:	RSB			;Yes

;Here to kill off a given execute buffer

XCTKIL:	BBCC	#V_XSV,F1,10$	;Was a buffer open?
	BSBW	XCTWIP		;Yes - close it
10$:	BSBW	XCTRED		;Read and find name of buffer
	TSTL	R1		;Was it found?
	BGEQ	20$		;Yes
	BRW	XCKERR		;Not found - error
20$:	MOVL	R1,R2
	BSBB	XCTKLL		;Else zero out its information
	CMPL	R2,XCTACW	;is this the active one?
	BNEQ	30$
	CVTBL	#-1,XCTACW	;Yes - say there is no active buffer
30$:	BRB	XCTEND		;Done

XCTKLL:	CLRQ	XCTNAM[R2]	;Zero out the buffer name
	BSBB	XCTKLF		;Delete the buffer contents from free space
XCTKLK::MOVQ	XCTKEY[R2],R0	;Is there a key?
	BEQL	10$		;No - done
	MOVAQ	XCTKEY[R2],R6
	CVTBL	#-1,SAVEAC+24	;Restore command in table
	BSBW	SUBTBX
	CLRQ	XCTKEY[R2]	;Clean out old key
10$:	RSB

;Subroutine to kill the contents of an execute buffer from free space
;Enter with R2/ buffer index

XCTKLF:	MOVL	XCTADR[R2],R4	;Get execute buffer pointer
	BNEQ	10$		;Any?
	RSB			;No - nothing to kill
10$:	MOVZBL	(R4)+,R1	;Get a buffer data byte
	CMPB	#^XFF,R1	;Is it the last byte?
	BNEQ	10$		;No - loop until found
	CLRB	-1(R4)		;Turn off the end-of-data flag
	MOVL	XCTADR[R2],R1	;Get pointer to start of data
	CLRL	XCTADR[R2]	;  and clear the pointer
	CMPL	R4,XCFPTR	;Does this data area butt against free space?
	BNEQ	20$		;No
	MOVL	R1,XCFPTR	;Yes - save as new start of free space
20$:	RSB			;Done
;Here to save a string into the active buffer

XCTWRT::BBCC	#V_XSV,F1,10$	;Was a buffer open?
	BSBW	XCTWIP		;Yes - close it
10$:	MOVAB	PARBUF+1,R6
XCWRT0::MOVL	XCTACW,R2	;Get pointer to old buffer contents
	BGEQ	10$
	BRW	XCOERR		;None active - error
10$:	BSBB	XCTKLF		;Delete previous contents from free space
	MOVL	XCFPTR,R4	;Get pointer to start of free space
	MOVL	R4,XCTADR[R2]	;Save as target pointer
	CLRL	R0		;Clear parenthetical counter

XCWRT1:	MOVZBL	(R6)+,R1	;Get a character
XCWRT1A:TSTB	R1		;Check for null (needed for xfer from XCWRPX)
	BNEQ	10$
	BRW	XCWEND		;Done if null
10$:	CMPB	R1,#^A" "	;Some control character?
	BLSS	XCWRT1		;Yes - ignore it
	CMPB	R1,#^A"^"	;Some command?
	BEQL	XCWCMD		;Yes - pursue it
	CMPB	R1,#^A"$"	;Enter (or escape)?
	BNEQ	20$
	MOVB	#^O33,R1	;Yes - set it up
20$:	CMPB	R1,#^A")"	;Maybe the end of a conditional?
	BNEQ	XCWRT2
	TSTL	R0		;If so, end the block
	BLEQ	XCWRT2
	BRW	XCWRPE
XCWRT2:	BSBW	XCTWO1		;Save character
	BRB	XCWRT1		;  and get another

XCWCMD:	MOVZBL	(R6)+,R1	;Get 1st letter of command name
	CMPB	R1,#^A"$"	;Really want a real dollar-sign?
	BEQL	XCWRT2		;Yes - just save it
	CMPB	R1,#^A")"	;  or close paren?
	BEQL	XCWRT2		;Yes - just save it
	CMPB	R1,#^A"^"	;Really want an up-arrow?
	BNEQ	10$
	BSBW	XCTWO1		;Yes - just go save it twice
	BRB	XCWRT2
10$:	CMPB	R1,#^A"9"	;No - got a repeat count?
	BGTR	20$		;No
	BRW	XCWRPT		;Yes - set count up
20$:	MOVL	#^A"^   ",XCTTMP ;Prepare to get command
	MOVAB	XCTTMP+1,R2
	BSBB	XCWGET1		;Put new character in with it
	BSBB	XCWGET		;Get rest of command name
	CMPL	XCTTMP,#^A"^RF " ;Got a roll forward?
	BEQL	XCWRT3		;Yes
	CMPL	XCTTMP,#^A"^RB " ;  or a roll backward?
	BEQL	XCWRT3		;Yes
XCWRT4:	MOVL	XCTTMP,R2	;Get the command name
	MOVL	#<CMDLEN/4>-1,R1 ;Look for command among names
10$:	CMPL	R2,CMDNAM[R1]	;Is this it?
	BEQL	20$		;Yes
	SOBGEQ	R1,10$		;No - keep looking
	BRB	XCWCON		;If not found, see if it's a conditional
20$:	CMPL	R1,#^A" "	;Got a high-numbered command?
	BGEQ	XCWRT5		;Yes
	BRB	XCWRT2		;No - O.K.

XCWRT5:	MOVZBL	#^A"^",R2	;Yes - precede it with an up-arrow
	BSBW	XCTWO2
	BRW	XCWRT2		;Then save command

XCWRT3:	BSBB	XCWGET		;Get rest of command name
	BRB	XCWRT4

XCWGET::MOVZBL	(R6)+,R1	;Get next character
XCWGET1: CMPB	R1,#^A"a"	;Lower case?
	BLSS	10$		;No
	SUBB	#^O40,R1	;Yes - convert to upper
10$:	MOVB	R1,(R2)+	;Save character
	RSB			;Done

;Conditional flags: cond; DO, FR, FC, IF, DW, NOT
;If DO flag, then rest of byte (5 bits) is high order of count
;If FC, FR, or F. then three low flags are: EQU, GRTR, NOT
;Also, 100 is end of a DO block and 101 is end of an IF

XCWCON:	TSTB	R1		;Is it a reset?
	BNEQ	10$		;No
	MOVZBL	#^O77,R1	;Yes - save "^", 77
	BRB	XCWRT5
10$:	MOVZWL	#CMDCLN-1,R1	;Look for a construct among the non-commands
XCWCN0:	MOVL	CMDCON[R1],R3	;Get the command
	BICL	#^XFF000000,R3	;Keep only the first three characters
	BISL	#^X20000000,R3	;Make the fourth character into a space
	CMPL	XCTTMP,R3	;Is this it?
	BEQL	10$		;Yes
	SOBGEQ	R1,XCWCN0	;No - keep looking
	BRW	XCWERR		;Error if not found
10$:	MOVL	CMDCON1[R1],R2	;Get the type flags
	BBS	#6,R2,20$	;Got a conditional?
	BRW	XCWCNX		;No - check further
20$:	CMPL	#^O102,R2	;Got a do-while?
	BNEQ	30$		;No
	MOVL	#^O100,-(SP)	;Yes - stack DO's end character
	BRB	40$
30$:	MOVL	#^O101,-(SP)	;Else stack IF's end character
40$:	MOVZBL	#^A"^",R1	;Start conditional block
	BSBW	XCTWO1
	BITL	#^O30,R2	;Got IF-ROW, -COLUMN, or -COUNTER?
	BEQL	XCWCN1		;No
	BRW	XCWCNF		;Yes - go read condition and number
XCWCN1:	MOVZBL	(R6)+,R1	;Get next character
	CMPB	#^A"^",R1	;"NOT" or character class?
	BEQL	10$
	BRW	XCWCN2		;No - finish off

;Values are: space (5), number (3), alpha (letter) (1), upper case (6),
;alpha-numeric (4), end of line (2), character == NOT space

10$:	MOVZBL	(R6)+,R1	;Get next character
	CMPB	#^A"(",R1	;Got a real open paren?
	BNEQ	20$
	BRB	XCWCN2		;Yes - treat it like the character it is
20$:	CMPB	R1,#^A"A"	;Got some real letter?
	BGEQ	30$		;Yes
	BRW	XCWERR		;No - it's an error from the start
30$:	CMPB	R1,#^A"a"	;Lower case?
	BLSS	40$
	SUBB	#^O40,R1	;Yes - convert to upper
40$:	CMPB	R1,#^A"X"	;Got a 'NOT" flag?
	BNEQ	50$
	BISL	#1,R2		;Yes - set the flag
	BRB	XCWCN1		;Go get the character or class
50$:	CMPB	R1,#^A"L"	;Check class:  Letter?
	BNEQ	60$		;No
	MOVZBL	#1,R1		;Yes - get value
	BRB	130$
60$:	CMPB	R1,#^A"N"	;Numeric?
	BNEQ	70$		;No
	MOVZBL	#3,R1		;Yes - get value
	BRB	130$
70$:	CMPB	R1,#^A"E"	;End of line?
	BNEQ	80$		;No
	MOVZBL	#2,R1		;Yes - get value
	BRB	130$
80$:	CMPB	R1,#^A"A"	;Alpha-numeric?
	BNEQ	90$		;No
	MOVZBL	#4,R1		;Yes - get value
	BRB	130$
90$:	CMPB	R1,#^A"U"	;Upper case?
	BNEQ	100$		;No
	MOVZBL	#6,R1		;Yes - get value
	BRB	130$
100$:	CMPB	R1,#^A"C"	;Any character?
	BNEQ	110$		;No
	BISL	#1,R2		;Yes - set "NOT" and space value
	BRB	120$
110$:	CMPB	R1,#^A"S"	;Space character?
	BNEQ	130$
120$:	MOVZBL	#5,R1		;Yes - set value
130$:	CMPL	R1,#6		;Got a legal value?
	BLEQ	140$		;Yes
	BRW	XCWERR		;No - mistake

140$:	BSBW	XCTWO2		;Save flags
	MOVZBL	#^A"^",R2	;Save class flag
XCWCN2:	BSBW	XCTWO2
	BSBW	XCTWO1		;Save class to look for
	MOVZBL	(R6)+,R1	;Get character after conditional
	BRW	XCWRPX		;Skip "(", if any, and loop

XCWCNX:	MOVZBL	#^A"^",R1	;Save an up-arrow
	BSBW	XCTWO1
	BSBW	XCTWO2		;Then save command
	CMPL	R2,#^O16	;Is it output?
	BEQL	XCWCXO		;Yes - read and set up the string
	CMPL	R2,#^O15	;Is it initialize?
	BEQL	XCWCX1		;Yes
	CMPL	R2,#^O21	;  or do-on-search-failure?
	BEQL	XCWCX1		;Yes - go stack
	CMPL	R2,#^O10	;Is it iterate-counter?
	BEQL	XCWCX1		;Yes
	BRW	XCWRT1		;No - loop
XCWCX1:	MOVL	#^O100,-(SP)	;Yes - stack the end-repeat character
	MOVZBL	(R6)+,R1	;Get next character
	BRW	XCWRPX		;Skip "(", if any, and loop

;Here for the output construct - save characters until a ")"

XCWCXO:	MOVZBL	(R6)+,R1	;Get the "(" after the "^OU"
	CMPB	R1,#^A"("	;Is it really an open paren?
	BEQL	XCWXO1		;Yes
	BRW	XCWERR		;No - error
XCWXO1:	MOVZBL	(R6)+,R1	;Get a character to output
	BNEQ	10$
	BRW	XCWERR		;Error if end of buffer reached
10$:	CMPB	R1,#^A")"	;End of string?
	BEQL	XCWXOE		;Yes - finish off
	CMPB	R1,#^A"$"	;Want an escape?
	BNEQ	20$		;No
	MOVZBL	#^O33,R1	;Yes - get one
20$:	CMPB	R1,#^A"^"	;Want a control character?
	BNEQ	30$		;No
	BSBB	XCWXOC		;Yes - convert the next character
30$:	BSBW	XCTWO1		;Save the character
	BRB	XCWXO1		;And get another

XCWXOE:	MOVZBL	#^O177,R1	;End the string
	BSBW	XCTWO1
	BRW	XCWRT1		;and get more input

XCWXOC:	MOVZBL	(R6)+,R1	;Get the control character
	CMPB	R1,#^A"$"	;Want a real dollar sign?
	BEQL	10$
	CMPB	R1,#^A")"	;  or close paren?
	BEQL	10$		;Yes - go save it
	BICB	#^C^O37,R1	;No - make it a control character
10$:	RSB			;Return to save it

;Here for IF-ROW, -COLUMN or -COUNTER

XCWCNF:	MOVZBL	(R6)+,R1	;Get condition of the if (G, L, E, N)
	CMPB	R1,#^A"a"	;Lower case?
	BLSS	10$
	SUBB	#^O40,R1	;Yes - convert to upper
10$:	CMPB	R1,#^A"G"	;Greater?
	BNEQ	20$		;No
	BISL	#2,R2		;Yes - set flag
	BRB	60$
20$:	CMPB	R1,#^A"L"	;Less?
	BNEQ	30$		;No
	BISL	#3,R2		;Yes - set flags
	BRB	60$
30$:	CMPB	R1,#^A"E"	;Equal?
	BNEQ	40$		;No
	BISL	#4,R2		;Yes - set flag
	BRB	60$
40$:	CMPB	R1,#^A"N"	;Not equal?
	BEQL	50$
	BRW	XCWERR		;No - error
50$:	BISL	#5,R2		;Yes - set flags
60$:	MOVZBL	(R6)+,R1	;Yes - get first digit of row or column
	BRB	XCWRP0		;Read and save number of row or column

XCWRPT:	MOVL	#^O100,-(SP)	;Stack the end-repeat character
	MOVZBL	#^A"^",R2	;Announce start of count
	BSBW	XCTWO2
	MOVZBL	#^O140,R2	;Get flags to indicate a "do"
XCWRP0:	CLRL	R3
	SUBB3	#^O60,R1,R3	;Convert character to a digit
	BGEQ	XCWRP1
	BRW	XCWERR		;Error if not numeric
XCWRP1:	MOVZBL	(R6)+,R1	;Get next character
	CMPB	R1,#^A"9"	;Numeric?
	BGTR	XCWRP2
	CMPB	R1,#^A"0"
	BLSS	XCWRP2		;No - end the count
	SUBL	#^A"0",R1	;Convert to a digit
	MULL	#10,R3		;Shift over the old stuff
	ADDL	R1,R3		;Put the new digit in
	BRB	XCWRP1		;  and get another one

XCWRP2:	BBC	#6,R2,XCWRP3	;Got DO, or FR/FC/F.?
	ROTL	#-7,R3,R3	;No - get high order count bits
	BISB	R3,R2		;Set them in flag word
	ROTL	#7,R3,R3	;Get low bits back
XCWRP3:	BSBB	XCTWO2		;Save flags and high bits
	BSBB	XCTWO3		;Save rest of repeat count
XCWRPX:	INCL	R0		;Count the level
	CMPB	R1,#^A"("	;Got start of the repeat block?
	BNEQ	10$		;No
	BRW	XCWRT1		;Yes - ignore it
10$:	BRW	XCWRT1A		;Else process the character, whatever it is

XCWRPE:	MOVZBL	#^A"^",R1	;Mark the end of the repeat section
	BSBB	XCTWO1
	MOVL	(SP)+,R1	;Get flavor of repeat
	BSBB	XCTWO1		;Store it
	DECL	R0		;Get next character
	BRW	XCWRT1

XCWEND:	CLRB	(R4)+		;End buffer with a null
	MOVB	#-1,(R4)+	;and set end-of-data flag
	MOVL	R4,XCFPTR	;Save it
	MOVL	XCTLVL,R1	;Get overflow flag
	CLRL	XCTLVL		;  and clear it
	TSTL	R1		;Did it overflow?
	BGEQ	10$		;No
	BRW	XCVERR		;Yes - error
10$:	TSTL	R0		;Some conditional not closed?
	BGTR	XCWEN1
	BBSC	#V_FLG,F,20$	;Want to return (to SWHMNY)?
	BRW	XCTEND		;No
20$:	RSB			;Yes


XCWEN1:	MOVL	(SP)+,R1	;Pop save conditionals off stack
	SOBGTR	R1,XCWEN1
	MOVAB	XCNMS1,R1	;Then give error message
	BRW	ERROR
XCWERR:	MOVAB	XCWERM,R1
	BRW	ERROR

XCTWO3:	MOVB	R3,(R4)+	;Output character in R3
	BRB	XCTWOU
XCTWO2:	MOVB	R2,(R4)+	;I mean in R2
	BRB	XCTWOU
XCTWO1:	MOVB	R1,(R4)+	;I mean in R1
XCTWOU:	CMPL	R4,XCTOVF	;Is buffer about to overflow?
	BNEQ	10$		;No - O.K.
	MOVB	#-1,(R4)	;Light end-of-data bit
	BSBB	XCGARB		;Do a garbage collect
	DECL	R4		;Point back to where we belong
	CLRB	(R4)		;Clear the end-of-data bit
	CMPL	R4,XCTOVF	;Was anything recovered?
	BNEQ	10$		;Yes - done
	MOVL	XCTACW,R4	;No - reset current write pointer
	MOVL	XCTADR[R4],R4
	CVTBL	#-1,XCTLVL	;Note that buffer oveflowed
10$:	RSB			;Read rest of buffer
;Subroutine to garbage collect the execute free space
;Returns pointer to lowest free address in R4
;Uses R0-R3

XCGARB:	PUSHR	#^M<R0>		;Save the level counter
	MOVAB	XCTFRE,R4	;Point to start of free space
XCGAR1:	CVTBL	#-1,R0		;Look for smallest pointer - start big
	MOVL	#XBFNUM-1,R3	;Look through all buffer pointers
XCGAR2:	MOVL	XCTADR[R3],R1	;Is this pointer active?
	BEQL	XCGAR3		;Not active
	CMPL	R4,R1		;Yes - is address greater than start of F.S.?
	BGTR	XCGAR3		;Too small - get another
	CMPL	R0,R1		;Is address less than lowest so far?
	BLEQU	XCGAR3		;No - skip it
	MOVL	R1,R0		;Yes - save new one instead
	MOVL	R3,R2		;Save index, too
XCGAR3:	SOBGEQ	R3,XCGAR2	;Loop through all pointers
	CMPL	#-1,R0		;Is there a lowest pointer?
	BNEQ	10$		;Yes
	POPR	#^M<R0>		;Restore the level number
	RSB			;No - return

10$:	MOVL	R0,R3		;Get the address
	MOVL	R4,XCTADR[R2]	;Save new pointer to buffer data
XCGAR4:	MOVB	(R3)+,(R4)+	;Transfer a byte
	CMPB	#^XFF,-1(R4)	;End of the data?
	BNEQ	XCGAR4		;No
	CMPL	R3,R4		;Done moving - was it really a move?
	BEQL	XCGAR1		;No
	CLRB	-1(R3)		;Yes - clear flag in old last byte
	BRB	XCGAR1

XCNMS1:	.ASCIZ	/###Conditional block not closed/
XCWERM:	.ASCIZ	/#########Bad command name/
;Here to write the active buffer
;and then execute it the given number of times

XCTXCT:	BBCC	#V_XSV,F1,10$	;Was a buffer open?
	BSBW	XCTWIP		;Yes - close it
10$:	MOVAB	PARBUF+1,R6	;Point to 2nd character of parameter
	MOVAB	PARBUF,R4	;  and to its start
XCTXC1:	MOVZBL	(R6)+,R1	;Shift execute count left a notch
	CMPB	R1,#^A"0"	;Is this a digit?
	BLSS	XCTXC2
	CMPB	R1,#^A"9"
	BGTR	XCTXC2		;No - got it all
	MOVB	R1,(R4)+	;Yes - save it and get more
	BRB	XCTXC1

XCTXC2:	CMPB	R1,#^A":"	;Does the number end with a colon?
	BEQL	10$
	DECL	R6		;No - back up over the latest character
10$:	CLRB	(R4)+		;End count with a null
	BISL	#M_FLG,F	;Set to get a return from XCTWRT
	BSBW	XCWRT0		;Write into the buffer
	BRW	EXCUT0		;Set up and execute the new buffer

;Here to output the contents of the active buffer in write format

XCTRDW:	CMPL	#PARBUF+1,PARPTR ;Has a name been given?
	BEQL	XCRDWC		;No - read the active buffer
	BISL	#M_FLG,F	;Yes - set up that buffer first
	BSBW	XCTSET
XCRDWC:	BBCC	#V_XSV,F1,10$	;Saving commands?
	BSBW	XCTWIP		;Yes - stop, and wipe out this one
10$:	MOVL	XCTACW,R6	;Point to the active buffer
	BGEQ	20$		;Any there?
	BRW	XCOERR		;No - error
20$:	MOVL	XCTADR[R6],R6	;Yes - get pointer
	MOVAB	PARBUF,R5	;Write to parameter buffer
	MOVB	#^A"W",(R5)+	;Start it off
	BRB	XCRDLT		;Go output the buffer's contents

;Here to output name and contents of active buffer in switch format

XCTRDL:	CMPL	#PARBUF+1,PARPTR ;Has a name been given?
	BEQL	XCRDLC		;No - read the active buffer
	BISL	#M_FLG,F	;Yes - set up that buffer first
	BSBW	XCTSET
XCRDLC:	BBCC	#V_XSV,F1,10$	;Saving commands?
	BSBW	XCTWIP		;Yes - stop, and wipe out this one
10$:	MOVL	XCTACW,R2	;Get name of active execute buffer
	BGEQ	20$		;Any?
	BRW	XCOERR		;No - error
20$:	MOVAB	PARBUF,R5	;Write to parameter buffer
	MOVL	#^A"/X",R1	;Start it off
	JSB	PUTSQ1
	MOVL	XCTADR[R2],R6	;Get pointer to buffer
	MOVAQ	XCTNAM[R2],R1	;Get pointer to name
	TSTL	(R1)		;Is name null?
	BEQL	30$		;Yes
	JSB	PUTSTG		;No - output it
30$:	MOVQ	XCTKEY[R2],R0	;Got a key sequence, too?
	BEQL	40$		;No
	BSBW	XCTRDK		;Yes - output it
40$:	MOVB	#^A":",(R5)+	;Separate name and contents

XCRDLT:	TSTL	R6		;Is there anything in the buffer?
	BNEQ	XCRDL0		;Yes
	BRW	XCREND		;No - go finish off
XCRDL0:	MOVZBL	(R6)+,R1	;Get a character
	BNEQ	10$		;If null, finish off
	BRW	XCREND
10$:	CMPB	R1,#^A"^"	;Special flag?
	BEQL	XCRSPC		;Yes - handle separately
	CMPB	R1,#^A" "	;Control character?
	BLSS	XCRCTL		;Yes - handle separately
	CMPB	R1,#^A"$"	;Want a real dollar sign?
	BNEQ	XCRDL1		;No
	MOVB	#^A"^",(R5)+	;Yes - display it as up-arrow dollar sign
XCRDL1:	MOVB	R1,(R5)+	;Output character
	BRB	XCRDL0		;and get another

XCRSPC:	MOVZBL	(R6)+,R1	;Get character after special flag
	CMPB	R1,#^A"^"	;Want a real up-arrow?
	BNEQ	10$		;No
	MOVB	R1,(R5)+	;Yes - output two arrows to show it's real
	BRB	XCRDL1
10$:	CMPB	R1,#^O77	;Reset command?
	BNEQ	20$		;No
	CLRL	R1		;Yes - get the right code
	BRB	XCRCTL
20$:	BBC	#6,R1,30$	;Got some kind of conditional?
	BRW	XCRRPT		;Yes
30$:	CMPB	R1,#^O40	;Got an exit or continue, or other?
	BLSS	XCRCON		;Yes - get string from conditional table
XCRCTL:	MOVL	CMDNAM[R1],R1	;Get command name
XCRCT1:	BSBW	PUTSPCL		;Output it
	BRB	XCRDL0		;Back to the flow

XCRCON:	MOVL	CMDCON[R1],R1	;Get string from the conditional table
	CMPL	R1,#^A"^OU("	;Got an output command?
	BNEQ	XCRCT1		;No - process it normally
	JSB	PUTSQ1		;Yes - output it
XCRCN1:	MOVZBL	(R6)+,R1	;Get a character of the output string
	CMPB	R1,#^O177	;End of string?
	BEQL	XCRCNE		;Yes - finish off
	CMPB	R1,#^A"$"	;Got a real dollar sign?
	BEQL	10$		;Yes
	CMPB	R1,#^A")"	;or close paren?
	BNEQ	20$		;No
10$:	MOVB	#^A"^",(R5)+	;Yes - precede with an up-arrow
20$:	CMPB	R1,#^O40	;Control character?
	BGEQ	30$
	BSBB	XCRCNC		;Yes - output specially
30$:	MOVB	R1,(R5)+	;Output the character
	BRB	XCRCN1		;and get more

XCRCNE:	MOVB	#^A")",(R5)+	;End string with a close paren
	BRW	XCRDL0		;And get more of the buffer

XCRCNC:	CMPB	R1,#^O33	;Escape?
	BNEQ	10$		;No
	MOVZBL	#^A"$",R1	;Yes - output as a dollar sign
	RSB
10$:	MOVB	R2,(R5)+	;No - precede with an up-arrow
	ADDB	#^O100,R1	;Make the control character visible
	RSB			;Done

XCREND:	SUBL3	#PARBUF,R5,R1	;Get length of the parameter
	CMPL	#TYPSIZ,R1	;Is it too much to type out?
	BGEQ	10$		;No - continue
	MOVAB	PARBUF+TYPSIZ,R5 ;Yes - truncate it
10$:	CLRB	(R5)		;End with a null
	MOVL	R5,PARPTR	;Save type pointer as parameter pointer
	MOVAB	TYPBUF,R5	;Point back to type buffer
	BRW	RECALL		;Pretend this was the last param typed

XCTRDK:	MOVB	#^A",",(R5)+	;Output the separator
	MOVAQ	XCTKEY[R2],R1	;Point to the key sequence
	MOVL	R4,-(SP)	;Save a register
	CLRL	R4		;Clear the byte counter
XCTRK1:	MOVZBL	(R1)+,R0	;Get a character
	BEQL	XCTRK2		;Done if character is null
	CMPB	R0,#^O177	;Got a rubout?
	BEQL	10$
	BITB	#^O140,R0	;  or a control character?
	BNEQ	30$		;No
10$:	MOVB	#^A"^",(R5)+	;Yes - simulate as up-arrow character
	CMPB	R0,#^O177	;  (Rubout as up-arrow "?")
	BEQL	20$
	BISB	#^O100,R0	;Convert to a printable character
	BRB	30$
20$:	MOVB	#^A"?",R0
30$:	MOVB	R0,(R5)+	;Output the character
	ACBB	#8,#1,R4,XCTRK1
XCTRK2:	MOVL	(SP)+,R4	;Restore R4
	RSB			;Then done

;Here if some kind of conditional is found

XCRRPT:	BITB	#^O76,R1	;Ending a repeat block?
	BNEQ	10$
	BRW	XCRRPE		;Yes - do so
10$:	BBC	#5,R1,20$	;Got an iterated do?
	BRW	XCRRPD		;Yes - handle specially
20$:	BITB	#^O30,R1	;Got an if-row, -column, or -counter?
	BEQL	30$		;No
	BRB	XCRRPF		;Yes - handle specially
30$:	BBC	#2,R1,40$	;Got an if-character?
	MOVL	CMDCON+12,R2	;Yes - get its sequence
	BRB	50$
40$:	MOVL	CMDCON+16,R2	;No - get sequence for do-while
50$:	MOVL	R2,R0		;Get ready to output the sequence
	MOVL	R1,R2
	MOVL	R0,R1
	BSBW	PUTSPCL		;Output the sequence
	BBC	#0,R2,60$	;Want a "not" flag?
	MOVL	#^A"^X",R1	;Yes - output it
	BSBW	PUTSPCL
60$:	MOVZBL	(R6)+,R1	;Get character to condition on
	CMPB	R1,#^A"("	;Is it a real open paren?
	BNEQ	70$
	MOVB	#^A"^",(R5)+	;Yes - lead it off with an up-arrow
70$:	MOVB	R1,(R5)+	;Output the condition
	CMPB	R1,#^A"^"	;Want a class of characters?
	BNEQ	XCRRPX		;No
	MOVZBL	(R6)+,R1	;Yes - get class
	MOVB	XCTCLS-1[R1],(R5)+ ;  and output it
XCRRPX:	MOVB	#^A"(",(R5)+	;Start off the repeat block
	BRW	XCRDL0		;and back to the flow

XCRRPF:	BBC	#3,R1,10$	;Got an if-column?
	MOVL	CMDCON+4,R2	;Yes - get its sequence
	BRB	20$
10$:	MOVL	CMDCON,R2	;No - get sequence for if-row
20$:	CMPB	R1,#^O130	;Or is it really an if-counter?
	BLSS	30$
	MOVL	CMDCON+8,R2	;Yes - get the real sequence
30$:	MOVL	R1,-(SP)	;Save the command
	MOVL	R2,R1		;Get the sequence
	BSBW	PUTSPCL		;Output it
	MOVL	(SP)+,R2	;Get the command again
	BICB	#^C7,R2		;Isolate the condition type
	MOVB	XCTREL-2[R2],(R5)+ ;Output the condition
	MOVZBL	(R6)+,R1	;Get row or column number
	BRB	XCRPD1		;Output it and finish off

XCRRPD:	MOVB	#^A"^",(R5)+	;Flag number as a count
	BICL	#^C^O37,R1	;Isolate the high-order bits
	ASHL	#7,R1,R1	;Position them
	MOVZBL	(R6)+,R2	;Get the low order bits
	ADDL	R2,R1		;Build the full number
XCRPD1:	JSB	PUTNUM		;Output it
	BRB	XCRRPX		;Save character and flow

XCRRPE:	MOVZBL	#^A")",R1	;End the repeat block
	BRW	XCRDL1		;Save character and flow

;Here to output list of defined names

XCTNML:	BSBW	SWHBOT		;Set up the bottom line
	MOVL	#XBFNUM-1,R2	;Look for name of buffer
	MOVL	XCTACW,R4	;Get the pointer to the currently active buffer
10$:	MOVQ	XCTNAM[R2],XCTTMP ;Get a name
	BNEQ	30$		;Any?  Yes
20$:	SOBGEQ	R2,10$		;No - loop thru list
	BRW	SWHNPE		;When done, finish off like the switch info
30$:	CMPL	R4,R2		;Else is this the active buffer?
	BNEQ	35$		;No
	MOVB	#^A"*",(R5)+	;Yes - mark it as such
35$:	BICB	#1,XCTTMP+7	;Clear the flag bit in name
	TSTL	XCTTMP		;Is this the null buffer?
	BNEQ	40$		;No
	TSTL	XCTTMP+4
	BNEQ	40$
	MOVQ	#^A"<NUL>",XCTTMP ;Yes - set up null name
40$:	MOVAB	XCTTMP,R1	;Point to the string
	JSB	PUTSTG		;Output name
	MOVZBL	#^A" ",R1	;Separate name from next name
	JSB	PUTSQ1
	BRB	20$		;Get next name

;Subroutine to read the buffer name and find it among XCTNAM
;Returns name in XCTTMP; index in R1.  R1/-1 if not found

XCTRED:	MOVAB	XCTTMP,R6	;Get pointer to target
	MOVAB	PARBUF+1,R2	;  and source of name
	CLRL	XCTTMP		;Clear target - name will have low bit on
	MOVL	#^X01000000,XCTTMP+4
	MOVZBL	#5,R3		;Read at most 5 characters
10$:	MOVZBL	(R2)+,R1	;Get next character
	BEQL	20$		;Done if null
	CMPB	R1,#^A"a"	;Lower case?
	BLSS	15$		;No
	SUBB	#^O40,R1	;Yes - convert to upper
15$:	MOVB	R1,(R6)+	;Store it in target
	SOBGTR	R3,10$		;Decrement count, get another char if needed
20$:	MOVL	#XBFNUM-1,R4	;Now look for name
30$:	MULL3	#8,R4,R3	;Compute the offset
	CMPL	L^XCTNAM(R3),XCTTMP ;Is this it?
	BNEQ	35$		;No
	CMPL	L^XCTNAM+4(R3),XCTTMP+4 ;Check the second half
	BEQL	40$		;This is it
35$:	SOBGEQ	R4,30$		;No - loop
40$:	MOVL	R4,R1		;Return value in the right place
	RSB

;Here to link current execute buffer to the push of a button

XCTBTN:	BBCC	#V_XSV,F1,10$	;Was a buffer open?
	BSBW	XCTWIP		;Yes - close it
10$:	MOVAB	XCBMSG,R1
	JSB	PUTBTM		;Put message on bottom line
	JSB	PROTOF		;Unprotect
	JSB	PUTTYP		;Output all this now

	MOVL	#^O1001,R9	;Note that it's button time
	MOVL	XCTACW,R2	;Point to active execute buffer
	MOVL	XCTADR[R2],R6	;Get pointer to buffer data
	BSBW	XCTKLK		;Clean out old key, if any
	MOVAQ	XCTKEY[R2],R6	;Make a ptr which doesn't use R2
	MOVL	R6,SAVEAC+20	;Save it also for later
	BISL	#^X8000,R2	;Set execute bit
	MOVL	R2,SAVEAC+24	;  and save for SUBTBX
	CLRL	R3		;Set up the character counter

XCTBT1:	$QIOW_S	FUNC=#IO$_TTYREADALL!IO$M_NOECHO,-
		CHAN=TTCHAN,-	;Read a character from the terminal
		P1=TTYBUF,-
		P2=#1
	MOVZBL	TTYBUF,R1	;Get the character
	CMPB	R1,#^A"G"	;End of command?
	BEQL	XCTBT3
	CMPB	R1,#^A"g"
	BEQL	XCTBT3		;Yes - finish off
	INCL	R3		;Already got 8 characters?
	CMPL	R3,#8
	BGTR	XCTBT1		;Yes - ignore it
	MOVB	R1,(R6)+	;No - save character
	BRB	XCTBT1

XCTBT3:	MOVL	SAVEAC+20,R6	;Get pointer to execute command sequence
	TSTL	(R6)		;Got a sequence?
	BEQL	10$
	BSBW	SUBTBX		;Yes - if it's legal change input table
10$:	BRW	XCTEND		;Done
XCBMSG:	.ASCIZ	/Push any command button, then "G": /
;Here to read a file of execute buffer switches
;Current buffers are replaced by these

XCTBSW:	BBCC	#V_XSV,F1,10$	;Was a buffer open?
	BSBW	XCTWIP		;Yes - close it
10$:	MOVAB	PARBUF+1,R6	;Prepare to get the filename
	MOVAB	XCTFIL,R3
	CLRL	R4		;Clear the count
20$:	MOVB	(R6)+,(R3)+	;Transfer a character
	BEQL	30$		;End of the string?  Yes
	INCL	R4		;No - count the character
	BRB	20$		;and loop until finished
30$:	$FAB_STORE FAB=XCT_FAB,FNS=R4 ;Save the length of the filespec
	CLRW	XCT_FAB+FAB$W_IFI
	$OPEN	FAB=XCT_FAB	;Open the file
	BLBS	R0,40$		;Was it successful?
35$:	BRW	XCIERR		;No - error
40$:	$CONNECT RAB=XCT_RAB	;Connect the record stream
	BLBC	R0,35$		;Check for errors
XCTSB0:	BSBW	PIKFRG		;Make sure the pick buffer is not fragged
	MOVL	XCT_XAB+XAB$L_EBK,R1 ;Get end of file block number
	MULL	#^X200,R1	;Compute bytes to read
	CMPL	R1,#PCBSIZ	;Is it too large?
	BLEQ	10$		;No
	MOVL	#PCBSIZ,R1	;Yes - truncate it
10$:	$RAB_STORE RAB=XCT_RAB,RBF=#0,RSZ=#0,UBF=PIKBUF,USZ=R1,BKT=#1
	$READ	RAB=XCT_RAB
	BLBS	R0,20$
	BRW	XCIERR
20$:	$DISCONNECT RAB=XCT_RAB
	$CLOSE	FAB=XCT_FAB
	SUBL3	#1,XCT_XAB+XAB$L_EBK,R1 ;Compute the ending byte address
	MULL	#^X200,R1
	ADDW	XCT_XAB+XAB$W_FFB,R1
	ADDL3	#PIKBUF,R1,END_INI

	MOVL	#XBFNUM-1,R2	;Zero all existing information
30$:	BSBW	XCTKLL
	SOBGEQ	R2,30$
	MOVAB	XCTFRE,XCFPTR	;All buffer space is now free
	MOVAB	PIKBUF,R2	;Point to the buffer
	MOVZWL	PIKBUF,SAVEAC	;Save the byte count
	MOVL	R2,SAVEAC+4	;  and its address

XCTSB1:	MOVL	SAVEAC+4,R2	;Get address and byte count of next line
	MOVL	SAVEAC,R3
	CMPW	#-1,R3		;If byte count = -1, end of file
	BNEQ	20$
10$:	BRW	XWFERR		;End - error - wrong format
20$:	CMPL	R2,END_INI	;Or if at the end of data, call it end of file
	BGEQ	10$
	ADDL	R2,R3		;Compute address of next line
	ADDL	#2,R3
	BBC	#0,R3,30$	;At an odd address?
	INCL	R3		;Yes - step to the next one
30$:	MOVL	R3,SAVEAC+4	;Save it for next time
	MOVZWL	(R3),SAVEAC	;Also save the byte count
	CLRW	(R3)		;Make sure line ends with a null
	ADDL	#2,R2		;Go to the start of the line
XCTSB2:	MOVZBL	(R2)+,R1	;Get a character of the file
	BEQL	XCTSB1		;If null, we're at end of the line
	CMPB	R1,#^A"/"	;Is it a switch?
	BNEQ	XCTSB2		;No - loop until start of switches
XCTSB3:	BSBW	SWHMNY		;Go parse the switches
5$:	MOVL	SAVEAC+4,R2	;Get address & byte count of next line
	MOVL	SAVEAC,R3
	CMPW	#-1,R3		;If byte count = -1, end of file
	BEQL	20$
	CMPL	R2,END_INI	;Or if at end of the data, call it end of file
	BGEQ	20$
	ADDL	R2,R3		;Compute address of the next line
	ADDL	#2,R3
	BBC	#0,R3,10$	;At an odd address?
	INCL	R3		;Yes - step to the next one
10$:	MOVL	R3,SAVEAC+4	;Save it for next time
	MOVZWL	(R3),SAVEAC	;Also save the byte count
	CLRW	(R3)		;Make sure line ends with a null
	ADDL	#2,R2		;Go to the start of the line
	TSTB	(R2)		;Is the first byte blank?
	BEQL	5$		;Yes - this line is empty
	MOVZBL	(R2)+,R1	;Get the first byte of the line
	CMPB	R1,#^A"/"	;Is it another switch?
	BEQL	XCTSB3		;Yes - go process it
20$:	BBSC	#V_FLG,F,30$	;Called by SWHMNX?
	BRW	XCTEND		;No - finish off
30$:	RSB			;Yes - return to it
;Execute, no parameter: if buffer is open, just close it
;If already closed, set to do same number of iterations as last time

EXCNPM::BBCC	#V_XSV,F1,EXCNP1 ;Saving commands?
	MOVL	XCTPTW,R6	;Yes - get pointer to end of buffer
	BSBW	XCTCLO		;Close off the buffer
	JMP	LOOP		;and get a new command

EXCNP1:	MOVL	XCTITR,R3	;Get number of iterations
	MOVL	R3,R4		;Any?
	BLEQ	10$		;No
	BRW	EXCUT1		;Yes - go set it up
10$:	MOVAB	XERNP1,R1	;No - error
	JMP	ERROR
XERNP1:	.ASCIZ	/####Enter number of iterations/

;Get a command from the execute buffer, from LOOP

XCTGET::BBC	#V_JRC,F1,10$	;Is this a journal restore?
	JMP	LOPJRN		;Yes - get the chraacter from the journal
10$:	MOVZBL	@XCTPTR,R1	;Get a command from read buffer
	INCL	XCTPTR
	CMPB	R1,#^A"^"	;Special character flag?
	BNEQ	20$		;No
	BRW	XCTGT1		;Yes - handle specially
20$:	TSTB	R1		;Got a real character?
	BEQL	XCTGT0		;No
	BRW	XCTGTE		;Yes - use it
XCTGT0:	MOVL	XCTACR,XCTPTR	;Else point back to start of buffer
	SOBGTR	XCTNUM,10$	;Else want to do another iteration?
	BRW	XCTDUN		;No - finish off or pop a level
10$:	BSBB	XCTWIS		;Yes - may want to whistle
	BRB	XCTGET		;Go get first command

XCTWIS:	BBS	#V_XBN,F1,XCTSTP ;Don't whistle if displaying the execute
	BITL	#7,XCTNUM	;or if not at multiple of 8th pass
	BNEQ	XCTSTP
	MOVB	#7,ECHBUF	;Output a bell
	$QIOW_S	CHAN=TTCHAN,-
		FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
		P1=ECHBUF,-
		P2=#1
XCTSTP:	JSB	SRCIPT		;Does the user want to abort the execute?
	BLBC	R0,10$		;No
	BRW	XABERR		;Yes - do so
10$:	RSB			;No

XCTGTE::CMPB	R1,#^A" "	;Some control character?
	BGEQ	10$		;No
	JMP	LOOP2		;Yes - handle it
10$:	JMP	ALPNUM		;No - just put it in file or buffer

XCTGT1:	MOVZBL	@XCTPTR,R1	;Get character after the up-arrow
	INCL	XCTPTR
	CMPB	R1,#^A"^"	;Want a real up-arrow?
	BNEQ	10$		;No
	JMP	ALPNUM		;Yes - treat it like a normal character
10$:	CMPB	R1,#^O77	;Got a reset command?
	BNEQ	20$
	CLRL	R1		;Yes - get the real code and dispatch
	JMP	LOOP2
20$:	CMPB	R1,#^O40	;Got an exit or continue, or something?
	BGEQ	30$
	BRW	XCTGCT		;Yes - go handle it
30$:	BBS	#6,R1,40$	;Got the start or end of a repeat?
	JMP	LOOP2		;No - process the command
40$:	BITB	#^O76,R1	;End of a repeat?
	BNEQ	50$		;No
	BRW	XCTGRX		;Yes - go handle it

;Here if some kind of conditional

50$:	BBS	#5,R1,XCGITR	;Got an iterated do?  Yes
	BITB	#^O30,R1	;Got an if-row, -column or -counter?
	BEQL	60$
	BRW	XCGTRC		;Yes
60$:	BSBW	MAKCPT		;No - re-make the character pointer
	MOVZBL	@XCTPTR,R2	;Get character or class to check for
	INCL	XCTPTR
	CMPB	R2,#^A"^"	;Got a class?
	BNEQ	70$		;No
	BISL	#^X4000,R1	;Yes - set class flag
70$:	BSBW	XCTCHK		;See if condition is true
	BBC	#2,R1,80$	;Got an if-character?
	BRW	XCGTIF		;Yes

;Here for do-while

80$:	TSTL	R0		;Was it false?
	BEQL	90$		;No
	BRW	XCTSKB		;Yes - skip the block
90$:	MOVL	R1,R3		;Set up the flags
	BISW	#^X8000,R3	;Set the do-while flag
	BRB	XCGIT1

;Here for iterated DO

XCGITR:	MOVZBL	@XCTPTR,R2	;Get the low bits of repeat count
	INCL	XCTPTR
	BICL	#^C^X1F,R1	;Put the high-order bits in, too
	BISL	R1,R2
	CLRL	R3		;Clear the flags
XCGIT1:	TSTL	R2		;If zero iterations, just skip the block
	BNEQ	10$
	TSTL	R3
	BNEQ	10$
	BRW	XCTSKB
10$:	INCL	XCTLVL		;Drop down a level of nesting
	CMPL	XCTLVL,#1	;Now at level one?
	BEQL	20$		;Yes - don't save
	MOVL	XCTRPR,-(SP)	;Save ptr to start of block
	MOVL	XCTRPT,-(SP)	;Save previous repeat count
20$:	MOVW	R2,XCTRPT	;Save count
	MOVW	R3,XCTRPT+2	;  and flags
	MOVL	XCTPTR,XCTRPR	;Save pointer to start of block
	BRW	XCTGET		;Pick up the first iteration

;Here for IF-ROW, IF-COLUMN, IF-COUNTER, and IF-CHARACTER (XCGTIF)

XCGTRC:	BBS	#3,R1,10$	;Got an if-column?
	MOVL	R7,R3		;No - get row for comparison
	BRB	20$
10$:	MOVL	R8,R3		;Yes - get column for comparison
20$:	MOVZBL	@XCTPTR,R2	;Get value to compare with
	INCL	XCTPTR
	CMPB	R1,#^O130	;Is it really an if-counter?
	BLSS	30$
	MOVL	XCTCTR,R3	;Yes - get the counter
	BRB	40$
30$:	DECL	R2		;It's one too high, since RW & CM are zero-based
40$:	CLRL	R0		;Assume compare will succeed
	BBC	#2,R1,50$	;Want equality?
	CMPB	R3,R2		;Yes - are they equal?
	BEQL	70$		;Yes - return true
	BRB	60$		;No - return false
50$:	CMPB	R3,R2		;No - is parameter greater than value?
	BGTR	70$
60$:	CVTBL	#-1,R0		;No - return false
70$:	BBC	#0,R1,XCGTIF	;Want to negate the result?
	MCOML	R0,R0		;Yes
XCGTIF:	TSTL	R0		;If true, keep going
	BNEQ	XCTSKB
	BRW	XCTGET
XCTSKB:	BSBB	XCTSKP		;Else skip over the block
	TSTB	R1		;End of the buffer?
	BNEQ	10$
	BRW	XCTGT0		;Yes
10$:	BRW	XCTGET		;No - get what comes afterwards

;Here to skip to end of a block and get what follows

XCTSKP:	CLRL	R0		;Clear count of blocks passed over
10$:	MOVZBL	@XCTPTR,R1	;Skip over negative "IF" block
	INCL	XCTPTR
	TSTB	R1		;Done if null
	BEQL	20$
	CMPB	R1,#^A"^"	;Start of end of a block?
	BNEQ	10$		;No - keep skipping
	MOVZBL	@XCTPTR,R1	;Yes - get following character
	INCL	XCTPTR
	BITB	#^O76,R1	;End of a block?
	BNEQ	30$		;No - maybe drop a little deeper
	SOBGEQ	R0,10$		;Yes - loop if not the right end
20$:	RSB			;Else done

30$:	BBC	#6,R1,10$	;If it's a command
	CMPB	R1,#^A"^"	;  or want a real up-arrow,
	BEQL	10$		;  then skip over it
	INCL	R0		;Else drop a level and keep skipping
	BRB	10$

;Here for an exit or continue construct

XCTGCT:	CMPB	R1,#7		;Got an exit or continue?
	BLEQ	10$
	SUBL	#8,R1		;No - dispatch to handle it
	MOVL	XCTJMP[R1],R1	;Get address to dispatch to
	JMP	(R1)		;  and do it
10$:	BNEQ	20$		;Want to end this iteration (^XX)?
	BRW	XCTGTX		;Yes - pop stack and do so
20$:	MOVL	R1,R2		;No - save type of construct
	MOVZBL	@XCTPTR,R0	;Get the ")" that follows the command
	INCL	XCTPTR
	BSBB	XCTSKP		;Skip to the end of the block
	TSTB	R1		;At end of the buffer?
	BNEQ	30$
	BRW	XCTGT0		;Yes
30$:	CMPB	R1,#^O100	;Is this an IF construct?
	BEQL	40$
	BRW	XCTGET
40$:	CMPB	R2,#6		;No - want to exit the block (^XB)?
	BEQL	XCTGRX		;No - continue the block
	BRB	XCTGXP		;Exit the block
;Here if end of a block - ignore if ^A (IF); loop or exit if ^@ (^DO)

XCTGRX:	CMPB	R1,#^O100	;End of DO block?
	BEQL	10$
	BRW	XCTGET		;No - ignore it
10$:	BBCC	#V_XCI,F1,20$	;Stop initializing?
	BRW	XCTGXI		;Yes - just de-bump level
20$:	BSBW	XCTSTP		;See if user wants to stop
	TSTL	XCTRPT		;Got a do-while?
	BLSS	XCTGXW		;Yes - check character at cursor
	SOBGTR	XCTRPT,XCTGXR	;No - do-itr - de-bump counter - done?  No
	BRB	XCTGXP		;Yes - pop back a level
XCTGXR:	MOVL	XCTRPR,XCTPTR	;Point to start of block
	BRW	XCTGET		;  and take commands from there

XCTGXW:	BSBW	MAKCPT		;Re-make character pointer
	MOVZWL	XCTRPT,R2	;Get character or class to check for
	MOVZWL	XCTRPT+2,R1	;Get flags
	BBC	#14,R1,10$	;Got a class?
	CLRL	R0		;Yes - go check the condition
	BSBW	XTCHC1
	BRB	20$
10$:	BSBW	XCTCHK		;No - check the condition
20$:	TSTL	R0		;True?
	BEQL	XCTGXR		;Yes - just do the block; else pop level

XCTGXP:	TSTL	XCTLVL		;Skip if the stack is clear
	BEQL	10$
	DECL	XCTLVL		;At bottom level?
	BLEQ	10$		;Yes - just keep going
	MOVL	(SP)+,XCTRPT	;Else get save count (or comparator)
	MOVL	(SP)+,XCTRPR	;  and initial repeat pointer
10$:	BRW	XCTGET		;And take commands from there

XCTGTX:	TSTL	XCTLVL		;Skip if the stack is clear
	BEQL	15$
10$:	SOBGTR	XCTLVL,20$	;Pop everything off the stack - any left?
15$:	BRW	XCTGT0		;No - do another iteration
20$:	MOVL	(SP)+,XCTRPT	;Yes - pop it off
	MOVL	(SP)+,XCTRPR
	BRB	10$		;  and try again

XCTGXI:	CLRL	XCTLVL		;End of XCT init - clear level
	MOVL	XCTACR,XCTINI	;Save real starting pointer
	MOVL	XCTPTR,XCTACR	;Save current pointer as starting pointer
	BRW	XCTGET		;Read more of buffer

;Dispatch for routines to handle special execute constructs

XCTJMP:	.ADDRESS XCTG10		;(10) Iterate-counter
	.ADDRESS XCTG11		;(11) Clear-counter
	.ADDRESS XCTG12		;(12) Bump-counter
	.ADDRESS XCTG13		;(13) De-bump-counter
	.ADDRESS XCTG14		;(14) Use-counter
	.ADDRESS XCTG15		;(15) Initialize
	.ADDRESS XCTG16		;(16) Output
	.ADDRESS XCTG17		;(17) Save-counter
	.ADDRESS XCTG20		;(20) No-display
	.ADDRESS XCTG21		;(21) Do-on-search-error

XCTG21:	BSBW	XCTSKP		;Not a search error, so just skip this block
	BRW	XCTGET		;Done

XCTG20:	BBCC	#V_XBN,F1,10$	;Turn off button flag - on?
	BISL	#M_XCT,F1	;Yes - turn oon normal execute flag
10$:	BRW	XCTGET		;Done

XCTG17:	BBC	#V_ENT,F,XCG17A	;Is there a parameter?
	MOVL	XCTSNM,R4	;Yes - get last time's nominal
	MOVL	R4,PARG1
	BSBW	PEEL.1		;Read new parm, if any
	BBC	#V_CMV,F,10$	;Cursor movement?
	MOVL	PARG2,R4	;Yes - get change in columns
	BRB	20$
10$:	MOVL	PARG1,R4
20$:	MOVL	R4,XCTSNM	;Save as new nominal
	JSB	ERASPM		;Fix up the screen
XCG17A:	MOVL	XCTSNM,XCTCTR	;Save new counter value
	BRW	XCTGET		;Done

XCTG16:	MOVZBL	@XCTPTR,R1	;Get a character to output
	INCL	XCTPTR
	CMPB	R1,#^O177	;End of string?
	BEQL	XCG16A		;Yes - output it and finish off
	MOVB	R1,(R5)+	;No - save the character
	BRB	XCTG16		;  and get another

XCG16A:	JSB	PUTTYP		;Output the string
	BRW	XCTGET		;and read more of the buffer

XCTG15:	BISL	#M_XCI,F1	;Initialize - set flag
	INCL	XCTLVL		;Drop down a level
	BRW	XCTGET		;Read more of buffer

XCTG14:	MOVL	XCTCTR,R1	;Get counter
	BGEQ	10$		;Is it negative?
	CLRL	R1		;Yes - set to zero
10$:	MOVL	R5,PARPTR	;Save output pointer
	MOVAB	PARBUF,R5
	JSB	PUTNUM		;Put number in parameter buffer
	MOVL	R5,R1		;Swap parameter and output pointers
	MOVL	PARPTR,R5
	MOVL	R1,PARPTR
	BICL	#M_PST,F1	;Indicate that a parameter has been entered
	BRW	XCTGET		;Read more of buffer

XCTG13:	DECL	XCTCTR		;De-bump counter
	BRW	XCTGET

XCTG12:	INCL	XCTCTR		;Bump counter
	BRW	XCTGET

XCTG11:	CLRL	XCTCTR		;Clear the counter
	BRW	XCTGET

XCTG10:	MOVL	XCTCTR,R2	;Get counter
	BGEQ	10$		;Negative?
	CLRL	R2		;Yes - use zero
10$:	CLRL	R3		;Clear the flags too
	BRW	XCGIT1		;Use it with an iterated DO

;Subroutine to check to see if character in R3 matches char or class in R2

XCTCHK:	CMPB	R2,#^A"^"	;Want a class?
	BEQL	XCTCHC		;Yes - handle separately
	CMPB	R3,R2		;No - got the right character?
	BNEQ	XCTCHF		;No
XCTCHT:	CLRL	R0		;Yes - flag as true
	BRB	XCCHND
XCTCHF:	CVTBL	#-1,R0		;No - flag as false
XCCHND:	BBC	#0,R1,10$	;Got .NOT. flag?
	MCOML	R0,R0		;Yes - return the opposite result
10$:	RSB			;Done

XCTCHP:	MOVL	SAVEAC,R1	;Restore saved R1
	BRB	XCCHND		;  and go complement flag if needed

XCTCHC:	MOVZBL	@XCTPTR,R2	;Get class to check for
	INCL	XCTPTR
XTCHC1:	CMPB	R2,#2		;End of line?
	BEQL	XCTCHE		;Yes
	CMPB	R2,#3		;Number?
	BEQL	XCTCHN		;Yes
	CMPB	R2,#5		;Space?
	BEQL	XCTCHS		;Yes

	CMPB	R3,#^A"A"	;Check for upper, letter or alpha-num
	BLSS	XCTCHM		;Not letter - may be number
	CMPB	R3,#^A"Z"	;Letter?
	BLEQ	XCTCHT		;Yes - return true
	CMPB	R2,#6		;Looking for upper case?
	BEQL	XCTCHF		;Yes - return false
	CMPB	R3,#^A"a"	;No - is it lower case?
	BLSS	XCTCHF		;No - return false
	CMPB	R3,#^A"z"
	BLEQ	XCTCHT
	BRB	XCTCHF		;Yes - return true

XCTCHM:	CMPB	R2,#4		;Not alpha - want alpha-num?
	BNEQ	XCTCHF		;No - return false
XCTCHN:	CMPB	R3,#^A"0"	;Check for number - is it?
	BLSS	XCTCHF
	CMPB	R3,#^A"9"
	BGTR	XCTCHF		;No - return false
	BRB	XCTCHT		;Yes - return true

XCTCHS:	BBC	#1,R1,XCCHSS	;Checking for a character?
	CMPB	R3,#^O15	;Yes - end of line?
	BNEQ	20$
10$:	BRB	XCTCHT		;Yes - return true (negated)
20$:	CMPB	R3,#^A" "	;No - space or tab?
	BEQL	10$		;Yes
	CMPB	R3,#9
	BEQL	10$		;Yes
	BRB	XCTCHF		;Otherwise return false

XCCHSS:	CMPB	R3,#^A" "	;Space?
	BEQL	XCCHE0		;Yes - make sure it's not trailing
	CMPB	R3,#9		;Tab?
	BEQL	XCCHE0		;Yes
	BRW	XCTCHF		;No - return false

XCCHE0:	MOVL	R1,SAVEAC	;Save R1
	PUSHAL	XCTCHP		;Save restore-R1 address
	BISL	#1,R1		;Look for non-end of line
XCTCHE:	MOVL	CHRPTR,R4	;Get cursor pointer
10$:	CMPB	R3,#^O15	;At end of line?
	BNEQ	20$		;No
	BRW	XCTCHT		;Yes - return true
20$:	CMPB	R3,#^A" "	;No - got a (maybe trailing) space?
	BEQL	30$		;Yes - skip it
	CMPB	R3,#9		;How about a (maybe trailing) tab?
	BEQL	30$
	BRW	XCTCHF		;No - return false
30$:	MOVZBL	(R4)+,R3	;Yes - get next character
	BEQL	30$		;Ignore nulls
	BRB	10$		;Go check the real character

;Here at end of execute buffer - finish off or pop up a level

XCTDUN:	MOVL	XCTPSV,R1	;Got a saved pointer?
	BEQL	XCTDN1		;No - really done
	MOVL	XCTPSV,XCTPTR	;Make saved pointer active again
	CLRL	XCTPSV		;Zero the saved pointer
	MOVL	XCTASV,XCTACR	;Set up saved starting pointer
	MOVL	XCTISV,XCTITR	;Set up nominal saved iterations
	MOVL	XCTNSV,XCTNUM	;Set up saved iterations, too
	BRW	XCTGET		;  and continue with them

XCTDN1:	BBC	#V_XBN,F1,10$	;Did user push a special button?
	BISL	#M_FLG,F	;Yes - remember it
10$:	MOVL	XCTASV,R1	;Get the saved starting pointer
	CLRL	XCTASV		;and clear it
	TSTL	R1		;Is there one?
	BEQL	XCTDN2		;No
	MOVL	#XBFNUM-1,R2	;Yes - find its index
20$:	CMPL	R1,XCTADR[R2]	;Is this it?
	BEQL	30$		;Yes
	SOBGEQ	R2,20$		;No - try next one
30$:	MOVL	R2,XCTACW	;Save index as the actual active buffer
XCTDN2:	MOVC3	#SAVPML,SAVPRM,PARAMS ;Restore all parameters
	MOVAB	TYPBUF,R5	;Restore the type buffer pointer
	BICL	#SWFLGS,F	;Restore previous flag settings
	BICL3	#^C<SWFLGS>,SAVFGS,R1
	BISL	R1,F
	BICL	#SWFLGS2,F1	;Restore previous F1 settings
	BICL3	#^C<SWFLGS2>,SAVFGS+4,R1
	BISL	R1,F1
	MOVL	XCTINI,R1	;Is there an initial pointer?
	BEQL	10$
	MOVL	R1,XCTACR	;Yes - set it up as starting pointer
10$:	CLRL	XCTINI		;Clear initial pointer
	BICL	#M_ENT,F	;Don't allow the user to leave enter in effect
	BBCC	#V_FLG,F,20$	;Did user push a special button?
	JMP	LOOP		;Yes - screen is already OK
20$:	JMP	DISALL		;No - re-display screen and loop

;Execute error messages

XSXERM:	.ASCIZ	/####Execute stacked too deeply/
XSXERR:	MOVAB	XSXERM,R1
	CLRL	XCTPSV
	JMP	ERROR
XSCERM:	.ASCIZ	/Counter must have a numeric parameter/
XSCERR:	MOVAB	XSCERM,R1
	JMP	ERROR
XWFERM:	.ASCIZ	/####Bad format for execute file/
XWFERR:	MOVAB	XWFERM,R1
	JMP	ERROR
XCIERM:	.ASCIZ	/#######Execute file not found/
XCIERR:	MOVAB	XCIERM,R1
	JMP	ERROR
XCXERM:	.ASCIZ	/######Current buffer is empty/
XCXERR:	MOVAB	XCXERM,R1
	JMP	ERROR
XCOERM:	.ASCIZ	/########No buffer is active/
XCOERR:	MOVAB	XCOERM,R1
	JMP	ERROR
XCSERM:	.ASCIZ	/#No free buffers - kill something/
XCSERR:	MOVAB	XCSERM,R1
	JMP	ERROR
XCEERM:	.ASCIZ	/####Start or end of file reached/
XCEERR::MOVAB	XCEERM,R1
	MOVAB	TYPBUF,R5
	JMP	ERROR
XCKERM:	.ASCIZ	/####Can't kill - name not found/
XCKERR:	MOVAB	XCKERM,R1
	JMP	ERROR
XCTERM:	.ASCIZ	/Execute buffer is about to overflow/
XCTERR::CLRB	@XCTPTW		;End buffer with a null
	BICL	#M_XSV,F1	;Stop saving
	MOVAB	XCTERM,R1
	JMP	ERROR
XCVERM:	.ASCIZ	/#####Execute buffer overflowed/
XCVERR:	MOVL	XCTACW,R1	;Clear overflowed buffer
	MOVL	XCTADR[R1],R1
	CLRL	(R1)
	MOVAB	XCVERM,R1
	JMP	ERROR
XABERM:	.ASCIZ	/#########Execution stopped/
XABERR:	MOVAB	XABERM,R1
	JMP	ERROR

GLOB		;Define the global symbols
.END