Google
 

Trailing-Edge - PDP-10 Archives - cust_sup_cusp_bb-x130c-sb - 10,7/unscsp/sos/sosfas.mac
There are 3 other files named sosfas.mac in the archive. Click here to see a list.
	TITLE	SOSFAS - Find and Search commands
; 	-----------------------------
; 
; This file contains the processing for Find and Substitute:
; 1. The find (F) command
; 2. The substitute (S) command
; 3. Common routines for searching files
; 
 
	SEARCH	SOSTCS
	$INIT
 
	SUBTTL	THE FIND (F) COMMAND
 
SEARCH::TLZ	FL,ASSMF	; Clear all flags
	SETZM	SRCNT		; Start with zero
	SETZM	CSW##		; Clear alter command string switch
	SETZM	ZSW0		; CLEAR SWITCHES
	MOVE	T1,[ZSW0,,ZSW0+1];Setup for blt
	BLT	T1,ZSW1		;And zero them
	MOVE	T1,[2,,[ASCIZ/F*/]]
	MOVEM	T1,FNDPMT	; Save find prompt
	TLO	FL2,L2.NAB	; Allow rubout of first altmode
	MOVE	T1,[POINT 9,SRBUF]; Set up byte pointer
	MOVEI	T3,SRPNT	; And pointer to byte pointer table
	PUSHJ	P,SSTRNG	; Get a search string
	JRST	[SKIPN SRPNT	; Was string set?
		NERROR	NSG	; No, tell him
		CAIN	C,12
		JRST	ASSMD1	; Special continue mode
		JRST	.+1]	; Yes, use old one
	TLZ	FL,NUMSRF!ALTSRF!EXCTSR; Clear flags
	SKIPE	EXACTF		; All searches to be exact?
	TLO	FL,EXCTSR	; Yes, set the exact bit
	PUSHJ	P,SCAN##	; Check for what comes after
	TRNN	FL,TERMF	; If terminator
	CAIN	C,","		; Or ,
	JRST	ASSMDT		; Set up limits specially
	CAIE	C,"!"
	CAIN	C,":"
	JRST	ASSMDT		; Let him specify 2nd half of range
	PUSHJ	P,GET2##	; Else call usual limit routine
SRC4:	MOVE	T1,HILN 	; Save end of range
	MOVEM	T1,SRHILN
	MOVE	T1,HIPG
	MOVEM	T1,SRHIPG
;Here to scan for switches in any order
SRCS1:	CAIE	C,","		;Something there
	  JRST	SRC1		;No
	PUSHJ	P,SCAN		;Yes--See what it is
	TRNN	FL,NUMF		;A NUMBER?
	  JRST	SRCS4		;No
	MOVEM	T2,SRCNT	;Yes--Save count
	JRST	SRCS3		;And continue
SRCS4:	TRNN	FL,IDF		;An indent?
	  JRST	SRCS2		;No
	MOVS	T1,ACCUM	;Yes--Get ident
	MOVE	T2,[-LNFSWT,,FSWT];Point to switches
	PUSHJ	P,DOSW		;Handle them
	  NERROR ILC		;No match
	JRST	SRCS3		;And continue
SRCS2:	SKIPN	NEWCMD		;See if in /compatibile mode
	 CAIE	C,"-"		;Yes--See if find not
	  JRST	SRCS2A		;No
	SETOM	FNSW		;Yes--Flag find not
	JRST	SRCS3		;And continue
SRCS2A:	CAIE	C,"*"		;Special check for infin repeate
	  NERROR ILC		;No--You lose
	HRLOI	T1,377777	;Yes--Set for lots
	MOVEM	T1,SRCNT	;Save
SRCS3:	PUSHJ	P,SCAN		;Read next token
	JRST	SRCS1		;And process
;End of switch scanning
SRC1:	TLNN	FL,ALTSRF	;Alter this linn
	 SKIPGE DSW		;Or delete?
	  TRNN FL,READOF	;Yes--See if readonly
	   CAIA			;No
	    NERROR IRO		;Yes--Illegal
	SKIPGE	MSW		;See if mark
	 TRNN	FL,READOF	;Yes--See if readonly
	  CAIA			;No
	   NERROR IRO		;Yes--Illegal
	SKIPGE	MSW		;See if mark
	 SKIPL	DSW		;And delete
	  CAIA			;No
	   NERROR ILC		;Yes--Illegal
	PUSHJ	P,CKTRMF##	; Make sure it terminates correctly
	SKIPE	CSW##		; Command alter mode?
	  PUSHJ	P,ACSTR##	; Yes--Get alter command string
SRCH1A: MOVEI	T1,SRPNT	; Get pointer to strings
	PUSHJ	P,CODSR 	; And generate code
	MOVE	T1,LOPG 	; Get set to hunt it
	MOVEM	T1,SRPG 	; Flag to say if we should print page
	TLO	FL2,NORENT	; Play it safe - no arbitrary reentering
	PUSHJ	P,FINDL1##	; Find first line of range
	TRZ	FL,LINSN	; No lines yet
	SETZM	FNDFLG		; No matches either
ONSRC:: PUSHJ	P,ONMOV##	; Check range
	  JRST	ENDSRC		; Done
	TLZE	FL,ASSMF	; First time and want .+1?
	JRST	[CAME T1,LOLN	; Is there exact match?
		JRST	.+1	; No, this is .+1
		AOS	SVCNT	; Pretend we didnt see it
		JRST	SRNXT]	; And take next
	TRO	FL,LINSN	; We saw one
	CAMN	T1,PGMK 	; Pages are special
	JRST	SRNXT		; Proceed
	MOVEI	T2,SRPNT	; Pointer to strings
	PUSHJ	P,COMTST	; Go search this line
	  JRST	SRNXT		; Loser
	SKIPE	FNSW		;See if find not
	  MOVEI	T3,0		;Yes--Clear alter count
	AOS	FNDFLG		; Found!
	MOVEM	T3,SVCCNT	; Save away the character count
	MOVE	T2,CPG		; Get current page
	CAME	T2,SRPG 	; And see if we should print it
	 SKIPE	SLSW		;But first see if silence
	  CAIA
	   PUSHJ P,PGPRN##	; Yes
	MOVE	T2,CPG		; Now set it as current
	MOVEM	T2,CPGL
	MOVEM	T2,SRPG 	; Also reset flag
	MOVE	T2,(PNTR)	; Also set line
	MOVEM	T2,CLN
	TLNE	FL,ALTSRF	; Are we going to edit?
	JRST	SRCALT		; Yes, go set things up
	SKIPE	SLSW		;Silence?
	  JRST	SRNXTC		;Yes--No print
	TLNE	FL,NUMSRF	; Do we want only line numbers?
	JRST	SRCNUM		; Yes
	PUSHJ	P,OUTLIN##
SRNXTC:	SKIPE	DSW		;See if delete
	  JRST	SRCDEL		;Yes--Go delete
	SKIPE	MSW		;See if mark
	  JRST	SRCMAR		;Yes--Go mark
	SOSG	SRCNT		; Have we found enough
	JRST	SRFND		; Yes, give up (we have seen at least one)
SRNXT:	PUSHJ	P,FINDN##	; Get next line to look a
	JRST	ONSRC
 
SRCNUM: MOVE	T1,(PNTR)	; Print sequence number
	MOVEM	T1,PRNTO1
	OUTSTR	PRNTO1
	JRST	SRNXTC		; And go
 
ENDSRC: TRZN	FL,LINSN	; Did we see one?
	NERROR	NLN		; Null range
SRFND:	SKIPE	T2,FNDFLG	; Find any?
	  JRST	SRFND1		;Yes!
	RERROR	SRF		; No: tell him
	JRST	COMND##		;And return
SRFND1:	SKIPE	DSW		;See if delete
	 SKIPN	INFFLG##	;Yes--See if /noinform
	  CAIA			;No
	   CAIA			;Yes--Dummy totals
	    SKIPE TSW		;See if totals wanted
	     CAIA		;Yes
	      JRST COMND##	;No--Just return
	PUSHJ	P,DPRNT##	;Print number
	OUTSTR	[ASCIZ/ line/]	;Give it
	SOSE	FNDFLG		;Just 1?
	  OUTCHR ["s"]		;No--Fix it up
	MOVEI	T1,[ASCIZ/ found/];Assume just find
	SKIPE	DSW		;See if delete
	  MOVEI	T1,[ASCIZ/ deleted/];Yes
	SKIPE	MSW		;See if mark
	  MOVEI	T1,[ASCIZ/ marked/];Yes
	TLNE	FL,ALTSRF	;See if alter
	  MOVEI	T1,[ASCIZ/ altered/];Yes
	OUTSTR	(T1)		;Type
	OUTSTR	[BYTE (7) 15,12];Finish off
	JRST	COMND##		;And return
 
 
