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