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 &REG,&PARAM

LCLC &P,&Z

LCLB &N

.* INTERNAL MACRO TO LOAD A PARAMETER INTO A REG.

AIF (T'&REG NE 'O' AND T'&PARAM NE 'O').OK

MNOTE 12,'*** PARAMETER &PARAM MISSING'

MEXIT

.OK ANOP

AIF (T'&REG NE 'N').REGOK

AIF (&REG GE 0 AND &REG LT 17).REGOK

MNOTE 8,'PARAMETER LOAD, &REG - 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 &REG,=A(&PARAM) WHEN NUMBER G/T 4095, 'LA' IS N/G.

MEXIT

.*

.NOTSELF ANOP

&LABEL LA &REG,&PARAM LOAD VALUE

MEXIT

.*

.LITERAL ANOP

&LABEL L &REG,&PARAM LOAD PARAMETER AND CLEAR HI BYTE

MEXIT

.HALFWRD ANOP

&LABEL LH &REG,&PARAM LOAD PARAMETER AND CLEAR HI BYTE

MEXIT

.*

.L1 AIF ('&PARAM' EQ '(0)').L0

&LABEL LA &REG,&Z&PARAM LOAD PARAMETER AND CLEAR HI BYTE

MEXIT

.L0 ANOP

&LABEL LR &REG,&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