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

	TITLE	REPSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
; USAGE -- [SUCCEED=-1/FAIL=0] = REPSTR(STRING,SUBSTR,STRING TO REPLACE SUBSTR)
	ENTRY	REPSTR,REPST.

REPSTR:
REPST.:

	SAVALL

	NEWLEN=T0
	T2=C1		;USED BY DETDIF
	L.REST=CNT

	STRARG	1,AP,BP1,LEN1,ML1
	STRARG	2,AP,BP2,LEN2
	STRARG	0,AP,,,R2
	HRRZS	R1

	PUSH	P,BP1		;SET UP SUBSTR DESTIN. (UBS)
	PUSH	P,LEN2		;LEN OF DESTINATION SUBSTR

	SUB	LEN2,LEN1	;CONTROLS PROCESSING
	HRRZ	NEWLEN,R1
	ADD	NEWLEN,LEN2
	IFE BND.CH,<
	IFE CHECK,<
	CAMGE	R2,NEWLEN		;SKIP SAYS EXCEED MAX
	ERROR	RPU$##,REP.F1>>
	JUMPE	LEN2,REP.CP	;NO NEED TO MOVE STRING PAST SUBSTR

	DETDIF	L.REST	;TO ADJ STR. PAST SUBSTR, NEED ITS LEN
	JUMPE	L.REST,REP.CP	;IF SUBSTR AT END, SPECIAL CASE
	IFE CHECK,<
	JUMPL	L.REST,[ERROR	RPU$##,REP.F2
]>

	JUMPG	LEN2,REP.DC	;DO TRICKY COPY


REP.CM:
	LOCSUB	REL$L##,<[BP1],LEN1>	;SET UP MOVEMENT OF STR. PAST ARG2

	POP	P,R1		;RESTORE OLD SUBSTR LEN
	POP	P,R0		;AND ITS BP
RCM1:				;COPY NEW SUBSTRING
	ILDB	C1,BP2
	IDPB	C1,R0
	SOJG	R1,RCM1
RCM2:				;COP SUBSTR PAST REPLACE PART
	ILDB	C1,BP1
	IDPB	C1,R0
	SOJG	L.REST,RCM2
	JRST	REP.SU

REP.DC:
	LOCSUB	REL$L##,<[R0],R1>
	MOVE	BP1,R0
	MOVE	LEN1,LEN2	;AT THIS PNT. HAVE BP AT END OF STRING
				;ALSO WANT ONE AT WHERE NEW END
				;OF STR. THE RELATIVE DIF BETWEEN
				;THESE TWO IS THE DIF IN LEN BETWEEN
				;ARG1 AND ARG2 -- LEN2
	MOVEI	ML1,-1
	LOCSUB	REL$L##,<[BP1],LEN1>
REP.D1:	DECR	LDB,C1,R0
	DECR	DPB,C1,BP1
	SOJG	L.REST,REP.D1
REP.CP:				;NEW SUBSTR
	POP	P,R1		;LEN
	POP	P,R0		;BP
RCP1:	ILDB	C1,BP2
	IDPB	C1,R0
	SOJG	R1,RCP1
REP.SU:
	FUNCT	SETST.##,<$1,0(AP),NEWLEN,$2,[-1]>
	SETO	R0,
	JRST	REPEND
	IFE CHECK,<
REP.F1:	ERROR	LEM$##,REP.FA
REP.F2:	ERROR	EPS$##,REP.FA
>
REP.FA:
	SUB	P,[2,,2]
	SETZ	R0,
REPEND:
	RETURN
	PRGEND

	TITLE	BLDSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- STRING-VAR=BLDSTR(STORAGE-AREA,INIT-LEN,MAXLEN)

	ENTRY BLDSTR,BLDST.

BLDSTR:
BLDST.:
	MOVEI	R0,@0(AP)	;ADDR OF STR INTO RET REG
	HRLI	R0,IPOSIZ	;THE BYTE DESC. PART
	IFE CHECK,<
	SKIPGE	R1,@1(AP)
	ERROR	LLZ$##>
	IFN	CHECK,<
	HRRZ	R1,@1(AP)>	;THE CURRENT LENGTH OF STR

	IFE BND.CH,<
	IFE CHECK,<
	SKIPN	@2(AP)
	JRST	BLDRET		;EQUATE 0 WITH MAX
	CAMLE	R1,@2(AP)
	ERROR	MLI$##,BLDRET>
	HRL	R1,@2(AP)	;ITS MAXIMUM LENGTH
>
BLDRET:	POPJ	P,		;THATS ALL
	PRGEND

; ********* SECONDARY ENTRY POINTS OF CMBSTR

	TITLE	ALNSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- ALNSTR(DESTINATION,WORDS,ICOUNT,SOURCES)

	ENTRY ALNSTR,ALNST.
ALNSTR:
ALNST.:
	JSP	R1,CB.SV$##

	MOVEI	MODE,PAD	;SOCOMBINE EXIT CODE WILL KNOW
	MOVN	CNT,@2(AP)
	HRLS	CNT
	HRRI	CNT,3(AP)		;SOURCE1 SAME ARG AS CMBSTR

	MOVEI	BP1,@0(AP)	;GET ARRAY ADDR
	HRLI	BP1,IPOSIZ
	MOVEI	LEN1,5
	IMUL	LEN1,@1(AP)	;ARRAY WORD CNT TO CHAR CNT
	IFE BND.CH,<
	MOVE	ML1,LEN1>	;THESE MUST BE EQUAL FOR PAD SWITCH
	JRST	CMBALIGN##
	PRGEND

	TITLE COPCHR
	SEARCH STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC 400000>

	ENTRY COPCHR,COPCH.
COPCHR:
COPCH.:

	DEFINE	GETELM(BP,LABL)<
	LDB	R2,[BPSIZ1,,R1]	;GET BYTE SIZE OF SOURCE "ARRAY EL".
	IDIV	R0,CPW$##(R2)		;WORD PART OF ELEMENT OFFSET
	ADD	R0,@BP(AP)	;ADD BYTE PTR TO OFFSET
	JUMPE	R1,DONE'LABL	;IS CHAR OFFSET 0?
LOOP'LABL:	IBP	R0
	SOJG	R1,LOOP'LABL	;EXHAUST CHAR OFFSET
	MOVE	R1,R0
>
	SAVE	<R2,C1>

	MOVE	R1,@2(AP)	;SOURCE BP
	MOVM	R0,@3(AP)	;GET POS OF SOURCE STRING
	SOJLE	R0,DONE1	;MAKE INTO OFFSET--CHK SPEC. CASE

	GETELM	2,1

DONE1:	ILDB	C1,R1
	SKIPGE	@3(AP)		;NO SKIP SAYS EXTEND SIGN
	JRST	[SETO	R1,		;INIT MASK
		 LSH	R1,-1(R2)	;CAUSE RIGHTMOST 1 TO BE "SIGN BIT" OF BYTE
		 TDNE	C1,R1		;NO SKIP SAYS SIGN ON
		 IOR	C1,R1		;EXTEND SIGN
		 JRST	.+1]

	MOVE	R1,@0(AP)		;DEST BP
	MOVE	R0,@1(AP)		;POS OF DEST STRING
	SOJLE	R0,DONE2

	GETELM	0,2
