In some programs, I want to know the least frequently used character in a string. I've written the routine to do this a couple times, but at 2am Sunday morning, when I should be sleeping, a different way to do that occurred to me, and kept me awake for an hour thinking about it. So today, 5/2 26, I got a fresh copy of char frequency from Wikipedia, formatted the frequency table, and wrote the code to find the 'rare' character. Tested it, and it worked THE FIRST TIME. :)
TR 0(0,R3),QFREQTBL
MVC 0(0,R3),2(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
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
This is the discussion about scanning a file, looking for a specific character string. There are several things here. But first, when I say PARM field, when I start my program, I can pass it a text line, and the program is presented with the length of the line followed by the line. Assembler programmers use this all the time. I think it's available in COBOL but I have no clue how COBOL does it.
Next, this whole thing is about searching for a character string (your name??) in a file. There are a couple things to consider.
1. How fast will it run. This can be serous.
2. How do you tell the program what to do, and what additional options are available.
For this discussion, we'll only look for a single string. The first time I encountered this was in the '70s. My boss wrote a really inefficient program that locked up our super-computer. I wrote one that did what he wanted and reduced the CPU time by many orders of magnitude. Now that I'm long retired, I play around with this and other things, using the SPFlite editor (really nice) and the Z390 simulator (really amazing). I wrote 2 assembler programs, and there are 2 AI generated COBOL programs.
There are 5 programs (well 4 and some JCL) all of which search for a string in a file.
The programs are:
1) Sample program to read a file and index through a record comparing to find a specified character string.
2) Sample program to read a file, and, with 1 instruction, look for a character that matches the first character of a requested string, and only when we have a first character match do the compare to see if we found the string.
3) ChatGPT generated COBOL program that is supposed to do what #1 above does. (But I think it has a logic error.)
4) Claude generated COBOL program that's supposed to be the same. It might work, but it's a tad wordy (200 lines).
5) Claude generated JCL to run the program.
(I might mention that I use bad form in that I use reg-13 for both my save area and also the base register. After 50 years, I go to some length to save registers. Also, my typing has gone seriously downhill at my age, so it would be amazing if these worked the first time.)
FINDPARM START 0 EXTREMELY INEFFICIENT 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'FINDPARM ASM &SYSDATE &SYSTIME'
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
SH R5,=H'1' CALC LENGTH-1
BNM OPEN AND OPEN FILES
WTO 'PARM MISSING, MUST CONTAIN STRING'
ABEND 1 QUIT IF NO PARM
OPEN OPEN (IN,INPUT,OUT,OUTPUT) OPEN
SH R6,DCBLRECL-IHADCB+IN CALC # TIMES TO COMP
B GET AND GO READ
* =============================== THIS SECTION IS THE PROGRAM ============
CLC CLC 2(0,R8),0(R1) COMPARE STRING TO REC LOCATIONS
FOUND PUT OUT,(0) WRITE IF FOUND
AP COUNT,P1 COUNT IT
GET GET IN READ
LR 0,1 SAVE REC ADDR
LR R4,R6 LOAD # LOCATIONS TO TEST
* ------------------------------
LOOP EX R5,CLC SCAN THE RECORD, 1 BYTE AT A TIME.
BE FOUND GO WRITE AND COUNT IF FOUND
LA R1,1(R1) BUMP INDEX
BCT R4,LOOP LOOP # TIMES=REC LENGTH-STRING LENGTH
B GET NOT FOUND, GO READ
* ================================= END OF THE PROGRAM ==================
Z CLOSE (IN,,OUT) DONE, CLOSE FILES
OI COUND+3,X'0F' FIX COUNT FIELD SIGN
UNPK MSG(7),COUNT PUT INTO MESSAGE
WTO MF=(E,MSG-4) WRITE MSG
L 13,4(13) ---------NORMAL HOUSEKEEPING CLEAN UP
LM 14,12,12(13)
SR 15,15
BR 14 EXIT
DC AL2(L'MSG,0)
MSG DC '....... RECORDS COPIED'
COUNT DC PL4'0'
P1 DC X'1C'
*
LTORG
PRINT NOGEN
* ---------------------------------
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=266,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM
* -------------------------------------------------
END FINDPARM
====================================================
====================================================
HERE'S A FASTER SCAN. ONLY DO A COMPARE WHEN
WE FIND A CHARACTER THAT MATCHES THE FIRST CHAR
OF THE PARM STRING.
====================================================
====================================================
FASTER START 0 FASTER 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'FASTER ASM &SYSDATE &SYSTIME'
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
SR 1,1 SET UP TABLE TO SCAN'
IC 1,2(R8) FOR 1ST CHAR OF STRING
LA R1,TRTTBL(R1)
MVI 0(R1),C'F'
LH R5,0(R8) LOAD LENGTH OF PARM
LR R6,R5 SAVE BOTH LENGTH
SH R5,=H'1' CALC LENGTH-1
BNM OPEN AND OPEN FILES
WTO 'PARM MISSING, MUST CONTAIN STRING'
ABEND 1 QUIT IF NO PARM
OPEN OPEN (IN,INPUT,OUT,OUTPUT) OPEN
SH R6,DCBLRECL-IHADCB+IN CALC # TIMES TO COMP
B GET AND GO READ
* =============================== THIS SECTION IS THE PROGRAM ============
CLC CLC 2(0,R8),0(R1) COMPARE STRING TO REC LOCATIONS
FOUND PUT OUT,(0) WRITE IF FOUND
AP COUNT,P1 COUNT IT
GET GET IN READ
LR 0,1 SAVE REC ADDR
LA 0(R4,R6) LOAD # LOCATIONS TO TEST
* ------------------------------
LOOP LR R2,R4 POINT TO END OF REC
SR R2,R1 CALC LENGTH LEFT TO TEST
BNP GET SHORT, GO READ NEXT
EX R2,TRT SCAN FOR FIRST CHAR OF PARM
BZ GET NOT FOUND, GO READ
EX R5,CLC FOUND, COMPARE
BE FOUND 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 COUND+3,X'0F' FIX COUNT FIELD SIGN
UNPK MSG(7),COUNT PUT INTO MESSAGE
WTO MF=(E,MSG-4) WRITE MSG
L 13,4(13) ---------NORMAL HOUSEKEEPING CLEAN UP
LM 14,12,12(13)
SR 15,15
BR 14 EXIT
DC AL2(L'MSG,0)
MSG DC '....... RECORDS COPIED'
COUNT DC PL4'0'
P1 DC X'1C'
TRTTBL DC XL256'00'
*
LTORG
PRINT NOGEN
* ---------------------------------
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=266,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM
* -------------------------------------------------
END FASTER
Next is a COBOL program, written by ChatGPT to find a string in a file. It indexes along a record and does a compare to the requested string. It's been a long time since I did any COBOL, but I think there's a logic error in it because it appears to be indexing along the requested search string. This was passed via Facebook, which removed all the spaces. I've tried to put 'em back, but I expect it could be better. It's about 60 lines of code.
IDENTIFICATION DIVISION.
PROGRAM-ID. STRSRCH.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TAPE-IN ASSIGN TO SYS010
ORGANIZATION IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD TAPE-IN
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD.
01 IN-REC.
05 IN-CHAR OCCURS 200 TIMES PIC X.
WORKING-STORAGE SECTION.
01 EOF-SW PIC X VALUE 'N'.
88 EOF VALUE 'Y'.
05 IN-CHAR OCCURS 200 TIMES PIC X.
01 SEARCH-STRING.
05 SRCH-CHAR OCCURS 10 TIMES PIC X
VALUE 'SEARCHTEXT'.
01 REC-COUNT PIC 9(9) COMP VALUE 0.
01 MATCH-COUNT PIC 9(9) COMP VALUE 0.
01 I PIC 9(4) COMP VALUE 0.
01 J PIC 9(4) COMP VALUE 0.
01 K PIC 9(4) COMP VALUE 0.
01 MATCH-SW PIC X VALUE 'N'.
PROCEDURE DIVISION.
MAIN-PARA.
OPEN INPUT TAPE-IN.
PERFORM UNTIL EOF
READ TAPE-IN
AT END
MOVE 'Y' TO EOF-SW
NOT AT END
ADD 1 TO REC-COUNT
PERFORM SEARCH-RECORD
END-READ
END-PERFORM.
CLOSE TAPE-IN.
DISPLAY 'TOTAL RECORDS READ ' REC-COUNT.
DISPLAY 'MATCHES FOUND ' MATCH-COUNT.
STOP RUN.
SEARCH-RECORD.
MOVE 1 TO I.
PERFORM UNTIL I > 191
MOVE 'Y' TO MATCH-SW
MOVE 1 TO J
MOVE I TO K
PERFORM UNTIL J > 10 OR MATCH-SW = 'N'
IF IN-CHAR (K) NOT = SRCH-CHAR (J)
MOVE 'N' TO MATCH-SW
ELSE
ADD 1 TO J
ADD 1 TO K
END-IF
END-PERFORM
IF MATCH-SW = 'Y'
ADD 1 TO MATCH-COUNT
DISPLAY 'MATCH IN RECORD ' REC-COUNT
END-IF
ADD 1 TO I
END-PERFORM.
=====================================================================================
But we're not done yet. Here's another program, written by CLAUDE that follows the same principle - reading a record, and scanning down the line testing to see if there's a match to the requested string. (this one saved the indenting that makes it easier to read, but, to be honest, I think that my assembler code is noticeably easier yet.)
IDENTIFICATION DIVISION.
PROGRAM-ID. STRSRCH.
AUTHOR. CLAUDE.
*****************************************************************
* *
* PROGRAM : STRSRCH *
* PURPOSE : SCAN A MULTI-VOLUME (20 REEL) SEQUENTIAL TAPE *
* FILE FOR OCCURRENCES OF A USER-SPECIFIED CHARACTER *
* STRING. WRITES A REPORT LISTING EACH MATCHING *
* RECORD AND A SUMMARY (RECORDS SCANNED, RECORDS *
* MATCHED, AND TOTAL HITS). *
* *
* TARGET : IBM SYSTEM/360 MODEL 195 *
* OPERATING SYSTEM: OS/MVT OR OS/VS2 (MVS) *
* COMPILER : IBM OS/VS COBOL (ANS-74 BASE) *
* *
* INPUTS : *
* PARMIN - 80-COL CARD IMAGE. *
* COLS 1-2 = TARGET LENGTH (01-50) *
* COL 3 = BLANK *
* COLS 4-53 = TARGET CHARACTERS, LEFT-JUSTIFIED *
* TAPEIN - 20 REEL STANDARD-LABEL TAPE FILE. *
* FB / LRECL=133 / BLKSIZE PER JCL. *
* VOLUME SWITCHING IS HANDLED BY DATA MANAGEMENT; *
* THE PROGRAM JUST READS UNTIL "AT END". *
* OUTPUT : *
* RPTOUT - PRINT-FORMAT REPORT (HEADER, DETAIL, TRAILER). *
* *
* ALGORITHM: *
* READ THE PARM CARD AND COPY THE TARGET INTO AN OCCURS-50 *
* BYTE TABLE. FOR EACH 133-BYTE TAPE RECORD, SLIDE A *
* WINDOW OF LENGTH N=TARGET-LEN OVER POSITIONS 1..134-N AND *
* DO A BYTE-WISE COMPARE. REFERENCE MODIFICATION IS NOT *
* USED -- KEEPS THE SOURCE COMPATIBLE WITH PRE-1985 IBM *
* COMPILERS. *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-360-195.
OBJECT-COMPUTER. IBM-360-195.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TAPE-IN ASSIGN TO UT-S-TAPEIN.
SELECT PARM-IN ASSIGN TO UR-S-PARMIN.
SELECT REPORT-OUT ASSIGN TO UT-S-RPTOUT.
*
DATA DIVISION.
FILE SECTION.
FD TAPE-IN
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD.
01 TAPE-RECORD.
05 TR-BYTE OCCURS 133 TIMES PIC X.
*
FD PARM-IN
RECORDING MODE IS F
LABEL RECORDS ARE OMITTED.
01 PARM-RECORD.
05 PR-LEN PIC 99.
05 FILLER PIC X.
05 PR-TARGET.
10 PR-T-BYTE OCCURS 50 TIMES PIC X.
05 FILLER PIC X(27).
*
FD REPORT-OUT
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD.
01 REPORT-LINE PIC X(133).
*
WORKING-STORAGE SECTION.
01 WS-FLAGS.
05 WS-EOF PIC X VALUE 'N'.
88 END-OF-TAPE VALUE 'Y'.
05 WS-MATCH-IN-REC PIC X VALUE 'N'.
88 REC-MATCHED VALUE 'Y'.
05 WS-CHAR-MATCH PIC X VALUE 'N'.
88 CHARS-MATCH VALUE 'Y'.
*
01 WS-COUNTS COMP.
05 WS-RECS-READ PIC 9(10) VALUE ZERO.
05 WS-RECS-MATCHED PIC 9(10) VALUE ZERO.
05 WS-TOTAL-HITS PIC 9(10) VALUE ZERO.
*
01 WS-SEARCH.
05 WS-TARGET-LEN PIC 9(3) COMP VALUE ZERO.
05 WS-LAST-START PIC 9(3) COMP VALUE ZERO.
05 WS-START PIC 9(3) COMP VALUE ZERO.
05 WS-J PIC 9(3) COMP VALUE ZERO.
05 WS-K PIC 9(3) COMP VALUE ZERO.
05 WS-TARGET-AREA.
10 WS-TG-BYTE OCCURS 50 TIMES PIC X.
*
01 WS-HEADER.
05 FILLER PIC X(01) VALUE '1'.
05 FILLER PIC X(40) VALUE
'STRSRCH - 20 REEL TAPE STRING SEARCH '.
05 FILLER PIC X(10) VALUE 'TARGET = ['.
05 WS-HD-TARGET PIC X(50).
05 FILLER PIC X(01) VALUE ']'.
05 FILLER PIC X(31) VALUE SPACES.
*
01 WS-DETAIL.
05 FILLER PIC X(01) VALUE SPACE.
05 FILLER PIC X(09) VALUE 'REC NO.: '.
05 WS-DT-RECNO PIC ZZZ,ZZZ,ZZZ,ZZ9.
05 FILLER PIC X(05) VALUE ' -- '.
05 WS-DT-TEXT PIC X(100).
05 FILLER PIC X(03) VALUE SPACES.
*
01 WS-TRAILER-1.
05 FILLER PIC X(01) VALUE '0'.
05 FILLER PIC X(20) VALUE
'RECORDS SCANNED : '.
05 WS-TR-READ PIC ZZ,ZZZ,ZZZ,ZZ9.
05 FILLER PIC X(96) VALUE SPACES.
01 WS-TRAILER-2.
05 FILLER PIC X(01) VALUE ' '.
05 FILLER PIC X(20) VALUE
'RECORDS WITH MATCH: '.
05 WS-TR-MATCHED PIC ZZ,ZZZ,ZZZ,ZZ9.
05 FILLER PIC X(96) VALUE SPACES.
01 WS-TRAILER-3.
05 FILLER PIC X(01) VALUE ' '.
05 FILLER PIC X(20) VALUE
'TOTAL HITS : '.
05 WS-TR-HITS PIC ZZ,ZZZ,ZZZ,ZZ9.
05 FILLER PIC X(96) VALUE SPACES.
*
PROCEDURE DIVISION.
*
A000-MAINLINE.
PERFORM B100-OPEN-FILES.
PERFORM B200-LOAD-PARM.
IF NOT END-OF-TAPE
PERFORM B300-WRITE-HEADER
PERFORM C000-PROCESS-TAPE UNTIL END-OF-TAPE
PERFORM D000-WRITE-TRAILER.
PERFORM B900-CLOSE-FILES.
STOP RUN.
*
B100-OPEN-FILES.
OPEN INPUT PARM-IN
INPUT TAPE-IN
OUTPUT REPORT-OUT.
*
B200-LOAD-PARM.
MOVE 'N' TO WS-EOF.
READ PARM-IN
AT END
DISPLAY '*** STRSRCH: NO PARM CARD SUPPLIED ***'
MOVE 'Y' TO WS-EOF.
IF NOT END-OF-TAPE
IF PR-LEN NUMERIC AND PR-LEN > ZERO AND PR-LEN <= 50
MOVE PR-LEN TO WS-TARGET-LEN
PERFORM B210-COPY-TARGET
VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WS-TARGET-LEN
MOVE PR-TARGET TO WS-HD-TARGET
COMPUTE WS-LAST-START = 133 - WS-TARGET-LEN + 1
DISPLAY 'STRSRCH: TARGET LEN=' WS-TARGET-LEN
' STRING=[' WS-HD-TARGET ']'
ELSE
DISPLAY '*** STRSRCH: INVALID LEN ON PARM CARD ***'
MOVE 'Y' TO WS-EOF.
*
B210-COPY-TARGET.
MOVE PR-T-BYTE (WS-J) TO WS-TG-BYTE (WS-J).
*
B300-WRITE-HEADER.
WRITE REPORT-LINE FROM WS-HEADER
AFTER ADVANCING PAGE.
*
C000-PROCESS-TAPE.
READ TAPE-IN
AT END
MOVE 'Y' TO WS-EOF.
IF NOT END-OF-TAPE
ADD 1 TO WS-RECS-READ
PERFORM C100-SCAN-RECORD.
*
C100-SCAN-RECORD.
MOVE 'N' TO WS-MATCH-IN-REC.
PERFORM C110-TRY-POSITION
VARYING WS-START FROM 1 BY 1
UNTIL WS-START > WS-LAST-START.
*
C110-TRY-POSITION.
MOVE 'Y' TO WS-CHAR-MATCH.
PERFORM C120-COMPARE-BYTE
VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WS-TARGET-LEN
OR NOT CHARS-MATCH.
IF CHARS-MATCH
ADD 1 TO WS-TOTAL-HITS
IF NOT REC-MATCHED
MOVE 'Y' TO WS-MATCH-IN-REC
ADD 1 TO WS-RECS-MATCHED
PERFORM C200-WRITE-DETAIL.
*
C120-COMPARE-BYTE.
COMPUTE WS-K = WS-START + WS-J - 1.
IF TR-BYTE (WS-K) NOT = WS-TG-BYTE (WS-J)
MOVE 'N' TO WS-CHAR-MATCH.
*
C200-WRITE-DETAIL.
MOVE WS-RECS-READ TO WS-DT-RECNO.
MOVE TAPE-RECORD TO WS-DT-TEXT.
WRITE REPORT-LINE FROM WS-DETAIL
AFTER ADVANCING 1 LINES.
*
D000-WRITE-TRAILER.
MOVE WS-RECS-READ TO WS-TR-READ.
MOVE WS-RECS-MATCHED TO WS-TR-MATCHED.
MOVE WS-TOTAL-HITS TO WS-TR-HITS.
WRITE REPORT-LINE FROM WS-TRAILER-1
AFTER ADVANCING 2 LINES.
WRITE REPORT-LINE FROM WS-TRAILER-2
AFTER ADVANCING 1 LINES.
WRITE REPORT-LINE FROM WS-TRAILER-3
AFTER ADVANCING 1 LINES.
*
B900-CLOSE-FILES.
CLOSE TAPE-IN
PARM-IN
REPORT-OUT.
=======================================================================
Oh my lord, it gets worse. Claude generated JCL to run the program above.
(Okay what's JCL?) Job Control Language which consists of:
- JOB card tells who pays for the computer time.
- EXEC card that tells the system what program to run, and
- DD (data definition) cards that allows the program to read and write files.
First I'll show you what you really need, and then post what Claude created.
//STRSRCH JOB (ACCT#),CLASS=A,MSGCLASS=X,MSGLEVEL=1,TIME=60
//STEP1 EXEC PGM=STRSRCH
//STEPLIB DD DSN=USER.LOAD.LIB,DISP=SHR
//SYSOUT DD SYSOUT=*
//RPTOUT DD SYSOUT=*
//TAPEIN DD DSN=PROD.HISTORY.MASTER,DISP=OLD
//PARMIN DD *
12 ERROR-CODE99 <== THIS IS WHAT WE'RE LOOKING FOR
/*
That's all ya need. Really!!! But Claude went a bit overboard with about 70 lines.
//STRSRCH JOB (ACCT#),'TAPE STRING SEARCH',
// CLASS=A,MSGCLASS=X,MSGLEVEL=(1,1),
// REGION=512K,TIME=(60,0),NOTIFY=&SYSUID
//*-----------------------------------------------------------------*
//* RUN STRSRCH AGAINST A 20-REEL STANDARD-LABEL TAPE FILE. *
//* *
//* KEY POINTS FOR A MULTI-VOLUME TAPE READ ON A 360/195: *
//* *
//* UNIT=(TAPE,2,DEFER) *
//* - REQUEST 2 TAPE DRIVES SO DATA MANAGEMENT CAN PRE-MOUNT *
//* THE NEXT REEL ON THE FREE DRIVE WHILE THE CURRENT REEL *
//* IS BEING READ. WITHOUT THIS, THE JOB STALLS FOR THE *
//* OPERATOR TO MOUNT EACH TAPE -- 19 STALLS ON A 20 REEL *
//* FILE. *
//* - DEFER POSTPONES THE FIRST MOUNT UNTIL THE OPEN. *
//* *
//* VOL=(PRIVATE,RETAIN,SER=(...)) LISTS ALL 20 SERIALS IN THE *
//* ORDER THEY WERE WRITTEN. RETAIN HOLDS A REEL ON THE *
//* DRIVE WHEN IT IS UNLOADED SO IT CAN BE RE-USED IF NEEDED *
//* LATER IN THE STEP. *
//* *
//* LABEL=(1,SL) -- FIRST FILE ON A STANDARD-LABEL TAPE. THE *
//* OS USES THE HDR/EOV/EOF LABELS TO HANDLE VOLUME SWITCHING *
//* TRANSPARENTLY; THE COBOL PROGRAM JUST READS UNTIL EOF. *
//* *
//* IF THE DATASET IS CATALOGED (THE NORMAL PRODUCTION CASE) YOU *
//* CAN STRIP THIS DOWN TO: *
//* //TAPEIN DD DSN=PROD.HISTORY.MASTER,DISP=OLD, *
//* // UNIT=(TAPE,2) *
//* AND THE CATALOG SUPPLIES VOL=SER, LABEL, AND DCB. *
//*-----------------------------------------------------------------*
//STEP1 EXEC PGM=STRSRCH
//STEPLIB DD DSN=USER.LOAD.LIB,DISP=SHR
//*
//* INPUT TAPE -- 20 REELS, STANDARD LABEL, FB / LRECL=133.
//* HALF-TRACK BLOCKING AT 6250 BPI = 27930 IS A REASONABLE CHOICE.
//*
//TAPEIN DD DSN=PROD.HISTORY.MASTER,
// DISP=OLD,
// UNIT=(TAPE,2,DEFER),
// VOL=(PRIVATE,RETAIN,
// SER=(R00001,R00002,R00003,R00004,R00005,
// R00006,R00007,R00008,R00009,R00010,
// R00011,R00012,R00013,R00014,R00015,
// R00016,R00017,R00018,R00019,R00020)),
// LABEL=(1,SL),
// DCB=(RECFM=FB,LRECL=133,BLKSIZE=27930)
//*
//* PARM CARD -- COLS 1-2 = LEN, COL 3 BLANK, COLS 4+ = TARGET.
//* THE EXAMPLE BELOW SEARCHES FOR THE 12-CHAR STRING "ERROR-CODE99".
//*
//PARMIN DD *
12 ERROR-CODE99
/*
//*
//RPTOUT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//