SRCDEL:	MOVE	T1,(PNTR)	;Get current line
	PUSHJ	P,DODEL##	;Delete it
	PUSHJ	P,FINDN1##	;Find next line
	JRST	FNDEND		;And continue onward

SRCMAR:	PUSHJ	P,MARK1##	;Mark the page
	PUSHJ	P,FINDN##	;Find next line
	JRST	FNDEND		;And continue

SRCALT:	MOVEI	T5,[SKIPLE T2,SVCCNT 	; Get count 
		    PJRST ALTSP##
		    POPJ P,]		; Space over correctly
	PUSHJ	P,ALTLIN##
	JRST	LEVINS##	; He said altmode
	PUSHJ	P,INSED##	; Insert it
	PUSHJ	P,FINDN
FNDEND:	SOS	SAVEN		; Decrement save counter
	SOSG	SRCNT
	JRST	SRFND		; DONE
	JRST	ONSRC		; Go on

ASSMD1: TROA	FL,CNTF 	; Mark as keep end of range
ASSMDT: TRZ	FL,CNTF 	; Just in case
	TLO	FL,ASSMF	; We assume .+1
	MOVE	T1,CLN		; Set things up for . to infinity
	MOVEM	T1,LOLN
	MOVEM	T1,HILN 	; As good as anything with the page we will
	MOVE	T1,CPGL 	; Use
	MOVEM	T1,LOPG
	TRZE	FL,CNTF 	; Keep end?
	JRST	NOSPC		; Yes
	CAIE	C,":"		; If a : or !
	CAIN	C,"!"
	JRST	HALFSP		; Get the second half (.+1 to given)
	MOVSI	T1,377777	; Get a large page
	MOVEM	T1,HIPG
	JRST	SRC4		; Back into things

HALFSP: MOVEM	T1,HIPG 	; Set top as /.
	PUSHJ	P,GET2HF##	; Get the second half
	JRST	SRC4		; And go

NOSPC:	MOVE	T1,SRHIPG
	MOVEM	T1,HIPG 	; Put back end
	MOVE	T1,SRHILN
	MOVEM	T1,HILN
	JRST	SRCH1A

;Call: t1=sixbit
;	T2=-LEN,,TABLE

DOSW:	HLRZ	T3,(T2)		;Get sixbit
	CAIE	T1,(T3)		;Match?
	  AOBJN	T2,DOSW		;No--Loop
	JUMPG	T2,CPOPJ##	;Error if not found
	HRRZ	T3,(T2)		;Get routine
	XCT	(T3)		;Do it
	JRST	CPOPJ1		;And return

FSWT:	'A  ',,[TLO FL,ALTSRF]	;Alter this line
	'C  ',,[PUSHJ P,DOCSW]	;Alter this line with command string
	'D  ',,[SETOM DSW]	;Delete this line
	'E  ',,[TLO FL,EXCTSR]	;Exact case match
	'L  ',,[TLO FL,NUMSRF]	;Print line number only
	'M  ',,[SETOM MSW]	;Insert page mark before this line
	'N  ',,[PUSHJ P,DOFN]	;Find not
	'S  ',,[SETOM SLSW]	;Print nothing
	'T  ',,[SETOM TSW]	;Print totals
	'U  ',,[TRO FL2,SUPN]	;Print line w/o line number
LNFSWT==.-FSWT

DOCSW:	SETOM	CSW
	TLO	FL,ALTSRF
	POPJ	P,

DOFN:	SKIPN	NEWCMD		;Compatible mode?
	 TLOA	FL,NUMSRF	;Yes--Like "l"
	  SETOM	FNSW		;No--Set find not
	POPJ	P,		;And return
	SUBTTL	THE SUBSTITUTE (S) COMMAND
 
; Substitute a string
 
SUBST:: TLZ	FL,ASSMF	; Do not assume anything yet
	SETZM	PARCNT		; Zero count for sequential partials
	MOVE	T1,[2,,[ASCIZ/S*/]]
	MOVEM	T1,FNDPMT	; Save for multiple string prompt
	TLO	FL2,L2.NAB	; Allow rubout of first altmode
	HRLOI	T1,377777	; Set for lots
	MOVEM	T1,RPCNT
	MOVE	T1,[POINT 9,R1BUF]
	MOVEI	T3,R1PNT
	PUSHJ	P,SSTRNG	; This code is just like search
	JRST	[SKIPE R2PNT	; Both strings must have been given
		SKIPN	R1PNT
		NERROR	NSG	; Else there has been an error
		CAIN	C,12	; Check for just a crret
		JRST	ASBMD1	; And do a continue
		JRST	NOSTR]	; There is no string
	MOVE	T1,[POINT 9,R2BUF]; Get string to replace by
	MOVEI	T3,R2PNT
	PUSHJ	P,SSTRNG
	JRST	[CAIN C,12
		JRST	[PUSH P,[.]	; Set up return
			JRST	RETSTR]	; And read more (first null)
		MOVEM	T1,R2PNT	; Null string means delete
		MOVEI	T2,0	; So set a real null string
		IDPB	T2,T1
		JRST	.+1]
	SUBI	T3,R2PNT	; Generate number of replacement strings
	MOVEM	T3,RSTRCT	; And save for later
NOSTR:	TLZ	FL,NOPRN!DECID!EXCTS1; Clear flags
	SETZM	TSW		;Clear total switch
	SETZM	LSW		;And print line # only switch
	SKIPE	EXACTF		; All searches exact?
	TLO	FL,EXCTS1	; Yes, set the exact mode bit
	PUSHJ	P,SCAN		; And start looking for more junk
	TRNN	FL,TERMF	; Nothing
	CAIN	C,","		; Or just a comma
	JRST	ASBMDT		; Then search from here to eternity
	CAIE	C,"!"		; He only wants to give a stopping point
	CAIN	C,":"
	JRST	ASBMDT
	PUSHJ	P,GET2		; Go get a range
REP4:	MOVE	T1,HILN 	; Save for possible continue
	MOVEM	T1,RPHILN
	MOVE	T1,HIPG
	MOVEM	T1,RPHIPG
;Here to scan for switches in any order
REPS1:	CAIE	C,","		;Something there
	  JRST	REP1		;No
	PUSHJ	P,SCAN		;Yes--See what it is
	TRNN	FL,NUMF		;A NUMBER?
	  JRST	REPS4		;No
	MOVEM	T2,RPCNT	;Yes--Save count
	JRST	REPS3		;And continue
REPS4:	TRNN	FL,IDF		;An indent?
	  NERROR ILC		;No--Lose
	MOVS	T1,ACCUM	;Yes--Get ident
	MOVE	T2,[-LNSWT,,SLSWT];Point to switches
	PUSHJ	P,DOSW		;Handle them
	  NERROR ILC		;No match
REPS3:	PUSHJ	P,SCAN		;Read next token
	JRST	REPS1		;And process
;End of switch scanning
REP1:	PUSHJ	P,CKTRMF	; Make sure it terminates correctly
REP1A:	TLO	FL2,NORENT	; Don't allow arbitrary reenter from here on
	MOVEI	T1,R1PNT	; Get the search code
	PUSHJ	P,CODSR
	MOVE	T1,LOPG
	MOVEM	T1,RPPG 	; For print outs
	PUSHJ	P,FINDLO##	; Get first line of range
	TRZ	FL,LINSN	; Nothing yet
	SETZM	FNDFLG		; No how
	TLNE	FL2,PDECID
	TLO	FL,DECID	; Set if perm mode on
ONREP:	PUSHJ	P,ONMOV 	; Check for still in range
	JRST	ENDREP		; Finally
	TLZE	FL,ASSMF	; Should we start with .+1
	JRST	[CAME T1,LOLN	; Is it the one we asked for
		JRST	.+1	; No, use it
		AOS	SVCNT	; Just in case a ! type of range
		JRST	RPNXT]
	TRO	FL,LINSN	; This line is good enough
	CAMN	T1,PGMK
	JRST	RPNXT		; Go take care of page marks
	MOVEI	T2,R1PNT	; Do the search
	PUSHJ	P,COMSRC
	JRST	RPNXT
	AOS	FNDFLG		; Found
	SKIPGE	T3		; Protect agains special killing tab
	IBP	ALTP
	PUSH	P,T3		; Save count of how far into line
	MOVE	T3,(PNTR)	; Set up current line
	MOVEM	T3,CLN
	MOVE	T3,CPG
	MOVEM	T3,CPGL
	MOVE	T2,[XWD LIBUF,LIBUF+1]; Clear it out
	SETZM	LIBUF
	BLT	T2,LIBUF+MXWPL+1; We will do replace here
	MOVE	T2,PNTR 	; Get the pointer to the line
	MOVE	T3,(T2) 	; Pick up the first word
	MOVEI	T4,LIBUF	; The place to put it
	JRST	SBALT3		; Transfer