DONE2:	IDPB	C1,R1		;STORE IN DEST BYTE
	RESTOR	<C1,R2>
	POPJ	P,
	PRGEND

	TITLE COPSTR

; USAGE -- COPSTR(DESTINATION,SOURCE)
; USAGE -- APNSTR(DESTINATION,SOURCE)
; USAGE -- CATSTR(DESTINATION,COUNT,SOURCE-1,SOURCE...)

	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	COPSTR.,COPST.
COPSTR:
COPST.:
	SAVE	<BP1,LEN2,BP2>
	STRARG	1,AP,BP2,LEN2
	STRARG	0,AP,BP1
	IFE BND.CH,<
	HLRZS	R1
	CAMGE	R1,LEN2		;IS MAX OF DEST GT LEN OF SOURCE
	MOVE	LEN2,R1	;CAUSE NOT ALL OF SOURCE TO BE COPIED
>
	FUNCT	SETST.##,<$1,0(AP),LEN2,$2,[-1]>
	JUMPLE	LEN2,COPEND
COP1:	ILDB	R1,BP2
	IDPB	R1,BP1
	SOJG	LEN2,COP1
COPEND:	RESTOR	<BP2,LEN2,BP1>
	POPJ	P,
	PRGEND

	TITLE	APPSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	APPSTR,APPST.
APPSTR:
APPST.:
	JSP	R1,CB.SV$##
	MOVEI	MODE,APPEND
	MOVNI	CNT,1		;SETUP FOR CMBSTR
	HRRI	CNT,1(AP)
	JRST	CB.MERGE##
	PRGEND

	TITLE	CATSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	CATSTR,CATST.
CATSTR:
CATST.:
	JSP	R1,CB.SV$##
	SETZ	MODE,
	MOVN	CNT,@1(AP)
	HRLS	CNT
	HRRI	CNT,2(AP)
	JRST	CB.MERGE##
	PRGEND

	TITLE CHKSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	CHKSTR,CHKST.
CHKSTR:
CHKST.:
	JSP	R1,CB.SV$##
	MOVE	MODE,@1(AP)
	IORI	MODE,CHKPNT	;IDENTIFIES E.P. AS CHKSTR
	MOVN	CNT,@3(AP)
	JUMPE	CNT,[MOVN	CNT,@4(AP)	;1ST TIME--DO INIT
		     SETZ	T0,
		     STRARG	5,AP,BP2,LEN2
		     JRST	CHK1]

	STRARG	2,AP,BP2,LEN2
	MOVE	T0,@4(AP)	;GET LONG CNT
	ADD	T0,CNT				;DIF BETWEEN ARGS

	;GIVES NEG OF NUM. STRINGS LEFT
CHK1:	HRLS	CNT		;THE AOBJN WORD
	HRRI	CNT,5(AP)	;IF THE DIF (IE. T0) IS 0
	ADDI	CNT,0(T0)		;ACCOUNT FOR CHKPOINT
				;THE 0(T0) SINCE MUST SKIP PART
				;OF CHKPOINTED STRING
	JRST	CB.MERGE##
	PRGEND

; ******** END OF 2NDARY ENTRY POINTS

	TITLE CMBSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- [OPT CHKPNT STRING-VAR] = CMBSTR(DEST-STR,MODE,ICOUNT,SOURCE-STR1,...STR-N)
; MODE = (APPEND,NOAPPEND) PERMUTED WITH (CHKPNT,NOCHKPNT) BY (OCTAL) BY (BLANK PAD)
; APPEND=1B35  -- CHKPNT=1B34

	ENTRY CMBSTR,CMBST.,CMBALIGN,CB.MERGE

CMBSTR:
CMBST.:
	JSP	R1,CB.SV$##
	MOVE	MODE,@1(AP)
	MOVN	CNT,@2(AP)	;TO PASS CNT
	HRLS	CNT		;SETUP AOBJN WORD
	HRRI	CNT,3(AP)	;FOR THE SOURCE STRINGS
	TRZ	MODE,CHKPNT	;DO NOT WANT SET ACCIDEN.

;EXPAND DESTINATION STRING

CB.MERGE:				;2NDARY E.P. ENTER HERE
	STRARG	0,AP,BP1,LEN1,ML1

CMBALIGN:
	IFN CHECK,<
	JUMPGE	CNT,CB.FA$##>
	IFE CHECK,<
	JUMPGE	CNT,[ERROR	NSS$##,CB.FA$##
]>

	TRNE	MODE,PAD	;NO SKIP SAYS RETAIN PASSED LEN TO KNOW IF PAD
	MOVE	R2,LEN1

;APPEND OR NO APPEND
	IFN BND.CH, <MOVEI	ML1,-1>	;ARTIF. SET TO LARGEST VALUE
	TRNE	MODE,APPEND		;SKIP IF BIT NOT SET
	JRST	[IFE BND.CH, <MOVE	T0,ML1>	;SAVE IT
		 IFN BND.CH, <ADD	ML1,LEN1>	;THE APPEND FACTOR
		 LOCSUB	REL$L##,<[BP1],LEN1>
		 IFE	BND.CH,<
		 MOVE	LEN1,ML1	;AT THIS PT. LEN1=0, SO RM. LEFT = NEW ML
		 MOVE	ML1,T0>		;RESTORE
		 IFN BND.CH,<
		 MOVEI	LEN1,-1>		;GET ROOM LEFT. TO LARGEST VALUE
		 JRST	CMB1]
	MOVE	LEN1,ML1	;SET ROOM LEFT IN COPY CASE

;36 BIT BYTES?

CMB1:
	TRNE	MODE,OCTAL
	JRST	[HLRE	LEN2,CNT	;WILL SET UP FULL WORD BYTES
		 MOVM	LEN2,LEN2
		 SETO	CNT,	;REALLY ONE STRING (IE. ARRAY)
		 MOVEI	BP2,@3(AP)
		 HRLI	BP2,444400	;FULL WORD BP
		 JRST	CMBOCT]

; ENTERED FROM CHKSTR?

	TRNE	MODE,CHKPNT
	JRST	CMBOCT		;CHKSTR SKIPS FIRST SOURCE-STR

; ******** BODY OF ROUTINE -- 2-LEVEL LOOP

CMBMOR:
	STRARG	0,CNT,BP2,LEN2	;EXPAND A SOURCE STRING
CMBOCT:	JUMPLE	LEN2,CMB.O	;SKIP INNER LOOP
	SUB	LEN1,LEN2	;REDUCE ROOM LEFT
	IFE BND.CH,<
	JUMPGE	LEN1,CMB.LP	;NO JUMP MEANS HAVE OVFL.
	ADD	LEN2,LEN1>	;REDUCE LEN2 BY AMOUNT OF OVFL
				;THEN DO AS USUAL--CAN DO SINCE LEN1 LT
				;0 TEST AT CMB.O WILL KEY CORRECT ACTION
