At 2am one morning, I thought of a different way to find the least often used character in a string. (There went a couple hours of sleep.) But it's cleaner, quicker, and shorter. "But why", you ask? I use that routine in string search programs for large (tape) files. For example, if you were looking for "EXAMPLE" if you look for "E" you'll get lots of hits. If you look for "X" not nearly as many. So the program runs faster. I coded the routine, and there was another program I was testing that not only used it, but displayed it's results. That showed me that I'd coded it correctly. I had yet another program that I was using as a simple example, and I put it in that program, which has now become PICKLE. (All the obvious names are already used.) It's fairly short and seems to work well.
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\PICKLE
FIND PARM STRING IN A TAPE FILE. JCL LOOKS LIKE
//SCAN EXEC PGM=PICKLE,PARM=ABC
//STEPLIB DD DISP=SHR,DSN= ????
//IN DD DISP=SHR,DSN= ???
//OUT DD ....
A COUPLE OF ERROR MESSAGES ARE PUT INTO SYSMSGS FOLLOWED BY ABEND.
YOU CAN ALSO HAVE A HEX PARM, LIKE: THESE ARE FOR CHECKING THE
X'C1C2C3' OR X"C4C5C6" OR X$C7C8C9$ 1ST AND LAST LOCATION TESTED.
OR C"ABC" OR C'DEF' OR C$GHI$ 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
PICKLE 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'PICKLE ASM V01.01 &SYSDATE &SYSTIME LINLYONS@YAHOO.COM '
* === NOTE, THE FOLLOWING CODE IS OVERLAID WITH HEX PARM DATA =========
BEGIN STM 14,12,12(13) GENERAL
ST 15,8(13) START
ST 13,4(15) HOUSE KEEPING
LR 13,15 STUFF
L 8,0(1) LOAD ADDR OF PARM
LH R5,0(R8) LOAD LENGTH OF PARM
LR R6,R5 SAVE BOTH LENGTH
BCTR R5,0 CALC LENGTH-1
*
NC IDMSG+51-17(18),IDNC
** NC IDMSG+51-17(18),=18X'BF'
CLI 1(R8),0
BE NOPARM
LH R5,0(R8)
LR R6,R5
BCTR R5,0
CLI 1(R8),5
BL NOTQUOTE
* ====================== CODE TO DEAL WITH X"CAC2C3" IN PARM ==========
LA R1,1(R6,R8)
CLC 3(1,R8),0(R1)
BNE NOTQUOTE
CLI 3(R8),C'"'
BE GOTQUOT
CLI 3(R8),C''''
BE GOTQUOT
CLI 3(R8),C'$'
BNE NOTQUOTE
GOTQUOT MVC HEXQ,2(R8)
CLI 2(R8),C'C'
BE CHARPARM
CLI 2(R8),C'X'
BNE BADPARM
*
TM 1(R8),1
BNO BADHEX
LH R2,0(R8)
SH R2,=H'4'
TRTHEX TRT 4(0,R8),TESTHEX-193
EX R2,TRTHEX
BO BADHEX
*
LR R0,R5
SRL R0,1
BCTR 0,0
STH R0,BEGIN+2
*
LA R14,4(R8)
LA R15,BEGIN+4
PACKPARM MVC BEGIN(2),0(R14)
TR BEGIN(2),MAKEHEX-193
PACK 0(2,R15),BEGIN(3)
LA R14,2(R14)
LA R15,1(R15)
BCT R0,PACKPARM
*
LA R8,BEGIN+2
MVC MSG+17(20),=CL20'COPIED'
B NOTQUOTE
HEXQ DC C'X"',C'X''',C'X$'
IDNC DC 8X'BF',X'FF',9X'BF'
BADPARM WTO 'PARM CAN ONLY CONTAIN HEX AND CHAR DATA',ROUTCDE=11
ABEND 3
BADHEX WTO 'PARM CONTAINS INVALID HEX CHARACTERS',ROUTCDE=11
ABEND 2 QUIT IF NO PARM
NOPARM WTO 'PARM MISSING, MUST CONTAIN SEARCH STRING',ROUTCDE=11
ABEND 1 QUIT IF NO PARM
* ================ END OF HEX PARM PROCESSING ========================
PREPOST DC 2H'0',2C' ' #BYTES BEFORE SEARCH CHAR AND #BYTES AFTER
MVCPARM MVC MSG+30(0),2(R8)
*
MVC BEGIN+4(0),4(R8)
CHARPARM SH R5,=H'3'
SH R6,=H'3'
EX R5,CHARPARM-6
STH R6,BEGIN+2
LA R8,BEGIN+2
NOTQUOTE LR 15,8
LH R5,0(R8) LOAD LENGTH OF PARM
LR R6,R5 SAVE BOTH LENGTH
BCTR R5,0 CALC LENGTH-1
*
LA 14,PREPOST
BAL R9,QFREQ
SR 1,1
IC 1,PREPOST+4 FOR 1ST CHAR OF STRING
LA R1,TRTTBL(R1)
MVI 0(R1),C'F'
PUSH PRINT
PRINT NOGEN
OPEN OPEN (IN,INPUT)
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
OPEN (OUT,OUTPUT)
LH R6,DCBLRECL-IHADCB+IN CALC # TIMES TO COMP
*
CLC MSG+17(7),=CL20'COPIED'
BE GET
MVC MSG+25(1),PREPOST+4 DON'T DO THIS
LA R0,11 IF THE PARM
LR R1,R5 IS HEX DATA.
CR R1,R0
BL *+6
LR R1,R0
EX R1,MVCPARM
POP PRINT
B GET AND GO READ
* =============================== THIS SECTION IS THE PROGRAM ========
DC F'0'
PUT L R0,PUT-4 WRITE IF FOUND
PUT OUT,(0) WRITE IF FOUND
AP COUNT,P1 COUNT IT
GET GET IN READ
ST R1,PUT-4 SAVE REC ADDR
LR R4,R6
TM DCBRECFM-IHADCB+IN,X'80' Q. RECFM=FB
BO *+8 YES.
LH R4,0(R1) NO, LOAD LENGTH FROM REC
*** LA R4,65 ==== FOR TESTING ONLY ==========
LA R4,1(R4,R1) POINT TO END OF REC
SH R4,PREPOST+2 BACK UP TO NOT TEST END
L R1,PUT-4
AH R1,PREPOST POINT PAST FRONT
* ===================== THIS IS THE BUSINESS SECTION ===============
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
BNZ FOUND
LA R1,256(R1)
B LOOP
TRT TRT 0(0,R1),TRTTBL
CLC CLC 2(0,R8),0(R2) COMPARE STRING TO REC LOCATIONS
SHORT EX R2,TRT SCAN FOR FIRST CHAR OF PARM
BZ GET NOT FOUND, GO READ
FOUND LR R2,R1
SH R2,PREPOST
EX R5,CLC FOUND, COMPARE
BE PUT MATCH, GO WRITE
LA R1,1(R1) NOT MATCH, BUMP LOCATION
B LOOP AND LOOP
* ================================= END OF THE PROGRAM ===============
Z CLOSE (IN,,OUT) DONE, CLOSE FILES
OI COUNT+3,X'0F' FIX COUNT FIELD SIGN
UNPK MSG(7),COUNT PUT INTO MESSAGE
WTO WTO '....... RECORDS CONTAIN "?" + ',ROUTCDE=11
MSG EQU WTO+8
L 13,4(13) ---------NORMAL HOUSEKEEPING CLEAN UP
LM 14,12,12(13)
SR 15,15
BR 14 EXIT
COUNT DC PL4'0'
P1 DC X'1C'
TRTTBL DC XL256'00'
*
LTORG
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
* ---------------------------------
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=266, X
EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM ,EXLST=EXLST
* -------------------------------------------------
POP PRINT
TR 0(0,R3),QFREQTBL
MVC 0(0,R3),2(R15)
QFREQ STM R2,6,58(R13) 15 = LENGTH-1(2),STRING (PARM)
LA R3,8(13) 14 = PRE-LEN(2), POST-LEN(2), CHAR
LH R1,0(R15) LOAD LENGTH-1
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
LR R4,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
LR R0,R6 CALC LAST
SR R0,R5 - LOW LOC
STH R0,2(R14) = POST LENG, SAVE IT
LR R0,R5 CALC LOW
SR R0,R3 - FIRST = PRE LENG
STH R0,0(R14) = PRE LENG, SAVE THAT
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' '
MAKEHEX DC X'0A0B0C0D0E0F',41C' ',X'00010203040506070809'
* -------------------------------------------------
* @@PAD#0 EQU *-PICKLE+4095 THIS IS CODE I USE WHILE TESTING
* @@PAD#1 EQU @@PAD#0/(4097) WITH THE Z390 SIMULATOR. NOT
* @@PAD#2 EQU (@@PAD#1*4096) NEEDED OTHERWISE, BUT DOESN'T
* ORG PICKLE+@@PAD#2 HURT. FORCES 4K ALIGNMENT.
*
* DCBD DEVD=DA
END PICKLE