If you've read some of these pages, you know I like coding string search programs. This started because my boss coded a really bad one in COBOL that locked up the IBM 195 system that the bank had back in the '70s. Today, my PC is faster than that system, but in it's day, it was a screaming machine, maybe 5-10 times faster than the model 65s that the bank had. So after he locked up their super computer, operations kicked him out, and I wrote a program that did what he wanted, really fast. But not to be satisfied, I can make it faster yet. The program I wrote looked for the first character of the string, and did the compare for the string. (Boss's program compared the string to location 1, then 2, then 3, then 4, all the way through the record.) But, for example, if my program then were to search for "EXIT" it would find an "E" and then do the compare. BUT, if I looked for "X" and then did the compare, it would do many fewer compares, so that's what I've been playing with.
There is a Z390 simulator that's free, and runs IBM mainframe assembler code on a PC. COOL !!! There's also an editor that's even nicer than the ISPF editor I used at work for many years. Both of those systems (z390 and SPFlite) are very well written by nice folks. SOOO, I can code assembler at my desk at home, and run it. I certainly cannot do it as well as I used to, but I like doing it. And it's probably good mental exercise.
So, I bit ago, I wrote FIND1 that scans for a string. I like it. Works well. Too bad I can't find some place to really use it. However, as above, I'm never satisfied. so I wrote FINDALL which can search for multiple strings all at the same time. It loads the strings, finds the least frequent character in each, sets up a table with entries for all those characters, and, with a single TRT instruction, looks for any of those characters, all at the same time. When it finds one, it does the proper compare, and if there's a match, writes the record to the output file for that string. It does have to be careful to not write the same record multiple times. And any one record might contain more than one of the strings.
At 11pm tonight, it worked. I think I started it a couple weeks ago. Some days, I just didn't feel like working. I never put in a whole day. But it works. I've made several tweaks, and I'll probably make, but it works. For my test run, I used the source code for the program. The strings I looked for are CLC, FREQ, BCT, BAL, MVC, DCB, and GET. While it's running, it produces a report, that I used many times to find mistakes that I made. (I make way more of 'em than I used to.) This is what that report looks like.
FINDALL, ASM 05/05/25 AT 23.01
FINDALL, ASM 05/07/25 AT 13.02 BY LIN LYONS, 4/25 TO EFFICIENTLY FIND MULTIPLE STRINGS IN 1 PASS
FINDALL IS LIKE FIND1, EXCEPT IT FINDS MULTIPLE STRINGS IN 1 PASS, WITH A SINGLE TRT TABLE SCANNING THE RECORD.
YOU COULD FIND THE HISTORY OF THIS, AND OTHER PROGRAMS, IN
HTTPS://SITES.GOOGLE.COM/SITE/LINLYONS/FINDALL-FIND-MULTIPLE-STRINGS-IN-1-PASS-THROUGH-A-FILE
EACH SEARCH STRING MUST HAVE A FILE TO WRITE RECORDS TO. THE DDNAME WILL BE THE STRING, OR DD=WHATEVER
IF THE STRING CONTAINS OTHER THAN LETTERS AND #S, THEN THE USER MUST SPECIFY A DDNAME.
SAMPLE CONTROL CARDS MIGHT LOOK LIKE:
C"YOURNAME",X"C4C3C2",DD=C4C3C2,C$YOUR NAME$
NOTICE THAT THE QUOTES MUST MATCH, BUT YOU CAN USE ANY SPECIAL CHARS.
ALSO, THE PROGRAM DOES NOT CHECK FOR COMMAS, OTHER THAN THE LOCATIONS MUST BE ACCURATE.
THERE IS AN INTERNAL TABLE THAT CAN HOLD ABOUT 6 ENTRIES.
IF YOU HAVE MORE THAN THAT, YOU NEED TO SPECIFY MORE, EG, PARM=12
STRINGS CAN BE SPECIFIED EITHER IN THE PARM, OR IN //SYSIN CARDS. EG
PARM="12,C"ABC",C"DEF GHI",DD=DEFGHI,X"D4E8E2C1D5",DD=MYSCAN
//SYSIN DD *
C"LOTS",C"MORE" C"STRINGS"
IF YOU CODE END (C"WXYZ",END) THAT WILL TERMINATE CC PROCESSING.
THE DEFAULT IS TO USE SELECT STRINGS FROM THE PARM FIELD, AND THEN
READ THE //SYSIN FILE AND USE MORE STRINGS FROM THAT. TO PREVENT
OPENING THE SYSIN FILE, CODE ",END " AT THE END OF THE PARM.
EG, PARM="C"ABC",X"CDEF",C"WHAT EVER",END "
THAT WILL PREVENT TRYING TO OPEN THE //SYSIN FILE.
SAMPLE JCL MIGHT LOOK LIKE
SCAN EXEC PGM=FINDALL,PARM="##,C"YOURNAME",DD,X"ABCD",DD=HEXOUT
//STEPLIB DD DISP=SHR,DSN=
//SYSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN=
//OUT DD SYSOUT=*
//SYSIN DD *
C"ABCD",DD,X"C1C2C3C4C5",DD,C"WHATEVER",DD=WHATEV
//YOURNAME DD SYSOUT=*
//HEXOUT DD SYSOUT=*
//ABCD DD SYSOUT=*
//ABCDE DD SYSOUT=*
//WHATEV DD SYSOUT=*
--------------------------------------
PARM=11
WORK AREA LARGE ENOUGH FOR 009 STRINGS+FILES
OPEN SYSIN
SYSIN OPEN FOR INPUT, RECFM=A0, LRECL=00080
C'CLC',C'FREQ',X'C2C3E3',DD=A,C'BAL',DD=BBBBB
C'FREQ',X'C2C3E3',DD=A,C'BAL',DD=BBBBB
X'C2C3E3',DD=A,C'BAL',DD=BBBBB
C'BAL',DD=BBBBB
C'MVC',X'C4C3C2',C'GET'
X'C4C3C2',C'GET'
C'GET'
000 002 001 C BBBBB B BAL
000 002 000 X A C2 C2C3E3
002 002 000 X DCB C2 C4C3C2
000 002 004 C CLC C CLC
000 002 005 C GET G GET
003 003 006 C FREQ Q FREQ
001 002 007 C MVC V MVC
OPEN IN
IN OPEN FOR INPUT, RECFM=A0, LRECL=00399
OPEN BBBBB
BBBBB OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
OPEN A
A OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
OPEN DCB
DCB OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
OPEN CLC
CLC OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
OPEN GET
GET OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
OPEN FREQ
FREQ OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
OPEN MVC
MVC OPEN FOR OUTPUT, RECFM=A0, LRECL=00399
TRT INSTRUCTIONS USED 5,146
CLC INSTRUCTIONS USED 3,729
IN CLOSED, RECORDS READ 1,154
BBBBB CLOSED, RECORDS WRITTEN 22
A CLOSED, RECORDS WRITTEN 04
DCB CLOSED, RECORDS WRITTEN 84
CLC CLOSED, RECORDS WRITTEN 22
GET CLOSED, RECORDS WRITTEN 36
FREQ CLOSED, RECORDS WRITTEN 24
MVC CLOSED, RECORDS WRITTEN 64
And the source program is:
AGO .START
--ASSEMBLE, LINK, AND GO -----------------------
C:\USERS\LIN\DOCUMENTS\Z390CODE\FINDALL
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\FINDALL
SET IN=C:\USERS\LIN\DOCUMENTS\BUSHSTUFF.TXT
SET OUT=%G%.OUT.TXT
BAT\ASMLG %G%.MLC TIME(1)
BAT\EZ390 %G%.MLC TEST
-----------------------------------------------------------
.START ANOP
* -----------------------------------------------------------
MACRO
&LABEL ERR &BC,&TEXT
LCLA &A
GBLA &ERR
LCLC &SYS
&A SETA K'&TEXT-3
&ERR SETA 1+&ERR
&SYS SETC 'SYS&ERR'
.* DC C'&A &ERR &SYS '
&LABEL REVB &BC,&SYS
STM 0,15,ERRREGS
BAL R9,ERR
DC AL1(&ERR,&A),C&TEXT
&SYS DS 0H
MEND
* -----------------------------------------------------------
MACRO
&LABEL REVB &COND,&TO
LCLC &C,&B
LCLA &LEN
AIF ('&COND' NE 'B').ADDREM
&LABEL NOP &TO
MEXIT
.ADDREM ANOP
&LEN SETA K'&COND
AIF ('&COND'(2,1) NE 'N').ADD
&B SETC '&COND'(3,&LEN-2)
AGO .DOIT
.ADD ANOP
&B SETC '&COND'(2,&LEN-1)
&B SETC 'N&B'
.DOIT ANOP
&LABEL B&B &TO
MEND
* -----------------------------------------------------------
MACRO
$ &TEXT
LCLA &N
&N SETA K'&TEXT-3
DC AL1(&N),C&TEXT
MEND
* -----------------------------------------------------------
* AFTER REG-SAVE, GET THE PARM FIELD. IF WE HAVE SEVERAL STRINGS
* TO SCAN FOR, WE'LL NEED A LARGER TABLED, AND 1-2-3 DIGITS OF PARM
* INDICATE THE MAX NUMBER OF TABLE ENTRIES.
* EACH TABLE ENTRY IS LARGE ENOUGH FOR THE ENTRY PLUS A DCB
* TO WRITE SELECTED RECORDS TO.
* ALTERNATIVELY, WE COULD JUST WRITE ALL SELECTED RECORDS TO //OUT DD
* PARM FIELD CAN CONTAIN ALSO CONTAIN A SEARCH STRING. IF IT DOES,
* MOVE IT TO THE "CARD" WORK AREA, AND PROCESS IT LIKE IT CAME
* FROM //SYSIN.
*
FINDALL START 0
YREGS
USING *,13,12
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
LA 12,1
LA 12,4095(12,13)
L R8,AGETMAIN
SH R8,=AL2(LDSECT)
USING DSECT,R8
L R1,0(R1)
LH R2,0(R1)
SH R2,=H'1'
BM BEGIN
MVC PARM(0),2(R1)
EX R2,*-6
CLI PARM,C'0'
BL NOGETM
BAL R9,OPENSYSP
*
LA R2,PARM
SR R3,R3
ICPARM# IC R0,0(R2)
N R0,=F'15'
MH R3,=H'10'
AR R3,R0
LA R2,1(R2)
CLI 0(R2),C'0'
BNL ICPARM#
MVC PARM,1(R2)
BAL R9,OPENSYSP
*
LA R0,2(R3)
MH R0,SIZE+2
ST R0,LGETMAIN
GETMAIN R,LV=(0)
ST R1,AGETMAIN
A R1,LGETMAIN
S R1,SIZE
ST R1,EGETMAIN
NOGETM L R8,AGETMAIN
SH R8,=AL2(LDSECT)
MVC CARD,PARM
MVC PARM-5,PARM-6
CLI CARD,C' '
BE GETCARD
B GOTCARD
*
* SELECT STRINGS CAN BE C"ABCD" OR X"ABCD" ETC
BEGIN BAL R9,OPENSYSP
GETCARD TM DCBOFLGS-IHADCB+SYSIN,DCBOFOPN
BO *+12
LA R2,SYSIN
BAL R9,OPENIN
GET SYSIN
MVC CARD,0(R1)
GOTCARD CLC =C'END ',CARD
BE ZS
LA R8,LDSECT(R8)
MVC LINE+1(80),CARD
BAL R9,PUTLINE
XC 0(LDSECTI,R8),0(R8)
MVC DSECTSTR,LINE
MVC DSECTDD,LINE
ST R8,LASTLIST
LA R0,LDSECT(R8)
ST R0,ENDLIST
CLI CARD,C' '
BE GETCARD
LA R1,CARD+1
MVC DSECTTYP,CARD
CLI CARD,C'X'
BE ITSHEX
CLI CARD,C'C'
ERR BNE,'BAD DATA TYPE'
PARSCARD LA R1,1(R1)
CLC LINE(44),0(R1)
ERR BE,'MISSING END QUOTE'
CLC CARD+1(1),0(R1)
BNE PARSCARD
LR R2,R1
S R1,=A(CARD+3)
MVC DSECTSTR(0),CARD+2
EX R1,*-6
STH R1,DSECTSTL
MVC CARD,2(R2)
QDD CLC =C'DD=',CARD
BE QDDSTR
MVC DSECTDD,DSECTSTR
CLI CARD,C' '
BE GETCARD
B GOTCARD
* DD=ABCD,C"...
QDDSTR MVC CARD,CARD+3
TRT CARD(9),QCHAR
ERR BZ,'BAD DDNAME'
LR R2,R1
S R1,=A(CARD+1)
MVC DSECTDD(0),CARD
EX R1,*-6
MVC CARD,1(R2)
CLI CARD,C' '
BE GETCARD
B GOTCARD
*
ITSHEX LA R14,CARD+2
LA R15,DSECTSTR
ITSHEXTR TRT 0(2,R14),TESTHEX
ERR BNZ,'BAD HEX OR QUOTE OR ODD LENGTH'
TR 0(2,R14),MAKEHEX
PACK 0(2,R15),0(3,R14)
LA R15,1(R15)
MVI 0(R15),C' '
LA R14,2(R14)
CLC CARD+1(1),0(R14)
BNE ITSHEXTR
*
LR R2,R14
S R2,=A(CARD+2)
SRL R2,1
SH R2,=H'1'
ERR BNP,'MIN HEX LENGTH=2'
STH R2,DSECTSTL
MVC CARD,2(R14)
B QDD
*
* ---------------------------- FIND LOW FREQ CHAR FOR EACH STRING---
*** BAL R9,LISTLIST
ZS L R8,AGETMAIN END OF //SYSIN, FIND LOW FREQ CHARS
FREQLOOP MVC LINE(60),DSECTSTR
TR LINE(60),FREQTBL
LA R2,LINE
LA R1,LINE+1
LH R0,DSECTSTL
FINDFRQ CLC 0(1,R1),0(R2)
BNL *+6
LR R2,R1
LA R1,1(R1)
BCT R0,FINDFRQ
S R2,=A(LINE) OFFSET TO LEAST FREQ CHAR
STH R2,DSECTPRE
LA R1,DSECTSTR(R2)
MVC DSECTCHR,0(R1)
LA R8,LDSECT(R8)
C R8,ENDLIST
BL FREQLOOP
* -------------------------- SORT LIST ON CHAR AND STRING
L R8,AGETMAIN
L R3,ENDLIST
SORTLOOP LR R1,R8
LA R14,LDSECT(R8)
SORTCLC CLC DSECTCHR-DSECT(L'DSECTSTR,R1),DSECTCHR-DSECT(R14)
BNH *+6
LR R1,R14
LA R14,LDSECT(R14)
C R14,ENDLIST
BL SORTCLC
*
CR R8,R1 Q. LOW ENTRY ALREADY FIRST?
BE NOSWAP YES, DON'T SWAP
MVC 0(LDSECT,R3),0(R1)
MVC 0(LDSECT,R1),0(R8)
MVC 0(LDSECT,R8),0(R3)
NOSWAP LA R8,LDSECT(R8)
C R8,ENDLIST
BL SORTLOOP
MVI 0(R8),X'FF'
MVC 1(63,R8),0(R8)
** BAL R9,LISTLIST
* ------------------------------------------------------
XC TRTTBL,TRTTBL
L R8,AGETMAIN
SR R1,R1
SR R2,R2
SETTABLE IC R1,DSECTCHR
LA R3,TRTTBL(R1)
LA R2,1(R2)
CLI 0(R3),0
BNE *+12
STC R2,0(R3)
STC R2,DSECT##
LA R8,LDSECT(R8)
C R8,ENDLIST
BL SETTABLE
BAL R9,LISTLIST
* ------------------------------------------------------
LA R2,IN
BAL R9,OPENIN
IC R0,DCBRECFM-IHADCB+IN
STC R0,DCBRECFM-IHADCB+OUT
LH R0,DCBLRECL-IHADCB+IN
STH R0,DCBLRECL-IHADCB+OUT
L R8,AGETMAIN
L R2,ENDLIST
LA R2,LDCB(R2)
ST R2,FIRSTDCB
SETUPDCB CLI DSECTDD,C' '
BNH DONTOPEN
MVC DCBDDNAM-IHADCB+OUT,DSECTDD
MVC 0(LDCB,R2),OUT
ST R2,DSECTDCB
BAL R9,OPENOUT
ST R2,LASTDCB
LA R2,LDCB(R2)
ST R2,ENDDCB
DONTOPEN LA R8,LDSECT(R8)
C R8,ENDLIST
BL SETUPDCB
* ------------------------------------------------------------
GET GET IN
AP #IN,P1
LA R3,0(R1)
ST R3,RECADDR
LH R4,DCBLRECL-IHADCB+IN
AR R4,R3
LOOP LR R2,R4
SR R2,R3
BNP GET
AP #TRT,P1
CH R2,=H'256'
BL SHORT
SR R2,R2
TRT 0(256,R3),TRTTBL
BNZ FOUND
LA R3,256(R3)
B LOOP
*
CLC 0(0,R14),DSECTSTR
CLC DSECTSTR(0),0(R14)
TRT 0(0,R3),TRTTBL
SHORT EX R2,SHORT-6
BZ GET
FOUND SLL R2,6 MULTIPLY BY 64
LA R3,1(R1)
LR R6,R1
L R8,AGETMAIN
SH R8,=H'64'
AR R8,R2
NEXTCLC LR R14,R6 FOUND CHAR
SH R14,DSECTPRE BACK UP TO FRONT OF STRING
LH R5,DSECTSTL STRING LENGTH
LA R15,0(R14,R5) A OF END OF STRING
CR R15,R4 Q. STRING PAST END OF BUFFER?
BNL NFOUND YES, NOT FOUND
AP #CLC,P1
EX R5,SHORT-12 NO, COMP;ARE STRING
BH LOOP Q. FOUND HIGHER THAN STR? YES, SKIP.
BNE NFOUND NOT =, TRY NEXT STRING
USING DCBDSECT,1
WRITE L R1,DSECTDCB LOAD DCB ADDR
LTR R1,R1
BP *+8
EX 0,*
CLC DCB###,#IN Q. DID WE ALREADY WRITE THIS?
BE NFOUND YES, DON'T WRITE TWICE
MVC DCB###,#IN NO, SAVE RECORD ##
AP DCB#,P1 COUNT
L R0,RECADDR LOAD REC ADDR
PUT (1),(0) AND WRITE.
DROP 1
*
NFOUND CLC DSECTCHR,DSECTCHR+LDSECT
BNE LOOP
LA R8,LDSECT(R8)
B NEXTCLC
* ---------------------------------------------------------
USING IHADCB,2
CLOSEOUT MVC LINE+9(24),=CL24'CLOSED, RECORDS WRITTEN'
B *+10
CLOSEIN MVC LINE+9(24),=CL24'CLOSED, RECORDS READ'
TM DCBOFLGS,DCBOFOPN
BO CLOSEC
MVC LINE,LINE-1
MVC LINE(8),DCBDDNAM
MVC LINE+9(8),=C'NOT OPEN'
B CLOSEPUT
CLOSEC CLOSE ((2))
MVC LINE(8),DCBDDNAM
USING DCBDSECT,2
MVC LINE+33(L'EDIT6),EDIT6
ED LINE+33(L'EDIT6),DCB#+2
CLOSEPUT PUT SYSPRINT,LINE-1
C R2,FIRSTDCB
BLR R9
C R2,LASTDCB
BNLR R9
LA R2,LDCB(R2)
B CLOSEOUT
DROP 2
EDIT6 DC X'4020206B2020206B2020206B212020'
*
Z LA R2,#TRT
LA R3,2
QTRT# MVC LINE+09(24),8(R2)
MVC LINE+33(L'EDIT6),EDIT6
ED LINE+33(L'EDIT6),2(R2)
PUT SYSPRINT,LINE-1
LA R2,32(R2)
BCT R3,QTRT#
LA R2,IN
BAL R9,CLOSEIN
L R2,FIRSTDCB
BAL R9,CLOSEOUT
SR 15,15
IC 15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
*
PUSH PRINT
PRINT NOGEN
OPENMSG DC C'........ OPEN FOR OUTPUT, RECFM=.., LRECL=.....'
USING IHADCB,2
OPENIN MVC LINE(6),=C'OPEN '
MVC LINE+6(8),DCBDDNAM
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
MVC OPENMSG(8),DCBDDNAM
MVC OPENMSG+18(3),=C' IN'
OPEN ((2),INPUT)
B OPENMSGL
OPENOUT MVC LINE(6),=C'OPEN '
MVC LINE+6(8),DCBDDNAM
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
MVC OPENMSG(8),DCBDDNAM
MVC OPENMSG+18(3),=C'OUT'
CLC =H'0',DCBLRECL
BNE OPENO
MVC DCBLRECL(2),DCBLRECL-IHADCB+IN
MVC DCBRECFM(1),DCBRECFM-IHADCB+IN
OPENO OPEN ((2),OUTPUT)
OPENMSGL UNPK OPENMSG+32(3),DCBRECFM(2)
TR OPENMSG+32(2),HEX-240
MVI OPENMSG+34,C','
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+42(5),DW+5(3)
MVC LINE(L'OPENMSG),OPENMSG
DROP 2
*
PUTLINE PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
*
MVC LINE(0),1(R4)
OPENSYSP TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BOR R9
OPEN (SYSPRINT,OUTPUT)
POP PRINT
PUT SYSPRINT,IDMSG
L R4,=A(DOC)
SR R3,R3
PUTDOC IC R3,0(R4)
EX R3,OPENSYSP-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R4,2(R4,R3)
CLI 0(R4),X'FF'
BL PUTDOC
PUT SYSPRINT,PARM-6
SR R0,R0
L R1,EGETMAIN
S R1,AGETMAIN
D R0,SIZE
CVD R1,DW
OI DW+7,X'0F'
MVC LINE(44),=C'WORK AREA LARGE ENOUGH FOR ... STRINGS+FILES'
UNPK LINE+27(3),DW+6(2)
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
PUT SYSPRINT,LINE-1
BR R9
* -----------------------------------------------------------
*
ERRREGS DC 16F'0'
ERRMSG DC C'ERR ... AT .... '
ERR SR R0,R0
IC R0,0(R9)
CVD R0,DW
OI DW+7,X'0F'
UNPK ERRMSG+4(3),DW+6(2)
LA R1,0(R9)
SR R1,R13
ST R1,DW
UNPK ERRMSG+11(5),DW+2(3)
TR ERRMSG+11(4),HEX-240
MVC LINE,LINE-1
MVC LINE(L'ERRMSG-1),ERRMSG
IC R1,1(R9)
MVC LINE+L'ERRMSG+3(0),2(R9)
EX R1,*-6
BAL R9,OPENSYSP
BAL R9,PUTLINE
MVC LINE(6),=C'R0-R7 '
LA R3,ERRREGS
BAL R9,ERRPUTR
MVC LINE(6),=C'R8-R15'
BAL R9,ERRPUTR
MVI RC,12
B Z
ERRPUTR LA R0,8
LA R1,LINE+7
UNPK 0(9,R1),0(5,R3)
TR 0(8,R1),HEX-240
MVI 8(R1),C' '
LA R1,9(R1)
LA R3,4(R3)
BCT R0,ERRPUTR+8
B PUTLINE
* -----------------------------------------------------------
LTORG
RC DC X'00'
P1 DC X'1C'
HEX DC C'0123456789ABCDEF'
DW DC 2D'0'
RECADDR DC F'0'
#TRT DC PL8'0',CL24'TRT INSTRUCTIONS USED'
#CLC DC PL8'0',CL24'CLC INSTRUCTIONS USED'
*
LGETMAIN DC F'0'
AGETMAIN DC A(LIST)
EGETMAIN DC A(PARM+100-LDSECT-LDCB)
ENDLIST DC A(0)
LASTLIST DC A(0)
*
FIRSTDCB DC A(0)
LASTDCB DC A(0)
ENDDCB DC A(0)
*
SIZE DC A(LDSECT+LDCB)
PARMLEN DC F'0'
PARMLENX DC F'0',C' '
LINE DC CL133' '
PUSH PRINT
PRINT NOGEN
DS 0F
SYSIN DCB DDNAME=SYSIN,DSORG=PS,EODAD=ZS,MACRF=GL,LRECL=80,RECFM=FT
DS 0F
IN DCB DDNAME=IN,DSORG=PS,EODAD=Z,MACRF=GL,LRECL=399,RECFM=FT
#IN DC PL8'0'
DS 0F
OUT DCB DDNAME=OUT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM
ORG OUT+104
DC 2PL8'0'
LDCB EQU *-OUT
DS 0F
LASTOUT DC XL8'00'
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM
POP PRINT
*
TRTTBL DC XL256'00'
* ------------------------------------------------------------
* THE NEXT FEW AREAS ARE USED DURING SETUP.
* AFTER SAVING STRINGS, THEY CAN BE USED FOR OUTPUT DCBS
IDMSG DC CL133' FINDALL, ASM &SYSDATE AT &SYSTIME BY LIN LYONS, AX
PRIL, 25 TO EFFICIENTLY FIND MULTIPLE STRINGS IN 1 PASS'
QCHAR EQU *-193
DC XL63'00'
CARD DS 0CL80
TESTHEX DC 193C' ',6X'00',41C' ',10X'00',6C' '
MAKEHEX EQU *-193
DC X'0A0B0C0D0E0F',41C' ',X'00010203040506070809'
*
* -------------------------------------------------
LISTLIST L R8,AGETMAIN
MVC LINE,LINE-1
LH R0,DSECTPRE PREFIX LENGTH
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+00(3),DW+6(2)
*
LH R0,DSECTSTL STRING LENGTH
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+04(3),DW+6(2)
*
IC R0,DSECT## ENTRY # IN LIST
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+08(3),DW+6(2)
*
MVC LINE+12(1),DSECTTYP CHAR OR HEX
MVC LINE+14(8),DSECTDD DDNAME
MVC LINE+23(1),DSECTCHR
MVC LINE+26(L'DSECTSTR),DSECTSTR
CLI DSECTTYP,C'C'
BE LISTLPUT
*
UNPK DW(3),DSECTCHR(2)
TR DW(3),HEX-240
MVC LINE+23(2),DW
LA R0,1
AH R0,DSECTSTL
LA R14,DSECTSTR
LA R15,LINE+26
LISTUNPK UNPK 0(3,R15),0(2,R14)
TR 0(2,R15),HEX-240
LA R14,1(R14)
LA R15,2(R15)
BCT R0,LISTUNPK
MVI 0(R15),C' '
LISTLPUT PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R8,LDSECT(R8)
C R8,ENDLIST
BL LISTLIST+4
PUT SYSPRINT,LINE-1
BR R9
LTORG
* -------------------------------------------------
FREQTBL DC X'222120',253X'02' ---- FROM WIKIPEDIA ----
ORG FREQTBL+X'81'
DC AL1(82,15,28,43,97,22,20,61,70)
ORG FREQTBL+X'91'
DC AL1(02,07,40,24,67,75,19,01,60)
ORG FREQTBL+X'A2'
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+C'A'
DC AL1(82,15,28,43,97,22,20,61,70)
ORG FREQTBL+C'J'
DC AL1(02,07,40,24,67,75,19,01,60)
ORG FREQTBL+C'S'
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+C'0'
DC AL1(89,88,87,86,85,84,83,82,81,80)
ORG FREQTBL+C' '
DC AL1(99)
ORG FREQTBL+C'.'
DC AL1(9)
ORG FREQTBL+C','
DC AL1(9)
ORG FREQTBL+C'/'
DC AL1(9)
*
ORG FREQTBL+X'20' ------ ASCII CHARACTERS -----
DC AL1(98)
ORG FREQTBL+X'30'
DC AL1(89,88,87,86,85,84,83,82,81,80)
ORG FREQTBL+X'40'
DC AL1(82,15,28,43,97,22,20,61,70)
DC AL1(02,07,40,24,67,75,19,01,60)
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+X'60'
DC AL1(82,15,28,43,97,22,20,61,70)
DC AL1(02,07,40,24,67,75,19,01,60)
DC AL1(63,91,28,10,24,01,20,01)
ORG
*
LIST DS 0CL64
DOC EQU *
$ 'FINDALL IS LIKE FIND1, EXCEPT IT FINDS MULTIPLE STRINGS IN 1 PASS, X
WITH A SINGLE TRT TABLE SCANNING THE RECORD.'
$ 'YOU COULD FIND THE HISTORY OF THIS, AND OTHER PROGRAMS, IN'
$ ' '
$ 'HTTPS://SITES.GOOGLE.COM/SITE/LINLYONS/FINDALL-FIND-MULTIPLE-STRINGS
S-IN-1-PASS-THROUGH-A-FILE '
$ ' '
$ 'EACH SEARCH STRING MUST HAVE A FILE TO WRITE RECORDS TO. THE DDNAMEX
WILL BE THE STRING, OR DD=WHATEVER'
$ 'IF THE STRING CONTAINS OTHER THAN LETTERS AND #S, THEN THE USER MUST
T SPECIFY A DDNAME.'
$ ' '
$ 'SAMPLE CONTROL CARDS MIGHT LOOK LIKE:'
$ 'C"YOURNAME",X"C4C3C2",DD=C4C3C2,C$YOUR NAME$ '
$ ' '
$ 'NOTICE THAT THE QUOTES MUST MATCH, BUT YOU CAN USE ANY SPECIAL CHARS
S.'
$ 'ALSO, THE PROGRAM DOES NOT CHECK FOR COMMAS, OTHER THAN THE LOCATION
NS MUST BE ACCURATE.'
$ ' '
$ 'THERE IS AN INTERNAL TABLE THAT CAN HOLD ABOUT 6 ENTRIES.'
$ 'IF YOU HAVE MORE THAN THAT, YOU NEED TO SPECIFY MORE, EG, PARM=12'
$ 'STRINGS CAN BE SPECIFIED EITHER IN THE PARM, OR IN //SYSIN CARDS. E
EG'
$ ' PARM="12,C"ABC",C"DEF GHI",DD=DEFGHI,X"D4E8E2C1D5",DD=MYSCAN'
$ '//SYSIN DD *'
$ 'C"LOTS",C"MORE" C"STRINGS"'
$ ' '
$ 'IF YOU CODE END (C"WXYZ",END) THAT WILL TERMINATE CC PROCESSING.'
$ ' '
$ 'THE DEFAULT IS TO USE SELECT STRINGS FROM THE PARM FIELD, AND THEN'
$ 'READ THE //SYSIN FILE AND USE MORE STRINGS FROM THAT. TO PREVENT'
$ 'OPENING THE SYSIN FILE, CODE ",END " AT THE END OF THE PARM.'
$ 'EG, PARM="C"ABC",X"CDEF",C"WHAT EVER",END "'
$ 'THAT WILL PREVENT TRYING TO OPEN THE //SYSIN FILE.'
$ 'SAMPLE JCL MIGHT LOOK LIKE'
$ ' '
$ 'SCAN EXEC PGM=FINDALL,PARM="##,C"YOURNAME",DD,X"ABCD",DD=HEXOUT'
$ '//STEPLIB DD DISP=SHR,DSN='
$ '//SYSPRINT DD SYSOUT=*'
$ '//IN DD DISP=SHR,DSN='
$ '//OUT DD SYSOUT=*'
$ '//SYSIN DD *'
$ 'C"ABCD",DD,X"C1C2C3C4C5",DD,C"WHATEVER",DD=WHATEV'
$ '//YOURNAME DD SYSOUT=*'
$ '//HEXOUT DD SYSOUT=*'
$ '//ABCD DD SYSOUT=*'
$ '//ABCDE DD SYSOUT=*'
$ '//WHATEV DD SYSOUT=*'
$ '--------------------------------------'
DC X'FF'
DC CL6' PARM='
PARM DC CL133' '
*
* DCBD DEVD=DA
*
* @@PAD#1 EQU ((*-FINDALL)/4096+1)*4096 THIS STUFF MAKES THE PROGRAM
* @@PAD#2 EQU @@PAD#1-(*-FINDALL) AN EVEN MULTIPLE OF 4K LONG
* ORG *+@@PAD#2 WHICH IS USEFUL FOR TESTING ON Z390
*
DCBDSECT DSECT 0
DCBDCB DS XL104
DCB# DS PL8
DCB### DS PL8
*
DSECT DSECT 0
DSECTPRE DS H OFFSET TO SRCH CHAR
DSECTSTL DS H STRING LENGTH-1
DSECTTYP DS C DATA TYPE, CHAR OR HEX
DSECT## DS X ENTRY # IN THE LIST
DSECTDD DS CL8
DSECTDCB DS FL4
DS X
DSECTCHR DS X TRT CHAR
LDSECTI EQU *-DSECT
DSECTSTR DS CL44 STRING
LDSECT EQU *-DSECT
END FINDALL