CMB.LP:
	ILDB	C1,BP2		;GET FROM SOURCE
	IDPB	C1,BP1		;GIVE TO R2
	SOJG	LEN2,CMB.LP	;GET I(TH) + 1 STR. IF CURR SOURCE EXHAUSTED
CMB.O:
	IFE BND.CH, <JUMPL	LEN1,CMBABORT>	;JUMP MEANS HAVE OVFL
	AOBJN	CNT,CMBMOR
	SUBM	ML1,LEN1	;IF ROOM LEFT (X), SIZE = MAX-X
	JRST	CMBEND		;NO MORE SOURCE STRINGS

; ********* END OF BODY
; EXIT CODE

CMBABORT:
	IFE BND.CH,<
	SETZ	T0,		;FAILURE NOTED AS LOGICAL FALSE
	MOVM	LEN2,LEN1	;LEN1 HELD NEG OF UNPROC. PART OF BP2
	MOVE	LEN1,ML1	;BY DEFINITION
	TRNN	MODE,CHKPNT	;SKIP IMPLIES USR WANTS STATUS OF INCOMP. MOVE
	JRST	CMBRET
	MOVEI	R1,@2(AP)
	MOVEM	BP2,0(R1)	;BP2 IS BEFORE THE CHAR WHICH WOULD OVFL
	MOVEM	LEN2,1(R1)	;SETS LENGTH AND ALSO MAX=LEN
	HLROS	CNT	;THE NUM OF SORC STR. LEFT
	MOVMM	CNT,@3(AP)	;AFTER ADJ CNT GET IT POSIT.
	JRST	CMBRET>		;MRG. SUCCESS EXIT PATH
CMBEND:
	SETO	T0,		;SUCCESS NOTED AS LOGICAL TRUE

CMBRET:
	TRNE	MODE,PAD
	JRST	CMBR2
CMBR0:	FUNCT	SETST.##,<$1,0(AP),LEN1,$2,[-1]>
CMBR1:	MOVE	R0,T0		;STORED UP RET VAL
	RETURN

CMBR2:	SUB	R2,LEN1	;IS THERE PADDING ROOM LEFT?
	 JUMPE	R2,CMBR1
	 JUMPL	R2,CMBR0		;DO SETST. IF NEW LEN GT OLD LEN
	 MOVEI	C1,PAD.CH		;SET UP BLANK BYTE
CMBPAD:	 IDPB	C1,BP1
	 SOJG	R2,CMBPAD
	 JRST	CMBR1

	PRGEND

	TITLE	CMPSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- PSEUDO-DP-VAL = CMPSTR(STR1,STR2,ICODE,MODE)
; THE PSEUDO-DP-VAL ACTUALLY CONSISTS OF TWO INTEGERS:
;	WORD 1 --	-1 / 0 OR CHAR POS OF FAIL CHAR.
;	WORD 2 -- -1 IF LEN1 .LT. LEN2
;		  0 IF EQUAL
;		  1   IF LEN1 .GTL. LEN2

; ICODE IS TYPE OF COMPARE: 0=EQ, 1=NE, 2=GE, 3=LE, 4=GT, 5=LT
; MODE IS (PADDED,EXACT,IGNORE) BY (TRACE,NOTRACE) BY (MIXED MODE/NO)
; SET BIT POSITIONS ON 1ST PAGE OF SOURCE CODE.

	ENTRY CMPSTR,CMPST.,CMPSTS

	CODE=T0	;TYPE OF COMPARE
	C2=T1	;2ND CHAR REG
	TRANSL=SVP	;AMOUNT TO ADJ C2 BY

; ************** CODE SPECIFIC ENTRY POINTS

	DEFINE CS.SETUP(KODE)<
	JSP	R1,CS.SV$##
	MOVEI	CODE,KODE
	JRST	CMPSPECIF>


	ENTRY EQLSTR,NEQSTR,GEQSTR,LEQSTR,GTRSTR,LESSTR
EQLSTR:
	CS.SETUP	0

NEQSTR:
	CS.SETUP	1

GEQSTR:
	CS.SETUP	2

LEQSTR:
	CS.SETUP	3

GTRSTR:
	CS.SETUP	4

LESSTR:
	CS.SETUP	5

; *****************

CMPSTR:
CMPST.:
CMPSTS:
	SAVALL
	IFN CHECK,<MOVE	CODE,@2(AP)>
	IFE CHECK,<
	SKIPGE	CODE,@2(AP)	;SETUP CODE & ERRCHK IF CHECK ON
	ERROR	CIV$##,CMP.FA
	CAILE	CODE,5		;CODES RUN FROM 0 TO 5
	ERROR	CIV$##,CMP.FA>
	MOVE	MODE,@3(AP)


;	SETUP THE TWO STRINGS TO COMPARE

CMPSPECIF:
	STRARG	0,AP,BP1,LEN1
	STRARG	1,AP,BP2,LEN2

	SETZ	TRANSL,
	TRNE	MODE,MIXMODE	;NO SKIP SAYS 5TH ARG
	MOVE	TRANSL,@4(AP)

	CAMN	LEN1,LEN2	;NO SKIP SAYS MODE DOESN'T MATTER
	JRST	[SETZ	R1,	;DENOTE THE EQUALITY
		 JRST	CMP0]	;MERGE WITH MAIN PATH
	SETO	R1,	;PRESET
	TRNN	MODE,TRACE	;SKIP MEANS YES--SO DO WORK
	 CAMLE	CODE,1	;NO SKIP SAYS MUST DO WORK
	 JRST	CMPCONTIN
	 TRNE	MODE,EXACT	;NO SKIP MEANS BY DEF. NOT = STR.
	 JRST	CMP.NN		;GOTO CMP.NE, BUT 1ST DO SETUPS
CMPCONTIN:
 	CAMG	LEN1,LEN2	;LEN1 IS ALWAYS ASSUMED SHORTED, SO...
 	JRST	CMP0			;NO SKIP MEANS NO ADJUST
 	EXCH	LEN1,LEN2
 	EXCH	BP1,BP2
	MOVN	TRANSL,TRANSL	;INVERT TRANSLATION FACTOR ALSO
 	MOVEI	R1,1		;NOTE FOR SELF & TELL USER L1 GT L2
CMP0:	JUMPLE	LEN1,CMP.LR	;HAVIN GONE THRU ALL OF LEN1, NOW
			;PROCESS LR=LEN RESIDUE=LEN2-LEN1
	SETZ	R0,		;INIT CURR POS

CMP1:
	ADDI	R0,1	;KEEP TRACK OF CURR POS
	ILDB	C1,BP1
	ILDB	C2,BP2
	ADD	C2,TRANSL
	CAME	C1,C2		;WELL HOW ARE THEY RELATED?
	JRST	@NE.CH(CODE)	;JRST TO APPROP PLACE FOR CHARS NE
	CAMGE	R0,LEN1			;SKIP SAYS TERM. LOOP
	JRST	CMP1
CMP.LR:
	ADDI	R0,1			;IF FAIL, WANT PAST SHORTER STR
	JUMPE	R1,@CMP.EQ(CODE)	;IF LENS ARE = , BECOMES SU
	TRNE	MODE,IGNORE	;NO SKIP -> IGNORE UNEQ. LEN
	JRST	@CMP.EQ(CODE)
	TRNE	MODE,EXACT	;SAYS LENS MUST BE SAME
	JRST	@CMP.NE(CODE)

