This is yet another scan program, to copy records that contain a specified character string. I've run this on the Z390 simulator, and it works. To run on a mainframe, you'll need to correct the DCBs, and you want to add the open-exit to //out.
The intended use of FILESCAN is:
//SCAN EXEC PGM=FILESCAN,PARM='(#),WORD OR STRING'
//* or PARM='WORD OR STRING'
//STEPLIB DD DISP=SHR,DSN=
//SYSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN=
//OUT DD SYSOUT=* (or whatever)
Note that Z390 parm processing is a bit different, so PARM='[4]-WORD OR STRING' also works.
OR, if the parm just contains the string, filescan will try to pick the least frequent character.
Filescan allows the user to specify the char location to use as the scan key.
It must be 1 digit. In this case, "D" would likely be the least frequent character within the first 9.
Or maybe "W" in which the parm would be, PARM='(1),WORD OR STRING'
No, you can't use "G" because only 1 digit is allowed.
MACRO
&LABEL ERMSG &MSG
LCLA &N
&N SETA K'&MSG-3
&LABEL BAL R14,ERROR
DC AL1(&N),C&MSG
MEND
*
FILESCAN START 0
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'
BNP PARMER1
MVC PARM(0),2(R2)
EX R3,*-6
ST R3,PARMLEN
STC R3,SCANCLC+1
BP BEGIN
PARMER1 ERMSG 'PARM= SEARCH ARG MISSING, REQUIRED'
DC C'PGM=FILESCAN, &SYSDATE &SYSTIME'
ERROR TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BO ERRORSR
PUSH PRINT
PRINT NOGEN
OPEN (SYSPRINT,OUTPUT)
POP PRINT
ERRORSR SR R15,R15
IC R15,0(R14)
MVC ERRMSG,ERRMSG-1
MVC ERRMSG+06(0),1(R14)
EX R15,*-6
LA R14,ERRMSG+12(R15)
MVC 0(22,R14),PARM
SR R14,R13
ST R14,12(R13)
UNPK ERRMSG(5),14(3,R13)
TR ERRMSG(4),HEX-240
MVI ERRMSG+4,C' '
PUT SYSPRINT,ERRMSG-1
CLC =C'$TEST$',PARM
BE Z2
CLC =C'$TEST$',PARM+4
BE Z2
ABEND 1
*
BEGIN LA R2,SYSPRINT
BAL R9,OPENOUT
LA R2,IN
BAL R9,OPENIN
LA R2,OUT
BAL R9,OPENOUT
*
CLI PARM,C'('
BE THISCHAR
CLI PARM,C'['
BE THISCHAR
* ------------------------ THIS SECTION CALCULATES THE LEAST
L R0,PARMLEN FREQUENTLY USED CHAR IN THE PARM
LA R1,PARM
LR R2,R1 I FOUND THESE 30 LINES OF CODE
SR R3,R3 PARTICULARLY DIFFICULT TO GET CORRECT.
IC R3,0(R1) I REMEMBER HAVING WRITTEN A SIMILAR
LA R14,FREQTBL(R3) ROUTINE SEVERAL YEARS AGO, AND IT
LR R15,R14 WAS DIFFICULT THEN TOO.
B TRYNEXT
*
CLCFREQ CLC 0(1,R15),0(R14)
BNL *+8
LR R2,R1
LR R14,R15
*
TRYNEXT LA R1,1(R1)
IC R3,0(R1)
LA R15,FREQTBL(R3)
BCT R0,CLCFREQ
*
IC R3,0(R2)
LA R14,TRTBL(R3)
MVI 0(R14),4
* ------------------------- AND THEN SET UP THE OFFSET TO THE
LA R0,PARM CHAR, AND THE LENGTH AFTER THE CHAR
LR R15,R2
SR R15,R0
ST R15,OFFSET
LA R1,PARM
A R1,PARMLEN
SR R1,R2
ST R1,SUFFIX
BAL R9,LISTSCAN GO SHOW ME WHETHER I DID IT RIGHT.
B GET
*
* ----------------------------------------------
PARMER2 ERMSG 'PARM=STRING OR PARM=(3),STRING REQUIRED'
PARMER3 ERMSG 'PARM=(#),STRING "#" CHAR SPEC BAD'
PARMER4 ERMSG 'PARM=(#),STRING SEL CHAR LONGER THAN PARM'
*
THISCHAR CLC =C'),',PARM+2
BE *+14
CLC =C']-',PARM+2
BNE PARMER2
*
CLI PARM+1,C'1'
BL PARMER3
L R3,PARMLEN
SR R2,R2
IC R2,PARM+1
N R2,=F'15'
BCTR 2,0
SH R3,=H'4'
ST R3,PARMLEN
STC R3,SCANCLC+1
MVC PARM,PARM+4
ST R2,OFFSET
LR R1,R3
SR R1,R2
BM PARMER4
ST R1,SUFFIX
* EX 0,*
BAL R9,LISTSCAN
*
GET GET IN
ST R1,RECADDR
AP #IN,P1
B SCAN
PUT L R0,RECADDR
PUT OUT,(0)
AP #OUT,P1
B GET
*
Z LA R3,4
LA 2,#IN
ZE MVC ERRMSG,ERRMSG-1
MVC ERRMSG(L'EDIT9),EDIT9
ED ERRMSG(L'EDIT9),0(R2)
MVC ERRMSG+L'EDIT9+2(21),5(R2)
PUT SYSPRINT,ERRMSG
LA R2,26(R2)
BCT R3,ZE
*
Z2 LA R2,IN
BAL R9,CLOSE
LA R2,OUT
BAL R9,CLOSE
LA R2,SYSPRINT
BAL R9,CLOSE
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
* -----------------------------------------------------------
SCAN L R3,RECADDR
LH R4,DCBLRECL-IHADCB+IN
AR R4,R3
S R4,SUFFIX
A R3,OFFSET
LA R0,256
SCANLOOP LR R2,R4
SR R2,R3 CALC ACTUAL LENG TO SCAN FOR 'CHAR'
CR R2,R0
BL SCANLAST
AP #TRT,P1
TRT 0(256,R3),TRTBL
BNZ SCANFND
LA R3,256(R3)
B SCANLOOP
TRT 0(0,R3),TRTBL
SCANLAST AP #TRT,P1
EX R2,SCANLAST-6
BZ GET
SCANFND LA R3,1(R1)
S R1,OFFSET
AP #CLC,P1
SCANCLC CLC PARM(0),0(R1)
BE PUT
B SCANLOOP
* -----------------------------------------------------------
* LISTSCAN MVC LISTSCM+24(1),OFFSET+3
* MVC LISTSCM+37(1),SUFFIX+3
* OI LISTSCM+24,C'0'
* OI LISTSCM+27,C'0'
*
LISTSCAN L R0,OFFSET
CVD R0,16(13)
MVC 28(4,13),=X'40202120'
ED 28(4,13),22(13)
MVC LISTSCM+24(2),30(13)
* OI 23(13),X'0F'
* UNPK 28(3,13),22(2,13)
* MVC LISTSCM+24(2),29(13)
L R0,SUFFIX
CVD R0,16(13)
MVC 28(4,13),=X'40202120'
ED 28(4,13),22(13)
MVC LISTSCM+37(2),30(13)
* OI 23(13),X'0F'
* UNPK 28(3,13),22(2,13)
* MVC LISTSCM+37(2),29(13)
L R1,OFFSET
LA R1,PARM(R1)
MVC LISTSCM+11(1),0(R1)
PUT SYSPRINT,LISTSCM-1
SR R1,R1
IC R1,LISTSCM+11
LA R1,TRTBL(R1)
MVI 0(R1),4
BR R9
* -----------------------------------------------------------
PUSH PRINT
PRINT NOGEN
YREGS
USING IHADCB,2
OPENIN MVC OPENMSG(8),DCBDDNAM
OPEN ((2),INPUT)
B LISTDCB
OPENOUT MVC OPENMSG(8),DCBDDNAM
OPEN ((2),OUTPUT)
C R2,=A(SYSPRINT)
BNE LISTDCB
MVC INITMSG+95(37),PARM
PUT SYSPRINT,INITMSG-1
MVC INITMSG,INITMSG-1
BR R9
*
LISTDCB UNPK OPENMSG+15(3),DCBRECFM(2)
TR OPENMSG+15(2),HEX-240
MVI OPENMSG+17,C' '
LH 0,DCBLRECL
CVD 0,16(13)
OI 23(13),X'0F'
UNPK OPENMSG+24(5),21(3,13)
LH 0,DCBBLKSI
CVD 0,16(13)
OI 23(13),X'0F'
UNPK OPENMSG+36(5),21(3,13)
PUT SYSPRINT,OPENMSG-1
BR R9
*
CLOSE TM DCBOFLGS,DCBOFOPN
BZR R9
CLOSE ((2))
BR R9
DROP 2
*
* * YOU'LL WANT TO USE EXLST=OPENEXIT IN //OUT
* PUSH USING
* OPENEXIT DC 0F'0',X'87'AL3(OPENEXIT+4)
* USING IHADCB,1
* USING *,15
* CLI DCBRECFM,0
* BNER 14
* MVC DCBRECFM,DCBRECFM-IHADCB+IN
* MVC DCBLRECL,DCBLRECL-IHADCB+IN
* POP USING
* BR 14
*
IN DCB DDNAME=IN,DSORG=PS,RECFM=FT,MACRF=GL,LRECL=399,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,RECFM=FT,MACRF=PM,LRECL=133
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,RECFM=FT,MACRF=PM,LRECL=133
*
POP PRINT
RECADDR DC F'0'
PARMLEN DC F'0'
OFFSET DC F'0'
SUFFIX DC F'0'
LTORG
EDIT9 DC X'402020206B2020206B212020'
HEX DC C'0123456789ABCDEF'
P1 DC X'1C'
P0 DC X'0C'
#IN DC PL5'0',CL21'RECORDS READ'
#TRT DC PL5'0',CL21'TRT INSTRUCTIONS USED'
#CLC DC PL5'0',CL21'CLC INSTRUCTIONS USED'
#OUT DC PL5'0',CL21'RECORDS WRITTEN'
OPENMSG DC C'........ RECFM=.. LRECL=..... BLKSI=..... '
ERRMSG DC CL133' '
INITMSG DC CL133'FILESCAN ASSEMBLED &SYSDATE AT &SYSTIME TO READ //X
IN AND COPY TO //OUT, RECORDS THAT CONTAIN PARM='
LISTSCM DC C'LOOK FOR C"?" AT OFFSET ??, WHICH IS ?? FROM END OF STRIX
RING = '
PARM DC CL133' '
TRTBL DC XL256'00'
*
FREQTBL DC X'999897',253X'02' ---- FROM WIKIPEDIA ----
ORG FREQTBL+X'81'
DC AL1(82,15,28,43,97,22,20,61,70)
ORG FREQTBL+X'91'
DC AL1(02,07,40,24,67,75,19,01,60)
ORG FREQTBL+X'A2'
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+C'A'
DC AL1(82,15,28,43,97,22,20,61,70)
ORG FREQTBL+C'J'
DC AL1(02,07,40,24,67,75,19,01,60)
ORG FREQTBL+C'S'
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+C'0'
DC AL1(89,88,87,86,85,84,83,82,81,80)
ORG FREQTBL+C' '
DC AL1(99)
ORG FREQTBL+C'.'
DC AL1(9)
ORG FREQTBL+C','
DC AL1(9)
ORG FREQTBL+C'/'
DC AL1(9)
*
ORG FREQTBL+X'20' ------ ASCII CHARACTERS -----
DC AL1(98)
ORG FREQTBL+X'30'
DC AL1(89,88,87,86,85,84,83,82,81,80)
ORG FREQTBL+X'40'
DC AL1(82,15,28,43,97,22,20,61,70)
DC AL1(02,07,40,24,67,75,19,01,60)
DC AL1(63,91,28,10,24,01,20,01)
ORG FREQTBL+X'60'
DC AL1(82,15,28,43,97,22,20,61,70)
DC AL1(02,07,40,24,67,75,19,01,60)
DC AL1(63,91,28,10,24,01,20,01)
*
* -----------------------------------------------------------
*
* DCBD DEVD=DA
END FILESCAN