Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	S$$PAT PATTERN ROUTINES
	SUBTTL	S$$ARB 'ARB' PATTERN PRIMITIVE ROUTINE

	ENTRY	S$$ARB
	EXTERN	S$$KWD
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	PUSHJ	PS,S$$ARB	; SAVES RETURN LINK ON PS/

S$$ARB:	PUSH	PS,CR	; SAVE CURSOR
	PUSH	PS,RC	; SAVE REM CHARS
	PUSHJ	PS,@-2(PS)	; SAVE ARBRST AND RETURN

; ARB RESTARTED
ARBRST:	SKIPN	S$$KWD+10	; IS &FULLSCAN ON?
	JUMPL	RC,ARBFAL	; NO, QUICKSCAN, FAIL IF CHARFAIL ON
	SOSGE	RC,(PS)	; RESTORE AND DECREMENT RC
	JRST	ARBFAL	; FAIL IF < 0
	IBP	-1(PS)	; INCREMENT CR
	MOVE	CR,-1(PS)	; AND RESTORE
	AOBJN	PS,@-2(PS)	; SIMULATE PUSH OF ARBRST AND CONTINUE

; ARB FAILED
ARBFAL:	SUB	PS,[XWD 3,3]	; POP PS 3 LEVELS
	POPJ	PS,	; GO TO NEXT PREVIOUS RESTART
	PRGEND

	SUBTTL	S$$BAL 'BAL' PATTERN PRIMITIVE ROUTINE

	ENTRY	S$$BAL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	PUSHJ	PS,S$$BAL	; SAVES RETURN LINK ON PS/

S$$BAL:	ADD	PS,[XWD 2,2]	; SIMULATE 2-LEVEL PUSH
	JUMPGE	PS,FIXPS	; BUT PUSH INSTEAD IF TOO DEEP
	SETZ	R1,	; INITIALIZE PAREN LEVEL
BALOOP:	SOJL	RC,BALFAL	; DECREMENT RC, FAIL IF <O
	ILDB	R0,CR	; INCREMENT CR, GET CHAR
	CAIN	R0,")"	; IS IT A RIGHT PAREN?
	JRST	RPAR	; YES
	CAIN	R0,"("	; NO, IS IT A LEFT PAREN?
	AOJA	R1,BALOOP	; YES, INCREASE PAREN LEVEL AND LOOP
BALCOM:	JUMPN	R1,BALOOP	; NO, OTHER, LOOP IF PAREN LEVEL > 0
	MOVEM	CR,-1(PS)	; SUCCEED, SAVE CR
	MOVEM	RC,(PS)	; AND SAVE RC
	PUSHJ	PS,@-2(PS)	; SAVE BALRST AND RETURN

; BAL RESTARTED
BALRST:	MOVE	CR,-1(PS)	; RESTORE CR
	MOVE	RC,(PS)	; RESTORE RC
	JRST	BALOOP-1	; START LOOP AGAIN

; RIGHT PAREN ENCOUNTERED
RPAR:	SOJGE	R1,BALCOM	; DECREMENT PAREN LEVEL, AND CONTINUE

; BAL FAILED
BALFAL:	SUB	PS,[XWD 3,3]	; OR FAIL (UNMATCHED ")"), POP PS 3 LEVELS
	POPJ	PS,	; GO TO NEXT PREVIOUS RESTART

; PUSH PS 2 LEVELS
FIXPS:	SUB	PS,[XWD 2,2]	; RESET PS
	PUSH	PS,CR	; AND PUSH NORMALLY
	PUSH	PS,RC
	JRST	BALOOP-1	; GO START LOOP
	PRGEND

	SUBTTL	S$$SUC 'SUCCEED' PATTERN PRIMITIVE ROUTINE

	ENTRY	S$$SUC
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	PUSHJ	PS,S$$SUC	; SAVES RETURN LINK ON PS/

S$$SUC:	PUSH	PS,CR	; SAVE CURSOR
	PUSH	PS,RC	; SAVE REM CHARS
	PUSHJ	PS,@-2(PS)	; SAVE SUCRST AND RETURN

; SUCCEED RESTARTED
SUCRST:	MOVE	CR,-1(PS)	; RESTORE CURSOR
	MOVE	RC,(PS)	; RESTORE REM CHARS
	AOBJN	PS,@-2(PS)	; SAVE SUCRST AND RETURN
	PRGEND

	SUBTTL	S$$REM 'REM' PATTERN PRIMITIVE ROUTINE

	ENTRY	S$$REM
	EXTERN	S$$LEN
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$REM	; SIMULATES LEN(RC)/

S$$REM:	MOVEI	R1,(RC)	; LEN() OF REMAINING CHARS
	JRST	S$$LEN
	PRGEND

	SUBTTL	S$$MIP,S$$MID,S$$MIE POSITIVE INTEGER ASSURANCE ROUTINES

	ENTRY	S$$MIP,S$$MID,S$$MIE
	EXTERN	S$$PGL,S$$MKI
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	MAKE POSITIVE INTEGER DESCRIPTOR FROM INTEGER
CALL:	JSP	R9,S$$MIP	; WITH INTEGER IN R1, RETURNS DESCR
IN R1
	MAKE POSITIVE INTEGER DESCRIPTOR FROM DESCRIPTOR
CALL:	JSP	R9,S$$MID	; WITH DESCRIPTOR IN R1, RETURNS INTEGER
DESCR IN R1
	NEGATIVE INTEGER ERROR
CALL:	JRST	S$$MIE/

S$$MID:	SETZ	R2,	; GET TYPE
	ROTC	R1,2
	CAIE	R2,2	; IS IT INTEGER?
	JRST	MAKINT	; NO, MAKE INTEGER
	ROTC	R1,-2	; RESTORE DESCR
	TLNN	R1,1B20	; IS INTEGER <0 ?
	JRST	(R9)	; NO, RETURN
S$$MIE:	MOVEM	R9,S$$PGL	; YES, ERROR
	CFERR	14,S$$PGL	; NEGATIVE INTEGER IN WRONG CONTEXT
MAKINT:	ROTC	R1,-2	; RESTORE DESCR
	JSP	R7,S$$MKI	; MAKE INTEGER
	JRST	TYPERR	; TYPE ERROR
S$$MIP:	JUMPL	R1,S$$MIE	; ERROR IF <0
	TLO	R1,1B18	; FORM DESCR
	JRST	(R9)	; AND RETURN
TYPERR:	MOVEM	R9,S$$PGL	; SAVE LINK
	CFERR	1,S$$PGL	; ERROR EXIT
	PRGEND

	SUBTTL	S$$LEN,S$$TAB,S$$RTB 'LEN','TAB','RTAB' PATTERN PRIMITIVES

	ENTRY	S$$LEN,S$$TAB,S$$RTB
	EXTERN	S$$SJC
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$LEN[S$$TAB,S$$RTB]	; WITH INTEGER ARG IN R1/

S$$TAB:	HRRZ	R2,@S$$SJC	; GET TOTAL CHARS
	SUBI	R2,(R1)	; SUBTRACT TAB CHARS
	MOVE	R1,R2	; PUT NEW REM CHARS IN R1
S$$RTB:	CAILE	R1,(RC)	; IS NEW RC > OLD RC?
	POPJ	PS,	; YES, ATTEMPT TO BACKUP CURSOR, FAIL
	EXCH	R1,RC	; SET NEW RC
	SUBI	R1,(RC)	; COMPUTE # CHARS TO BE ADVANCED
	JUMPGE	RC,MOVECR	; GO ADVANCE CURSOR IF RC IS NOT < 0
NEGRCF:	POPJ	PS,	; OR FAIL, OFF END OF SUBJECT
S$$LEN:	SUBI	RC,(R1)	; COMPUTE NEW REM CHARS
	JUMPL	RC,NEGRCF	; FAIL IF < 0
MOVECR:	JUMPE	R1,(R9)	; SUCCEED IMMEDIATELY IF MOVEMENT = 0
	MUL	R1,POINT2	; COMPUTE # OF WHOLE WORDS
	ROT	R2,4	; AND REMAINING CHAR INDEX
	XCT	CHNGCR-1(R2)	; PERFORM INCREMENTATION OF CR
	JRST	(R9)	; AND RETURN