;FOR CASE "PADDED" STILL MORE WORK

	MOVEI	C1,PAD.CH
	SKIPA	0
CPS1:	ADDI	R0,1
	ILDB	C2,BP2
	CAME	C1,C2
	JRST	@NE.CH(CODE)
	CAMGE	R0,LEN2
	JRST	CPS1

	JRST	@CMP.EQ(CODE)

;******************************

;TABLE 1 -- ACTION ON NE CHAR

NE.CH:
	JRST	CMP.FA	;FOR CODE = EQ
	JRST	CMP.SU	;NE
	JRST	CMP.G	; GE, LE, GT, LT RESPEC.
	JRST	CMP.L
	JRST	CMP.G
	JRST	CMP.L

;TABLE 2 -- ACTION IF STILL ALIVE AT END OF STRING

	;THE TWO STRINGS HAVE BEEN DCLED OFFIC. =
CMP.EQ:
	JRST	CMP.SU
	JRST	CMP.FA
	JRST	CMP.SU
	JRST	CMP.SU
	JRST	CMP.FA
	JRST	CMP.FA

;TABLE 3 -- THIS IS REACHED IN THE CASE EXACT MODE & LENS DIF.
CMP.NN:	CAMLE	LEN1,LEN2
	MOVEI	R1,1
CMP.NE:
	JRST	CMP.FA	;BY DEF
	JRST	CMP.SU

;SUCCESS OR FAILUR WILL BE DECIDED ON BASIS OF LEN

	JRST	CMP.GG
	JRST	CMP.LL
	JRST	CMP.GG
	JRST	CMP.LL

;INDIRECT DESTINATIONS ***********

; IT IS NOW KNOWN THAT STR1 OR STR2 IS GTR THAN THE OTHER
; DEPENDING ON WHETHER THE TWO HAVE BEEN SWITCHED AND WHAT
; THE CURRENT COMMAND IS, THE DATA FOR THE COMPARE AT .GL WILL BE SET UP

CMP.G:	JUMPLE	R1,CMP.GL
	EXCH	C1,C2
	JRST	CMP.GL
CMP.L:	JUMPG	R1,CMP.GL
	EXCH	C1,C2
CMP.GL:	CAMG	C1,C2
	JRST	CMP.FA
	JRST	CMP.SU

CMP.GG:	JUMPG	R1,CMP.SU
	JRST	CMP.FA
CMP.LL:	JUMPL	R1,CMP.SU
	JRST	CMP.FA


CMP.FA:	TRNN	MODE,TRACE	;NO SKIP=TRACE OFF..JUST RET LOGICAL FALSE
	SETZ	R0,
	SKIPA	0
CMP.SU:	SETO	R0,	;LOGICAL TRUE
	RETURN

	PRGEND

	TITLE	TRCSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- (UBS)=TRCSTR(STRING)
; RETURNS BLANK STRIPPED STRING

	ENTRY TRCSTR,TRCST.,NP
TRCSTR:
TRCST.:
NP:
	SAVE	<ML1,LEN1,BP1,C1>
	STRARG	0,AP,BP1,LEN1,ML1
	LOCSUB	REL$L##,<[BP1],LEN1>
	HRRZ	LEN1,R1		;DON'T WANT TO DAMAGE LEFT SIDE R1
	JUMPLE	LEN1,TRCEND
TRC1:	DECR	(LDB,C1,BP1)
	CAIN	C1,40
	SOJG	LEN1,TRC1
TRCEND:
	HRR	R1,LEN1		;SET UP TRUNCATED LEN
	RESTOR	<C1,BP1,LEN1,ML1>
	POPJ	P,
	PRGEND

	TITLE	BEFCHR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	BEFCHR,BEFCH.

; *********** SIMPLER ENTRY POINTS ***********

; USAGE -- (UBS) = BEFCHR(HOST,TABLE,MASK)
; USAGE -- (UBS) = AFTCHR(HOST,TABLE,MASK)
; USAGE -- (UBS) = WHICHR(HOST,TABLE,MASK)
; USAGE -- (UBS) = ALLCHR(HOST,TABLE,MASK,BEFORE,AFTER)

BEFCHR:
BEFCH.:
	JSP	R1,FC.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FC.MERGE##	;JSP IS USED SO THAT A FAILURE IN FNDCHR (OR FNDSTR) 
			;DOES NOT HAVE TO WORRY ABOUT TWIDDLING THE STK
			;IMPLIED ALSO HOWEVER IS THAT SVP MUST HAVE NO OTHER 
			;USE IN FNDCHR (OR FNDSTR)
	FUNCT	BNDST.##,<$1,0(AP),$2,[1],POS2>
	RETURN
	PRGEND

	TITLE	AFTCHR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	AFTCHR,AFTCH.
AFTCHR:
AFTCH.:
	JSP	R1,FC.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FC.MERGE##
	FUNCT	RELST.##,<$1,0(AP), POS2>
	RETURN
	PRGEND

	TITLE	WHICHR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	WHICHR,WHICH.
WHICHR:
WHICH.:
	JSP	R1,FC.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FC.MERGE##
	FUNCT	VECST.##,<$1,0(AP), POS2,$2,[1]>
	RETURN
	PRGEND

	TITLE	ALLCHR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	ALLCHR,ALLCH.
ALLCHR:
ALLCH.:
	JSP	R1,FC.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FC.MERGE##
	SETZ	C1,

	SKIPN	@3(AP)		;IF 0, SET PTRS DIF
	JRST	[MOVE	R2,3(AP)	;GET ARG TYP & PTR
		 TLNE	R2,100	;MUST BE ON TO BE INTEGER
		 TLNE	R2,640	;MUST BE OFF TO BE INTEGER
		 JRST	.+1	;NOT INTEGER--MERGE
		 AOJA	C1,ALLC1]	;NOTE FACT
	FUNCT	BNDST.##,<$1,0(AP),$2,[1],POS2>
	MOVEI	R2,@3(AP)
	MOVEM	R0,0(R2)	;STORE (UBS) IN ACTUAL-ARG
	MOVEM	R1,1(R2)

ALLC1:	SKIPN	@4(AP)		;IF 0, SET PTRS DIF
	JRST	[MOVE	R2,4(AP)
		 TLNE	R2,100	;MUST BE ON TO BE INTEGER
		 TLNE	R2,640	;MUST BE OFF TO BE INTEGER
		 JRST	.+1	;NOT INTEGER--MERGE
		 SOJA	C1,ALLC2]	;NOTE FACT

	FUNCT	RELST.##,<$1,0(AP), POS2>
	MOVEI	R2,@4(AP)
	MOVEM	R0,0(R2)
	MOVEM	R1,1(R2)

ALLC2:	JUMPN	C1,ALLC4	;RET A CONCAT
	FUNCT	VECST.##,<$1,0(AP), POS2,$2,[1]>
	RETURN

