I wrote PICKLE last week to search for a string in a large file. Works good. I'm, happy with it. BUT what if there are multiple strings I'd like to find? Ah hah. So I wrote PICKELS (plural for more strings). Fairly similar, but more complicated. The input (strings) can be specified either in the PARM field, or the //SYSIN file. If you want hex, it has to be SYSIN. If there is no PARM then //SYSIN is used. If there is a PARM, then //SYSIN is ignored. You cannot use both. Sample JCL might look like:
//SEARCH EXEC PGM=PICKLES ,PARM= search arguments
//STEPLIB DD DISP=SHR,DSN=
//SYSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN=
//OUT01 DD DISP=(,CATLG),DSN= ....
//OUT02 DD DISP=(,CATLG),DSN= ....
//OUT03 DD DISP=(,CATLG),DSN= ....
//OUT04 DD DISP=(,CATLG),DSN= ....
//OUT05 DD DISP=(,CATLG),DSN= ....
//SYSIN DD * (note if col-1 is blank, it's a comment)
C'Z390'
C'z390'
C'PICKLES'
C'LICENSE'
C'WARRANTY'
C'Users'
C'LLC'
X'C9E3' IT
C'TRT'
C'TR'
X"C3D3C3" CLC
C$TABLE$
X'C1E9' AZ
/*
When I ran the above, records are written to the files, and the report looks like:
PICKLES V01.01 ASM 05/08/26 00.59 linlyons@yahoo.com
SYSPRINT OPENED FOR OUTPUT, RECFM=A0 LRECL=00133
SYSIN OPENED FOR INPUT, RECFM=A0 LRECL=00080
CARD= C'Z390'
CARD= C'z390'
CARD= C'WARRANTY'
CARD= C'Users'
CARD= X'C1E9' AZ
SYSIN CLOSED,
003 OUT02 000 003 003 C z z390
006 OUT04 000 004 004 C U Users
009 OUT03 007 000 007 C Y WARRANTY
012 OUT05 001 000 001 X E9 C1E9
015 OUT01 000 003 003 C Z Z390
IN OPENED FOR INPUT, RECFM=A0 LRECL=00399
OUT01 OPENED FOR OUTPUT, RECFM=A0 LRECL=00399
OUT02 OPENED FOR OUTPUT, RECFM=A0 LRECL=00399
OUT05 OPENED FOR OUTPUT, RECFM=A0 LRECL=00399
OUT03 OPENED FOR OUTPUT, RECFM=A0 LRECL=00399
OUT04 OPENED FOR OUTPUT, RECFM=A0 LRECL=00399
IN CLOSED,
RECORDS READ 1,063
STRINGS FOUND 23
OUT02 CLOSED, 06 RECRDS WRITTEN TO OUT02 z390
OUT04 CLOSED, 01 RECRDS WRITTEN TO OUT04 Users
OUT03 CLOSED, 01 RECRDS WRITTEN TO OUT03 WARRANTY
OUT05 CLOSED, 11 RECRDS WRITTEN TO OUT05 X C1E9
OUT01 CLOSED, 04 RECRDS WRITTEN TO OUT01 Z390
And the source code is:
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\PICKLES
FIND CHARACTER STRINGS IN A TAPE FILE. JCL LOOKS LIKE
//SCAN EXEC PGM=PICKLES (NO PARM)
//STEPLIB DD DISP=SHR,DSN= ????
//SYSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN= ???
//OUT01 DD ....
//OUT02 DD ....
//OUT03 DD ....
//OUT04 DD ....
//OUT05 DD ....
//SYSIN DD *
C'LIN LYONS'
C'STEWART LYONS'
C'MY FRIEND'
C'MY WORST ENEMY'
X'C1C2C3C4C5C6C7C8'
/*
THIS STARTED WITH PICKLE, BUT WHAT IF YOU WANT MULTIPLE STRINGS?
TURNS OUT THAT SEARCHING FOR 10 IS NOT MUCH MORE EXPENSIVE
THAN JUST SEARCHING FOR ONE.
THE PARM FIELD CAN ONLY HAEV CHAR THESE ARE FOR CHECKING THE 1ST
STRINGS, BUT //SYSIN CAN HAVE BOTH AND LAST LOCATION TESTED.
CHARACTER AND HEX. C"ABC" X"C1C2C3" 60 WXYZ
61 WXYZ
NEED TO UNCOMMENT DCBD, ADD OPEN EXIT ON //OUT 62 WXYZ
AND DELETE CODE BEFORE OPEN (OUT,OUTPUT) 63 WXYZ
MIGHT WANT DEVD=DA IN DCB FIELDS 64 WXYZ
65 WXYZ
MANY OF US HAVE WRITTEN "FIND A STRING" PROGRAMS. 66 WXYZ
I WROTE THIS ONE BECAUSE I FOUND A BETTER METHOD OF 67 WXYZ
OF DETERMINING THE LEAST FREQUENTLY USED CHAR IN A 68 WXYZ
STRING. IT'S CLEANER, QUICKER, AND A BIT SHORTER. 69 WXYZ
70 WXYZ
WXYZ 1
WXYZ 2
WXYZ 3
WXYZ 4
.START ANOP
.START ANOP
* -----------------------------------------------------------
MACRO
&LABEL ERR &IF,&MSG
LCLA &N
LCLC &Z
&Z SETC 'SYS&SYSNDX.Z'
&N SETA (K'&MSG)
&N SETA &N-3
&LABEL REVB &IF,&Z
BAL R14,ERR
DC AL1(&N),C&MSG
&Z 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
&LBL SORT &FIRST,&END,&ENTLEN,&KEY,&KEYLEN
* SORT FIRST,END,ENTLEN,KEYLOC,KEYLEN
LCLA &N
LCLC &L
&N SETA &SYSNDX
&L SETC 'SYS&N'
&LBL STM 14,4,12(13)
$$LA 14,&ENTLEN LOAD ENTRY LENGTH
$$LA 15,&END
LA 4,&ENTLEN.(15)
SR 15,14
$$LA 1,&FIRST
&L.A LR 3,1
LA 2,&ENTLEN.(1)
&L.C CLC &KEY.(&KEYLEN,1),&KEY.(2)
BH *+6
LR 2,1
BXLE 1,14,&L.C
CR 2,1
BE &L.N
MVC 0(&ENTLEN,4),0(2)
MVC 0(&ENTLEN,2),0(3)
MVC 0(&ENTLEN,3),0(4)
&L.N LA 1,&ENTLEN.(3)
CR 1,15
BL &L.A
LM 14,4,12(13)
MEND
*
MACRO
&LABEL $$LA ®,&FIELD
AIF ('&FIELD'(1,1) EQ '(').REG
&LABEL LA ®,&FIELD
MEXIT
.REG LA ®,0&FIELD
MEND
* -----------------------------------------------------------
PICKLES START 0 FAST SCAN OF A FILE
USING *,13 LOOKING FOR THE STRING SPECIFIED IN
YREGS , THE PARM FIELD.
B BEGIN-*(15) BRANCH AROUND SAVE AREA
DC 17F'0'
IDMSG DC C'PICKLES V01.01 ASM &SYSDATE &SYSTIME LINLYONS@YAHOO.COM'
IDNC DC 8X'BF',X'FF',5X'BF',X'FF',3X'BF'
BEGIN STM 14,12,12(13) GENERAL
ST 15,8(13) START
ST 13,4(15) HOUSE KEEPING
LR 13,15 STUFF
NC IDMSG+L'IDMSG-18(18),IDNC
L R8,0(R1) SAVE PARM ADDR
L R0,LGETMAIN
GETMAIN R,LV=(0)
ST R1,AGETMAIN
LR R0,R1
LR R15,R1
LR R14,R1
S R14,=A(LDSECT)
A R1,LGETMAIN
SH R1,=AL2(LDSECT+LDSECT)
STM R14,R1,FIRSTDCB-4
LA R2,SYSPRINT
BAL R9,OPENSYSP
CLI 1(R8),0
BE USESYSIN
CLI 1(R8),1
BE USESYSIN
CLC SPACES(2),2(R8)
BE USESYSIN
LH R7,0(R8)
BCTR R7,0
MVC PARM(0),2(R8)
EX R7,*-6
LA R7,PARM R7=PARM LEN-1
LA R8,PARM R8=PARM
LA R6,1(R7,R8) R6=END OF PARM
* ---------------------- GET STRINGS FROM PARM, NOT SYSIN
USEPARM MVC CARD-6(4),=C'PARM'
PUT SYSPRINT,CARD-7
MVC LINE,LINE-1
CLI 0(R8),X'80' Q. DELIMITER INSTEAD OF COMMA?
BNL *+14 NO.
MVC PARMCOMA+1(1),0(R8) YES PUT IT INTO CLI INST.
MVC PARM,PARM+1 AND BUMP PAST.
*
CLC =C'OPENALL',0(R8) Q. OPEN OUTPUT FILES FIRST?
BNE *+14 NO.
MVI OPENALL,C'O' YES, SET FLAG.
MVC PARM,PARM+8 AND BUMP PAST KEYWORD
*
PARMNEXT LR R5,R8 START OF STRING
PUT SYSPRINT,CARD-7
PARMLOOP LA R5,1(R5) LOOP TO END
CR R5,R6 Q. END OR PARM
BNL PARMFND YES, SAVE LAST PARAM
PARMCOMA CLI 0(R5),C',' Q. END OF THIS STRING
BNE PARMLOOP NO, LOOP
PARMFND BAL R9,GETDSECT GET A DSECT
USING DSECT,7
LR R1,R5
SR R1,R8 CALC LENGTH OF STRING
BCTR R1,0 SUBT-1
STH R1,STRINGL SAVE LENGTH-1
MVC STRING(0),0(R8)
EX R1,*-6 MOVE STRING TO DSECT
MVC PARM,1(R5) POINT PAST DELIM
CLI PARM,C' '
BNE PARMNEXT NO, LOOP
B ZZZ YES, SYSIN EODAD
* ------------------------------ GET A DSECT ENTRY ----------
GETDSECT L R7,LASTDCB
LA R0,LDSECT(R7)
ST R0,LASTDCB
C R0,ENDCB
ERR BNL,'TOO MANY STRINGS'
MVI 0(R7),C' ' INIT DSECT
MVC 1(LDSECT,R7),0(R7)
*
* THIS IS INTERESTING. IF WE LOOK FOR TR AND TRT, SORT TRT BEFORE
* TR, BY PADDING THE END OF THE STRING WITH X'FFFFFF'
*
MVI STRING,X'FF'
MVC STRING+1(L'STRING-1),STRING
ZAP DCOUNT,P0
BR R9
* ---------------------------------------------
USESYSIN LA R2,SYSIN
BAL R9,OPENIN
ZAP HW,P0
GETSYSIN GET SYSIN
CLI 0(R1),C' '
BE GETSYSIN
MVC CARD(80),0(R1)
PUT SYSPRINT,CARD-7
*** WTO MF=(E,WTOCARD)
BAL R9,GETDSECT
MVC DATATYPE,CARD
AP HW,P1
OI HW+1,X'0F'
UNPK DDDNAME+2(3),HW SET DDNAME=OUT##
MVC DDDNAME(3),=C'OUT'
** MVC DCOUNT+8(24),=CL24'RECORDS WRITTEN TO OUT??'
MVC DCOUNT+30(2),DDDNAME+3
LA R3,CARD+2
CLI CARD,C'X'
BE CARDHEX
CLI CARD,C'C'
ERR BNE,'INVALID SYSIN CARD DATA TYPE, C+X ONLY'
CARDLOOP LA R3,1(R3)
CLC 0(1,R3),CARD+1
BE CARDFND
CLC SPACES(4),0(R3)
BNE CARDLOOP
ERR B,'DELIMITER MISSING OR NOT MATCHING'
CARDFND LR R4,R3
S R4,=A(CARD+3)
STH R4,STRINGL
MVC STRING(0),CARD+2
EX R4,*-6
B GETSYSIN
*
CARDHEX LA R4,STRING
LR R5,R3
LR R6,R4
LA R0,L'STRING
HEXLOOP TRT 0(2,R3),TESTHEX-193
ERR BNZ,'BAD HEX'
TR 0(2,R3),MAKEHEX-193
PACK 0(2,R4),0(3,R3)
MVI 1(R3),X'FF'
LA R4,1(R4)
LA R3,2(R3)
LA R1,1(R1)
CLC CARD+1(1),0(R3)
BE HEXFOUND
BCT R0,HEXLOOP
EX 0,*
HEXFOUND MVI 0(R4),X'FF'
LA R0,STRING+1
SR R4,R0
STH R4,STRINGL
B GETSYSIN
* -------------------THIS IS BOTH A MSG AND AN ERROR MSG RTN---------
DC F'0'
ERR LA 14,0(14)
ST 14,ERR-4
LR 15,14
SR 15,13
ST 15,8(13)
MVC LINE,LINE-1
MVC LINE(3),=C'ERR'
UNPK LINE+4(5),10(3,13)
TR LINE+4(4),HEX-240
MVI LINE+8,C' '
CLI 1(R14),C' '
BNE *+10
MVC LINE(3),=C'MSG'
SR 1,1
IC 1,0(14)
MVC LINE+09(0),1(14)
EX 1,*-6
PUT SYSPRINT,LINE-1
L R14,ERR-4
SH R14,=H'8'
LA R15,X'F0'
CLI 9(R14),C' '
MVC LINE,LINE-1
BNE *+8
EX R15,0(14)
ABEND 1
* -----------------END OF ERR/MSG ROUTINE----OPEN ROUTINE----
USING IHADCB,2
OPENOUT MVC OPENMSG(8),DCBDDNAM
CLC =H'0',DCBLRECL
BNE OPENOO
MVC DCBRECFM,DCBRECFM-IHADCB+IN
MVC DCBLRECL,DCBLRECL-IHADCB+IN
B OPENOO
PUSH PRINT
PRINT NOGEN
OPENSYSP MVC OPENMSG(8),DCBDDNAM
OPENOO OPEN ((2),OUTPUT)
MVC OPENMSG+20(3),=C'OUT'
CLC OPENMSG(8),=C'SYSPRINT'
BNE LISTDCBM
MVC LINE(L'IDMSG),IDMSG
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
B LISTDCBM
OPENMSG DC C' OPENED FOR OUTPUT, RECFM= LRECL='
OPENIN MVC OPENMSG(8),DCBDDNAM
OPEN ((2),INPUT)
POP PRINT
MVC OPENMSG+20(3),=C' IN'
LISTDCBM UNPK OPENMSG+34(3),DCBRECFM(2)
TR OPENMSG+34(2),HEX-240
MVI OPENMSG+36,C' '
LH R0,DCBLRECL
CVD R0,16(13)
OI 23(13),X'0F'
MVC LINE(L'OPENMSG),OPENMSG
UNPK LINE+L'OPENMSG(5),21(3,13)
DROP 2
*
PUTLINE PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
*
LISTHEX LA R0,1
LISTHEXU UNPK 0(3,R15),0(2,R1)
TR 0(2,R15),HEX-240
LA R15,2(R15)
LA R1,1(R1)
BCT R0,LISTHEXU
MVI 0(R15),C' '
BR R14
*
LISTHW LH R0,0(R1)
CVD R0,DW
OI DW+7,X'0F'
UNPK 0(3,R15),DW+6(2)
LA R15,4(R15)
BR R14
*
LIST L R7,FIRSTDCB
LISTLOOP LA R15,LINE+2
CLI DTRT#,C' '
BE *+12
LA R1,DTRT#
BAL R14,LISTHW
MVC 0(5,R15),DDDNAME
LA R15,07(R15)
LA R1,PREPOST
BAL R14,LISTHW
LA R1,PREPOST+2
BAL R14,LISTHW
LA R1,STRINGL
BAL R14,LISTHW
MVC 0(1,R15),DATATYPE
LA R15,2(R15)
CLI DATATYPE,C'C'
BE LISTCHAR
*
LA R1,DCHAR
BAL R14,LISTHEX
LA R15,1(R15)
LH R1,STRINGL
LA R0,1(R1)
LA R1,STRING
BAL R14,LISTHEX+4
B LISTPUT
LISTCHAR LH R1,STRINGL
LA R1,2(R1)
MVC 0(0,R15),DCHAR
EX R1,*-6
LISTPUT PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
CLI DTRT#,C' '
BE LISTNEX
CLC DCHAR(L'STRING),DCHAR+LDSECT
BNE LISTNEX
ERR B,' ERROR, DUPLICATE SEARCH KEYS, SCAN NOT RUN '
MVI RC+1,12
LISTNEX LA R7,LDSECT(R7)
C R7,LASTDCB
BL LISTLOOP
BR R9
* ================================================================
ZZ LA R2,SYSIN
BAL R9,CLOSE
ZZZ L R7,FIRSTDCB
ZZZLOOP LA R15,STRINGL
LA R14,PREPOST
BAL R9,QFREQ
MVC DCHAR,PREPOST+4
LA R7,LDSECT(R7)
C R7,LASTDCB
BL ZZZLOOP
** BAL R9,LIST
LM 7,8,FIRSTDCB
LA 6,STRING-DSECT+3
*
SORT SORT (7),(8),LDSECT,DCHAR-DSECT,L'STRING+2
MVI DCHAR-DSECT(R8),X'FF'
** BAL R9,LIST
* ================================================================
LM R7,R8,FIRSTDCB
SR R4,R4
SR R3,R3
SETTRT LA R4,3(R4)
STH R4,DTRT#
IC R3,DCHAR
LA R14,TRTTBL(R3)
CLI 0(R14),0
BNE *+8
STC R4,0(R14)
MVC DDCB,OUT
MVC DCBDDNAM-IHADCB+DDCB,DDDNAME
CLI OPENALL,C'O'
BNE *+12
LA R2,DDCB
BAL R9,OPENOUT
LA R7,LDSECT(R7)
CR R7,R8
BL SETTRT
BAL R9,LIST
CLI RC+1,0
BNE EXIT
LA R2,IN
BAL R9,OPENIN
B GET AND GO READ
* =============================== THIS SECTION IS THE PROGRAM ========
DC F'0'
GET GET IN READ
AP COUNTIN,P1
ST R1,GET-4 SAVE REC ADDR
TESTL L R1,GET-4
LA R3,0(R1) R3=START OF REC
LH R4,DCBLRECL-IHADCB+IN R4=END OF REC
LA R4,0(R1,R4)
TM DCBRECFM-IHADCB+IN,X'80' Q. RECFM=FB
BO LOOP YES.
LH R4,0(R1) NO, LOAD LENGTH FROM REC
LA R4,0(R4,R1) POINT TO END OF REC
LA R1,4(R1)
B LOOP
* ===================== THIS IS THE BUSINESS SECTION ===============
LA R1,256(R1)
LOOP LR R2,R4 POINT TO END OF REC
SR R2,R1 CALC LENGTH LEFT TO TEST
BM GET SHORT, GO READ NEXT
CH R2,=H'256'
BL SHORT
TRT 0(256,R1),TRTTBL
BZ LOOP-4
N R2,=F'255'
B FOUND
TRT TRT 0(0,R1),TRTTBL
CLC CLC STRING(0),0(R5) COMPARE STRING TO REC LOCATIONS
SHORT EX R2,TRT SCAN FOR FIRST CHAR OF PARM
BZ GET NOT FOUND, GO READ
FOUND LR R7,R2
SLL R7,6
A R7,FIRSTDCB-4
NEXTSTR LA R5,0(R1)
SH R5,PREPOST
CR R5,R3
BL NXTDSECT
LA R0,1(R5)
AH R0,PREPOST+2
CR R0,R4
BNL NXTDSECT
LH R6,STRINGL
EX R6,CLC
BE WRITE
NXTDSECT CLC DCHAR,DCHAR+LDSECT
BNE SCANMORE
LA R7,LDSECT(R7)
B NEXTSTR
SCANMORE LA R1,1(R1) NOT MATCH, BUMP LOCATION
B LOOP AND LOOP
DC F'0'
WRITE ST R1,WRITE-4
LA R2,DDCB
TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BO *+8
BAL R9,OPENOUT
L R0,GET-4
PUT (2),(0)
AP DCOUNT,P1
AP COUNTOUT,P1
L R1,WRITE-4
B SCANMORE
* ================================= END OF THE PROGRAM ===============
ED15 DS 0XL20
DC X'40202020',3X'6B202020',X'6B212020'
DC F'0'
TOTALS ST R9,TOTALS-4
L R7,FIRSTDCB
TOTALOOP LA R2,DDCB
TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZ TOTANEXT
LA R6,LINE+14
LA R1,L'ED15-2(R6)
MVC 0(L'ED15,R6),ED15
EDMK 0(L'ED15,R6),DCOUNT
** MVC L'ED15+1(22,R6),DCOUNT+8
MVC L'ED15+1(22,R6),=C'RECRDS WRITTEN TO ?????'
MVC L'ED15+1+18(5,R6),DDDNAME
LH R14,STRINGL
MVC 27+L'ED15(0,R6),STRING
EX R14,*-6
CLI DATATYPE,C'X'
BNE NOTHEX
LA R0,1(R14)
LA R14,STRING
MVI 25+L'ED15(R6),C'X'
LA R15,27+L'ED15(R6)
TOTAUNPK UNPK 0(3,R15),0(2,R14)
TR 0(2,R15),HEX-240
MVI 2(R15),C' '
LA R14,1(R14)
LA R15,2(R15)
BCT 0,TOTAUNPK
*
NOTHEX MVC 0(67,R6),0(R1)
BAL R9,CLOSE
TOTANEXT LA R7,LDSECT(R7)
C R7,LASTDCB
BL TOTALOOP
L R9,TOTALS-4
BR R9
*
SR R7,R7
CLOSE TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZR R9
CLOSE ((2))
MVC LINE(8),DCBDDNAM-IHADCB(R2)
MVC LINE+6(7),=C'CLOSED,'
LTR R7,R7
BZ PUTLINE
B PUTLINE
*
Z LA R2,IN DONE, CLOSE FILES
BAL R9,CLOSE
LA R3,COUNTIN
LA R2,2
ZCOUNT MVC LINE(16),8(R3)
LA R1,LINE+14+L'ED15
MVC LINE+16(L'ED15),ED15
EDMK LINE+16(L'ED15),0(R3)
MVC LINE+17(44),0(R1)
PUT SYSPRINT,LINE-1
LA R3,COUNTOUT
BCT R2,ZCOUNT
MVC LINE,LINE-1
BAL R9,TOTALS
CLOSE SYSPRINT
*
EXIT LH 15,RC
L 13,4(13) ---------NORMAL HOUSEKEEPING CLEAN UP
L 14,12(13)
LM 0,12,20(13)
BR 14 EXIT
* ---------------------------------
LTORG
HW DC H'0'
COUNTIN DC PL8'0',CL16'RECORDS READ'
COUNTOUT DC PL8'0',CL16'STRINGS FOUND'
OPENALL DC C' '
RC DC H'0'
P0 DC X'0C'
P1 DC X'1C'
HEX DC C'0123456789ABCDEF'
FIELDS DC C'DW, L/AGETMAIN,FIRST-4,FIRST/LAST/ENDDCB'
DW DC D'0'
LGETMAIN DC F'4000'
AGETMAIN DC F'0'
DC F'0'
FIRSTDCB DC F'0'
LASTDCB DC F'0'
ENDCB DC F'0'
WTOLINE DC H'60,0'
DC C' '
LINE DC CL133' '
WTOCARD DC H'60,0'
DC C' CARD= '
CARD DS 0CL80
PARM DC CL133' '
TRTTBL DC XL256'00'
*
* ---------------------------------
EXLST DC A(EXLST+4+X'87000000')
USING *,15
CLI DCBRECFM-IHADCB+IN,0
BNER 14
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
BR 14
DROP 15
PUSH PRINT
PRINT NOGEN
* ---------------------------------
SYSIN DCB DDNAME=SYSIN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=80,EODAD=ZZ X
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=399,EODAD=Z X
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM ,EXLST=EXLST
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
* -------------------------------------------------
POP PRINT
TR 0(0,R3),QFREQTBL
MVC 0(0,R3),4(R15)
QFREQ STM R2,6,58(R13) 15 = STRING
LA R3,8(13) 14 = PRE-LEN, POST-LEN, CHAR
LH R1,0(R15)
EX R1,QFREQ-6 MOVE STRING TO WORK AREA (UP TO 50)
EX R1,QFREQ-12 TRAN TO FREQ VALUES
LR R0,R1 LOAD CHAR COUNT-1
LA R4,1(R3) POINT TO FIRST FREQ VALUE
LR R5,R3 R5 = PLACE TO SAVE LOWEST
LA R6,1(R3,R1) R6 = LAST TO CALC POST LEN (CHARS AFTER)
QFREQL CLC 0(1,R4),0(R5) Q. IS THIS THE LOWEST SO FAR?
BNL *+6 NO
LR R5,R4 YES, SAVE IT
LA R4,1(R4) BUMP TO NEXT
BCT R0,QFREQL AND LOOP
QFREQZ LR R0,R6 CALC LAST
SR R0,R5 - LOW LOC
BCTR R0,0 = POST LENG, SAVE IT
STH R0,2(R14)
LR R0,R5 CALC LOW
SR R0,R3 - FIRST = PRE LENG
STH R0,0(R14) = PRE LENG, SAVE THAT
LA R1,4(R15)
AR R1,R0
* SR R5,R3 CALC LOC LOC - FIRST = OFFSET OF CHAR
* LA R1,2(R5,R15) POINT TO LOW CHAR
MVC 4(1,R14),0(R1) AND SAVE THAT
LM R2,R6,58(R13) RELOAD REGS
BR R9 AND RETURN
*
* HTTPS://EN.WIKIPEDIA.ORG/WIKI/LETTER_FREQUENCY
QFREQTBL DC X'898887',253X'86' ASCII FIRST (WIKIOPEDIA)
ORG QFREQTBL+X'30'
DC X'59585756555453525150' NUMBERS
ORG QFREQTBL+X'40'
DC X'27161D20291A18222513141F1B242617112123281E151C121910' UPPER
ORG QFREQTBL+X'60'
DC X'47363D40493A38424533343F3B444637314143463E353C323930' LOWER
*
ORG QFREQTBL+X'C1' EBCDIC UPPER
DC X'27161D20291A182225'
ORG QFREQTBL+X'D1'
DC X'13141F1B2426171121'
ORG QFREQTBL+X'E2'
DC X'23281E151C121910'
*
ORG QFREQTBL+X'81' LOWER
DC X'47363D40493A384245'
ORG QFREQTBL+X'91'
DC X'33343F3B4446373141'
ORG QFREQTBL+X'A2'
DC X'43463E353C323930' LOWER
*
ORG QFREQTBL+X'F0'
DC X'59585756555453525150' NUMBERS
*
TESTHEX DC 6X'00' ,41C' ',10X'00',6C' '
SPACES DC 41C' ',10X'00',6C' ' (DOUBLE DIPPING HERE)
MAKEHEX DC X'0A0B0C0D0E0F',41C' ',X'00010203040506070809'
* -------------------------------------------------
@@PAD#0 EQU *-PICKLES+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG PICKLES+@@PAD#2
*
DSECT DSECT 0
DS XL192 128+64 = 132+60 = 192
LDSECT EQU *-DSECT
ORG DSECT
PREPOST DS 2H,C
DATATYPE DS C
STRINGL DS H LENGTH
DCHAR DS 2C SEARCH CHAR AND BLANK
STRING DS CL30 STRING
DTRT# DS H
DS 0D
DCOUNT DS PL8 ,CL24'RECORDS WRITTEN TO OUT??'
DDDNAME DS CL8
DDCB DS CL104
ORG
* ----------------------------------------------
* DCBD DEVD=DA
END PICKLES