SBALT2: SKIPE	T3,(T2)
	TRNE	T3,1		; Is it the end of the line
	JRST	SBALT1
SBALT3: MOVEM	T3,(T4) 	; Put it away
	ADDI	T4,1
	AOJA	T2,SBALT2

SBALT1: SUBI	T4,LIBUF	; Get size line used to be
	MOVEM	T4,OCNT
	POP	P,CCNT		; Get the number of chrs into line
	SKIPGE	CCNT		; Must be .ge. 0
	SETZM	CCNT
	SUBI	ALTP,(PNTR)	; Convert pointer to libuf
	ADD	ALTP,[XWD 70000,LIBUF]; And back up one
NXTRPL: SETZM	PARCNT		; Zero for next rep
	LDB	T1,[POINT 4,-1(T1),12]; Get string number
	CAMLE	T1,RSTRCT	; Is it larger
	MOVE	T1,RSTRCT	; Then use last
	MOVE	T1,R2PNT(T1)
	MOVSI	T4,70000	; Decrement pointer
	ADDM	T4,SRCALP
REPSTR: ILDB	C,T1		; Get the next chr
	JUMPE	C,ENDRP 	; The end of the replace string
	TRZE	C,PT.PAT	;See if special
	 JRST	[TRZE C,PT.NUM	;Number coming?
		  JRST	REPNUM	;Yes--Go handle
		 CAILE	C,PATLEN;In range?
		  JRST	ERRIRS	;No--Error
		 JRST	@PATOUT(C)];And dispatch
PUTSTR: IDPB	C,ALTP		; Put in the replacement
	AOS	C,CCNT		; Advance count
	CAIL	C,MXWPL*5	; Check against max
	NERROR	LTL		; And lose
	JRST	REPSTR
ENDRP:	MOVE	T3,CCNT 	; Get count so search can go on
	PUSH	P,ALTP		; Save replace pointer
	PUSH	P,SRCALP	; And the end of input pointer
	MOVE	ALTP,SRCALP	; Continue from here
	ILDB	T1,SRCALP	; See what char we stopped on
	CAIE	T1,12		; Have we gone too far?
	PUSHJ	P,COMSRT	; This will continue
	JRST	FINLIN		; All done with matches, finish up
	CAIL	T3,MXWPL*5	; Are there too many?
	NERROR	LTL
	POP	P,T2
DOMOV:	ILDB	C,T2		; Move the chrs that did not match
	CAMN	T2,ALTP 	; Have we gotten to the next match
	JRST	DONMOV		; Yes
	IDPB	C,(P)		; The byte pointer is still in the stack
	JRST	DOMOV
DONMOV: MOVEM	T3,CCNT 	; Put the count back in core
	POP	P,ALTP		; This is now the deposit pointer
	JRST	NXTRPL		; Go do a replace

SLSWT:	'Q  ',,[TLO FL,DECID]	;Decide mode
	'E  ',,[TLO FL,EXCTS1]	;Exact case match
	'L  ',,[SETOM LSW]	;Print only line numbers
	'S  ',,[TLO FL,NOPRN]	;Print nothing
	'T  ',,[SETOM TSW]	;Give totals at the end
	'U  ',,[TRO FL2,SUPN]	;Print w/o line number
	'N  ',,[PUSHJ P,DOSN]	;In compatible mode, like s
	'D  ',,[PUSHJ P,DODS]	;In compatible mode, like q
LNSWT==.-SLSWT

DOSN:	SKIPE	NEWCMD##	;Compatible?
	  NERROR ILC		;No--Error
	TLO	FL,NOPRN	;Yes--Like s
	POPJ	P,		;And return

DODS:	SKIPE	NEWCMD##	;Compatible?
	  NERROR ILC		;No--Error
	TLO	FL,DECID	;Yes--Like q
	POPJ	P,		;And return

REPNUM:	CAILE	C,PATLEN	;In range?
	 JRST	ERRIRS		;No--Error
	ILDB	CS,T1		;Get count
	JRST	@PATNUM(C)	;And dispatch
FINLIN: POP	P,SRCALP	; Get set to move to end
	POP	P,ALTP
	ILDB	C,2(P)		; We just happen to know its still there
	CAIE	C,12		; If so we have eaten a return
	JRST	ENDFIN		; All is ok
FINL2:	MOVEI	C,15
	SKIPA			; So put it in
ENDFIN: ILDB	C,SRCALP
	IDPB	C,ALTP
	AOS	CS,CCNT
	CAIL	CS,MXWPL*5
	NERROR	LTL
	CAIE	C,12
	JRST	ENDFIN		; Done when we see the line feed
	MOVEI	T1,0		; Zero out rest of this line
DOZER:	TLNN	ALTP,760000	; Pointer at end of line?
	JRST	ZEROD
	IDPB	T1,ALTP
	JRST	DOZER
ZEROD:	SUBI	ALTP,LIBUF	; Movei ac,1-libuf(ac)
	MOVEI	ALTP,1(ALTP)	; Get count
	MOVEM	ALTP,NCNT
	TLNE	FL,NOPRN	; Did he want printing supressed
	JRST	NOPLIN
	MOVE	T2,CPG		; Get this page
	CAMN	T2,RPPG 	; Is it one we started on
	JRST	NOPPRN		; Yes, do not print 'page #'
	MOVEM	T2,RPPG 	; Save for next time
	PUSHJ	P,PGPRN
NOPPRN: SKIPL	LSW		;Print just line numbers?
	  JRST	NOPP2		;No
	MOVE	T1,LIBUF		;Get line number
	MOVEM	T1,PRNTO1	;Save for printer
	OUTSTR	PRNTO1		;Type it
	JRST	NOPP1		;And continue
NOPP2:	MOVEI	T2,LIBUF	; Print the line
	HRRZ	T1,NCNT		; Length of the line
	PUSHJ	P,OUTLN1##
NOPP1:	TLNN	FL,DECID	; Does he want the option of saying no
	JRST	NOPLIN		; No, insert it
NOVCMD: PUSHJ	P,GETONE##
	CAIN	T1,177		; Did he say rubout(do not insert)?
	JRST	REJECT		; Yes, just ignore this line
	CAIN	T1,15		; Did he say <CR>?
	INCHRW	T1		; Yes, flush out the line feed
	CAIE	T1,12
	CAIN	T1," "		; Space means use it
	JRST	ACCEPT
	ANDI	T1,137		; Force upper case
	OCRLF			; Need carriage return line feed now
	CAIN	T1,"N"		;See if no
	 JRST	REJECT		;Yes--Reject
	CAIN	T1,"Y"		;See if yes
	 JRST	ACCEPT		;Yes--Accept
	CAIN	T1,"H"		;See if help
	 JRST	HELP		;Yes
	CAIE	T1,"Q"
	CAIN	T1,"E"		; Does he want out
	JRST	ENDREP		; Yes: quit
	CAIN	T1,"A"
	JRST	RPALT
	CAIN	T1,"G"		; Get out of decide mode
	JRST	[TLZ FL,DECID	; Leave decide mode
		 JRST NOPLIN]
	OUTSTR	[BYTE (7) "?"," ",7,0,0]
	CLRBFI			; Clear him out
	JRST	NOVCMD		; Try again
HELP:	OUTSTR	[ASCIZ/
Type one of the following without carriage return

<space>	  Accept the change
<CR>	  Accept the change
<delete>  Restore original line and continue search
E	  Restore original line and end search
G	  Accept this change and all the rest without asking
N	  Restore original line and continue search
Q	  Restore original line and end search
Y	  Accept the change and continue
/]
	CLRBFI			;Flush buffer
	JRST	NOVCMD		;And try again
 
REJECT: 
IFN XSARSW,<
	SKIPN	EXPFLG		; Print correct reject message