ALLC3:				;BEF !! SELF
	JUMPL	C1,ALLC4
	FUNCT	VECST.##,<$1,0(AP),$2,[1],POS2>
	RETURN
ALLC4:				;SELF !! AFT
	FUNCT	BNDST.##,<$1,0(AP),POS2,$2,[0]>
	RETURN

; ********** END OF SIMPLE E.P. **************

	PRGEND

	TITLE	FNDCHR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- INTEGER-POSITION = FNDCHR(STRING,MODE,TABLE,MASK,[IPOS1,IPOS2])
; MODE -- EITHER ENTIRE STRING IN WHICH CASE IPOS1,2 NOT PRESETN
;		OR PARTIAL IN WHICH CASE THEY ARE

	ENTRY	FNDCHR,FNDCH.,FC.MERGE,FNDCHS

FNDCHR:
FNDCH.:
FNDCHS:
	SAVALL

	MOVE	MODE,@1(AP)
	TRZ	MODE,RETUBS	;CAN'T HAVE USER ACCIDEN. SETTING THIS
	MOVEI	BASP,@2(AP)
	MOVE	MASK,@3(AP)

FC.MERGE:
	STRARG	0,AP,BP1,LEN1,ML1

	TRNE	MODE,PARTIA
	JRST	[MOVE	POS1,@4(AP)
		 SKIPN	POS2,@5(AP)
		 MOVEI	POS2,1(LEN1)
		 IFE CHECK,<
		 CAILE	POS2,1(LEN1)	;DON'T ASK
		 ERROR	SPE$##>
		 LOCSUB	REL$##,<[BP1],POS1>
		 JRST	.+2]		;STANDARD IF THEN ELSE
	JRST	[MOVEI	POS1,1
		 MOVE	POS2,LEN1
		 AOJA	POS2,.+1]

	TRNE	MODE,ANCHOR
	MOVEI	POS2,2		;ASSUME A PARTIA OF 1,2

	TRNE	MODE,BAKWDS
	JRST	FCH.P2		;HERE SAYS WILL DECR BP

; PATH 1 *********

	SUB	POS1,POS2	;PROVIDES HOW MANY TIMES THRU (NEGATIVE)
	IFN CHECK,<
	JUMPGE	POS1,FCH.FA>
	IFE CHECK,<
	JUMPG	POS1,[ERROR	FES$##,FCH.FA
]
	JUMPE	POS1,FCH.FA>
FCH1:	ILDB	C1,BP1
	ADD	C1,BASP		;BASE OF TABLE + IDX IN TAB
	TDNE	MASK,0(C1)	;NO SKIP SAYS FOUND
	JRST 	FCH.SU
	AOJL	POS1,FCH1
	JRST	FCH.FA

; PATH 2 **********

FCH.P2:
	LOCSUB	REL$L##,<[BP1],LEN1>
	SUB	POS2,POS1	;PROVIDES HOW MANY TIMES THRU 
	IFN CHECK,<
	JUMPLE	POS2,FCH.FA>
	IFE CHECK,<
	JUMPL	POS2,[ERROR	FES$##,FCH.FA
]
	JUMPE	POS2,FCH.FA>
	SUBI	POS1,1		;WILL CAUSE IDX.E TO BE RETURNED OTHERW.
FCH2:	DECR	LDB,C1,BP1
	ADD	C1,BASP		;BASE OF TABLE + IDX IN TAB
	TDNE	MASK,0(C1)	;NO SKIP SAYS FOUND
	JRST 	FCH.SU
	SOJG	POS2,FCH2
	JRST	FCH.FA

; END OF PATH 2 *********

FCH.FA:
	SETZ	R0,
	SETZ	R1,
	JRST	FCHEND
FCH.SU:
	ADD	POS2,POS1	;POS1 IS NEG

	; ******** CODE TO HANDLE SIMPLER E.P.

	TRNE	MODE,RETUBS
	JRST	0(SVP)		;THE RETURN IN RESPONSE TO THE JSP
				;IN THE SIMPLER E.P.

	; ********* END OF SIMPLER E.P.

	MOVE	R0,POS2		;THE POSITION OOF THE FND CHAR
	TRNE	MODE,IDX.E		;NO SKIP SAYS POS. PAST CHAR WANTED
	ADDI	R0,1
	SUB	C1,BASP		;C1 NOW AGAIN CHAR CODE
	MOVE	R1,C1
FCHEND:
	RETURN
	PRGEND

	TITLE	BEFSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	BEFSTR,BEFST.

; ************ (UBS) RETURNING ENTRY POINTS ************

; USAGE -- (UBS) = BEFSTR(HOST,COUNT,SEARCH-STRINGS)
; USAGE -- (UBS) = AFTSTR(HOST,COUNT,SEARCH-STRINGS)
; USAGE -- (UBS) = WHISTR(HOST,COUNT,SEARCH-STRINGS)
; USAGE -- (UBS) = ALLSTR(HOST,BEFORE,AFTER,COUNT,SEARCH-STRINGS)

BEFSTR:
BEFST.:
	JSP	R1,FS.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FS.MERGE##	;JSP IS USED SO THAT A FAILURE IN FNDSTR (OR FNDSTR) 
			;DOES NOT HAVE TO WORRY ABOUT TWIDDLING THE STK
			;IMPLIED ALSO HOWEVER IS THAT SVP MUST HAVE NO OTHER 
			;USE IN FNDSTR (OR FNDSTR)
	FUNCT	BNDST.##,<$1,0(AP),$2,[1],POS2>
	RETURN
	PRGEND

	TITLE	AFTSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	AFTSTR,AFTST.
AFTSTR:
AFTST.:
	JSP	R1,FS.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FS.MERGE##
	SUBI	R1,1
	ADD	POS2,R1
	FUNCT	RELST.##,<$1,0(AP), POS2>
	RETURN
	PRGEND

	TITLE	WHISTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	WHISTR,WHIST.
WHISTR:
WHIST.:
	JSP	R1,FS.SV$##	;DO SAVE AND SET UP
	JSP	SVP,FS.MERGE##
	FUNCT	VECST.##,<$1,0(AP), POS2,R1>
	RETURN
	PRGEND

	TITLE	ALLSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>
	ENTRY	ALLSTR,ALLST.
ALLSTR:
ALLST.:
	JSP	R1,FS.SV$##	;DO SAVE AND SET UP
	MOVEI	CAP,3(AP)	;CNT IN DIF PLACE FOR ALLSTR
	JSP	SVP,FS.MERGE##
	SETZ	C1,		;CONTROLS PROC IF EITHER BEFPTR,AFTPTR 0

	MOVE	LEN1,R1		;LEN OF FOUND STRING
	SKIPN	@1(AP)		;IF 0, SET PTRS DIF
	JRST	[MOVE	R2,1(AP)		;GET ARG TYP & PTR
		 TLNE	R2,100	;MUST BE ON TO BE INTEGER
		 TLNE	R2,640	;MUST BE OFF TO BE INTEGER
		 JRST	.+1	;NOT INTEGER--MERGE
		 AOJA	C1,ALLS1]	;NOTE FACT

	FUNCT	BNDST.##,<$1,0(AP),$2,[1],POS2>
	MOVEI	R2,@1(AP)
	MOVEM	R0,0(R2)	;STORE (UBS) IN ACTUAL-ARG
	MOVEM	R1,1(R2)