CHNGCR:	JRST	ONECHR	; REM=1, 1 CHR
POINT2:	^O63146300000	; REM=2, IMPOSSIBLE, USE SPACE
	JRST	TWOCHR	; REM=3, 2 CHR
	JRST	THRCHR	; REM=4, 3 CHR
	JFCL		; REM=5, IMPOSSIBLE
	JRST	FOUCHR	; REM=6, 4 CHR
	ADDI	CR,1(R1)	; REM=7, 5 CHR
FOUCHR:	IBP	CR	; 4
THRCHR:	IBP	CR	; 3
TWOCHR:	IBP	CR	; 2
ONECHR:	IBP	CR	; 1
	ADDI	CR,(R1)	; ADD WHOLE WORDS
	JRST	(R9)	; AND RETURN
	PRGEND

	SUBTTL	S$$MBT MAKE BREAK TABLE ROUTINE

	ENTRY	S$$MBT
	EXTERN	S$$PGL,S$$LKS,S$$BKT,S$$GNS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$MBT	; WITH DESCRIPTOR IN R1, OLDPTR IS POIN-
	OLDPTR	; TER TO PREVIOUS BREAK TABLE SYMBOL TABLE ENTRY (KEY
WORD). RETURN BREAK TABLE DESCRIPTOR (FAKE STRING DESCR) IN R1/

S$$MBT:	MOVE	R2,(R9)	; GET OLDPTR
	CAME	R1,(R2)	; COMPARE STRING WITH OLD STRING
	JRST	LKPMBT	; NOT =, LOOKUP
	MOVE	R1,1(R2)	; GET OLD BREAK TABLE DESCR
	JRST	1(R9)	; RETURN
LKPMBT:	MOVEM	R9,S$$PGL	; SAVE PROGRAM LINK
	HRLZI	R0,9B22	; T=9 FOR BREAK TABLE LOOKUP
	JSP	R8,S$$LKS	; DO LOOKUP
	SOJA	R2,LKPFND	; SYMBOL FOUND
	SETZ	R0,	; NEW ENTRY, GET CHAR COUNT
	HRRZ	R8,(R1)
	MOVE	R7,R1	; SAVE STRING DESCR
	HRRM	R2,GETR2	; AND SYMBOL TABLE ENTRY POINTER
	MOVEI	R0,4	; GET BLOCK FOR BREAK TABLE
	JSP	R6,S$$GNS
	HRLI	R1,^O700	; FAKE STRING DESCR
	MOVEM	R1,@GETR2	; SAVE IN VALUE LOC OF ENTRY
	MOVEI	R0,1	; BIT MARK
	MOVEI	R1,R3	; TEMPORARY TABLE POINTER
	SETZB	R3,R4	; CLEAR TEMP TABLE
	SETZB	R5,R6
	JUMPE	R8,.+4	; SKIP IF 0 CHARS
MBTLOP:	ILDB	R2,R7	; GET NEXT CHAR
	DPB	R0,S$$BKT(R2)	; SET BIT IN TABLE
	SOJG	R8,MBTLOP	; LOOP FOR EACH CHAR
GETR2:	MOVEI	R2,.-.	; RESTORE ENTRY PTR
	MOVE	R1,(R2)	; RESTORE BREAK TABLE POINTER
	HRRM	R3,(R1)	; SAVE BITS IN REAL TABLE
	MOVEM	R4,1(R1)
	MOVEM	R5,2(R1)
	MOVEM	R6,3(R1)
	SOJA	R2,.+2	; PTR TO KEY WORD OF ENTRY
LKPFND:	MOVE	R1,1(R2)	; GET BREAK TABLE DESCR
	MOVEM	R2,(R9)	; SAVE NEW OLDPTR IN CALLING SEQUENCE
	JRST	1(R9)	; AND RETURN
	PRGEND

	SUBTTL	S$$ANY,S$$NTA 'ANY','NOTANY' PATTERN PRIMITIVES

	ENTRY	S$$ANY,S$$NTA
	EXTERN	S$$BKT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$ANY[S$$NTA]	; WITH BREAK TABLE POINTER IN R1/

S$$ANY:	JSP	R8,S$$NTA+1	; ANY, INDEX=0
S$$NTA:	JSP	R8,S$$NTA+1	; NOTANY, INDEX=1
	SUBI	R8,S$$NTA
	SOJGE	RC,.+2	; DECREMENT RC
	POPJ	PS,	; OR FAIL IF NO MORE CHARS
	ILDB	R2,CR	; GET CHAR
	LDB	R0,S$$BKT(R2)	; GET BREAK BIT
	CAIE	R0,(R8)	; IS INDEX=BREAK BIT ?
	JRST	(R9)	; NO, SUCCEED
	POPJ	PS,	; YES, FAIL
	PRGEND

	SUBTTL	S$$SPN,S$$NSP 'SPAN','NSPAN' PATTERN PRIMITIVES

	ENTRY	S$$SPN,S$$NSP
	EXTERN	S$$BKT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$SPN[S$$NSP]	; WITH BREAK TABLE POINTER IN R1/

S$$SPN:	SOJGE	RC,.+2	; DECREMENT RC
	POPJ	PS,	; FAIL IF NO MORE CHARS (MUST MATCH AT LEAST 1)
	ILDB	R2,CR	; GET CHAR
	LDB	R0,S$$BKT(R2)	; GET BREAK BIT
	JUMPN	R0,S$$NSP	; CONTINUE IF ON
	POPJ	PS,	; OR FAIL
S$$NSP:	SOJGE	RC,.+2	; DECREMENT RC
	AOJA	RC,(R9)	; SUCCEED IF NO MORE CHARS
	MOVE	R8,CR	; SAVE CURSOR IN CASE OF BACKUP
	ILDB	R2,CR	; GET CHAR
	LDB	R0,S$$BKT(R2)	; GET BREAK BIT
	JUMPN	R0,S$$NSP	; LOOP IF ON
	MOVE	CR,R8	; OR BACKUP 1 CHAR
	AOJA	RC,(R9)	; AND SUCCEED
	PRGEND

	SUBTTL	S$$BRX 'BREAKX' PATTERN PRIMITIVE

	ENTRY	S$$BRX
	EXTERN	S$$BRK
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$BRX	; WITH BREAK TABLE PTR IN R1/

S$$BRX:	HRRM	R9,BEGBRX	; SAVE LINK
	JSP	R9,S$$BRK	; DO BREAK
BEGBRX:	MOVEI	R9,.-.	; RESTORE LINK
	PUSH	PS,CR	; SAVE CURSOR
	PUSH	PS,RC	; SAVE REM CHARS
	PUSH	PS,R1	; SAVE BREAK TABLE POINTER
	PUSH	PS,R9	; SAVE LINK
	PUSHJ	PS,(R9)	; SAVE BRXRST AND RETURN

; BREAKX RESTARTED
BRXRST:	SOS	RC,-2(PS)	; GET REM CHARS AND DECREMENT
	MOVE	CR,-3(PS)	; GET CURSOR
	IBP	CR	; AND INCREMENT
	MOVE	R1,-1(PS)	; GET BREAK TABLE POINTER
	SUB	PS,[XWD 4,4]	; RESET PS
	JSP	R9,S$$BRK	; DO BREAK
	ADD	PS,[XWD 5,5]	; SET PS TO RESTART
	MOVEM	CR,-4(PS)	; SAVE NEW CURSOR
	MOVEM	RC,-3(PS)	; SAVE NEW REM CHARS
	JRST	@-1(PS)	; AND RETURN
	PRGEND

	SUBTTL	S$$BRK 'BREAK' PATTERN PRIMITIVE

	ENTRY	S$$BRK
	EXTERN	S$$BKT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$BRK	; WITH BREAK TABLE POINTER IN R1/

