perm filename SAISUB.FAI[S,AIL] blob sn#191943 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(SUB,<SUBST,SUBSR>,<SAVE,RESTR,X22,.SKIP.,GOGTAB>,<SUBSTRING ROUTINES>)
HERE (SUBST)
	MOVE	LPSA,-2(P)		;END LOC
	JRST	SBSTR			;GO FINISH UP
HERE (SUBSR)
	SOS	LPSA,-2(P)		;#CHARS
	ADD	LPSA,-1(P)		;-1 + START = END
SBSTR:	MOVE	TEMP,GOGTAB		;FOR A MOMENT
	POP	P,UUO1(TEMP)		;SAVE RETURN -- NONSTANDARD!!
	SETZM	.SKIP.			;ASSUME ALL OK
	MOVE	USER,(P)		;START LOC
	HRRZ	TEMP,-1(SP)		;LENGTH OF STRING
	JUMPL	LPSA,[     TDZA LPSA,LPSA ;END LOC CANNOT BE NEGATIVE
		      NO4: MOVE LPSA,TEMP ;NOR GREATER THAN LENGTH
			   HLLOS .SKIP.   ;TELL THE USER END WAS WRONG
			   JRST  OKS1]
	CAMLE	LPSA,TEMP		;END LOC CANNOT BE GREATER THAN LENGTH
	 JRST	 NO4
OKS1:	CAIL	USER,1(LPSA)		;NEW STRING MUST HAVE NON-NEG LENGTH
	 JRST	 NO1			;ADJUST TO 1(LPSA)
	JUMPLE	USER,[NO2:	MOVEI USER,1	;NON-POS, ADJUST TO 1
				JRST NO3
			NO1:	MOVEI USER,1(LPSA) ;1 PAST END OF REQUEST
			NO3:	HRROS .SKIP.	   ;TELL USER START IS BAD
				JRST  OKS]	   ;NOW CAN DO SUBSTRING
OKS:	SUBI	LPSA,-1(USER)		;NEW STRING LENGTH
	HRRM	LPSA,-1(SP)		;GET RID OF IT, FORGET IT
	MOVE	LPSA,(SP)		;BP
	LDB	TEMP,[POINT 3,LPSA,5]
	TRC	TEMP,4			;# CHARS FROM BEG OF CURRENT BP
	ADDI	TEMP,-1(USER)		;+ # ADDITIONAL CHARS DUE TO SUBSTR
	CAILE	TEMP,4			;CAN WE AVOID DIV OR SUB?
	 JRST	 DIVSUB			;NO
GETPTF:	HLL	LPSA,PTBL(TEMP)		;GET POINTER AND SIZE FIELDS
PTWAY:	MOVEM	LPSA,(SP)		;RESULT BP
	SUB	P,X22			;RID SELF OF ARGUMENTS
	JRST	@3(P)			;RETURN
DIVSUB:	CAILE	TEMP,9			;CAN WE AVOID DIV?
	 JRST	 DIV			;NO
	SUBI	TEMP,5			;PUT # IN RANGE 0 TO 4
	ADDI	LPSA,1			;INCREMENT BP
	JRST	GETPTF			;FINISH UP
DIV:	IDIVI	TEMP,5			;# WORDS TO USER, # CHARS TO TEMP
	ADD	LPSA,TEMP		;INCREMENT BP ADR FIELD
	HLL	LPSA,PTBL(USER)		;GET POINTER AND SIZE FIELDS
	JRST	PTWAY			;FINISH UP
PTBL:	POINT	7,0
	POINT	7,0,6			;POINTER AND SIZE FIELDS FOR 7-BIT BYTES
	POINT	7,0,13
	POINT	7,0,20
	POINT	7,0,27
	POINT	7,0,35
ENDCOM (SUB)
END