ALLS1:	MOVE	POS1,LEN1
	SUBI	POS1,1
	ADD	POS1,POS2
	SKIPN	@2(AP)		;IF 0, SET PTRS DIF
	JRST	[MOVE	R2,2(AP)
		 TLNE	R2,100	;MUST BE ON TO BE INTEGER
		 TLNE	R2,640	;MUST BE OFF TO BE INTEGER
		 JRST	.+1	;NOT INTEGER--MERGE
		 SOJA	C1,ALLS2]	;NOTE FACT

	FUNCT	RELST.##,<$1,0(AP), POS1>
	MOVEI	R2,@2(AP)
	MOVEM	R0,0(R2)
	MOVEM	R1,1(R2)

ALLS2:
	JUMPN	C1,ALLS3	;RETURN A CONCATENATION
	FUNCT	VECST.##,<$1,0(AP), POS2,LEN1>
	RETURN

ALLS3:
	JUMPL	C1,ALLS4
	FUNCT	VECST.##,<$1,0(AP),$2,[1],POS2>
	RETURN
ALLS4:
	FUNCT	BNDST.##,<$1,0(AP),POS2,$2,[0]>
	RETURN

; ************ END OF (UBS) E.P. ***********

	PRGEND

	TITLE	FNDSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- PSEUDO-DP-VAL = FNDSTR (BIG-STRING,MODE,[IPOS1,IPOS2],[ICOUNT,STR1,STR-N])
; MODE CAN BE (INDEX-END/INDEX-START) * (ENTIRE/PARTIAL) * (MORE.1/1) * * (HALF-IN-HALF-OUT/ALL IN)
; THE PRESENCE OF IPOS1,2 DEPENDS ON PARTIAL
; THE PRESENCE OF ICOUNT,STR1... DEPENDS ON MORE.1

	ENTRY	FNDSTR,FNDST.,FS.MERGE,FNDSTS

;
	C1A=T0
	CAP=T0	;CURR ARG PTR--USED UNTIL ARG LIST DECODED
	C2=T1	;2ND CHAR PTR

	; NOTE !!! THESE THREE USE "NON-TEMPORARY" REGS

	KP.CNT=R2	;USED TO REINIT OUTER LOOP LEVEL
	TLEN=ML1

FNDSTR:
FNDST.:
FNDSTS:
	SAVALL

	MOVE	MODE,@1(AP)
	TRZ	MODE,RETUBS	;DON'T WANT THIS BIT ACCIDEN. SET
	HRRZI	CAP,2(AP)	;CAP=CURR ARG P

FS.MERGE:
	STRARG	0,AP,BP1,LEN1,ML1

; THE REST OF THE ARGS ARE VARIABLY POSITIONED

	TRCE	MODE,PARTIA	;INVERT SO HIHO TEST WILL SUCCEED WHEN "ENTIRE"
	JRST	[MOVE	POS1,@0(CAP)
		 SKIPN	POS2,@1(CAP)
		 MOVEI	POS2,1(LEN1)	;POS2=0 DEFAULTS TO MAX POS2
		 IFE CHECK,<
		 CAILE	POS2,1(LEN1)
		 ERROR	SPE$##>
		 LOCSUB	REL$##,<[BP1],POS1>
		 ADDI	CAP,2
		 JRST	.+2]		;STANDARD IF THEN ELSE
	JRST	[MOVEI	POS1,1
		 MOVEI	POS2,1		;PRESET FOR ANCHOR MODE
		 TRNN	MODE,ANCHOR	;YES (ANCHOR=HIHO)
		 MOVE	POS2,LEN1
		 AOJA	POS2,.+1]

	TRNE	MODE,MORE.1
	JRST	[MOVN	CNT,@0(CAP)	;WILL BE USING AOBJN'S
		 AOJA	CAP,.+2]
	SETO	CNT,

; ****************************************

	IFE CHECK,<
	JUMPGE	CNT,[ERROR	NSS$##,FND.F1
]>
	IFN CHECK,<
	JUMPGE	CNT,FND.F1>	;NO STRINGS?
	HRLS	KP.CNT,CNT	;SET UP BOTH WORDS WITH LEFT SIDE NEG CNT
	HRRI	KP.CNT,1(P)	;THE STRINGS WILL BE PUT ON STK
	HLL	CAP,CNT
	SUB	CAP,[1,,1]	;SINCE MUST PRETEST (AOBJP),MUST 
				;ADJST ARG CNT FURTHER NEG
		;THE MEANS OF GETTING THEM OFF THE ARG LST
	ILDB	C1,BP1		;MAY NEED IN FND0 LOOP -- NOTE: IMPLIES
				;NEED TO SKIP INSTR. AT FND.LP 1ST TIME THRU
FND0:

	SUB	POS1,POS2	;THE NUM OF CHAR POS TO CONSIDER
	IFN CHECK,<
	JUMPGE	POS1,FND.FA>
	IFE CHECK,<
	JUMPG	POS1,[ERROR	FES$##,FND.FA
]
	JUMPE	POS1,FND.FA>
	JRST	FNDLP1
; ********** BODY OF ROUTINE -- 2-LEVEL LOOP

FND.LP:
	ILDB	C1,BP1
FNDLP1:	MOVE	CNT,KP.CNT
	SUBI	LEN1,1
FND2:
	AOBJP	CAP,FND2A	;THIS LIST WILL BE STEPPED THRU--NOTE
				; THAT CALLS TO CMPSTR WILL START AT 2ND CHAR
	STRARG	0,CAP	;STRARG WITH NO LOCATIONS TO STORE INTO
				; LEAVES A (UBS) IN R0-R1

	ILDB	C2,R0		;BUMP BP AND BELOW LEN & PRESET 1ST CHAR

	PUSH	P,R0
	HRRZS	R1
	SOJL	R1,[PUSH	P,R1	;WILL CAUSE NULL STRING TO MATCH
					;BUT ALSO WANT EARLIER STRINGS TO
					;MATCH FIRST IF POSSIBLE
		 PUSH	P,C1		;PRETEND FIRST CHAR OF SEARCH-STR
					;IS FIRST CHAR OF HOST
		 JRST	.+2]
	JRST	[PUSH	P,R1
		 PUSH	P,C2		;PRE-STORE 1ST CHAR OF SEARCH-STR
		 JRST	.+1]