>
	OUTSTR	[ASCIZ '[Rejected]
']
	JRST	RPNXT1		; Get next line
 
ACCEPT: 
IFN XSARSW,<
	SKIPN	EXPFLG		; Print correct accept message
>
	OUTSTR	[ASCIZ '[Accepted]
']
 
NOPLIN: PUSHJ	P,INSED 	; Insert the new line
	PUSHJ	P,FINDN 	; Get next
	SOSG	RPCNT		; See if out of count
	JRST	COMND
	MOVE	T1,(PNTR)	; Get pointer back
	JRST	ONREP

RPALT:	MOVE	T1,OCNT 	; Save count
	PUSHJ	P,RPSALT##
	PUSHJ	P,ALTLN1## 	; Do alter
	JRST	[OCRLF		; Quit
	      JRST ENDREP]
	JRST	NOPLINE 	; Use it now
ASBMD1: TROA	FL,CNTF 	; Mark as keep end of range
ASBMDT: TRZ	FL,CNTF 	; Just in case
	TLO	FL,ASSMF	; We assume .+1
	MOVE	T1,CLN
	MOVEM	T1,LOLN 	; Set for here to eternity
	MOVEM	T1,HILN
	MOVE	T1,CPGL
	MOVEM	T1,LOPG
	MOVEI	T1,1		; Set for only one
	MOVEM	T1,RPCNT
	TRZE	FL,CNTF 	; Keep end?
	JRST	NOSPSB
	CAIE	C,":"		; If a : or a !
	CAIN	C,"!"
	JRST	HALFSB		; Get the second half (.+1 to given)
	MOVSI	T1,377777	; Get a large page
	MOVEM	T1,HIPG
	JRST	REP4		; Onward
 
HALFSB: MOVEM	T1,HIPG 	; Set to as /.
	PUSHJ	P,GET2HF	; Get the second half
	JRST	REP4		; And go

NOSPSB: MOVE	T1,RPHIPG
	MOVEM	T1,HIPG
	MOVE	T1,RPHILN
	MOVEM	T1,HILN
	JRST	REP1A
QUOOUT:	ILDB	C,T1		; Get next chr
	JUMPN	C,PUTSTR	; Must not be 0
	JRST	ERRIRS		;This string is illegal

QUONUM:	ILDB	C,T1		;Get next char
	PUSH	P,T1		;Save byte pointer
QUONU1:	IDPB	C,ALTP		;Store char
	AOS	T1,CCNT		;Advance count
	CAIL	T1,MXWPL*5	;Check against max
	NERROR	LTL		;And lose
	SOJG	CS,QUONU1	;Loop for repeat count
	POP	P,T1		;Restore byte pointer
	JRST	REPSTR		;And continue

NXSOUT: AOS	CS,PARCNT	; Get next partial
DLMNUM: CAILE	CS,0
	 CAMLE	CS,ARBCNT	; Is it in range
	  JRST	ERRIRS		;No such partial string
	MOVE	T4,ARBPTR-1(CS)	;Get correct string pointer
FNDRST: ILDB	C,T4		; Now insert that string
	JUMPE	C,REPSTR	; Go finish the replacement string
	IDPB	C,ALTP
	AOS	C,CCNT
	CAIL	C,MXWPL*5
	NERROR	LTL
	JRST	FNDRST

UCLOUT:	AOS	CS,PARCNT	;Get next partial
	MOVE	C,[TRZ C," "]	;Upper case function
	JRST	XXXOUT
LCLOUT:	AOS	CS,PARCNT	;Get next partial
	MOVE	C,[TRO C," "]	;Lower case function
	JRST	XXXOUT
VCLOUT:	AOS	CS,PARCNT	;Get next partail
	MOVE	C,[TRC C," "]	;Invert case function
	JRST	XXXOUT

UCLNUM:	MOVE	C,[TRZ C," "]	;Upper case function
	JRST	XXXOUT
LCLNUM:	MOVE	C,[TRO C," "]	;Lower case function
	JRST	XXXOUT
VCLNUM:	MOVE	C,[TRC C," "]	;Invert case function

XXXOUT:	CAILE	CS,0		;Check range
	 CAMLE	CS,ARBCNT	;..
	  JRST	ERRIRS		;Error
	MOVEM	C,INOCHR##	;"AS GOOD A PLACE AS ANY"
	MOVE	T4,ARBPTR-1(CS)	;Get correct string pointer
XXXRST:	ILDB	C,T4		;Get a char
	JUMPE	C,REPSTR	;Jump if the end
	MOVE	CS,CTBL(C)	;Get bits
	TLNE	CS,LETF_16	;This a letter?
	 XCT	INOCHR##	;Yes--Do conversion
	IDPB	C,ALTP		;Store char
	AOS	C,CCNT		;Count chars
	CAIL	C,MXWPL*5	;See if too long
	 NERROR	LTL		;Yes--Die
	JRST	XXXRST		;No--Loop
RPNXT1: SOSG	RPCNT
	JRST	RPFND
RPNXT:	PUSHJ	P,FINDN
	JRST	ONREP		; Continue looking at lines

ENDREP: TRZN	FL,LINSN	; Were there any?
	NERROR	NLN
RPFND:	SKIPE	T2,FNDFLG	; Find any?
	  JRST	RPFND1		;Yes!
	RERROR	SRF		; Nope
	JRST	COMND		; Go on
RPFND1:	SKIPN	TSW		;Total wanted?
	  JRST	COMND		;No
	PUSHJ	P,DPRNT##	;Print number
	OUTSTR	[ASCIZ/ line/]	;Give it
	SOSE	FNDFLG		;Just 1?
	  OUTCHR ["s"]		;No--Fix it up
	OUTSTR	[ASCIZ/ substituted
/]
	JRST	COMND		;And return
	SUBTTL	COMMON ROUTINES FOR SEARCHING FILES
 
; This routine generates code for finding a match
; for the first character of a search string. The pointer
; to a set of byte pointers for search strings is in T1

CODSR::	MOVE	T2,[POINT 7,ARBBUF]	;Setup for first string
	MOVEM	T2,ARBPTR		;Store
	MOVEI	T2,CODEBF	; Set up pointer to place to put code
	MOVEI	ALTP,0		; The number of the current string
	HRLI	T1,-SRNUM	; The number of strings
CODS5:	TLZ	FL,NEGF!DEMCHR	; Turn off the ^E seen flag
	MOVE	T3,(T1)		; Get a pointer
	JUMPE	T3,ENDCOD	; A ZERO BYTE POINTER IS END OF CODE
READCD:	PUSHJ	P,CODCHR	;Get a char handling specials
READC1:	JUMPN	T5,(T5)		;Dispatch if special
COMLET:	MOVE	CS,CTBL(C)	; Get the majic bits
	TLNN	FL,EXCTS1!EXCTSR	; Is this an exact search?
	TLNN	CS,LETF_16	; Or not a letter
	JRST	NORMCR		; Yes just the test
	HRLI	C,(<CAIE C,>)	; Do a caie
	MOVEM	C,(T2)
	XOR	C,[XWD 4000,40]	; Cain .xor. caie = 4000,,0
	MOVEM	C,1(T2)
	TLNE	FL,NEGF		; ^E THAT CHR
	JRST	GENSKP		; Generate a skipa
COMXCT:	MOVE	C,[XCT JSPR]	; The call to search further
	DPB	ALTP,[POINT 4,C,12]	; Ac field gives string number
	MOVEM	C,2(T2)
	ADDI	T2,3		; Advance output pointer
ENDSTR:	ADDI	ALTP,1		; Next string
	AOBJN	T1,CODS5	; If any
ENDCOD:	MOVE	C,[JRST COMSRT]	; A RETURN
	MOVEM	C,(T2)
	POPJ	P,

CODCHR:	ILDB	C,T3		;Get next char
	JUMPE	C,ERRISS	;Error if nul
	MOVEI	T5,0		;Setup dispatch
	TRZN	C,PT.PAT	;Special pattern match char?
	 POPJ	P,		;No--Return
	TRZE	C,PT.NUM	;See if number following
	 IBP	T3		;Yes--Eat past it
	CAILE	C,PATLEN	;Yes--See if in range
	 JRST	ERRISS		;No--Illegal string
	MOVE	T5,PATCOD(C)	;Get dispatch
	POPJ	P,		;And return
SEPCOD:	MOVE	C,[SKIPG CS,CTBL(C)]	; Get bits
	MOVEM	C,(T2)
	MOVE	C,[TRNE CS,NSEPF]	; Check for %,$,or .
	TRNE	FL2,QSEPF		; Separators?
	MOVSI	C,(<SKIPA>)	; Yes; 
TSTNNS:				; Here to generate 'negative non-skip' code
	MOVEM	C,1(T2)
	TLNE	FL,NEGF		; Skipa in normal case
	JRST	COMXCT
GENSKP:	MOVSI	C,(<SKIPA>)
	MOVEM	C,2(T2)
	AOJA	T2,COMXCT	; So XCT will go in right place

QUOCOD:	ILDB	C,T3		; Get next chr
	JUMPE	C,ERRISS	;Error if end
	JRST	NORMCR		;And require exact case match regardless

BOLCOD:	HRRI	C,215		; GET SPECAIL BOL CHAR
	JRST	NORMCR		; AND CONTINUE
EOLCOD:	SKIPA	C,[CAIE C,15]	; Get <CR> char in rh of c & skip (lh irrelevant)
ANYCOD:	SKIPA	C,[CAIE C,15]	; Get special instr for <EOL> & skip
NORMCR:	HRLI	C,(<CAIN C,>)	; Exact or not letter
GENIVT:				; Here to invert txne/txnn or caie/cain
	TLNE	FL,NEGF
	TLC	C,4000		; Cain .xor. caie = 4000,,0
NORMC1:	MOVEM	C,(T2)
	SOJA	T2,COMXCT	; Make the XCT go in right pl@ce


INFCOD:	PUSHJ	P,CODCHR	;Get next char
	JUMPE	T5,READCD	;Nothing special
	CAIN	C,.PTNOT		; Just check validity
	 JRST	INFCOD
	CAIE	C,.PTINF	; Test for 'any number of'
	 CAIN	C,.PTMR1	; Test for '1 or more'
	  JRST	ERRISS		;Yes--Illegal format
	CAIN	C,.PTQUO
	 ILDB	C,T3
	JUMPE	C,ERRISS	;End of string error
	JRST	READCD		; Look for first other chr

JSPR:	JSP	T1,SRCRET	; Call continue search


SPCCOD:	MOVE	C,[CAIE C,11]	; The 'tab' test
	MOVEM	C,(T2)
	MOVE	C,[CAIN C,40]	; The 'space' test
	MOVEM	C,1(T2)
TSTNSK:	TLNE	FL,NEGF		; Test for negative
	JRST	GENSKP		; Yes, generate a skip
	JRST	COMXCT		; No, next instruction if successful

DGTCOD:	MOVE	C,[CAIL C,"0"]	; Lower-bound test
	MOVEM	C,(T2)
	MOVE	C,[CAILE C,"9"]	; Upper-bound test
	JRST	TSTNNS		; Fail gets no skip

LCLCOD:	MOVE	C,[CAIL C,"A"+40] ; Lower-bound test
	MOVEM	C,(T2)
	MOVE	C,[CAILE C,"Z"+40] ; Upper-bound test
	JRST	TSTNNS		; Fail gets no skip

UCLCOD:	MOVE	C,[CAIL C,"A"] ; Lower-bound test
	MOVEM	C,(T2)
	MOVE	C,[CAILE C,"Z"] ; Upper-bound test
	JRST	TSTNNS		; Fail gets no skip

LTRCOD:	MOVE	C,[MOVE CS,CTBL(C)] ; Get char status bits
	MOVEM	C,(T2)
	MOVE	C,[TLNE CS,LETF_16] ; Test for letter
	AOJA	T2,GENIVT	; Incr pc & jump to check - sign

ALMCOD:	MOVE	C,[MOVE CS,CTBL(C)] ; Get char status bits
	MOVEM	C,(T2)
	MOVE	C,[TLNE CS,<LETF!SNUMF>_16] ; Test for letter/number
	AOJA	T2,GENIVT	; Incr pc & jump to check - sign

MR1COD:	PUSHJ	P,CODCHR	;Get next char
	JUMPE	T5,READC1	;Ok
	CAIE	C,.PTINF	; Test for 'any # of'
	 CAIN	C,.PTMR1	; Test for '1 or more'
	  JRST	ERRISS		;Yes--Illegal
	JRST	READC1		;And look for it

NOTCOD:	TLC	FL,NEGF		; Invert the '-' sign
	JRST	READCD		; & CONTINUE READING

LSTCOD:	ILDB	T5,T3		;Get char count
LSTC.1:	ILDB	C,T3		;Get a char to match
	TLO	C,(CAIN C,)	;Generate instr to compare
	MOVEM	C,(T2)		;Store
	SOJLE	T5,[SOJA T2,TSTNSK]	;Return if end
	MOVEI	T4,1(T5)	;Copy
	LSH	T4,1		;Double
	ADDI	T4,-1(T2)	;Form address
	TLO	T4,(JRST)	;Make jrst
	MOVEM	T4,1(T2)	;Stode
	ADDI	T2,2		;Advance code
	JRST	LSTC.1		;And loop
; Read in the strings to search for
; T3 has place to put pointers, T1 a byte pointer for strings

 
SSTRNG::MOVEI	T2,SRBLG	; The permissible length
	HRLI	T3,-SRNUM	; T3 has pointer to place byte pointers
SSTR0:	MOVEM	T1,SVPT 	; Save the pointer for end of string
SSTR1:	PUSHJ	P,GNCH##	; Get a chr
	PUSHJ	P,ECHR		;Process if ^e special char
	 JRST	SSTR1		;It was--Get next char
	CAIN	C,200		; Altmode terminates
	 JRST	SSTEND
	CAIN	C,15		; Ignore returns
	 JRST	SSTR1
	CAIN	C,12		; Line feed is end of one string
	 JRST	SSTR2
	PUSHJ	P,SSCHR		;Store the char
	JRST	SSTR1		;And loop

SSTR2:	CAMN	T1,SVPT		; Null string?
	JRST	[HLRZ C,T3	; First one?
		CAIE	C,-SRNUM	; Well?
		JRST	.+1	; No
		MOVEI	C,12	; Return a line feed
		POPJ	P,]
RETSTR:	MOVEI	C,0		; Terminate string with 0
	PUSHJ	P,SSCHR		;Store the null
	MOVE	C,SVPT		; Set up pointer
	MOVEM	C,(T3)
	AOBJP	T3,[RERROR TMS
		    JRST SSERR]
	PUSH	P,T1
	MOVE	T1,FNDPMT	; x*, x={F,S,L}
	SKIPN	COMFLF		; Don't prompt if in command file
	PUSHJ	P,PROMPT##	; Prompt for next string
	POP	P,T1
	JRST	SSTR0

SSTEND: CAIN	T2,SRBLG	; Did we see any?
	POPJ	P,		; No, return
	MOVEI	C,0		; Yes, terminate last
	IDPB	C,T1
	MOVE	T1,SVPT
	MOVEM	T1,(T3)		; Set pointer
SSTR5:	AOBJP	T3,CPOPJ1	; Zero out other pointers
	SETZM	(T3)
	JRST	SSTR5

;Here to store C in the search string (pointed by T1) and give error
;if the string is too long

SSCHR:	IDPB	C,T1		;Store the char
	SOJG	T2,CPOPJ##	;Return if ok
	RERROR	STL		;String is too long
				;Fall into sserr

;Here to clean up after a scanning error (STL or TMS)

SSERR:	HRLZ	T1,T3		; Zero out first pointer
	MOVNS	T1
	ADDI	T1,-SRNUM(T3)	; Find start
	SETZM	(T1)		;And clear
	JRST	COMND
	SUBTTL	PSEUDO ^E CHARACTER HANDLING

ECHR:	CAIE	C,.PTPAT	;Special match char?
	 JRST	CPOPJ1		;No--Return
	SETZM	ENUM		;Clear number
	PUSH	P,T1		;Save some acs
	PUSHJ	P,GCHR		;Get upper case char
	PUSHJ	P,GETNUM	;Get number if there
	MOVEM	T1,ENUM		;Save number
	CAIN	C,"V"		;Flag for next letter coming?
	  JRST	VCHR		;Yes
	CAIN	C,"<"		;Open angle bracket?
	  JRST	ACHR		;Yes
	CAIN	C,"M"		;Flag for n'th match
	 SKIPE	ENUM		;And no number?
	  CAIA			;No
	   JRST	MCHR		;Yes--Go handle
	CAIN	C,"Q"		;Quote the char?
	 JRST	QCHR		;Yes
	CAIN	C,"["		;Bracket list?
	 JRST	LCHR		;Yes
	MOVSI	T1,-ELEN	;Get etable length
	CAIE	C,@ETAB(T1)	;Match?
	AOBJN	T1,.-1		;No--Loop
	JUMPG	T1,ERRISS	;Error if not found
	MOVE	C,ETAB(T1)	;Get char bits
EPATP:	POP	P,T1		;Restore byte pointer
				;Fall into epat
;Epat - add pattern char and number into string
;Call: t1=byte pointer, c=char bits
EPAT:	TLNE	C,(ET.NMI)	;See if number illegal
	 SKIPN	ENUM		;Yes--See if number given
	  CAIA			;Ok
	   JRST	ERRISS		;Yes--Error
	TLNE	C,(ET.NMR)	;See if number required
	 SKIPE	ENUM		;Yes--See if number given
	  CAIA			;Ok
	   JRST	ERRISS		;No--Error
;;	LDB	C,[POINTR (C,ET.COD)];Get pattern code
	LDB	C,[POINT 9,C,8]	;Get pattern code
	TRO	C,PT.PAT	;Flag special
	SKIPE	ENUM		;See if number
	 TRO	C,PT.NUM	;Yes--Flag its following
	PUSHJ	P,SSCHR		;Store the pattern char
	SKIPE	C,ENUM		;Get the number
	 PUSHJ	P,SSCHR		;Store if given
	POPJ	P,		;And return

MCHR:	PUSHJ	P,GCHR			;Get next char
	PUSHJ	P,GETNUM		;Get number
	MOVEM	T1,ENUM			;Save number
	JUMPE	T1,ERRISS		;Error if zero
	CAIE	C,.PTPAT		;^E NEXT?
	 JRST	ERRISS			;No--Error
	PUSHJ	P,GCHR			;Get next char
	CAIE	C,"M"			;End of string?
	 JRST	ERRISS			;No--Error
	MOVE	C,TABDLM		;Get .ptdlm bits
	JRST	EPATP			;And store

VCHR:	PUSHJ	P,GCHR		;Get a char
	CAIN	C,"V"
	 MOVE	C,TABVCL		;Get .ptvcl bits
	CAIN	C,"L"
	 MOVE	C,TABLCL		;Get .ptlcl bits
	CAIN	C,"U"
	 MOVE	C,TABUCL		;Get .ptucl bits
	CAIG	C,177
	 JRST	ERRISS
	JRST	EPATP

QCHR:	MOVE	C,TABQUO		;Get .ptquo bits
	POP	P,T1			;Get byte pointer back
	PUSHJ	P,EPAT			;Store pattern char
	PUSHJ	P,GNCH		;Get a char
	CAIN	C,200		;See if <esc>
	 MOVEI	C,33		;Yes--Convert
	PJRST	SSCHR		;And go store

LCHR:	POP	P,T1			;Get byte pointer back
	MOVE	C,TABLST		;Get .ptlst bits
	PUSHJ	P,EPAT			;Store
	MOVSI	T4,-^D100		;Get max
LCHR1:	PUSHJ	P,GNCH			;Get a char
	MOVEM	C,CHRBLK(T4)		;No--Save it
	PUSHJ	P,GNCH			;Get a char
	AOBJP	T4,ERRISS		;Error if too many
	CAIN	C,"]"			;End?
	 JRST	LCHR2			;Yes
	CAIN	C,","			;Terminate?
	 JRST	LCHR1			;Yes
	JRST	ERRISS			;No--Error
LCHR2:	MOVEI	C,(T4)			;Get count
	MOVN	T4,C			;Get -count
	HRLZI	T4,(T4)			;Get -count,,0
	PUSHJ	P,SSCHR			;Store the count
LCHR3:	MOVE	C,CHRBLK(T4)		;Get a char
	PUSHJ	P,SSCHR			;Store
	AOBJN	T4,LCHR3		;Loop
	POPJ	P,			;And return
ACHR:	MOVEI	T1,0			;Clear number
ACHR1:	PUSHJ	P,GCHR			;Get next char
	CAIL	C,"0"			;See if digit
	 CAILE	C,"7"			;..
	  JRST	ACHR2			;No
	LSH	T1,3			;Shift digits over
	ADDI	T1,-"0"(C)		;Combine
	JRST	ACHR1			;And loop
ACHR2:	CAIG	T1,177			;Too big?
	 CAIE	C,">"			;Close angle bracket?
	 JRST	ERRISS
	EXCH	T1,(P)			;Get byte pointer,save number
	MOVE	C,TABQUO		;Get .ptquo bits
	PUSHJ	P,EPAT			;Handle pattern char
	POP	P,C			;Restore number
	PJRST	SSCHR			;Store and return
GETNUM:	MOVEI	T1,0			;Clear number
GETNM1:	CAIL	C,"0"			;Digit?
	 CAILE	C,"9"			;..
	  POPJ	P,			;No--Return
	IMULI	T1,^D10			;Accumulate digits
	ADDI	T1,-"0"(C)		;,,
	PUSHJ	P,GCHR			;Get next char
	JRST	GETNM1			;And loop

GCHR:	PUSHJ	P,GNCH##	;Get next char
	TRZ	C,200		;Clear special chars
	MOVE	CS,CTBL(C)	;Get bits
	TLNE	CS,LETF_16	;Letter?
	 TRZ	C,40		;Yes--Make upper case
	POPJ	P,		;And return

;Pattern match table
;Define code,char,number illegal,number required
;
DEFINE XX(CODE,CHAR,NUMI,NUMR),<
	EXP	CODE*ET.COD+<"CHAR">*ET.CHR+NUMI*ET.NMI+NUMR*ET.NMR
>

ET.COD==1B8
ET.NMI==1B9
ET.NMR==1B10
ET.CHR==1

ETAB::	XX .PTLTR,<L>,0,0
	XX .PTNXS,<X>,0,0
	XX .PTNOT,<N>,1,0
	XX .PTINF,<*>,1,0
TABDLM:	XX .PTDLM,<M>,0,1
	XX .PTDGT,<D>,0,0
	XX .PTANY,<C>,0,0
	XX .PTMR1,<+>,1,0
	XX .PTALM,<A>,0,0
	XX .PTSPC,< >,0,0
	XX .PTEOL,<Z>,1,0
	XX .PTBOL,<B>,1,0
	XX .PTSEP,<S>,0,0
TABLCL:	XX .PTLCL,<\>,0,0
TABUCL:	XX .PTUCL,<^>,0,0
TABVCL:	XX .PTVCL,<V>,0,0
TABQUO:	XX .PTQUO,<Q>,0,0
TABLST:	XX .PTLST,<[>,0,0
ELEN==:.-ETAB
COMTST:	PUSHJ	P,COMSRC	;Do the search
	 TDZA	T1,T1		;Failure--Set to 0
	  MOVEI	T1,1		;Success--Set to 1
	SKIPE	FNSW		;See if find not
	  XORI	T1,1		;Yes--Invert answer
	ADDM	T1,(P)		;Modify return of success
	POPJ	P,		;And return

; The search itself

COMSRC::MOVEM	T2,BUFSAV	; Save the pointer to strings
	CAML	PNTR,BUFBLL	; Is this line known to be in core?
	PUSHJ	P,GETLTH##	; No, make sure line is in core
	MOVNI	T3,1		; The count of how far into line we are
	MOVEI	ALTP,1(PNTR)	; Set byte pointer
	HRLI	ALTP,(<POINT 7,0,6>)
	MOVEI	C,215		; Start with a line delimiter
	JRST	CODEBF		; Go scan
COMSRT:	ILDB	C,ALTP		; We return here if no match for this one
	CAIE	C,12		; Done?
	AOJA	T3,CODEBF	; No, go on
	POPJ	P,		; Yes, non-match retunr

SRCRET:	PUSH	P,T1		; Save the return address
	PUSH	P,ALTP		; And the string pointer
	PUSH	P,C		; And the character
	LDB	T1,[POINT 4,-1(T1),12]	; Get string number
	ADD	T1,BUFSAV	; Point to byte pointer
	SKIPN	T1,(T1)		; Get it
	ERROR	ICN		; There should be one there
	MOVE	T2,[POINT 7,ARBBUF]	; Set up arbit match
	MOVEI	T4,MXWPL*^D10	; Pointer and count
	SETZM	ARBCNT		; The number of arbitrary matches seen
	TLZ	FL,ARBITG	; Off at start
	PUSHJ	P,LINMAT	; Go check for match
	JRST	LOSE		; We lose, continue scan
	MOVEM	ALTP,SRCALP	; Pointer to end of string
	POP	P,C		; Restore
	POP	P,ALTP
T1PPJ1::	POP	P,T1
CPOPJ1::	AOS	(P)	; Skip return
	POPJ	P,
LOSE:	POP	P,C		; Restore
	JRST	APOPJ##
NXTCHR:	CAIN	C,12		; Was that last of line?
	 POPJ	P,		; Yes, lose 
	ILDB	C,ALTP		; No, try next
LINMAT:	PUSHJ	P,CHRMAT	; Check for match
	 POPJ	P,		; None, return
	JUMPN	CS,NXTCHR	;Jump if more
	AOS	(P)		; SAVE A JRST CPOPJ1
	POPJ	P,		;Skip return


CHRMAT:	TLZ	FL,NEGF!DEMCHR	; No ^E seen and chr can be 0
READCH:	ILDB	CS,T1		; Get next
	JUMPE	CS,MATCH	;Jump if end of string
	TRZE	CS,PT.PAT	;See if special
	 JRST	[TRZE CS,PT.NUM	;Number coming?
		  JRST	NUMCON	;Yes
		 CAILE	CS,PATLEN;No--See if in range
		  JRST	ERRISS	;No--Error
		 JRST	@PATCON(CS)]	;And process
TSTCHR:	CAIN	C,(CS)		;Are they the same?
	 JRST	ISTRU1		; Yes, check negf
	MOVE	T5,CTBL(CS)	; Get bits
	TLNN	FL,EXCTS1!EXCTSR	; Exact?
	TLNN	T5,LETF_16	; Or not let
	JRST	ISFALS		; No match
	XORI	CS,40		; Check other case
EXACHR:	CAIN	C,(CS)
	 JRST	ISTRU1
	JRST	ISFALS		; Lose

MATCH:	TLNE	FL,DEMCHR	; Did we need a character there?
	 JRST	ERRISS		;Yes, illegal string
	JRST	CPOPJ1	; Ok return
; Pattern match special character branch table

.PTPAT=="E"-100		;^E = SPECIAL PATTERN FLAG IE NEXT CHAR IS .PT???
PT.NUM==200	;Number byte following 
PT.PAT==400	;Special pattern in last 7 bits

	DEFINE	PATS,<
	XLIST
PATC <NUL,LTR,NXS,NOT,UCL,INF,DLM,DGT,ANY,MR1,LCL,ALM,BOL,SPC,EOL,VCL,QUO,SEP,LST>
	LIST
>

DEFINE	PATC(LIST),<
	IRP LIST,<
	IF1,<BLOCK 1>
	IF2,<
		IFDEF LIST'COD,<EXP LIST'COD>
		IFNDEF LIST'COD,<EXP ERRISS>
	>
>
>

PATCOD:	PATS

DEFINE	PATC(LIST),<
	IRP LIST,<
	IF1,<BLOCK 1>
	IF2,<
		IFDEF LIST'CON,<EXP LIST'CON>
		IFNDEF LIST'CON,<EXP ERRISS>
	>
	>
>

PATCON:	PATS

DEFINE	PATC(LIST),<
	IRP LIST,<
	IF1,<BLOCK 1>
	IF2,<
		IFDEF LIST'OUT,<EXP LIST'OUT>
		IFNDEF LIST'OUT,<EXP ERRIRS>
	>
	>
>

PATOUT:	PATS

DEFINE	PATC(LIST),<
	IRP LIST,<
	IF1,<BLOCK 1>
	IF2,<
		IFDEF LIST'NUM,<EXP LIST'NUM>
		IFNDEF LIST'NUM,<EXP ERRIRS>
	>
	>
>

PATNUM:	PATS

DEFINE	PATC(LIST),<
	IRP LIST,<
	IF1,<BLOCK 1>
	IF2,<
		IFDEF LIST'CUM,<EXP LIST'CUM>
		IFNDEF LIST'CUM,<EXP ERRISS>
	>
	>
>

PATCUM:	PATS
	PATLEN==-1		;So +1 starts with zero
DEFINE	PATC(LIST),<IRP LIST,<.PT'LIST==<PATLEN==PATLEN+1>>>

	PATS

ERRISS:	NERROR	ISS
ERRIRS:	NERROR	IRS
	SUBTTL	F/S CONTINUATION CHECKING ROUTINES

LTRCON:	MOVE	T5,CTBL(C)	; Get char bits
	TLNE	T5,LETF_16	; Test for a letter
	JRST	ISTRU		; Yes, jump
	JRST	ISFALS		; No, jump

NOTCON:	TLC	FL,NEGF		; Invert the negative flag
	TLO	FL,DEMCHR	; Require a next char
	JRST	READCH		; & READ ON

UCLCON:	TDZA	T5,T5		; Set zero for upper case
LCLCON:	MOVEI	T5,40		; Set 40 for lower case
	CAIL	C,"A"(T5)	; Test for letter
	CAILE	C,"Z"(T5)	; Test for letter
	JRST	ISFALS		; No, jump
	JRST	ISTRU		; Yes, jump

DGTCON:	CAIL	C,"0"		; Test for a decimal digit
	CAILE	C,"9"		; Test for a decimal digit
	JRST	ISFALS		; No, jump
	JRST	ISTRU		; Yes, jump

ALMCON:	MOVE	T5,CTBL(C)	; Get char bits
	TLNE	T5,<LETF!SNUMF>_16 ; Test for letter/number
	JRST	ISTRU		; Yes, jump
	JRST	ISFALS		; No, jump

SPCCON:	CAIE	C,40		; Test for space
	CAIN	C,11		; Test for tab
	JRST	ISTRU		; Yes, jump
	JRST	ISFALS		; No, jump

EOLCON:	CAIE	C,15		; Test for end of line
	JRST	ISFALS		; No, jump
	JRST	ISTRU		; Yes, jump

BOLCON:	CAIE	C,215		; TEST FOR BOL
	JRST	ISFAL1		; NO, JUMP
	JRST	ISTRU1		; YES, JUMP

QUOCON:	ILDB	CS,T1		;Get next char
	JUMPE	CS,ERRISS	;Error if zero
	JRST	EXACHR		;And go test

ANYCON:	CAIE	C,15			;Eol
	 CAIN	C,215			;Bol
	  JRST	ISFALS			;Yes--Lose
	JRST	ISTRU			;No--Win

SEPCON:	MOVE	T5,CTBL(C)		; Get table ent
	JUMPG	T5,ISFALS		; Not a sep
	TRNN	FL2,QSEPF		; Check . % $
	TRNN	T5,NSEPF		; Checking - do we have one?
	JRST	ISTRU		; No: sep
	JRST	ISFALS		; Yes: not a sep

LSTCON:	ILDB	T5,T1		;Get repeat count
LSTN.1:	ILDB	CS,T1		;Get a char
	CAIN	CS,(C)		;Match?
	 JRST	LSTN.2		;Yes--Win
	SOJG	T5,LSTN.1	;No--Loop
	JRST	ISFALS		;And lose
LSTN.2:	SUBI	T5,1		;Fix up count
	ADJBP	T5,T1		;Advance pointer
	MOVE	T1,T5		;Position back in t1
	JRST	ISTRU		;And win
	SUBTTL	NUMCON -- HANDLE ^EN<PATTERN>

;These routine tries to find n of the specified pattern character
;If they do, the string is stored in arbbuf and arbcnt is incremented
;Once only and the skip return is taken.  failure takes the non-skip
;Return, with the arbbuf setup anyway.

NUMCON:	ILDB	CN,T1			;Get count
	SOJE	CN,@PATCON(CS)		;Dispatch if just one
	JRST	NUMC.2			;And skip fetch char
NUMC.1: ILDB	C,ALTP			;Get a new char
	CAIN	C,12			;See if eol
	 JRST	ISTRU1			;Yes
NUMC.2:	PUSHJ	P,@PATCUM(CS)		;See if matches
	 JRST	ISFAL1			;Fail unless not
	SOJG	CN,NUMC.1		;Yes--Loop for all
	ILDB	C,ALTP			;Get last
	PJRST	@PATCON(CS)		;And dispatch
	SUBTTL	F/S CUMTINUATION CHECKING ROUTINES (NUMBERS)

;These routines are just like xxxcon routines except they dispatch
;To nstru/nsfals instead of istru/isfals as the former routines
;Do not terminate the arbtrary string nor increment the arbcnt 
;Counter. they are duplicated for speed only, vs having a flag
;In the xxxcon routines to control storage.

LTRCUM:	MOVE	T5,CTBL(C)	; Get char bits
	TLNE	T5,LETF_16	; Test for a letter
	JRST	NSTRU		; Yes, jump
	JRST	NSFALS		; No, jump

UCLCUM:	TDZA	T5,T5		; Set zero for upper case
LCLCUM:	MOVEI	T5,40		; Set 40 for lower case
	CAIL	C,"A"(T5)	; Test for letter
	CAILE	C,"Z"(T5)	; Test for letter
	JRST	NSFALS		; No, jump
	JRST	NSTRU		; Yes, jump

DGTCUM:	CAIL	C,"0"		; Test for a decimal digit
	CAILE	C,"9"		; Test for a decimal digit
	JRST	NSFALS		; No, jump
	JRST	NSTRU		; Yes, jump

ALMCUM:	MOVE	T5,CTBL(C)	; Get char bits
	TLNE	T5,<LETF!SNUMF>_16 ; Test for letter/number
	JRST	NSTRU		; Yes, jump
	JRST	NSFALS		; No, jump

SPCCUM:	CAIE	C,40		; Test for space
	CAIN	C,11		; Test for tab
	JRST	NSTRU		; Yes, jump
	JRST	NSFALS		; No, jump

EOLCUM:	CAIE	C,15		; Test for end of line
	JRST	NSFALS		; No, jump
	JRST	NSTRU		; Yes, jump

BOLCUM:	CAIE	C,215		; TEST FOR BOL
	JRST	NSFAL1		; NO, JUMP
	JRST	NSTRU1		; YES, JUMP

QUOCUM:	ILDB	CS,T1		;Get next char
	JUMPE	CS,ERRISS	;Error if zero
	JRST	TSTCHR		;And go test

ANYCUM:	CAIE	C,15			;Eol
	 CAIN	C,215			;Bol
	  JRST	NSFALS			;Yes--Lose
	JRST	NSTRU			;No--Win

SEPCUM:	MOVE	T5,CTBL(C)		; Get table ent
	JUMPG	T5,NSFALS		; Not a sep
	TRNN	FL2,QSEPF		; Check . % $
	TRNN	T5,NSEPF		; Checking - do we have one?
	JRST	NSTRU		; No: sep
	JRST	NSFALS		; Yes: not a sep
MR1CON:!
INFCON:	TLNN	FL,NEGF		; This has no meaning
	TLOE	FL,ARBITG	; Are we seeing 
	 JRST	ERRISS		;Yes, illeal string
	PUSH	P,T1		; Save search pointer
	MOVEI	T5,0		; Set arbitrary string to null
	IDPB	T5,T2
	SOJLE	T4,ILFMTR
	AOS	T5,ARBCNT
	MOVEM	T2,ARBPTR(T5)	;Save pointer to n'th string
	PUSH	P,ARBCNT	; Save in case we come back with no match
	PUSH	P,T2
	PUSH	P,T4
	PUSH	P,C
	CAIE	CS,.PTMR1	; Test for '1 or more'
	JRST	CHKTHS		; No, jump
	TLO	FL,DEMCHR	; Character demanded now
	PUSHJ	P,READCH	; Test for next character matches
	  JRST	ARBFAI		; No, then this doesn't match
	JRST	ARBAL1		; Yes, then treat as normal arbitrary
CHKTHS:	TLO	FL,DEMCHR	; Need a character now
	PUSHJ	P,READCH	; Call self recursively
	JRST	PROCED		; This could not match just scan on
ARBAL1:				; To here on first match
	MOVE	T2,-3(P)	; Restore arbit count
	MOVEM	T2,ARBCNT
	MOVE	T4,-1(P)	; And arbit chr count
	MOVE	T2,-2(P)	; And pointer
	PUSH	P,ALTP		; Save chr pointer
	TLZ	FL,ARBITG	; Can see another  now
	PUSHJ	P,LINMAT	; A MATCH
	JRST	RECUR		; No, try for another of that chr
	ADJSP	P,-7		; Get all that junk off stack
	JRST	CPOPJ1 		; And return to caller of linmat
RECUR:	POP	P,ALTP		; Get back pointer
	POP	P,C		; And chr
	MOVE	T4,-2(P)	; Restore count
	MOVEM	T4,ARBCNT
	POP	P,T4
	POP	P,T2		; Also chr counter and pointer
	DPB	C,T2		; Put in that chr
	MOVEI	T5,0		; And terminator
	IDPB	T5,T2
	SOJLE	T4,ILFMTR
	MOVE	T5,ARBCNT	;Get arbcnt
	MOVEM	T2,ARBPTR(T5)	;Save pointer to n'th string
	PUSH	P,T2
	PUSH	P,T4		; Resave
	MOVE	T1,-3(P)	; Restore search pointer
	ILDB	C,ALTP		; Get another chr
	PUSH	P,C		; Sav it
	TLZ	FL,NEGF		; Turn this off for recursion
	CAIE	C,12		; End of world?
	JRST	CHKTHS
ARBFAI:				; To here to fail the match
	ADJSP	P,-5		; Reduce stack
	POPJ	P,		; And error ret
PROCED:	TLZ	FL,ARBITG!NEGF	; Just go on
	POP	P,C
	POP	P,T4
	POP	P,T2
	POP	P,ARBCNT
	POP	P,(P)		; Get rid of extra pointer
	JRST	CHRMAT		; Continue match scanning
	SUBTTL	ISTRU/ISFALS

;These routines are called with  c/ char to store in arbitrary buffer.
;The buffer counter is terminated with a null following and arbcnt
;Count is incremented. istru returns cpopj
;If neg flag on, cpopj1 if neg flag off. isfals returns cpopj if neg
;Flag off, cpopj1 if neg flag on.

ISFALS:	CAIN	C,15		; Is it a return
	  AOJA	T4,.+2		; Adjust count and enter a null string
	IDPB	C,T2		; Save in arbit
	MOVEI	T5,0
	IDPB	T5,T2
	SUBI	T4,2		; Count them
	JUMPLE	T4,ILFMTR	; This line must have illegal format
	AOS	T5,ARBCNT	; One more seen
	MOVEM	T2,ARBPTR(T5)	;Store pointer to n'th string
ISFAL1:	TLNE	FL,NEGF		; Was neg flag on?
	 JRST	[CAIE	C,15	;Eol
		  CAIN	C,215	;Bol
		   POPJ P,	;Yes--Never win
		 AOS	(P)	;No--Skip return
		 POPJ	P,]	;..
	POPJ	P,

ISTRU:	CAIN	C,15
	  AOJA	T4,.+2
	IDPB	C,T2		; Save chr
	MOVEI	T5,0
	IDPB	T5,T2
	SUBI	T4,2
	JUMPLE	T4,ILFMTR
	AOS	T5,ARBCNT
	MOVEM	T2,ARBPTR(T5)	;Store pointer to n'th string
ISTRU1:	TLNN	FL,NEGF		; Negate?
	 AOS	(P)		; No, match
	POPJ	P,
	SUBTTL	NSTRU/NSFALS

;These routines are just like istru/isfals except that they do
;Not terminate the arbitrary string with a null nor is the
;Arbcnt counter incremented. these are used
;By the numcon continuation routine to treat ^e5d as 1 string

NSFALS:	CAIN	C,15		; Is it a return
	  AOJA	T4,.+2		; Adjust count and enter a null string
	IDPB	C,T2		; Save in arbit
	SOJLE	T4,ILFMTR	; This line must have illegal format
NSFAL1:	TLNE	FL,NEGF		; Was neg flag on?
	JRST	[CAIE	C,15	;Eol
		  CAIN	C,215	;Bol
		   POPJ P,	;Yes--Never win
		 AOS	(P)	;No--Skip return
		 POPJ	P,]	;..
	POPJ	P,

NSTRU:	CAIN	C,15
	  AOJA	T4,.+2
	IDPB	C,T2		; Save chr
	SOJLE	T4,ILFMTR
NSTRU1:	TLNN	FL,NEGF		; Negate?
	 AOS	(P)		; No, match
	POPJ	P,
ILFMTR: MOVE	T1,(PNTR)	; Give him an error message about
	MOVEM	T1,LINOUT	; This dirty line
	OUTSTR	LINOUT		; Poof
	MOVE	T2,CPG
	PUSHJ	P,DPRNT##
	NERROR	ILFMT
	XLIST
	LIT
	LIST
	RELOC	0

ENUM:	BLOCK	1
ARBPTR::	BLOCK	^D100
CHRBLK:	BLOCK	^D100
ZSW0:!
DSW:	BLOCK	1
MSW:	BLOCK	1
SLSW:	BLOCK	1
LSW:	BLOCK	1
TSW:	BLOCK	1
FNSW:	BLOCK	1
ZSW1==.-1

	END