1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-02 09:37:06 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1458 lines
31 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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