FND2A:
	CAME	C1,2(CNT)	;COMPARE PRE-SETUP 1ST CHAR OF SEA-STR WITH CURR CHAR OF HOST
	JRST	FND3		;LAST STATS IN INNER LOOP

	;  A FEW CONSISTENCY AND MODE-CAUSED CHECKS

	CAMGE	LEN1,1(CNT)		;WHAT'S LEFT OF 1ST ARG HAS TO BE LONGER THAN OTHER
	JRST	[TRNE	MODE,MORE.1	;NO SKIP SAYS MORE
		 JRST	FND3
		 JRST	FND.FA]
	TRNN	MODE,HIHO!ENTIRE	;ENTIRE/PARTIA HAVE BEEN INVRTED
	JRST	[MOVM	R0,POS1		;POS1 IS NEGATIVE OF REMAINDER
					; OF THE HOST STRING
		 CAMG	R0,1(CNT)	;FOR A COMPARISON OF REM(HOST) AND
					;SEA-STR TO SUCCEED,REM(HOST) MUST BE
					;GE LEN(SSTR). ACTUAL TEST
					;IS "G" SINCE 1(CNT) CONTAINS 1 LESS
					;THAN LEN(SSTR)
		 JRST	FND3		;DON'T BOTHER
		 JRST	.+1]		;1ST TERM IS LESS

	; GETTING HERE SAYS CHKS SUCCEEDED -- NOW DO COMPARE

	SKIPG	TLEN,1(CNT)
	JRST	FND.SU		;IF NULL STR. OR CHAR HAVE ALREADY MATCHED
	MOVE	R0,BP1		;CAN'T CLOBBER
	MOVE	R1,0(CNT)	;THE SEARCH-STR BP --BOTH AT 2ND CHAR
FND.CM:	ILDB	C1,R0
	ILDB	C2,R1
	CAME	C1,C2
	JRST	FND3A		;IF ANY .NE. FAIL ON COMPARE
	SOJG	TLEN,FND.CM
	JRST	FND.SU		;NO EARLY EXIT
FND3A:	LDB	C1,BP1		;RESTORE C1
FND3:	ADDI	CNT,2		;CNT POINTS AT TRIPLETS OF WORDS (BP,LEN)
	AOBJN	CNT,FND2
	AOJL	POS1,FND.LP
	JRST	FND.FA

; EXIT CODE
FND.SU:
	HLRS	KP.CNT	;ADJST STACK FOR SOURCE STRINGS
	JUMPGE	CAP,[MOVE	CAP,KP.CNT
		     JRST	FND.S1]
	HLRS	CAP		;CAP=[-NUM NOT PUSHED,,-SAME]
	SETCA	CAP,		;SET POSITIVE CORRECTLY--DO NOT NEGATE!!
	ADD	CAP,KP.CNT	;DECREASE KP.CNT
