QSTRING CODE
QSTRING CODE
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\QSTRING
FIND CHARACTER STRINGS IN A TAPE FILE. JCL LOOKS LIKE
//SCAN EXEC PGM=QSTRING (NO PARM)
//STEPLIB DD DISP=SHR,DSN= ????
//SYSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN= ???
//OUT01 DD ....
//OUT02 DD ....
//OUT03 DD ....
//OUT04 DD ....
//SYSIN DD *
C'LIN LYONS'
C'STEWART LYONS'
C'MY FRIEND'
C'MY WORST ENEMY'
X'C1C2C3C4C5C6C7C8'
/*
THIS STARTED WITH QSTRING1, 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 HAVE 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
* -----------------------------------------------------------
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
* -----------------------------------------------------------
QSTRING 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'QSTRING V01.01 ASM &SYSDATE &SYSTIME LINLYONS@YAHOO.COM'
IDNC DC 8X'BF',X'FF',5X'BF',X'FF',3X'BF'
IDMSG2 DC C'COPY RECORDS CONTAINING 1 OR MORE STRINGS SPECIFIED INX
PARM OR SYSIN'
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 R1,LGETMAIN # OF DSECT TABLE ENTRIES
LA R1,4(R1) ADD 4 EXTRA
SLL R1,8 MULTIPLY BY 256
LR R0,R1 INTO R0
ST R0,LGETMAIN SAVE ACTUAL LENGTH
GETMAIN R,LV=(0)
ST R1,AGETMAIN ADD
LA R10,512(R1) SORT OF FRONT
SRL R10,8
SLL R10,8 ALIGN DSECTS ON 256 BYTE BOUNDARY
ST R10,ATRTTBL
LR 14,10 FIRSTDCB-256
LA 15,256(10) FIRSTDCB
LR 0,15 LASTDCB
LR 1,15 END OF TABLE
A R1,LGETMAIN PAST END
SH 1,=AL2(1024) BACKUP 4 ENTRIES
STM 14,1,FIRSTDCB-4 STORE 'EM ALL
MVI 0(R10),0
MVC 1(255,R10),0(R10)
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
ZAP HW,P0
*
PARMNEXT LR R5,R8 START OF STRING
PUT SYSPRINT,CARD-7
PARMLOOP LA R5,1(R5) LOOP TO END
CLC SPACES(6),0(R5)
BE PARMFND
CR R5,R6 Q. END OF 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
MVI DATATYPE,C'C'
AP HW,P1
OI HW+1,X'0F'
UNPK DDDNAME+2(3),HW
MVC DDDNAME(3),=C'OUT'
MVC DCBDDNAM-IHADCB+OUT(5),DDDNAME
MVC DDCB,OUT
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(L'IDMSG),IDMSG2
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,1(R4)
STH R4,DTRT#
IC R3,DCHAR
** LA R14,TRTTBL(R3)
LA R14,0(R10,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),0(R10)
BZ LOOP-4
N R2,=F'255'
B FOUND
TRT TRT 0(0,R1),0(R10)
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 R14,R2
SLL R14,8
LA R7,0(R14,R10)
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
BNE NXTDSECT
BAL R9,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 2F'0'
WRITE CLC DUPCHECK,COUNTIN
BER R9
MVC DUPCHECK,COUNTIN
ST R1,WRITE-4
ST R9,WRITE-8
LA R2,DDCB
C R2,FIRSTDCB
BNL *+8
EX 0,*
C R3,LASTDCB
BL *+8
EX 0,*
CLC =C'DCBV',0(R2)
BE *+8
EX 0,*
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
L R9,WRITE-8
BR R9
* ================================= 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
LM R0,R1,LGETMAIN
FREEMAIN R,LV=(0),A=(1)
*
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'
ATRTTBL DC A(0)
LGETMAIN DC F'38'
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' '
*
* ---------------------------------
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
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=399,EODAD=Z
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 *-QSTRING+4095
@@PAD#1 EQU @@PAD#0/(4097)
@@PAD#2 EQU (@@PAD#1*4096)
ORG QSTRING+@@PAD#2
*
DSECT DSECT 0
DS XL256 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 CL28 STRING
DTRT# DS H
DS 0D
DCOUNT DS PL8 ,CL24'RECORDS WRITTEN TO OUT??'
DUPCHECK DS CL8
DDDNAME DS CL8
DDCB DS CL104
ORG
* ----------------------------------------------
* DCBD DEVD=DA
END QSTRING