S$$BRK:	SOJGE	RC,.+2	; DECREMENT RC
	POPJ	PS,	; OR FAIL IF NO MORE CHARS (MUST FIND BREAK CHAR)
	MOVE	R8,CR	; SAVE CURSOR IN CASE OF BACKUP
	ILDB	R2,CR	; GET CHAR
	LDB	R0,S$$BKT(R2)	; GET BREAK BIT
	JUMPE	R0,S$$BRK	; LOOP IF NOT ON
	MOVE	CR,R8	; BACKUP CURSOR
	AOJA	RC,(R9)	; AND SUCCEED
	PRGEND

	SUBTTL	S$$BRQ 'BREAKQ' PATTERN PRIMITIVE

	ENTRY	S$$BRQ
	EXTERN	S$$BKT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$BRQ	; WITH BREAK TABLE POINTER IN R1.
IF SINGLE (') OR DOUBLE (") QUOTES ARE MEMBERS OF THE CHARACTER CLASS,
THEY ARE IGNORED/

S$$BRQ:	SOJGE	RC,.+2	; DECREMENT RC
	POPJ	PS,	; OR FAIL IF NO MORE CHARS
	MOVE	R8,CR	; SAVE CURSOR IN CASE OF BACKUP
	ILDB	R2,CR	; GET CHAR
	CAIE	R2,"'"	; IS IT SINGLE OR DOUBLE QUOTE?
	CAIN	R2,^O42
	JRST	GOBLQT	; YES, GO GOBBLE UP QUOTED SECTION
	LDB	R0,S$$BKT(R2)	; NO, GET BREAK BIT
	JUMPE	R0,S$$BRQ	; LOOP IF NOT ON
	MOVE	CR,R8	; BACKUP CURSOR
	AOJA	RC,(R9)	; AND RETURN SUCCESSFULLY

; GOBBLE UP QUOTED SUBSTRING
GOBLQT:	SOJGE	RC,.+2	; DECREMENT RC
	POPJ	PS,	; FAIL IF NO MORE CHARS
	ILDB	R0,CR	; GET CHAR
	CAIE	R0,(R2)	; IS IT CLOSING QUOTE?
	JRST	GOBLQT	; NO, LOOP
	JRST	S$$BRQ	; YES, GO BACK TO REGULAR LOOP
	PRGEND

	SUBTTL	S$$RBS,S$$RBR 'ARBNO' PATTERN PRIMITIVE

	ENTRY	S$$RBS,S$$RBR
	EXTERN	S$$KWD
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	ARBNO START
CALL:	JSP	R9,S$$RBS	; WITH LOC FOLLOWING ARBNO IN R1, START
OF PATTERN ARG AT (R9)
	ARBNO RESTART
CALL:	JSP	R9,S$$RBR	; IMMEDIATELY FOLLOWING PATTERN ARG/

S$$RBS:	PUSH	PS,R9	; SAVE START OF PATTERN ARG
	PUSH	PS,CR	; SAVE CURSOR
	PUSH	PS,RC	; SAVE REM CHARS
	PUSHJ	PS,(R1)	; SAVE RBRST1 AND SKIP OVER PATTERN ARG FIRST TIME

; FIRST ARBNO RESTART
RBRST1:	SUB	PS,[XWD 3,3]	; RESET PS
	JUMPGE	RC,.+2	; CHARFAIL SET?
	POPJ	PS,	; YES, FAIL
	MOVE	CR,2(PS)	; RESTORE CURSOR
	MOVE	RC,3(PS)	; RESTORE REM CHARS
	PUSH	AS,1(PS)	; SAVE START OF PATTERN ARG
	SKIPN	S$$KWD+10	; IS &FULLSCAN ON?
	PUSH	AS,RC	; NO, QUICKSCAN, SAVE REM CHARS
	PUSHJ	PS,@1(PS)	; SAVE RBRST2 AND START PATTERN ARG

; FIRST FAILURE OF PATTERN ARG
RBRST2:	SKIPN	S$$KWD+10	; IS &FULLSCAN ON?
	SUB	AS,[XWD 1,1]	; NO, QUICKSCAN, POP AS EXTRA TIME
	SUB	AS,[XWD 1,1]	; POP AS
	POPJ	PS,	; FAIL

; PATTERN ARG SUCCEEDED
S$$RBR:	SKIPE	S$$KWD+10	; IS &FULLSCAN OFF (QUICKSCAN MODE)?
	JRST	RBRFLS	; NO, SKIP
	CAMN	RC,(AS)	; YES, HAS CURSOR MOVED?
	POPJ	PS,	; NO, RESTART PATTERN ARG
	PUSH	PS,(AS)	; SAVE OLD RC, THIS INSTANCE OF ARG MAY BE RESTARTED
	SUB	AS,[XWD 1,1]	; AND POP AS
RBRFLS:	SUB	AS,[XWD 1,1]	; POP START OF PATTERN ARG OFF AS
	PUSH	PS,1(AS)	; AND SAVE ON PS
	PUSH	PS,CR	; SAVE CURSOR
	PUSH	PS,RC	; SAVE REM CHARS
	PUSHJ	PS,(R9)	; SAVE RBRST3 AND SUCEEDED ARBNO

; SUBSEQUENT ARBNO RESTARTS
RBRST3:	SUB	PS,[XWD 3,3]	; RESET PS
	JUMPGE	RC,RBRNEW	; JUMP IF CHARFAIL NOT SET
	PUSH	AS,1(PS)	; SAVE START OF PATTERN ARG
	SKIPE	S$$KWD+10	; IS &FULLSCAN ON?
	JRST	.+3	; YES, SKIP
	SUB	PS,[XWD 1,1]	; NO, QUICKSCAN, POP OLD RC OFF PS
	PUSH	AS,1(PS)	; AND SAVE ON AS
	POPJ	PS,	; FAIL TO NEXT PREVIOUS RESTART OF PATTERN ARG
RBRNEW:	MOVE	CR,2(PS)	; RESTORE CURSOR
	MOVE	RC,3(PS)	; RESTORE REM CHARS
	PUSH	AS,1(PS)	; SAVE START OF PATTERN ARG
	SKIPN	S$$KWD+10	; IS &FULLSCAN ON?
	PUSH	AS,RC	; NO, QUICKSCAN, SAVE REM CHARS
	PUSHJ	PS,@1(PS)	; SAVE RBRST4 AND START PATTERN ARG

; SUBSEQUENT FAILURE OF PATTERN ARG
RBRST4:	SKIPN	S$$KWD+10	; IS &FULLSCAN ON?
	POP	PS,(AS)	; NO, POP OLD RC OFF PS, REPLACE NEWER VAL ON AS
	POPJ	PS,	; FAIL TO NEXT PREVIOUS RESTART OF PATTERN ARG
	PRGEND

	SUBTTL	S$$UEB,S$$UES UNEVALUATED EXPR WITHOUT FUNCTION CALLS

	ENTRY	S$$UEB,S$$UES
	EXTERN	S$$STB,S$$STS,S$$STP,S$$FLP
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$UEB[S$$UES]	; START AND SUCCEED OF UNEVALUA-
TED EXPRESSIONS NOT CONTAINING FUNCTION CALLS. S$$UES EXPECTS THE RESULT
VALUE IN R1 AND PRESERVES IT/

S$$UEB:	PUSH	SS,PS	; SAVE PS ON SS
	PUSH	SS,AS	; SAVE AS ON SS
	PUSH	SS,CR	; SAVE CURSOR ON SS
	PUSH	SS,RC	; SAVE REM CHARS ON SS
	PUSH	SS,S$$FLP	; SAVE FAILPOINT ON SS
	MOVE	ES,S$$STB	; RESTORE ES
	ADD	ES,S$$STS	; FROM ES SAVED
	HRROI	R1,UEBFAL	; MAKE NEW FAILPOINT
	MOVEM	R1,S$$FLP
	JRST	(R9)	; START UNEVALUATED EXPRESSION

; FAILURE OF UNEVALUATED EXPRESSION
UEBFAL:	MOVE	SS,S$$STB-1	; RESET SS
	ADD	SS,S$$STP-1	; FROM SS PREVIOUS
	MOVE	PS,1(SS)	; RESTORE PS, AS, AND FAILPOINT
	MOVE	AS,2(SS)
	MOVE	R1,5(SS)
	MOVEM	R1,S$$FLP
	POPJ	PS,	; FAIL TO NEXT PREVIOUS RESTART

; SUCCEEDED UNEVALUATED EXPRESSION
S$$UES:	POP	SS,S$$FLP	; RESTORE FAILPOINT
	SUB	SS,[XWD 4,4]	; POP RC, CR, AS, AND PS OFF SS
	MOVE	PS,1(SS)
	MOVE	AS,2(SS)
	MOVE	CR,3(SS)
	MOVE	RC,4(SS)
	JRST	(R9)	; CONTINUE MATCH
	PRGEND

	SUBTTL	S$$UFB,S$$UFS UNEVALUATED EXPR WITH FUNCTION CALLS

	ENTRY	S$$UFB,S$$UFS
	EXTERN	S$$STB,S$$STS,S$$STP,S$$SJC,S$$FLP
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$UFB[S$$UFS]	; START AND SUCCEED OF UNEVALUA-
TED EXPRESSION CONTAINING FUNCTION CALLS. S$$UFS EXPECTS THE RESULT VALUE
IN R1 AND PRESERVES IT/

S$$UFB:	SUB	PS,S$$STB+1	; FORM PS-BASE
	EXCH	PS,S$$STP+1	; EXCHANGE WITH PS PREVIOUS
	PUSH	SS,PS	; SAVE OLD PS PREVIOUS
	SUB	AS,S$$STB+2	; DITTO WITH AS
	EXCH	AS,S$$STP+2
	PUSH	SS,AS
	MOVE	R1,S$$STS+3	; GET CS SAVED
	EXCH	R1,S$$STP+3	; EXCHANGE WITH CS PREVIOUS
	PUSH	SS,R1	; SAVE OLD CS PREVIOUS
	PUSH	SS,S$$STP	; SAVE ES PREVIOUS
	MOVE	ES,S$$STS	; UPDATE ES FROM ES SAVED
	ADD	ES,S$$STB
	PUSH	ES,S$$SJC	; SAVE SUBJECT ON ES
	MOVE	R1,ES	; FORM NEW ES PREVIOUS
	SUB	R1,S$$STB
	MOVEM	R1,S$$STP	; AND SAVE
	PUSH	SS,DT	; SAVE DT, CURSOR,REM CHARS, FAILPOINT
	PUSH	SS,CR
	PUSH	SS,RC
	PUSH	SS,S$$FLP
	MOVN	R1,S$$STB-1	; MAKE NEW SS PREVIOUS
	ADD	R1,SS
	MOVEM	R1,S$$STP-1	; SAVE
	HRROI	R1,UFBFAL	; MAKE NEW FAILPOINT
	MOVEM	R1,S$$FLP	; SAVE
	JRST	(R9)	; START UNRVALUATED EXPR

; FAILURE OF UNEVALUATED EXPR
UFBFAL:	MOVE	SS,S$$STB-1	; RESET SS
	ADD	SS,S$$STP-1	; FROM SS PREVIOUS
	SETZ	R9,	; SET FAIL FLAG

; SUCCEEDED UNEVALUATED EXPR
S$$UFS:	POP	SS,S$$FLP	; RESTORE FAILPOINT
	SUB	SS,[XWD 7,7]	; POP PARAMETERS OFF SS
	MOVE	RC,7(SS)	; RESTORE RC, CR, DT
	MOVE	CR,6(SS)
	MOVE	DT,5(SS)
	MOVE	R2,4(SS)	; RESTORE ES PREVIOUS
	EXCH	R2,S$$STP	; EXCHANGE FOR NEWER ES PREVIOUS
	ADD	R2,S$$STB	; UPDATE TO ES
	POP	R2,S$$SJC	; RESTORE SUBJECT
	SUB	R2,S$$STB	; AND RESTORE ES SAVED
	MOVEM	R2,S$$STS
	MOVE	R2,3(SS)	; RESTORE CS PREVIOUS AND CS SAVED
	EXCH	R2,S$$STP+3
	MOVEM	R2,S$$STS+3
	MOVE	AS,2(SS)	; RESTORE AS AND AS PREVIOUS
	EXCH	AS,S$$STP+2
	ADD	AS,S$$STB+2
	MOVE	PS,1(SS)	; DITTO WITH PS
	EXCH	PS,S$$STP+1
	ADD	PS,S$$STB+1
	MOVN	R2,S$$STB-1	; MAKE OLD SS PREVIOS
	ADD	R2,SS
	MOVEM	R2,S$$STP-1	; AND SAVE
	JUMPN	R9,(R9)	; RETURN TO MATCH IF SUCCESSFUL
	POPJ	PS,	; OR FAIL TO NEXT PREVIOUS RESTART
	PRGEND

	SUBTTL	S$$ASC CURSOR ASSIGNMENT ROUTINE

	ENTRY	S$$ASC
	EXTERN	S$$PGL,S$$DSG,S$$SJC
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$ASC	; WITH VARIABLE NAME DESCR IN R1/

S$$ASC:	MOVEM	R9,S$$PGL	; SAVE LINK
	MOVE	R8,R1	; SAVE NAME DESCR
	HRRZ	R1,@S$$SJC	; FORM CURSOR POSITION
	SUBI	R1,(RC)
	TLO	R1,1B18	; MAKE INTEGER DESCRIPTOR
	TLNE	R8,3B23	; IS VAR DEDICATED?
	JRST	S$$DSG	; YES
	MOVEM	R1,(R8)	; NO, ASSIGN (POSSIBLE OUTPUT)
	JRST	(R9)	; RETURN
	PRGEND

	SUBTTL	S$$VAS PATTERN VALUE ASSIGNMENT START ROUTINE

	ENTRY	S$$VAS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$VAS	; SAVES CURSOR, REM CHARS ON AS/

S$$VAS:	PUSH	AS,CR	; PUSH CURSOR ONTO AS
	PUSH	AS,RC	; PUSH REM CHARS ONTO AS
	PUSHJ	PS,(R9)	; PUSH VASRST ONTO PS AND RETURN

; SUBPATTERN FAILURE, RESTART ASSIGNMENT INITIALIZATION
VASRST:	SUB	AS,[XWD 2,2]	; POP AS 2 LEVELS
	POPJ	PS,	; FAIL TO NEXT PREVIOUS RESTART
	PRGEND

	SUBTTL	S$$IVA IMMEDIATE VALUE ASSIGNMENT ROUTINE

	ENTRY	S$$IVA
	EXTERN	S$$PSA
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$IVA	; WITH INITIAL CR AND RC ON AS, VARIA-
BLE NAME DESCR IN R1/

S$$IVA:	MOVE	R8,R1	; SAVE NAME DESCR
	SUB	AS,[XWD 2,2]	; POP AS 2 LEVELS
	MOVE	R7,1(AS)	; GET OLD CR
	MOVE	R0,2(AS)	; GET OLD RC
	PUSH	PS,R7	; PUSH OLD CR ONTO PS
	PUSH	PS,R0	; PUSH OLD RC ONTO PS
	SUBI	R0,(RC)	; COMPUTE STRING LENGTH
	PUSHJ	PS,S$$PSA	; PUSH IVARST ONTO PS AND PERFORM ASSIGNMENT

; IMMEDIATE VALUE ASSIGNMENT RESTART
IVARST:	SUB	PS,[XWD 2,2]	; POP PS 2 LEVELS
	PUSH	AS,1(PS)	; PUSH OLD CR ONTO AS
	PUSH	AS,2(PS)	; PUSH OLD RC ONTO AS
	POPJ	PS,	; FAIL TO NEXT PREVIOUS RESTART
	PRGEND

	SUBTTL	S$$ACV,S$$CVA CONDITIONAL VALUE ASSIGNMENT ROUTINES

	ENTRY	S$$ACV,S$$CVA
	EXTERN	S$$PGL,S$$STS,S$$STB,S$$PSA
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	ASSIGN CONDITIONAL VALUES AT END OF MATCH
CALL:	JRST	S$$ACV	; CALLED FROM S$$MTS WITH RETURN LINK IN R9,
CS INITIAL IN R12, OPERATES AT REGISTER LEVEL 12 AND ASSIGNS SUBSTRINGS
OF THE SUBJECT TO THE GIVEN VARIABLES
	CONDITIONAL VALUE ASSIGNMENT
CALL:	JSP	R9,S$$CVA	; EXPECTS PREVIOUS CR AND RC ON AS, VARIA-
BLE NAME DESCRIPTOR IN R1/

; ASSIGN CONDITIONAL VALUES
S$$ACV:	MOVEM	R9,S$$PGL	; SAVE PROGRAM LINK
	MOVN	R11,S$$STS+3	; GET - CS SAVED
	HRR	R11,S$$STB+3	; GET CS BASE IN RH
	ADD	R12,R11	; FORM -COND VAL*3,FIRSTCV ENTRY PTR
	AOBJN	R12,.+1
ACVLOP:	MOVE	R8,2(R12)	; GET NAME DESCR
	MOVE	R7,(R12)	; GET CURSOR PTR TO BEGINNING OF SUBSTR
	MOVE	R0,1(R12)	; GET LENGTH OF SUBSTRING
	JSP	R9,S$$PSA	; DO PATTERN SUBSTRING ASSIGNMENT
	ADD	R12,[XWD 3,3]	; GO ON TO NEXT CS ENTRY
	JUMPL	R12,ACVLOP	; AND LOOP IF ANY ENTRIES REMAIN
	JRST	@S$$PGL	; OR RETURN

; CONDITIONAL VALUE ASSIGNMENT
S$$CVA:	SUB	AS,[XWD 2,2]	; POP AS 2 LEVELS
	MOVE	CS,S$$STS+3	; UPDATE CS
	ADD	CS,S$$STB+3	; FROM CS SAVED
	MOVE	R2,1(AS)	; GET OLD CR
	MOVE	R3,2(AS)	; GET OLD RC
	PUSH	PS,R3	; SAVE OLD RC ON PS
	PUSH	CS,R2	; SAVE OLD CR ON CS
	SUBI	R3,(RC)	; COMPUTE SUBSTRING LENGTH
	PUSH	CS,R3	; SAVE ON CS
	PUSH	CS,R1	; PUSH VARIABLE NAME DESCR ONTO CS
	SUB	CS,S$$STB+3	; SAVE CS
	MOVEM	CS,S$$STS+3
	PUSHJ	PS,(R9)	; SAVE CVARST ON PS AND RETURN TO MATCH

; CONDITIONAL VALUE ASSIGNMENT RESTARTED
CVARST:	SUB	PS,[XWD 1,1]	; POP PS 1 LEVEL
	MOVN	CS,[XWD 3,3]	; POP CS 3 LEVELS
	ADDB	CS,S$$STS+3	; AND SAVE
	ADD	CS,S$$STB+3	; UPDATE CS
	PUSH	AS,1(CS)	; SAVE OLD CR
	PUSH	AS,1(PS)	; SAVE OLD RC
	POPJ	PS,	; GO TO NEXT PREVIOUS RESTART
	PRGEND

	SUBTTL	S$$PSA PATTERN SUBSTRING ASSIGNMENT ROUTINE

	ENTRY	S$$PSA
	EXTERN	S$$GRS,S$$DSG,S$$MVS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$PSA	; WITH NAME DESCR IN R8, INITIAL BYTE
PTR IN R7, AND CHAR COUNT IN R0/

S$$PSA:	JUMPE	R0,NULASG	; SKIP IF 0 CHARS
	HRRM	R0,RESTCT	; SAVE CHAR COUNT
	MUL	R0,[^F0.2B0]	; COMPUTE WORD COUNT
	ADDI	R0,2
	JSP	R6,S$$GRS	; GET BLOCK FOR NEW STRING
	HRLI	R1,^O700	; FORM STRING DESCR
	MOVEM	R1,SAVDSC	; SAVE IT
RESTCT:	MOVEI	R3,.-.	; GET CHAR COUNT
	HRRM	R3,(R1)	; SAVE IN STRING BLOCK
	MOVE	R2,R7	; GET STARTING BYTE POINTER
	JSP	R7,S$$MVS	; MOVE STRING
	MOVE	R1,SAVDSC	; RESTORE DESCR
NULCON:	TLNE	R8,3B23	; IS VARIABLE DEDICATED?
	JRST	S$$DSG	; YES
	MOVEM	R1,(R8)	; NO, ASSIGN, POSSIBLE OUTPUT
	JRST	(R9)	; RETURN

; NULL VALUE
NULASG:	SETZ	R1,	; NULL DESCR
	JRST	NULCON	; GO ASSIGN
; STORAGE
SAVDSC:	BLOCK	1
	PRGEND

	SUBTTL	S$$APS,S$$APR,S$$APF PATTERN ALTERNATION ROUTINES

	ENTRY	S$$APS,S$$APR,S$$APF
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	START ALTERNATION
CALL:	JSP	R9,S$$APS	; WHERE STNEXT IS THE START OF THE
	XWD	.-.,STNEXT	; NEXT ALTERNATION

	RESTART ALTERNATION
CALL:	JSP	R9,S$$APR
	XWD	.-.,STNEXT

	FINISH ALTERNATION
CALL:	JSP	R9,S$$APF	; NEXT RESTART WILL FAIL/

; START ALTERNATION
S$$APS:	PUSH	PS,CR	; PUSH CURSOR ONTO PS
	HRLM	RC,(R9)	; SAVE REM CHAR COUNT WITH RESTORT POINT
	PUSH	PS,(R9)	; AND PUSH ONTO PS
	JRST	1(R9)	; AND CONTINUE

; RESTART ALTERNATION
S$$APR:	MOVE	CR,(PS)	; RESTORE CURSOR
	HLRZ	RC,1(PS)	; RESTORE REM CHARS
	HRRZ	R1,(R9)	; GET NEXT RESTART POINT
	HRRM	R1,1(PS)	; AND SAVE ON PS
	AOBJN	PS,1(R9)	; SIMULATE PUSH OF PS, AND CONTINUE

; FINISH ALTERNATION
S$$APF:	POP	PS,CR	; RESTORE CURSOR AND REM CHARS FOR LAST TIME,
	HLRZ	RC,2(PS)	; NEXT RESTART WILL PASS TO NEXT PRE-
	JRST	(R9)	; VIOUS RESTART POINT, CONTINUE
	PRGEND

	SUBTTL	S$$RPS,S$$RPL PATTERN REPLACEMENT ROUTINES

	ENTRY	S$$RPS,S$$RPL
	EXTERN	S$$MTS,S$$KWD,S$$SJC,S$$STB,S$$STP,S$$GRS,S$$MVS,S$$MKS
	EXTERN	S$$PGL,S$$TAC
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	SUCCEEDED REPLACEMENT
CALL:	JSP	R9,S$$RPS	; PUSHES CURSOR, REMAINING CHARS, AND
INITIAL POSITION ONTO SS, SUBJECT ONTO ES, THEN GOES TO S$$MTS
	FORM REPLACEMENT STRING
CALL:	JSP	R12,S$$RPL	; WITH SUBSTITUTE STRING IN R1, 
PARAMETERS ON SS AND ES, AND RETURNS REPLACEMENT STRING DESCR IN R1/

; SUCEEDED REPLACEMENT
S$$RPS:	MOVE	ES,S$$STB	; RESTORE ES
	ADD	ES,S$$STP	; FROM ES PREVIOUS
	MOVE	R1,1(ES)	; GET FIRST ELEMENT PUSHED
	TLNN	R1,1B20	; IS IT NAME OR PATTERN?
	AOBJN	ES,.+1	; NAME, EXTRA PUSH FOR ASSIGNMENT
	PUSH	ES,S$$SJC	; SAVE SUBJECT ON ES
	PUSH	SS,CR	; SAVE CURSOR ON SS
	PUSH	SS,RC	; SAVE REM CHARS ON SS
	SKIPN	S$$KWD+9	; IS & ANCHOR NONZERO?
	JRST	UNANCH	; NO, UNANCHORED MODE
	PUSH	SS,[0]	; YES, NO CHARS FROM FRONT
	JRST	S$$MTS+2	; CONTINUE
UNANCH:	HRRZ	R1,@S$$SJC	; GET TOTAL # OF CHARS
	MOVE	R2,S$$STB+1	; FORM PS INITIAL
	ADD	R2,S$$STP+1
	SUB	R1,2(R2)	; GET TOT # - LAST INITIAL RC
	PUSH	SS,R1	; SAVE AS # OF CHARS FROM FRONT
	JRST	S$$MTS+2	; CONTINUE

; FORM REPLACEMENT STRING
S$$RPL:	MOVEM	R12,S$$PGL	; SAVE LINK
	SETO	R0,	; MAKE SURE REPLACEMENT IS STRING
	JSP	R7,S$$MKS
	CFERR	1,S$$PGL	; ERROR IF NOT
	MOVEM	R1,S$$TAC	; SAVE DESCRIPTOR
	SUB	SS,[XWD 3,3]	; POP SS 3 PLACES
	MOVEI	R8,(R3)	; SAVE REPLACEMENT STRING CHAR COUNT
	ADD	R3,3(SS)	; ADD # CHARS FROM FRONT OF SUBJECT
	ADD	R3,2(SS)	; ADD # CHARS FROM REAR OF SUBJECT
	JUMPE	R3,NULRPL	; SKIP OUT IF TOTAL = 0
	MOVEI	R9,(R3)	; SAVE TOT # OF CHARS
	MUL	R3,[^F0.2B0]	; COMPUTE # WORDS NEEDED
	MOVEI	R0,2(R3)
	JSP	R6,S$$GRS	; GET BLOCK FOR NEW STRING
	HRLI	R1,^O700	; FORM STRING DESCR
	MOVE	R10,R1	; SAVE DESCR
	HRRM	R9,(R10)	; SAVE CHAR COUNT IN STRING BLOCK
	MOVE	R3,3(SS)	; GET CHARS FROM FRONT OF SUBJECT
	POP	ES,R2	; GET SUBJECT BYTE POINTER
	JUMPE	R3,MIDRPL	; SKIP IF NONE
	JSP	R7,S$$MVS	; MOVE FRONT IN
MIDRPL:	MOVEI	R3,(R8)	; GET CHARS FROM REPLACEMENT STRING
	JUMPE	R3,ENDRPL	; SKIP IF NONE
	SETZ	R2,	; GET REPLACEMENT BYTE PTR
	EXCH	R2,S$$TAC
	JSP	R7,S$$MVS	; MOVE REPLACEMENT IN
ENDRPL:	MOVE	R3,2(SS)	; GET CHARS FROM REAR OF SUBJECT
	JUMPE	R3,RPLVAL	; SKIP IF NONE
	MOVE	R2,1(SS)	; GET FINAL CURSOR POSITION
	JSP	R7,S$$MVS	; MOVE REAR IN
RPLVAL:	MOVE	R1,R10	; GET NEW STRING DESCR
	JRST	(R12)	; RETURN
NULRPL:	POP	ES,R1	; THROW AWAY SUBJECT DESCR
	SETZ	R1,	; RETURN NULL VALUE
	JRST	(R12)
	PRGEND

	SUBTTL	S$$MTX,S$$MTS,S$$MTA PATTERN MATCH ROUTINES

	ENTRY	S$$MTX,S$$MTS,S$$MTA
	EXTERN	S$$PGL,S$$GRS,S$$FLR,S$$SJC,S$$DBT,S$$MKS,S$$STB,S$$STS
	EXTERN	S$$STP,S$$KWD,S$$ACV,S$$NUL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	EXECUTE MATCH
CALL:	JSP	R12,S$$MTX	; WHERE NPAR, IF POSITIVE, IS NUMBER OF
	XWD	NPAR,POOLPT	; PARMS+1, AND POOLPT IS A POINTER TO THE
DATA BLOCK POOL. PARAMETERS, IF ANY, ARE ON ES. IF NPAR < 0, NO BLOCK
IS ACQUIRED AND THE DUMMY HEADER AT 1(R12) IS USED BY THE PATTERN DESCR
INSTEAD. AFTER TRANSFERRING PARAMETERS (IF ANY) TO THE DATA BLOCK AND
STORING THE PATTERN DESCRIPTOR IN DT, THE SUBJECT, CURSOR, AND REM
CHARS ARE INITIALIZED FROM THE SUBJECT STORED ON ES (WHICH IS FORCED
TO BE STRING), AND THE PATTERN DESCRIPTOR PUSHED ONTO ES. ES IS SAVED,
PS, AS, AND CS INTIALIZED, AND THE NPAR,POOLPT WORD PUSHED ONTO AS.
IF &ANCHOR IS NONZERO, S$$FLR IS PUSHED ONTO PS AND CONTROL IS TRANSFER-
RED TO THE MATCH CODE. IF &ANCHOR IS ZERO, THE CURSOR, RC, AND MATCH
FAIL POINTER ARE PUSHED ONTO PS AND CONTROL TRANSFERRED TO THE MATCH CODE
	SUCCEEDED MATCH
CALL:	JSP	R9,S$$MTS	; RESTORES ES AND PUTS DATA BLOCK, IF
ANY, BACK IN POOL, AND PERFORMS CONDITIONAL ASSIGNMENTS, IF ANY. RE-
TURNS TO 0(R9) AND OPERATES AT REGISTER LEVEL 12
	ABORTED MATCH
CALL:	JRST	S$$MTA	; FROM 'ABORT' OR 'FENCE' PRIMITIVES/

; SUCCEEDED MATCH
S$$MTS:	MOVE	ES,S$$STP	; RESTORE ES
	ADD	ES,S$$STB	; FROM ES PREVIOUS
	JSP	R4,RETBLK	; RETURN DATA BLOCK TO POOL
	MOVE	R12,S$$STP+3	; GET CS INITIAL
	CAME	R12,S$$STS+3	; SAME AS CS SAVED?
	JRST	S$$ACV	; NO, ASSIGN CONDITIONAL VALUES
	JRST	(R9)	; YES, RETURN
RETBLK:	MOVE	R1,(AS)	; GET NPAR,POOLPT WORD PTR OFF AS
	JUMPL	R1,(R4)	; RETURN IF DUMMY DATA BLOCK
	MOVE	R2,(R1)	; GET NPAR,POOLPT WORD
	MOVE	R3,(DT)	; GET FIRST WORD OF DATA BLOCK
	TLC	R3,3B19	; CHANGE BACK TO NONRETURNABLE
	HRRI	R3,(R2)	; AND POINT TO LATEST POOL BLOCK
	MOVEM	R3,(DT)	; PUT BACK IN DATA BLOCK
	HRRI	R2,(DT)	; NEW NPAR,POOLPT WORD
	MOVEM	R2,(R1)	; BACK IN CALLING SEQUENCE
	JRST	(R4)	; RETURN

; ABORTED MATCH
S$$MTA:	MOVE	ES,S$$STB	; RESTORE ES TO INITIAL POSITION
	ADD	ES,S$$STP
	MOVE	DT,1(ES)	; GET FIRST ELT PUSHED
	TLNN	DT,1B20	; IS IT NAME OR PATTERN?
	MOVE	DT,2(ES)	; NAME, GET SECOND ELT PUSHED
	MOVE	AS,S$$STB+2	; RESTORE AS TO INITIAL POSITION
	ADD	AS,S$$STP+2	; USING AS PREVIOUS
	AOBJN	AS,ABTPAT	; + 1 PUSH, AND GO ABORT

; EXECUTE MATCH
S$$MTX:	MOVE	R11,(R12)	; GET NPAR,POOLPT WORD
	HRLZI	DT,6B21	; FORM LH OF PATTERN DESCR
	JUMPGE	R11,GTDBLK	; IF NPAR> 0, SKIP OVER
	HRRI	DT,1(R12)	; OR USE DUMMY DATA BLOCK
	JRST	GTSUBJ	; AND PROCEED WITH SUBJECT
GTDBLK:	HRRZI	R1,(R11)	; GET POOLPT
	JUMPE	R1,[MOVEM	R12,S$$PGL	; IF ZERO, GET NEW DATA BLK
		HLRZ	R0,R11
		JSP	R6,S$$GRS
		MOVE	R10,(R1)	; GET FIRST WORD
		JRST	GTDBLR]	; OF DATA BLOCK AND RETURN
	MOVE	R10,(R1)	; GET FIRST WORD OF DATA BLOCK
	HRRI	R11,(R10)	; GET PTR TO NEXT BLOCK IN POOL
	MOVEM	R11,(R12)	; RESTORE NPAR,POOLPT WORD
	TLC	R10,3B19	; MAKE BLOCK RETURNABLE
GTDBLR:	HRRI	R10,1(R12)	; GET PTR TO PATTERN MATCH CODE
	MOVEM	R10,(R1)	; SAVE BACK IN DATA BLOCK
	HRRI	DT,(R1)	; RH OF PATTERN DESCR POINTS TO DATA BLOCK
	HLRZ	R8,R11	; GET ACTUAL # OF PARAMS
	MOVEI	R8,-1(R8)
	JSP	R9,S$$DBT	; MOVE PARAMETERS FROM ES TO DATA BLOCK
GTSUBJ:	MOVE	R1,(ES)	; GET SUBJECT DESCRIPTOR OFF ES
	MOVEM	DT,(ES)	; SAVE PATTERN DESCRIPTOR ON ES
	TLNE	R1,^O770000	; IS IT A STRING?
	JRST	[SETO	R0,	; NO, MAKE STRING
		JSP	R7,S$$MKS
		CFERR	1,R12	; CAN'T DO, ERROR
		JRST	GTSUBR]	; OK, GO ON BACK
GTSUBR:	JUMPN	R1,.+2	; SKIP IF NON-NULL
	MOVE	R1,S$$NUL	; OR INSURE NULL POINTER
	MOVEM	R1,S$$SJC	; SAVE IN SUBJECT
	SUB	ES,S$$STB	; SAVE ES
	MOVEM	ES,S$$STS	; IN ES SAVED
	MOVE	PS,S$$STB+1	; ACTIVATE PS
	ADD	PS,S$$STP+1	; FROM PS PREVIOUS
	MOVE	AS,S$$STB+2	; DITTO FOR AS
	ADD	AS,S$$STP+2
	MOVE	R0,S$$STP+3	; INITIALIZE CS SAVED
	MOVEM	R0,S$$STS+3	; FROM CS PREVIOUS
	HRRI	R11,(R12)	; GET POINTER TO POOLPT WORD
	PUSH	AS,R11	; PUSH NPAR,[POOLPT] ONTO AS
	MOVE	CR,S$$SJC	; INITIALIZE CURSOR
	HRRZ	RC,(CR)	; AND REM CHAR COUNT
	MOVE	R1,(DT)	; GET PATTERN CODE POINTER
	SKIPN	S$$KWD+9	; IS &ANCHOR NONZERO?
	JRST	UNANCH	; NO, UNANCHORED MODE
	PUSHJ	PS,(R1)	; SAVE ABTPAT ON PS AND GO TO PATTERN CODE
ABTPAT:	JSP	R4,RETBLK	; FAILED MATCH, RETURN DATA BLOCK TO POOL
	JRST	S$$FLR	; AND FAIL
UNANCH:	PUSH	PS,CR	; SAVE CURSOR
	PUSH	PS,RC	; SAVE REM CHARS
	PUSHJ	PS,(R1)	; SAVE MVANCH ON PS AND GO TO PATTERN CODE
MVANCH:	SKIPN	S$$KWD+10	; IS FULLSCAN NONZERO?
	JUMPL	RC,ABTPAT	; NO, QUICKSCAN, ABORT PAT IF CHARFAIL ON
	SOSGE	RC,(PS)	; INCREMENT INITIAL MATCH POSITION
	JRST	ABTPAT	; AND QUIT IF OUT OF SUBJECT
	IBP	-1(PS)	; INCREMENT CURSOR
	MOVE	CR,-1(PS)	; AND UPDATE
	MOVE	R1,(DT)	; GET POINTER TO PATTERN CODE
	AOBJN	PS,(R1)	; SAVE MVANCH ON PS AND GO TO PATTERN CODE
	PRGEND

	SUBTTL	S$$MKP,S$$CKP MAKE ELEMENT FOR PATTERN ROUTINES

	ENTRY	S$$MKP,S$$CKP
	EXTERN	S$$PGL,S$$MKS,S$$STB,S$$STS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$MKP[S$$CKP]	; WITH DESCR IN R1, MAKES SURE
DESCR IS STRING OR PATTERN, OR MAKES STRING, RETURNING DESCR IN R1. IN
ADDITION, S$$CKP SAVES A PATTERN DESCR ON ES, AND SETS UP A RESTART TO
POP IT OFF/

S$$CKP:	JSP	R8,S$$MKP+1	; FLAG NOT =0
S$$MKP:	SETZ	R8,	; FLAG = 0
	TLNN	R1,^O770000	; IS IT A STRING?
	JRST	(R9)	; YES, RETURN
	TLC	R1,3B20	; IS IT A PATTERN?
	TLNE	R1,^O17B21
	JRST	MAKSTR	; NO
	TLC	R1,3B20	; YES
	JUMPE	R8,(R9)	; RETURN IF S$$MKP
	EXCH	PS,S$$STS	; SAVE PS, GET ES SAVED
	ADD	ES,S$$STB	; UPDATE ES
	PUSH	ES,R1	; SAVE PATTERN DESCR ON ES
	SUB	ES,S$$STB	; GET NEW ES SAVED
	EXCH	PS,S$$STS	; SAVE, AND RESTORE PS
	PUSHJ	PS,(R9)	; SAVE CKPRST ON PS AND RETURN
CKPRST:	MOVN	R1,[XWD 1,1]	; POP ES SAVED
	ADDM	R1,S$$STS
	POPJ	PS,	; AND FAIL TO NEXT PREVIOUS RESTART
MAKSTR:	TLC	R1,3B20	; RESTORE DESCR
	MOVEM	R9,S$$PGL
	SETO	R0,	; MAKE STRING
	JSP	R7,S$$MKS
	CFERR	1,S$$PGL	; CAN'T DO, ERROR
	JRST	(R9)	; RETURN
	PRGEND

	SUBTTL	S$$GPB,S$$PTS,S$$PTX PATTERN EXECUTION ROUTINES

	ENTRY	S$$GPB,S$$PTS,S$$PTX
	EXTERN	S$$PGL,S$$MST,S$$GRS,S$$DBT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	GET PATTERN BLOCK
CALL:	JSP	R12,S$$GPB	; WHERE NARG IS THE NUMBER OF PARMS+1
	XWD	NARG,SKIPAT	; AND SKIPAT IS THE FIRST LOCATION FOLLOW-
ING THE PATTERN MATCH CODE. EXPECTS PARAMETERS ,IF ANY, ON ES, ACQUIRES
A DATA BLOCK (IF ANY IS REQUIRED, OR USES DUMMY HEADER AT 1(R12)), TRANS-
FERS PARAMETERS INTO DATA BLOCK, POPS ES, AND RETURNS WITH PATTERN DESCR
IN R1 TO SKIPAT. THE RESTARTABLE FLAG IS SET IF NARG IS NEGATIVE OR IF
A PARAMETER IS A RESTARTEABLE PATTERN
	SUCCEEDED PATTERN
CALL:	JRST	S$$PTS	; IF PATTERN CANNOT BE RESTARTED, POP PS, POP
DT OFF AS, AND POPJ AS BACK TO HIGHER PATTERN. IF PATTERN CAN BE RESTAR-
TED, PUSH RETURN LINK, DT, AND PATTERN RESTART ONTO PS, POP DT OFF AS,
AND POPJ AS BACK TO HIGHER PATTERN
	EXECUTE PATTERN
CALL:	JSP	R9,S$$PTX	; WITH STRING OR PATTERN DESCR IN R1. IF
STRING, GO TO S$$MST, OTHERWISE PUSHES RETURN LINK, DT ONTO AS, PATTERN
FAIL ONTO PS, LOADS DT WITH NEW DESCR, AND GOES TO SUBPATTERN EXECUTION
CODE/

; GET PATTERN BLOCK
S$$GPB:	MOVE	R11,(R12)	; GET PARAMETER WORD
	HLRE	R0,R11	; GET NPAR
	MOVEI	R10,6B21	; GET LH OF PATTERN DESCR
	JUMPGE	R0,.+3	; SKIP OVER IF NPAR>0
	TRO	R10,1B22	; OTHERWISE SET RESTARTEABLE FLAG
	MOVN	R0,R0	; AND MAKE NPAR > 0
	CAIE	R0,1	; IS NPAR = 1?
	AOJA	R12,GETDBL	; NO, GET DATA BLOCK
	MOVEI	R1,1(R12)	; YES, FORM POINTER TO DUMMY HEADER
GPBRET:	HRLI	R1,(R10)	; FORM PATTERN DESCR
	JRST	(R11)	; RETURN
GETDBL:	MOVEM	R12,S$$PGL	; SAVE PROGRAM LINK
	JSP	R6,S$$GRS	; GET BLOCK FOR DATA BLOCK
	HRRM	R12,(R1)	; SAVE POINTER TO PATTERN MATCH CODE
	SOS	R8,R0	; GET ACTUAL # OF PARAMS
	JSP	R9,S$$DBT	; TRANSFER PARMS INTO DATA BLOCK
	TRNE	R10,1B22	; IS RESTARTEABLE FLAG SET?
	JRST	GPBRET	; YES, GO OUT
	HRLZI	R7,^O15B22	; NO , SEARCH DATA BLOCK FOR RESTART-
	MOVNI	R8,(R8)	; EABLE PATTERN
	HRLZI	R8,(R8)
	ADDI	R8,1(R1)
	CAMG	R7,(R8)	; IS DESCR A RESTARTEABLE PATTERN?
	TROA	R10,1B22	; YES, SET FLAG AND SKIP
	AOBJN	R8,.-2	; NO, LOOP
	JRST	GPBRET	; OR GO OUT

; SUCCEEDED PATTERN
S$$PTS:	TLNN	DT,1B22	; CAN PATTERN BE RESTARTED?
	JRST	PTCONT-1	; NO, THROW AWAY BACKUP
	PUSH	PS,-1(AS)	; YES,  PUSH RETURN LINK ONTO PS
	PUSH	PS,DT	; PUSH INNER DT ONTO PS
	PUSHJ	PS,PTCONT	; PUSH PATRST ONTO PS , GO CONTINUE
PATRST:	PUSH	AS,-1(PS)	; ON RESTART, PUSH RETURN LINK ONTO AS
	PUSH	AS,DT	; AND PUSH OUTER DT ONTO AS
	SUB	PS,[XWD 2,2]	; POP PS 2 PLACES
	MOVE	DT,2(PS)	; RESTORE INNER DT AND IGNORE RETURN LINK
	POPJ	PS,	; GO TO NEXT PREVIOUS RESTART
	SUB	PS,[XWD 1,1]	; THROW AWAY PATFAIL
PTCONT:	POP	AS,DT	; RESTORE OUTER DT FROM AS
	POPJ	AS,	; GO SUCEED IN OUTER PATTERN

; EXECUTE PATTERN
S$$PTX:	TLNN	R1,^O770000	; IS IT STRING?
	JRST	S$$MST	; YES, GO MATCH
	PUSH	AS,R9	; NO, PUSH RETURN LINK ONTO AS
	PUSH	AS,DT	; PUSH OUTER DT ONTO AS
	MOVE	DT,R1	; SET UP DT FOR INNER PATTERN
	MOVE	R1,(R1)	; GET PTR TO INNER PATTERN CODE
	PUSHJ	PS,(R1)	; PUSH PATFAL ONTO PS AND GO TO INNER PATTERN
PATFAL:	SUB	AS,[XWD 2,2]	; POP AS 2 PLACES
	MOVE	DT,2(AS)	; RESTORE OUTER DT AND IGNORE RET LINK
	POPJ	PS,	; FAIL TO NEXT PREVIOUS RESTART POINT
	PRGEND

	SUBTTL	S$$DBT DATA BLOCK TRANSFER ROUTINE

	ENTRY	S$$DBT
	RADIX	10
	SEARCH	S$$NDF

	P$BRKE=7	; BREAK EVEN POINT BETWEEN BLT AND POPS

	COMMENT/
CALL:	JSP	R9,S$$DBT	; WITH DESCRIPTOR(S) ON ES, DATA BLOCK
POINTER IN R1, NUMBER OF ELEMENTS IN R8. MOVES DESCRS OFF ES INTO BLOCK,
LEAVING ES POINTING TO BEFORE FIRST DESCR. LEAVES R1, RH(R8) UNCHANGED/

S$$DBT:	MOVNI	R7,(R8)	; GET - # OF PARS
	CAIG	R8,P$BRKE	; > BREAK EVEN POINT?
	JRST	BOTPOP(R7)	; NO, DO SERIES OF POPS
	ADDI	R7,1(ES)	; YES, DO BLT, POINT TO FIRST PAR ON ES
	HRLZI	R7,(R7)
	ADDI	R7,1(R1)	; POINT TO FIRST PAR LOC IN DATA BLOCK
	MOVEI	R6,(R8)	; POINT TO LAST PAR LOC IN DATA BLOCK
	ADDI	R6,(R1)
	BLT	R7,(R6)	; MOVE PARMS
	HRLI	R8,(R8)	; POP STACK CORRECT # OF PARMS
	SUB	ES,R8
	JRST	(R9)	; RETURN

	P$BRKR=0	; MAKE SERIES OF POPS
	REPEAT	P$BRKE,
<	POP	ES,P$BRKE-P$BRKR(R1)
	P$BRKR=P$BRKR+1>
BOTPOP:	JRST	(R9)	; RETURN
	PRGEND

	SUBTTL	S$$MST MATCH STRING ROUTINE

	ENTRY	S$$MST
	RADIX	10
	SEARCH	S$$NDF

	P$BRKE=7	; BREAK EVEN POINT FOR GOING TO FAST REG LOOP

	COMMENT/
CALL:	JSP	R9,S$$MST	; WITH DESCR IN R1/

S$$MST:	SETZ	R0,	; GET CHAR COUNT
	HRRZ	R0,(R1)
	SUB	RC,R0	; SUBTRACT FROM REM CHARS
	JUMPL	RC,MSFAIL	; FAIL IF TOO MANY FOR SUBJECT
	CAIL	R0,P$BRKE	; LESS THAN BREAK EVEN POINT?
	JRST	FSTMST	; NO, LOAD LOOP INTO FAST REGISTERS
MSTLP1:	SOJL	R0,(R9)	; YES, SUCCEED IF STRING EXHAUSTED
	ILDB	R2,R1	; GET CHAR FROM STRING
	ILDB	R3,CR	; GET CHAR FROM SUBJECT
	CAIN	R2,(R3)	; DO THEY MATCH?
	JRST	MSTLP1	; YES, LOOP
MSFAIL:	POPJ	PS,	; NO, FAIL TO NEXT PREVIOUS RESTART
FSTMST:	HRRM	R9,MSTLP2	; SAVE RETURN LINK
	MOVE	R9,[XWD MSTLP2,MSTLP3]
	BLT	R9,MSTFIN	; MOVE LOOP INTO R4-R9
	JRST	MSTLP3	; AND START IT
MSTLP2:	PHASE	4
MSTLP3:	SOJL	R0,.-.	; R4: SUCCEED IF STRING EXHAUSTED
	ILDB	R2,R1	; R5: GET CHAR FROM STRING
	ILDB	R3,CR	; R6: GET CHAR FROM SUBJECT
	CAIN	R2,(R3)	; R7: DO THEY MATCH?
	JRST	MSTLP3	; R8: YES, LOOP
MSTFIN:	POPJ	PS,	; R9: NO, FAIL
	DEPHASE
	END