FND.S1:
	ADD	P,CAP
	ADD	P,CAP		;CAP NEG
	ADD	P,CAP		;2 WORDS PER STRING
	SUB	P,[3,0]			;CAP = NOT(STR#,,STR#),WHICH
					;ISN'T SAME AS NEG(STR#,,STR#)

	ADD	POS2,POS1
	MOVE	R0,POS2		;THE INDEX OF THE START OF THE MATCHED STR
				;POS1 CONTAINS CURRPOS-POS2

	AOS	R1,1(CNT)	;CNT POINTS AT THE CURRENT (UBS)... CONSEQ.
				;THE SECOND WORD IS THE LEN OF THE
				;STRING PTED. AT. HOWEVER IN THE "FND0"
				;LOOP EACH LENGTH WAS DECREMENTED BY 1
				;SINCE CMPST. STARTS COMPARING AT THE
				;2ND CHAR OF EACH SEARCH STRING

	; ********** INTERCEPT FOR (UBS) RETURNING E.P.

	TRNE	MODE,RETUBS	;NO SKIP INTERCEPTS
	JRST	0(SVP)		;BACK TO INCES. CALLER

	; ********* END OF INTERCEPT

	TRNE	MODE,IDX.E	;NO SKIP SAYS USER WANTS IDX AFTER MAT. STR
	ADD	R0,1(CNT)	;LEN OF STR. MATCHED

	TRNE	MODE,WHICH	;SKIP PUTS WHICH STRING IN LEFT SIDE OF R1
	JRST	[HLRS	CNT		;KP.CNT=INIT,,INIT. NOW CNT=IDX,,IDX
		 SUB	CNT,KP.CNT	;CNT NOW IDX-1 FROM OTHER END
		 MOVEI	R1,1(CNT)	;ADD 1 SINCE KP.CNT-KP.CNT=0
		 RETURN]
	RETURN
FND.FA:	HLRS	KP.CNT	;ADJST STACK FOR SOURCE STRINGS
	ADD	P,KP.CNT
	ADD	P,KP.CNT		;KP.CNT NEG
	ADD	P,KP.CNT		;2 WORDS PER STRING
	SUB	P,[3,0]			;KP.CNT = NOT(STR#,,STR#),WHICH
					;ISN'T SAME AS NEG(STR#,,STR#)
FND.F1:	SETZ	R0,
	SETZ	R1,	;CONSISTENCY
	RETURN
	PRGEND

	TITLE	LENSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- INTEGER-POS = LENSTR (STRING)

	ENTRY	LENSTR,LENST.

LENSTR:
LENST.:
	STRARG 0,AP

	HRRZ	R0,R1	;THE RETURN VAL
	SETZ	R1,	;CONSISTENCY
	POPJ	P,
	PRGEND

; ******************

	TITLE	VECSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- (UBS) = VECSTR (STRING,IPOS,LENGTH)

	ENTRY	VECSTR,VECST.

VECSTR:
VECST.:
	IFE BND.CH, <SAVE	<R2>>
	STRARG	0,AP,,,R2
	IFE CHECK,<
	IFE BND.CH, <HRRZS	R1>
	CAMGE	R1,@2(AP)
	ERROR	EPS$##>

	LOCSUB REL$##,<[R0],@1(AP)>
	IFN CHECK,<
	MOVE	R1,@2(AP)>

	IFE CHECK,<
	SKIPGE	R1,@2(AP)	;IS LEN LEGAL
	ERROR	LLZ$##
	IFE BND.CH,<
	CAMGE	R2,R1
	ERROR	LEM$##>
>
	IFE BND.CH,<
	HRL	R1,R2		;SET UP MAXLEN
	RESTOR	<R2>>
	POPJ	P,
	PRGEND

	TITLE	BNDSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- (UBS) = BNDSTR (STRING,IPOS1,IPOS2)

	ENTRY BNDSTR,BNDST.
BNDSTR:
BNDST.:
	IFE BND.CH, <SAVE	<R2>>
	STRARG	0,AP,,,R2

	IFE CHECK,<
	IFE BND.CH, <HRRZS	R1>
	ADDI	R1,1
	CAMGE	R1,@2(AP)
	ERROR	EPS$##
	SUBI	R1,1>

	LOCSUB REL$##,<[R0],@1(AP)>
	SKIPN	@2(AP)		;IF ZERO LET REL$## RET VAL STAND
	JRST	BND1
	HRRZ	R1,@2(AP)	;FURTHER POS
	SUB	R1,@1(AP)	;NEARER POS
	IFE CHECK,<
	IFE BND.CH,<
	CAMGE	R2,R1
	ERROR	LEM$##>
	JUMPL	R1,[ERROR	FES$##
]>
BND1:
	IFE BND.CH,<
	HRL	R1,R2		;SET UP MAXLEN
	RESTOR	<R2>>
	POPJ	P,
	PRGEND


; ***********************

	TITLE	RELSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- (UBS) = RELSTR(STRING,IPOS)

	ENTRY	RELSTR,RELST.

RELSTR:
RELST.:
	IFE BND.CH, <SAVE <R2>>
	STRARG	0,AP,,,R2

	LOCSUB REL$L##,<[R0],@1(AP)>

	IFE BND.CH,<
	HRL	R1,R2		;SET UP MAXLEN
	RESTOR	<R2>>
	POPJ	P,
	PRGEND

	TITLE	SETSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- NO-RETURN-VAL = SETSTR(STRING,LEN,MAXLEN)
; WILL PERFORM OPERATION ON LEN/MAXLEN IF GTR THAN ZERO

	ENTRY SETSTR,SETST.

SETSTR:
SETST.:

	SAVE	<R2>
	LDB	R0,[TYPCOD+AP,,0]
	MOVEI	R1,@0(AP)

	ADDI	R0,TYP.X2
	JRST	@R0		;DATA TYPE INDEXED TABLE (IMMED. FOLLOWS)

TYP.X2:
	JRST	SET.SP		;FOR INTERNAL USE AND STRING PTR CONSTANT
	JRST	SET.C		;LOGICAL TREAT AS DATA-VARYING STRING
	JRST	SET.NOOP
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	SET.NOOP
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	SET.NOOP
	JRST	SET.NOOP
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	SET.SP		;COMPLEX IS STRING PTR
	JRST	SET.SP		;BYTE DESCRIPTOR IS STR PTR
	ERROR	IDT$##		;WILL RETURN DIRECTLY TO CALLER
	JRST	SET.Z		;ASCIZ

SET.SP:
	SKIPL	R2,@1(AP)
	HRRM	R2,1(R1)
	IFE BND.CH,<
	SKIPL	R2,@2(AP)
	HRLM	R2,1(R1)>
	HLRZ	R2,-1(AP)	;ARG CNT
	CAIN	R2,777774		;-4?
	JRST	[MOVE	R2,@3(AP)	;SET UP BYTE SIZE
		 DPB	R2,[300601,,0]	;AND STORE INDEXED BY R1
		 JRST	SETEND]
	JRST	SETEND

SET.Z:
	HRLI	R1,IPOSIZ
	MOVE	R0,R1		;GET IN USUAL LOC
	SKIPGE	R1,@1(AP)
	JRST	SETEND
	MOVEI	R2,-1	;WANT NO OVFL.
	LOCSUB	REL$L##,<[R0],R1>
	SETZ	R2,
	IDPB	R2,R0	;STORE A ZERO IN LEN--R1 +1
	JRST	SETEND

SET.C:
	SKIPL	R2,@1(AP)
	HRRM	R2,-1(R1)
	IFE BND.CH,<
	SKIPL	R2,@2(AP)
	HRLM	R2,-1(R1)>
	JRST	SETEND

SET.NOOP:
SETEND:
	SETZ	R0,
	SETZ	R1,
	RESTOR	<R2>
	POPJ	P,
	PRGEND

	TITLE	TABSTR
	SEARCH	STRDCL
	IFE HIGH,<
	TWOSEG
	RELOC	400000>

; USAGE -- (NO RETURN VALUE) = TABSTR(ARRAY,MASK,STRING-OF-CHARS-TO-BE-IN-TABLE)
; USAGE -- CALL TONSTR(ARRAY,MASK,STRING-OF-CHARS-2-TURN-ON)
; USAGE -- CALL TOFSTR(ARRAY,MASK,STRING-OF-C-2-TURN-OFF)
; USAGE -- CALL TAZSTR(ARRAY,MASK) -- ZERO TABLE
; USAGE -- CALL TAOSTR(ARRAY,MASK) -- ONES TABLE

	ENTRY TABSTR,TABST.,TONSTR,TONST.,TOFSTR,TOFST.
	ENTRY TAZSTR,TAZST.,TAOSTR,TAOST.

;	BASP=T1	;BASE PTR FOR ARRAY
;	MASK=T0

; ******** THE ENTRY CODE **********

TABSTR:
TABST.:
	SETZ	R1,	;INCEST. ARG.
	JSP	SVP,TAB.SV
	;CODE TO SEE IF SETTING UP TAB FOR STR. OR (NOT) STR.

	TLNE	MASK,3		;IF 2 BITS ARE BOTH 0--YOU KNOW IS COMP.
	TRNN	MASK,3		;CANT HAPPEN ON BOTH TESTS IF COMP.
	JRST	[JSP	SVP,TAB.O	;TURN TAB ON
		 SUBI	BASP,TABSIZ	;RE-INIT BASP
		 SETCA	MASK,
		 JRST	TAB.OF]
	JRST	TAB.ON

TONSTR:
TONST.:
	SETZ	R1,
	JSP	SVP,TAB.SV
TAB.ON:	SETCA	MASK,
TAB1:	ILDB	C1,R0	;FOR EACH CHAR IN ARG3, SET A BIT IN THE APPROP. TAB WD.
	ADD	C1,BASP
	IORM	MASK,0(C1)
	SOJG	R1,TAB1
	JRST	TABEND
TOFSTR:
TOFST.:
	SETZ	R1,
	JSP	SVP,TAB.SV
TAB.OF:
TAB3:	ILDB	C1,R0	;FOR EACH CHAR IN ARG3, TURN OFF A BIT IN THE APPROP. TAB WD.
	ADD	C1,BASP
	ANDM	MASK,0(C1)	;TURNS OFF THE SELECTED BIT
	SOJG	R1,TAB3
	JRST	TABEND
TAZSTR:
TAZST.:
	SETO	R1,
	JSP	SVP,TAB.SV
	JSP	SVP,TAB.Z
	JRST	TABEND
TAOSTR:
TAOST.:
	SETO	R1,
	JSP	SVP,TAB.SV
	SETCA	MASK,
	JSP	SVP,TAB.O
	JRST	TABEND
 
; ******* END OF ENTRY CODE  ********

TAB.SV:
	SAVE <BASP,MASK,C1>
	MOVEI	BASP,@0(AP)
	SETCM	MASK,@1(AP)	;TO CHK TO SEE IF MASK IS ALL ONES WITH A ZERO

	JUMPL	R1,0(SVP)	;NO STRARG FOR TAO,TAZ
	STRARG	2,AP
	HRRZS	R1		;DON'T NEED MAXLEN FOR THIS

	JUMPLE	R1,TABEND
	JRST	0(SVP)

TAB.Z:
	SUB	BASP,[TABSIZ,,0]	;FOR AOBJM
TAB2:	ANDM	MASK,0(BASP)	;SET EVERY WORD OFF
	AOBJN	BASP,TAB2
	JRST	0(SVP)

TAB.O:
	SUB	BASP,[TABSIZ,,0]	;FOR AOBJM
TAB4:	IORM	MASK,0(BASP)	;SET EVERY WORD ON
	AOBJN	BASP,TAB4
	JRST	0(SVP)

TABEND:
	RESTOR <C1,MASK,BASP>
	SETZ	R0,	;CONSIST
	SETZ	R1,	;CONSIST
	POPJ	P,
	END