GOFISH
The history of GOFISH is that in the '70s, my boss wanted to search a large tape file for a character string. He wrote a COBOL program to do that, such that it was so inefficient that it completely locked up the 360/95. He told me, so I wrote one that was better. (What was he searching for? I haven't a clue.) In any case my program used the PARM field to specify the character strings to look for. What it did was look for the first character of the string, and, when found, compare the string.
I've rewritten it to search for the least frequently occurring character, which makes it run even faster. Also, you can search for up to 9 strings, and write the records that contain those strings to different files. Since any record may contain more than one of the strings, when multiple strings are specified, we have to test the entire record, rather than just to the first string found. (But, if there's only 1 string, it doesn't do that extra scan.)
To use it on an MVS system, you'll want to change the DCBs, and make QDCB use the OPENEXIT to copy LRECL, etc from //IN to the output files. I think that's all that's needed. With a proportional font, it looks ugly. It's fine with a fixed font.
* -------------------------------------------------------
MACRO
SORT &BEG=,&END=,&KEY=,&KEYLN=,&ENTRYLN=
LCLA &N I CAN'T BELIEVE IT, IT TOOK ME
LCLC &L 2 TRIES TO GET SORT TO WORK. TWO
&N SETA &SYSNDX TRIES! I BETTER PRACTICE WHETHER
&L SETC 'SYS&N' TO PUT SOCKS OR SHOES ON FIRST!!
STM R14,R5,24(R13)
$$LA R14,&BEG
$$LA R15,&END
LA R4,&ENTRYLN LOAD ENTRY LENG
LR R0,R15 14=BEG 15=END 4=ENTLEN
SR R0,R4 0=LAST ENTRY
.*
&L.A LA R1,&ENTRYLN.(R14) BUBBLE SORT.
LR R3,R14 PULL THE LOWEST
&L.C CLC &KEY.(&KEYLN,R1),&KEY.(R14) ENTRY TO THE TOP,
BNL *+6 THEN THE NEXT, ETC.
LR R14,R1
LA R1,&ENTRYLN.(R1)
CR R1,R15
BL &L.C
.*
CR R3,R14
BE &L.N
.*
MVC 0(&ENTRYLN,R15),0(R14) PUT THE LOWEST ENTRY FIRST,
MVC 0(&ENTRYLN,R14),0(R3) THEN THE NEXT LOWEST, ETC.
MVC 0(&ENTRYLN,R3),0(R15) DEAD SIMPLE. REALLY.
.*
&L.N LA R14,&ENTRYLN.(R3)
CR R14,R0
BL &L.A
LM R14,R5,24(R13)
MEND
* -------------------------------------------------------
MACRO
&LABEL $$LA ®,&PARAM
LCLC &P,&Z
LCLB &N
.* INTERNAL MACRO TO LOAD A PARAMETER INTO A REG.
AIF (T'® NE 'O' AND T'&PARAM NE 'O').OK
MNOTE 12,'*** PARAMETER &PARAM MISSING'
MEXIT
.OK ANOP
AIF (T'® NE 'N').REGOK
AIF (® GE 0 AND ® LT 17).REGOK
MNOTE 8,'PARAMETER LOAD, ® - INCORRECT REGISTER SPECIFICATION'
.REGOK ANOP
&Z SETC '0'
AIF ('&PARAM'(1,1) EQ '(').L1
AIF (T'&PARAM EQ 'N').SELF
AIF ('&PARAM'(1,2) EQ '=A').LITERAL
AIF ('&PARAM'(1,2) EQ '=F').LITERAL
AIF ('&PARAM'(1,2) EQ '=H').HALFWRD
.*
AIF (T'&PARAM NE 'N').NOTSELF
.SELF AIF (&PARAM LT 4096).NOTSELF
&LABEL L ®,=A(&PARAM) WHEN NUMBER G/T 4095, 'LA' IS N/G.
MEXIT
.*
.NOTSELF ANOP
&LABEL LA ®,&PARAM LOAD VALUE
MEXIT
.*
.LITERAL ANOP
&LABEL L ®,&PARAM LOAD PARAMETER AND CLEAR HI BYTE
MEXIT
.HALFWRD ANOP
&LABEL LH ®,&PARAM LOAD PARAMETER AND CLEAR HI BYTE
MEXIT
.*
.L1 AIF ('&PARAM' EQ '(0)').L0
&LABEL LA ®,&Z&PARAM LOAD PARAMETER AND CLEAR HI BYTE
MEXIT
.L0 ANOP
&LABEL LR ®,&PARAM LOAD PARAMETER FROM REG-0
MEND
* -------------------------------------------------------
MACRO
&LBL MSG &MSG,&ERR=ERREND
LCLA &N
LCLC &L
&N SETA &SYSNDX
&L SETC 'SYS&N'
&LBL BAL R1,&L.B
DC AL1(L'&L.M-1)
&L.M DC C&MSG
&L.B BAL R14,&ERR
MEND
* -------------------------------------------------------
GOFISH START 0
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
USING *,13
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R2,0(R1)
LH R3,0(R2)
SH R3,=H'1'
BM OPENSYSP
MVC PARM(0),2(R2)
SAVPARM EX R3,*-6
* PARM='DDNAM,ABC DEF GHI,DDNAM2,IJK LMN,DD,DATA'
CLI PARM,X'80'
BH COMMAOK
MVC CLI1+1(1),PARM
MVC PARM,PARM+1
COMMAOK LA R0,15 GETMAIN A 15 ENTRY TABLE.
MH R0,=AL2(LDSECT)
ST R0,LGETMAIN
GETMAIN R,LV=(0) LGETMAIN = GETMAIN LENG
ST R1,AGETMAIN AGETMAIN = ADDR + START OF TBL
LR R7,R1 EGETMAIN = END OF TBL
LR R8,R1
A R8,LGETMAIN CLAIM 2 ENTRIES SHORTER FOR SORT W/A
LR R0,R8
SH R0,=AL2(LDSECT) NEED TO LEAVE 1 SORT SAVE
ST R0,EGETMAIN ENTRY.
*
* WTO MF=(E,WTOPARM)
*
* EGETMAIN POINTS TO THE LAST PLACE WE WANT TO USE.
* THEN WHEN TABLE IS LOADED, IT INDICATES THE END
* OF ACTIVE TABLE ENTRIES.
*
PUSH PRINT
PRINT NOGEN DOM'T PRINT ALL THOSE DCB LABLES
OPENSYSP OPEN (SYSPRINT,OUTPUT) TO WADE THROUGH WHEN LOOKING
POP PRINT AT THE LISTING.
LM R2,R3,=A(DOC,ENDDOC-5)
MVC LINE(L'DOC),0(R2)
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
CLI PARM,C' '
BE PUTDOCL
XC TRTTBL,TRTTBL
B QPARM
PUTDOC MVC LINE(64),0(R2) PRINT DOCUMENTATION IF
PUT SYSPRINT,LINE-1 NO PARM= IS CODED.
PUTDOCL LA R2,64(R2)
CR R2,R3
BL PUTDOC
MVC LINE,LINE-1
B EXIT8
* ----------------------------SUBROUTINES -------------------------
* --------------------DDNAME CAN BE 8, STRING 32-------------------
GET32 LA R0,32 HEX IS A PAIN, BUT YA GOTTA DO IT,
CLI PARM,C'X' DDNAME + STRING PROCESSING IS THE SAME
BNE GET8+4 FOR CHARACTERS, INCLUDING SPACES.
CLI PARM+1,C'"'
BE TRYHEX HEX CAN BE SINGLE OR DOUBLE "
CLI PARM+1,C''''
BNE GET8+4
*
TRYHEX MVC 12(64,R13),PARM MAKE A COPY SO SYSPRINT LOOKS
LA R5,14(R13) LESS WIERD
LA R3,2(R4) POINT TO LOC IN DSECT FOR STRING
HEXLOOP TRT 0(2,R5),TESTHEX
BNZ BADHEX
TR 0(2,R5),TRHEX PACK 2 CHARS AT A TIME
PACK 0(2,R3),0(3,R5)
LA R3,1(R3)
LA R5,2(R5)
CLC 0(1,R5),PARM+1 Q. END QUOTE?
BE HEXDONE YES, DONE. R2=X"1122",##
CLC 1(1,R5),PARM+1 Q. ODD # HEX DIGITS = ERROR
BE BADHEX
BCT R0,HEXLOOP ALLOW 32 BYTES
B PARMLONG
*
HEXDONE LR R1,R3 HERE WE HAVE TO MAKEE THINGS
SR R1,R4 LOOK LIKE THEY DO WHEN WE'RE
SH R1,=H'3' DOING CHARACTER PROCESSING.
STH R1,0(R4) SAVE DATA LENGTH-1
*
LA R2,PARM(R1) POINT R2 AT END OF STRING
SR R5,R13
SH R5,=H'13'
LA R2,PARM+2(R5)
BR R9
*
BADHEX OI RC,8
MSG 'BAD HEX CHAR OR ODD #'
* --------------------------------------------------------------------
GET32C LA R0,32
B *+8
GET8 LA R0,8 SAVE UP TO 8 OR 32 BYTE STRING
LA R2,PARM
LA R3,1(R2)
*
LA R2,1(R2)
CLI1 CLI 0(R2),C','
BE FOUND
CLC SPACES(22),0(R2)
BE FOUND
BCT R0,CLI1-4
PARMLONG OI RC,8
MSG 'DDNAME OR STRING TOO LONG'
FOUND LR R1,R2
SR R1,R3
STH R1,0(R4)
MVC 2(0,R4),PARM
EX R1,*-6
* MVC PARM,1(R2)
BR R9
* ----------------------------------------------------------------
USING DSECT,7
QFREQ LA R0,1 THIS ROUTINE FINDS THE LEAST
AH R0,DSTRING-2 FREQUENTLY USED CHARACTER
LA R2,DSTRING IN A STRING, SO WE CAN KEY
LR R1,R2 THE SEARCH ON THAT CHARACTER
MVI DCHAR,C'0' MAKING THE PROGRAM RUN FASTER.
MVI DFREQ,222
QF10 SR R15,R15 I JUST MADE UP THE TABLE, BASED
IC R15,0(R2) ON WHAT I THOUGHT WOULD BE
L R14,=A(FREQTBL) THE FREQUENCY OF VARIOUS
AR R14,R15 CHARACTERS. IF YOU HAVE A
CLC 0(1,R14),DFREQ BETTER TABLE, I'LL BE HAPPY
BNL QF20 TO USE IT.
MVC DFREQ,0(R14)
MVC DCHAR,0(R2)
LR R14,R2
SR R14,R1
STH R14,DLOC
*
QF20 LA R2,1(R2)
BCT R0,QF10
SR R1,R1
IC R1,DCHAR
LA R0,TRTTBL
SR R0,R1
ST R0,DTRT
BR R9
* --------------------------------------------------------------
PUSH PRINT
PRINT NOGEN
USING IHADCB,2
OPEN2IN CLI RC,0 OPEN FILES
BNE SKIPOPEN AND LIST DCB INFO.
MVC DCBMSG(8),DCBDDNAM 'CAUSE I ALWAYS WANT TO KNOW.
BAL R14,ADDADCB
OPEN ((2),INPUT)
B DCBMSG2
OPEN2OUT CLI RC,0
BNE SKIPOPEN
MVC DCBMSG(8),DCBDDNAM
BAL R14,ADDADCB
OPEN ((2),OUTPUT)
B DCBMSG2
POP PRINT
*
SKIPOPEN MVC SKIPOPEM+5(8),DCBDDNAM
SKIPOPEM MSG ' NOT OPENED DUE TO ERRORS'
BR R9
*
DCBMSG2 UNPK DCBMSG+15(3),DCBRECFM(2)
TR DCBMSG+15(2),HEX-240
MVI DCBMSG+17,C' '
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK DCBMSG+24(5),DW+5(3)
LH R0,DCBBLKSI
CVD R0,DW
OI DW+7,X'0F'
UNPK DCBMSG+36(5),DW+5(3)
MVC LINE(L'DCBMSG),DCBMSG
LR R14,R9
B PUTLINE
DCBMSG DC C' .... RECFM= LRECL=..... BLKSI=..... '
DROP 2
* --------------------------------------------------------------
DCBLIST DC A(DCBLIST+4),15F'0'
ADDADCB L R1,DCBLIST
ST R2,0(R1)
LA R1,4(R1)
ST R1,DCBLIST
BR R14
*
USING IHADCB,2
CLOSE LA R4,DCBLIST+4
L R2,0(R4)
TM DCBOFLGS,DCBOFOPN
BNO NOCLO
CLOSE ((2))
NOCLO LA R4,4(R4)
C R4,DCBLIST
BL CLOSE+4
CLOSE (SYSPRINT)
BR R9
* ------------------------------------------------
USING DSECT,7 COMMON MSG ROUTINE. SEE MSG MACRO ABOVE.
* ------------------------------------------------
ERREND OI RC,8
MVC LINE(6),=C'ERROR '
MSG STM R14,R1,PUTLINE-16
TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BO SETMSG
OPEN (SYSPRINT,OUTPUT)
SR 1,1
LM R14,R1,PUTLINE-16
SETMSG LA R0,0(R14)
SR R0,R13
ST R0,12(R13)
MVC LINE+6(13),=C'(....) '
UNPK LINE+7(5),14(3,R13)
TR LINE+7(4),HEX-240
MVI LINE+11,C')'
SR R15,R15
IC R15,0(R1)
MVC LINE+15(0),1(R1)
EX R15,*-6
LA R14,LINE+20(R15)
MVC 0(40,R14),PARM
B PUTLINE+4
*
DC 4F'4'
PUTLINE STM R14,R1,PUTLINE-16
PUT SYSPRINT,LINE-1
SR 1,1
MVC LINE,LINE-1
CLI RC,0
BNE EXIT
LM R14,R1,PUTLINE-16
BR R14
* --------------------------------------------------
EXIT8 OI RC,8
EXIT BAL R9,COUNTS
BAL R9,CLOSE
LM R0,R1,LGETMAIN
LTR R1,R1
BZ NOFREEM
FREEMAIN R,LV=(0),A=(1)
NOFREEM SR R15,R15
IC R15,RC
L R13,4(R13)
L R14,12(R13)
LM R0,R12,20(R13)
BR R14
* -------------------------------- PARM PROCESSING -------------
PUSH USING
QPARML LA R7,LDSECT(R7)
B QPARM+6
QPARM XC TRTTBL,TRTTBL
C R7,EGETMAIN
BL INITDSCT
OI RC,8
MSG 'TOO MANY SELECT STRINGS'
L R7,AGETMAIN
INITDSCT XC 0(LDSECT,R7),0(R7)
MVC DDNAME,SPACES
LA R4,DDNAME-2
BAL R9,GET8 GET DDNAME
PUT SYSPRINT,PARM-9
SR 1,1
MVC PARM,1(R2)
CLC SPACES(12),PARM
BNE GOTDDN
MSG 'DDNAME,STRING ARE PAIRS, NOT ODD # OF THEM'
B EXIT8
GOTDDN MVC DCBDDNAM-IHADCB+QDCB,DDNAME
MVC DDCB,QDCB
*
LA R4,DSTRING-2
BAL R9,GET32 GET STRING
ST R2,60(R13)
BAL R9,QFREQ
MVC PARM-2(1),DCHAR
PUT SYSPRINT,PARM-9
SR 1,1
L R2,60(R13)
MVC PARM,1(R2)
MVI PARM-2,C' '
AP #PARMS,=P'1'
CLC SPACES(12),PARM
BNE QPARML
CLI RC,0
BNE EXIT
* +++++++++++++++++++++++++++++++++++++++++++++++++++++
LA R7,LDSECT(R7)
ST R7,EGETMAIN
CP #PARMS,=P'1'
BE NOSORT
L R2,AGETMAIN
SORT BEG=(2),END=(7),ENTRYLN=LDSECT,KEY=DCHAR-DSECT,KEYLN=1
XC 0(LDSECT,R7),0(R7)
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++
NOSORT LM R7,R8,AGETMAIN NEXT, SET UP THE TRT TAGBLE
LA R6,99 TO FIND THE BYTES,
LA R1,1 FOR THE STRINGS SPECIFIED.
SR R2,R2
*
SETUPTRT SR R3,R3
IC R2,DCHAR
LA R3,TRTTBL(R2)
CLI 0(R3),0
BNE *+8
STC R1,0(R3)
LA R1,1(R1)
CP #PARMS,=P'1'
BE LISTLOOP-4
*
L R14,AGETMAIN
CLCDDNAM CLC DDNAME,DDNAME-DSECT(R14) WHEN THE SAME DDNAME
BNE DONTCHAI IS USED FOR MULTIPLE
CR R7,R14 STRINGS, WE ALREADY
BE DONTCHAI SORTED THE TABLE TO
ST R7,ADCB-DSECT(R14) PUT 'EM NEXT TO EACH
DONTCHAI LA R14,LDSECT(R14) OTHER. WE NOW HAVE
CR R14,R7 TO CHAIN THE ENTRIES
BL CLCDDNAM TOGETHER.
*
CH R6,DSTRING-2
BL *+8
LH R6,DSTRING-2 R6 = SHORTEST STRING
*
LA R7,LDSECT(R7)
CR R7,R8
BL SETUPTRT
* ------------------------------------------
MVC LINE(18),=C'DDNAME CHAR STRING'
BAL R14,PUTLINE
LM R7,R8,AGETMAIN DURING TESTING, I WAS CURIOUS
LISTLOOP MVC LINE(8),DDNAME WHETHER THE TABLES WERE SET
MVC LINE+10(1),DCHAR UP CORRECTLY. DOESN'T COST
LH R1,DSTRING-2 MUCH. LEFT THE CODE IN.
MVC LINE+12(0),DSTRING
EX R1,*-6
PUT SYSPRINT,LINE-1
SR 1,1
MVC LINE,LINE-1
LA R7,LDSECT(R7)
CR R7,R8
BL LISTLOOP
* ------------------------------------------
OPENIN LA R2,IN HERE WE OPEN THE INPUT FILE
BAL R9,OPEN2IN AND THE OUTPUT FILES THAT
L R7,AGETMAIN WERE SPECIFIED.
OPENLOOP CLC =F'0',ADCB
BNE *+10
OPENLO LR R2,R7
BAL R9,OPEN2OUT
LA R7,LDSECT(R7)
C R7,EGETMAIN
BL OPENLOOP
B GET
* ------------------------------------------------
PUT L R1,ADCB Q. DOES THIS LINK TO A DIFFERENT
LTR R1,R1 DCGB? YES, USE THAT.
BNZ *+6 NO, USE THIS DCB.
LR R1,R7
CLI DFREQ-DSECT(R1),C'W' THIS BIT MAKES SURE THAT
BE NEXTRT WE ONLY WRITE A REC TO
MVI DFREQ-DSECT(R1),C'W' A FILE ONE TIME.
PUT (1),(10)
AP #PUT,=P'1' THE PROBLEM THAT EXISTS IS
CP #PARMS,=P'1' THAT ANY RECORD CAN HAVE
BE GET MULTIPLE SELECT STRINGS,
B NEXTRT BUT WE ONLY WANT TO WRITE
* IT ONCE.
GET GET IN
AP #GET,=P'1'
*
L R7,AGETMAIN HERE WE TURN OFF THE
ERASWRIT MVI DFREQ,0 'WE WROTE THIS RECORD'
LA R7,LDSECT(R7) FLAG, FOR THIS RECORD.
C R7,EGETMAIN
BL ERASWRIT
*
LA R10,0(R1) REG-10 = BEG OF RECORD
LH R11,DCBLRECL-IHADCB+IN
TM DCBRECFM-IHADCB+IN,X'80'
BO *+8
LH R11,0(R10)
LA R11,0(R10,R11) REG-11 = END OF RECORD
*
SR R2,R2
LR R5,R10
LR R14,R11
SR R14,R10
CH R14,=H'256'
BL SHORT
B TRTLONG
NEXTRT LR R5,R12
LA R1,1(R5,R6)
CR R1,R11
BH GET
*
TRTLONG LR R14,R11
SR R14,R5
SR R2,R2
CH R14,=H'255'
BL SHORT
AP #TRT,=P'1'
TRT 0(255,R5),TRTTBL
BNZ FOUNDCHR
LA R5,255(R5)
B TRTLONG
*
TRT 0(0,R5),TRTTBL
SHORT AP #TRT,=P'1'
EX R14,SHORT-6
BZ GET
*
FOUNDCHR LA R12,1(R1)
AP #FNDCHAR,=P'1'
BCTR R2,0
LR R7,R2
MH R7,=AL2(LDSECT)
A R7,AGETMAIN
B FNDLOOP
L R2,LDSECT(R2)
FNDLOOP LR R14,R1
SH R14,DLOC
CR R14,R10
BL NEXTRT
LH R2,DSTRING-2
LA R3,1(R14,R15)
CR R3,R11
BH NEXTRT
B CLCSTR
CLC DSTRING(0),0(R14)
CLCSTR AP #CLC,=P'1'
EX R2,CLCSTR-6
BE PUT
CLC DCHAR,DCHAR+LDSECT
BNE NEXTRT
LA R7,LDSECT(R7)
B FNDLOOP
* ------------------------------------------------
LTORG
HEX DC C'0123456789ABCDEF'
RC DC X'00'
#PARMS DC PL2'0'
DW DC D'0'
LGETMAIN DC F'0'
AGETMAIN DC F'0'
EGETMAIN DC F'0'
*
#GET DC PL6'0',CL16'RECORDS READ'
#TRT DC PL6'0',CL16'TRT INSTS DONE'
#FNDCHAR DC PL6'0',CL16'TRT CHAR FOUND'
#CLC DC PL6'0',CL16'CLC INSTS DONE'
#PUT DC PL6'0',CL16'RECORDS WRITTEN'
DC X'FF'
COUNTS LA R2,#GET
MVC LINE(L'EDIT11),EDIT11
ED LINE(L'EDIT11),0(R2)
MVC LINE+L'EDIT11+2(16),6(R2)
PUT SYSPRINT,LINE
SR 1,1
LA R2,#TRT-#GET(R2)
CLI 0(R2),X'99'
BL COUNTS+4
BR R9
EDIT11 DC X'4020206B2020206B2020206B212020'
*
DC H'111,0',C' '
LINE DC CL133' ',CL60' '
*
WTOPARM DC H'80,0'
DC CL9' PARM= '
PARM DC CL133' '
SPACES DC CL133' '
*
*
EXLST DC 0F'0',X'85',AL3(EXLST+4) THIS OPEN EXIT
PUSH USING COPIES LRECL
DROP 13 AND RECFM
USING *,15 FROM //IN TO
CLC =H'0',DCBLRECL-IHADCB(R2) //OUT
BNER 14 ADDING THE LENGTH
LH R1,DCBLRECL-IHADCB+IN OF THE FIELDS THAT
* AH R1,LLBB WERE SPECIFIED.
STH R1,DCBLRECL-IHADCB(R2)
CLI DCBRECFM-IHADCB(R2),0
BNER 14
MVC DCBRECFM-IHADCB(1,R2),DCBRECFM-IHADCB+IN
BR 14
DROP 15
POP USING
* LLBB DC 2H'0'
LTORG
*
PRINT NOGEN
DS 0D
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=133
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=140,EODAD=EXIT
QDCB DCB DDNAME=QQQ,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=120 EXLST=EXLST
POP PRINT
CNOP 0,8
FREQTBL DC 256X'05'
ORG FREQTBL
DC X'151413'
ORG FREQTBL+X'20' BLANK + SPECIAL CHARS
DC X'15',15X'09'
ORG FREQTBL+X'30' ASCII NUMBERS
DC X'14',9X'12',6X'09'
ORG FREQTBL+X'40' ASCII UPPER CASE LETTERS
DC X'091411111114111111141011121212141110121212131010091309'
DC 6X'08' SPECIAL CHARS,THEN LOWER CASE LETTERS
DC X'091411111114111111141011121212141110121212131010091309'
DC 5X'08'
ORG FREQTBL+X'80'
DC X'05141111111411111114',6X'05' EBCDIC LOWER CASE
DC X'05111112131314110013',6X'05' "
DC X'05051313120909081209',6X'05' "
DC 16X'05'
ORG FREQTBL+X'C1'
DC X'141212121912121214',6X'05' UPPER CASE
DC X'05121212141414120314',6X'05'
DC X'05051414121111040904',6X'05'
DC X'15151413131313131313',6X'05'
ORG
*
TESTHEX EQU *-192 TRYING TO KEEP THE PGM UNDER 4K
TRHEX EQU *-128
DC C' ',XL6'00',CL41' ',XL10'00',CL6' '
DC X'000A0B0C0D0E0F',CL41' ',X'00010203040506070809',CL6' '
*
TRTTBL DS 0XL256
DOC DS 0CL64
*
*DC C'GOFISH, &SYSDATE, FINDS STRINGS BASED ON PARM FIELD. EG: '
*DC C'//FISHING EXEC PGM=GOFISH,PARM="DD1,STR1,DD1,STR2,DD3,STRING '
*DC C'//SYSPRINT DD SYSOUT=* (DD1 GETS STR1+2) OR DD3,X"C1C2C3"'
*DC C' '
*DC C'PARM CONTAINS DDNAME AND STRING PAIRS, SEPARATED BY COMMAS. '
*DC C'IF THE FIRST BYTE OF PARM IS LESS THAN X"80" IT WILL BE USED '
*DC C'INSTEAD OF COMMA. STRINGS ARE CHARACTER UNLESS X-QUOTE IS USED.'
*DC C'//IN IS THE INPUT FILE. OUTPUT FILES ARE SPECIFIED IN PARM. '
*DC C' '
DC C'GOFISH, ASM &SYSDATE, &SYSTIME, BY LINLYONS, FINDS CHAR STRINGS.'
DC C' '
DC C'THE PROBLEM BEING ADDRESSED WAS LOOKING FOR A CHARACTER STRING '
DC C'IN A LARGE FLAT FILE. WHAT THIS PROGRAM DOES IS PICK THE LEAST '
DC C'FREQUENTLY USED CHARACTER OF THE STRING AND SEARCH FOR THAT. '
DC C'WHEN FOUND, BACK UP AND COMPARE THE STRING. '
DC C' '
DC C'WE USE TRT TO SCAN FOR THE CHARACTER IN QUESTION, WHICH ALLOWS '
DC C'US TO SCAN FOR MORE THAN 1 CHARACTER IN THE SAME INSTRUCTION, '
DC C'AND WHEN FOUND, REG-2 WILL INDICATE WHICH CHARACTER WE FOUND. '
DC C' '
DC C'WE USE COMMA TO SEPARATE THE STRINGS, SO YOUR STRING CANNOT HAVE'
DC C'A COMMA IN IT. YOU CAN HAVE SPACES, OR WHATEVER. TO SOLVE THAT,'
DC C'YOU CAN SPECIFY, AS THE FIRST CHARACTER OF THE PARM, A DIFFERENT'
DC C'SEPARATOR -- ANY CHARACTER LOWER THAN X"80". '
DC C' '
DC C'THE ONLY INPUT IS FROM THE PARM FIELD. IF YOU NEED MORE, USE MY'
DC C'OTHER PROGRAM, EDITFILE, WHICH IS MUCH MORE COMPREHENSIVE. '
DC C'GOFISH WOULD NORMALLY BE USED TO LOOK FOR A STRING. YOUR NAME? '
DC C' '
DC C'//SCAN EXEC PGM=GOFISH,PARM="OUTFILE,YOUR NAME" '
DC C'//STEPLIB DD DISP=SHR,DSN=..WELL.YOU.KNOW '
DC C'//SYSPRINT DD SYSOUT=* '
DC C'//IN DD DISP=SHR,DSN=FILE.TO.SEARCH '
DC C'//OUTFILE DD SYSOUT=* '
DC C' '
DC C'BUT THAT IS NOT ENOUGH. YOU CAN SEARCH FOR MULTIPLE STRINGS IN A'
DC C'SINGLE PASS, AND COPY THE SELECTED RECORDS TO VAROIUS FILES. EG'
DC C' '
DC C'PARM="DDNAME,SOME STRING,DDNAME, ANOTHER STRING,DD#2,WHATEVER" '
DC C' '
DC C'RECORDS CONTAINING EITHER OF THE FIRST 2 STRINGS ARE WRITTEN TO '
DC C'THE SAME FILE. A SECOND FILE IS USED TO GET OTHER RECORDS. ' '
DC C' '
DC C'AND, IF YOU ARE LOOKING FOR A COMMA, THEN YOU NEED A DIFFERENT '
DC C'SEPARATOR, SPECIFIED AS THE FIRST CHAR OF THE PARM FIELD. EG '
DC C' '
DC C'PARM="$OUTDD$YOUR,STRING" '
DC C' '
DC C'HAVE FUN. LIKED WRITING IT IN THE 70S, AND NEEDED A BREAK FRON '
DC C'WORKING ON THE LOGIC FOR PGM=EDITFILE, SO WROTE THIS. ' '
ENDDOC EQU *
*
DSECT DSECT 0
DDCB DS XL104
ADCB DS A
DS H
DDNAME DS CL8
DCHAR DS C
DFREQ DS C
DLOC DS H
DTRT DS A
DS 3XL6 THERE'S A BUG. LEAVE THIS HERE.
DS H
DSTRING DS CL32
LDSECT EQU *-DSECT
GOFISH CSECT
END GOFISH