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