I've written several scan programs, but had never written a program that looks for both upper and lower case, characters, or a mix of them. Took me longer than I'd hoped, but is, I think, nicer than I'd hoped. You can scan a file, looking for various different strings, and copy records containing those strings in one pass. The output can be either a single file, or a different file for each string. There are two SYSPRINT files, from 2 runs, and then the source code follows. SCANTEXT was written to run on the Z390 simulator, but intended to be used on an IBM mainframe. To do that, you'll need to change the DCBs. You'd also want a DCB exit to copy recfm and lrecl. First is the short version of SYSPRINT.
SYSPRINT OPENED FOR OUTPUT, RECFM=A0 LRECL=00133 BLKSIZE=00000
PARM=OUTFILES,MVC,STM,ASSEMBLER
PARM=MVC,STM,ASSEMBLER
SCANTEXT, ASM 05/13/23 AT 21.50 FIND TEXT STRINGS. CODE PARM=DOC FOR DESCRIPTION
IN OPENED FOR INPUT, RECFM=A0 LRECL=00188 BLKSIZE=00000
EBCDIC 55 ASCII 5 EBCDIC ASSUMED
0202 MAX STRINGS=045
PARM=MVC,STM,ASSEMBLER
PARM=STM,ASSEMBLER
PARM=ASSEMBLER
OUT1 OPENED FOR OUTPUT, RECFM=A0 LRECL=00188 BLKSIZE=00000
OUT2 OPENED FOR OUTPUT, RECFM=A0 LRECL=00188 BLKSIZE=00000
OUT3 OPENED FOR OUTPUT, RECFM=A0 LRECL=00188 BLKSIZE=00000
# TIMES STRING FOUND
| LENGTH-1 OF STRING
| | OFFSET FROM BEGIN TO SEARCH CHAR
| | | LENGTH AFTER SEARCH CHAR
| | | | SEARCH CHAR # IN TRT TABLE
| | | | | SEARCH CHAR
| | | | | | STRING
| | | | | | |
0B8E 4 080503 1 B ASSEMBLER DD=OUT1
7 020200 2 M STM DD=OUT2
80 020101 3 V MVC DD=OUT3
1,599 RECORDS READ
03 SCAN PARMS SAVED
3,388 TRT INSTS USED
1,880 CLC INSTS USED
4 OUT1 CLOSED
7 OUT2 CLOSED
80 OUT3 CLOSED
IN CLOSED
======= but there is a much longer version of SYSPRINT that I used for testing ======
SYSPRINT OPENED FOR OUTPUT, RECFM=A0 LRECL=00133 BLKSIZE=00000
PARM=DOC,LISTSTATS,EBCDIC,ASCII,EBCDICTR,ASCIITR,LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=LISTSTATS,EBCDIC,ASCII,EBCDICTR,ASCIITR,LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=EBCDIC,ASCII,EBCDICTR,ASCIITR,LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=ASCII,EBCDICTR,ASCIITR,LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=EBCDICTR,ASCIITR,LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=ASCIITR,LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=LRECL=3500,EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
SCANTEXT, ASM 05/13/23 AT 21.50 FIND TEXT STRINGS. CODE PARM=DOC FOR DESCRIPTION
COPY RECORDS THAT CONTAIN STRINGS SPECIFIED IN THE PARM FIELD.
THE SEARCH IS DONE FOR A MIX OF UPPER AND LOWER CASE.
AND THE INPUT FILE CAN BE EITHER EBCDIC OR ASCII.
IF YOU ARE SEARCHING FOR A STRING, YOU CAN CODE JUST THAT STRING
IN THE PARM FIELD, AND SCANTEXT WILL SEARCH FOR UPPER AND LOWER
CASES OF THAT STRING, AND YOU CAN IGNORE THE REST OF THIS.
HOWEVER, I HAVE GONE TO CONSIDERABLE TROUBLE TO ALLOW USERS TO
SEARCH FOR MULTIPLE STRINGS IN A SINGLE PASS. AND, YOU CAN SEARCH
FOR A STRING THAT CONTAINS A COMMA,BY USING A DIFFERENT DELIMITER.
YOU COULD EVEN USE BLANK AS A DELIMITER, "BUT ONLY 1".
EVEN BETTER, THE DEFAULT IS TO WRITE ALL SELECTED RECORDS TO THE
//OUT FILE, BUT YOU CAN SPECIFY "OUTFILES" IN THE PARM, AND THE
RECORDS WILL BE WRITTEN TO INDIVIDUAL "//OUT#" FILES.
IN ORDER TO ALLOW USERS TO SEARCH FOR A STRING WITH A COMMA, THE
PARM FIELD MUST START WITH A COMMA, OR ALTERNATE SEPARATOR.
FOLLOWING THAT ARE KEYWORDS, FOLLOWED BY STRINGS. KEYWORDS ARE:
LISTSTATS- PRINT THE CONTROL TABLE 4 TIMES DURING PROCESSING
ASCIITR - FOR TESTING, TO CHANGE EBCDIC INPUT TO ASCII
EBCDICTR - JUST BECAUSE
DOC - PRINT THIS DESCRIPTION
OUTFILES - CREATE MULTIPLE //OUT# FILES
ASCII - INPUT FILE IS ASCII
EBCDIC - INPUT FILE IS EBCDIC
(THE PROGRAM CHECKS THE FIRST RECORD TO GUESS WHETHER IT IS
AN ASCII OR EBCDIC FILE, BUT DOES NOT ALWAYS GET IT RIGHT.)
LRECL=##### TO USE A LARGER LRECL FOR THE //IN FILE.
FOLLOWING THE KEYWORDS ARE THE SELECT STRINGS.
FOR TESTING, I READ AN ASSEMBLER LISTING AND LOOKED FOR
,MVC,STM,BAL,BUBBLE,QFREQ,TRT,FLAG,EQ,UNPK,USING,DROP,LA R1,DW
(BUT WHEN I WAS WRITING MULTIPLE OUT FILES, THE LIST WAS SHORTER.)
//SCAN EXEC PGM=SCANTEXT,PARM=",OUTFILES,MVC,STC,ASSEMBLER"
//STEPLIB DD DISP=SHR,DSN=
//SYSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN=
//OUT DD SYSOUT=*
//OUT1 DD SYSOUT=*
//OUT2 DD SYSOUT=*
//OUT3 DD SYSOUT=*
THERE ARE COUNTS AT THE END OF THE RUN THAT SHOW HOW MANY TIMES
EACH STRING WAS FOUND. UNLESS "OUTFILES" IS SPECIFIED, ONLY THE
FIRST OCCURRENCE OF A STRING IN A RECORD IS COUNTED. AND, ALL
THE RECORDS GO TO THE //OUT FILE, RATHER THAN INDIVIDUAL FILES.
IN OPENED FOR INPUT, RECFM=A0 LRECL=03500 BLKSIZE=00000
OUT OPENED FOR OUTPUT, RECFM=A0 LRECL=03500 BLKSIZE=00000
0202 MAX STRINGS=045
PARM=EXACTLY,WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=WER2,HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=HEIGHT,HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=HTML,FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=FRAME,PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=PEGS,ERECTING,ASSEMBLING,JOINT,STORIES
PARM=ERECTING,ASSEMBLING,JOINT,STORIES
PARM=ASSEMBLING,JOINT,STORIES
PARM=JOINT,STORIES
PARM=STORIES
# TIMES STRING FOUND
| LENGTH-1 OF STRING
| | OFFSET FROM BEGIN TO SEARCH CHAR
| | | LENGTH AFTER SEARCH CHAR
| | | | SEARCH CHAR # IN TRT TABLE
| | | | | SEARCH CHAR
| | | | | | STRING
| | | | | | |
0312 0 060105 X EXACTLY
0 030003 W WER2
0 050302 G HEIGHT
0 030201 M HTML
0 040004 F FRAME
0 030003 P PEGS
0 070700 G ERECTING
0 090504 B ASSEMBLING
0 040004 J JOINT
0 060303 R STORIES
# TIMES STRING FOUND
| LENGTH-1 OF STRING
| | OFFSET FROM BEGIN TO SEARCH CHAR
| | | LENGTH AFTER SEARCH CHAR
| | | | SEARCH CHAR # IN TRT TABLE
| | | | | SEARCH CHAR
| | | | | | STRING
| | | | | | |
031A 0 090504 B ASSEMBLING
0 040004 F FRAME
0 070700 G ERECTING
0 050302 G HEIGHT
0 040004 J JOINT
0 030201 M HTML
0 030003 P PEGS
0 060303 R STORIES
0 030003 W WER2
0 060105 X EXACTLY
# TIMES STRING FOUND
| LENGTH-1 OF STRING
| | OFFSET FROM BEGIN TO SEARCH CHAR
| | | LENGTH AFTER SEARCH CHAR
| | | | SEARCH CHAR # IN TRT TABLE
| | | | | SEARCH CHAR
| | | | | | STRING
| | | | | | |
0322 0 090504 1 B ASSEMBLING
0 040004 2 F FRAME
0 070700 3 G ERECTING
0 050302 G HEIGHT
0 040004 5 J JOINT
0 030201 6 M HTML
0 030003 7 P PEGS
0 060303 8 R STORIES
0 030003 9 W WER2
0 060105 A X EXACTLY
# TIMES STRING FOUND
| LENGTH-1 OF STRING
| | OFFSET FROM BEGIN TO SEARCH CHAR
| | | LENGTH AFTER SEARCH CHAR
| | | | SEARCH CHAR # IN TRT TABLE
| | | | | SEARCH CHAR
| | | | | | STRING
| | | | | | |
0B8E 2 090504 1 B ASSEMBLING
1 040004 2 F FRAME
1 070700 3 G ERECTING
2 050302 G HEIGHT
1 040004 5 J JOINT
4 030201 6 M HTML
1 030003 7 P PEGS
4 060303 8 R STORIES
2 030003 9 W WER2
4 060105 A X EXACTLY
22 RECORDS WRITTEN
1,756 RECORDS READ
10 SCAN PARMS SAVED
18,281 TRT INSTS USED
17,134 CLC INSTS USED
IN CLOSED
OUT CLOSED
================= finally, we've gotten to the source code. ==============
Yeah, I know, no comments. Deal with it. I'll think about it. Maybe.
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANTEXT
SET PA1=",MVC,STM,BAL,BUBB,QFRE,TRT,EQ,LA R1,UNPK,"
SET PA2=",DROP,LISTSTR,SETFREQ,DW"
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANTEXT
SET IN=%G%.PRN
SET OUT=%G%.OUT.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
SET SYSIN=%G%.SYSIN.TXT
BAT\ASMLG %G%.MLC TIME(1) PARM(%PA1%USING%PA2%)
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANTEXT
SET LISTING=%G%.PRN
SET ATFILE=%G%.BREAK.ATFILE.TXT
SET COMMANDS=%G%.BREAK.COMMANDS.TXT
SET SYSIN=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)
LOADLOC=FE000 13R%
LRECL=90
LABEL=PRINTR2,ERR*,MSG*,Z,ZS,GETMAIN,TRY*,SET*,SAV*,QFREQ,QS1*,QS9*
LABEL=TES*,EDIT0*,GETIN,WRITOUT,
LABEL=AGETMAIN,CARD,LINE,
COMMAND=
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANTEXT ASMLG
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANTEXTT EZ390
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANTEXTB BK PTS
COMPRESS=Y
CMDFILE=Y
ATFILE=Y
.START ANOP
*
MACRO
@ &MSG
LCLA &N,&M
&N SETA K'&MSG
&N SETA &N-2
DC AL1(&N-1),C&MSG
MEND
*
MACRO
&LBL ERR &BC,&MSG,&ERR=ERR
&LBL REVB &BC,4+SYS&SYSNDX
BAL 1,SYS&SYSNDX
@ &MSG
SYS&SYSNDX BAL 14,&ERR
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
* -----------------------------------------------------------
SCANTEXT START 0
YREGS
USING *,13,12 NORMAL INIT STUFF
B 52(R15)
DC 12F'0' SET BASE AND SAVE PARM
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
LA R12,4095
LA R12,1(R12,R13)
L R3,0(R1)
LA R2,SYSPRINT
BAL R9,OPENOUT
LH R2,0(R3)
SH R2,=H'1'
ERR BM,'NO PARM',ERR=ERR
LA R4,PARM
CLI 2(R3),C'A'
BL *+8
LA R4,PARM+1
MVC 0(0,R4),2(R3)
EX R2,*-6
*
CLI PARM,X'80'
ERR BNL,', SEPATOR MISSING',ERR=ERR
MVC SEPAR,PARM
MVC PARM,PARM+1
SR R3,R3
B QPARMBAL
*
QPARMMV L R1,0(R2)
MVC 0(1,R1),PARM
LA R2,PARM+2(R3)
MVC PARM,0(R2)
QPARMBAL PUT SYSPRINT,PARMPUT
BAL R2,QPARMIC
*
DC AL4(FLAGTR)
@ 'ASCIITR'
DC AL4(FLAGTR)
@ 'EBCDICTR'
DC AL4(FLAGDOC)
@ 'DOC'
DC AL4(FLAGOUT)
@ 'OUTFILES'
DC AL4(FLAGASCI)
@ 'ASCII'
DC AL4(FLAGASCI)
@ 'EBCDIC'
DC AL4(FLAGLIST)
@ 'LISTSTATS'
DC X'FF'
CLC PARM(0),5(R2)
QPARMIC IC R3,4(R2)
EX R3,QPARMIC-6
BE QPARMMV
LA R2,6(R2,R3)
CLI 0(R2),0
BE QPARMIC
CLC =C'LRECL=',PARM
BNE OPENINOU
* DOC,ASCII,EBCDIC,MAKEEBCDIC,MAKEASCI,ASCII
*
LA R14,PARM+6
SR R15,R15
ADDLRECL IC R1,0(R14)
N R1,=F'15'
MH R15,=H'10'
AR R15,R1
LA R14,1(R14)
CLI 0(R14),C'0'
BNL ADDLRECL
STH R15,DCBLRECL-IHADCB+IN
MVC PARM,1(R14)
B QPARMBAL
*
OPENINOU BAL R9,PRINTDOC
LA R2,IN
BAL R9,OPENIN
CLI FLAGOUT,C'O'
BE *+12
LA R2,OUT
BAL R9,OPENOUT
*
MVI RECFM,C'F'
MVC DW(1),DCBRECFM-IHADCB+IN
NI DW,X'70'
CLI DW,X'40'
BNE *+8
MVI RECFM,C'V'
*
SR R10,R10
BAL R9,QASCII
SR R11,R11
MVC LINE,LINE-1
* ------------------------------------------
* CLI FLAGASCI,C'A'
* BNE PARMLA-4
* TR PARM,EBC2ASCI
* TR SEPAR,EBC2ASCI
* ------------------------------------------
LA R4,STRINGS
USING STRDSECT,4
L R0,0(R4)
CVD R0,DW
OI DW+7,X'0F'
UNPK MAXSTRM+21(3),DW+6(2)
MAXSTRM ERR B,'MAX STRINGS=... ',ERR=MSG
*
USING STRDSECT,4
PARMLA LA R3,PARM
C R4,=A(ENDDOC-L'STRINGS)
ERR BNL,'TOO MANY SEARCH STRINGS'
AP #PARMS,P1
PUT SYSPRINT,PARMPUT
PARML LA R3,1(R3)
CLC SEPAR,0(R3)
BE PARMF
CLC LINE+88(22),0(R3)
BNE PARML
B PARMF
*
PASCIIX TRT SSTRING(0),0(R14) NOTASCII
PARMMVC MVC SSTRING(0),PARM
PARMTR TR SSTRING(0),0(R14) TOASCII
PARMF LR R1,R3
S R1,=A(PARM+1)
MVC STRDSECT(LSTRING),LINE
XC STRDSECT(6),STRDSECT
ZAP SCOUNT,P0
*
EX R1,PARMMVC
STH R1,SLENGTH
STH R1,SSTRING-2
CLI FLAGASCI,C'A'
BNE PARMNOTA
*
L R14,=A(NOTASCII)
EX R1,PASCIIX
MVC ASCIERR+14(1),0(R1)
ASCIERR ERR BNZ,'STRING ( ) HAS AN INVALID ASCII CHAR',ERR=ERR
*
PARMNOTA MVC PARM,1(R3)
*
LA R4,LSTRING(R4)
ST R4,ENDSTRIN
CLC PARM(11),LINE+80
BNE PARMLA
DROP 4
SR R4,R4
* --------------------------------------------
LA R3,STRINGS
USING STRDSECT,3
SETFREQ LA R2,6(R3)
LA R4,0(R3)
BAL R14,QFREQ
* MVC 7(1,R3),6(R3)
LA R3,LSTRING(R3)
C R3,ENDSTRIN
BL SETFREQ
DROP 3
BAL R9,LISTSTR
*
BAL R9,BUBBLE
BAL R9,LISTSTR
BAL R9,QOFFSET
BAL R9,LISTSTR
BAL R9,GETMAIN
CLI FLAGASCI,C'E'
BE DUPEBCDI
MVC TRTTABLE+97(26),TRTTABLE+65
B DUPEBCDI+6
*
DUPEBCDI MVC TRTTABLE+128(48),TRTTABLE+192
L R1,PUT-4
MVI PARM-1,C' '
CLI FLAGASCI,C'A'
BNE *+8
MVI PARM-1,X'20'
MVC PARM,PARM-1
MVC LINE,LINE-1
MVC 0(4,R13),*+6
B GETGOT
*
* IF NEITHER ASCII NOR EBCDIC WAS SPECIFIED, THEN WE'RE GOING TO
* COUNT ASCII AND EBCDIC CHARACTERS IN THE FIRST RECORD OF THE FILE.
* WHICHEVER COUNT IS GREATER, WE'LL ASSUME THAT'S THE CHARACTER SET
* OF THE ENTIRE FILE.
*
* X'4B' IS A PERIOD IN EBCDIC AND C'K' IN ASCII, SO YOU HAVE TO
* USE ONE CHARACTER SET OR THE OTHER.
*
DC F'0'
QASCII ST R9,QASCII-4
BAL R9,READAREC
CLI FLAGASCI,C' '
BNE QASCIIZ
CLI FLAGASCI,C' '
BNE QASCIIZ
L R2,LRECL
L R1,PUT-4
LA R2,0(R1,R2)
SR R3,R3
SR R4,R4
QASCIIL CLI 0(R1),X'4B'
BE QASCIIN
CLI 0(R1),X'20'
BE QASCIIA
CLI 0(R1),X'30'
BL QASCIIN
CLI 0(R1),X'3A'
BL QASCIIA
CLI 0(R1),X'41'
BL QASCIIN
CLI 0(R1),X'5B'
BL QASCIIA
CLI 0(R1),X'61'
BL QASCIIN
CLI 0(R1),X'7B'
BL QASCIIA
CLI 0(R1),X'81'
BL QASCIIN
CLI 0(R1),X'AA'
BL QASCIIE
CLI 0(R1),X'C1'
BL QASCIIN
CLI 0(R1),X'EA'
BL QASCIIE
CLI 0(R1),X'F0'
BL QASCIIN
CLI 0(R1),X'F9'
BH QASCIIN
QASCIIE AP #EBCDIC,P1
B QASCIIN
QASCIIA AP #ASCII,P1
QASCIIN LA R1,1(R1)
CR R1,R2
BL QASCIIL
MVI FLAGASCI,C'E'
MVC LINE(6),=C'EBCDIC'
MVC LINE+6(6),ED5
ED LINE+6(6),#EBCDIC
MVC LINE+15(5),=C'ASCII'
MVC LINE+20(6),ED5
ED LINE+20(6),#ASCII
MVC LINE+28(15),=C'EBCDIC ASSUMED'
CP #EBCDIC,#ASCII
BH *+14
MVC LINE+28(6),=C' ASCII'
MVI FLAGASCI,C'A'
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
QASCIIZ L R9,QASCII-4
BR R9
ED5 DC X'402020202120'
#ASCII DC PL3'0'
#EBCDIC DC PL3'0'
*
* TR2EBCDI L R4,=A(ASCI2EBC)
* B *+8
* TR2ASCII L R4,=A(EBC2ASCI)
* LA R3,STRINGS
* TRTR TR 8(36,R3),0(R4)
* LA R3,L'STRINGS(R3)
* C R3,ENDSTRIN
* BL TRTR
* BR R9
*
LISTITLE EQU *
@ '# TIMES STRING FOUND'
@ '| LENGTH-1 OF STRING'
@ '| | OFFSET FROM BEGIN TO SEARCH CHAR'
@ '| | | LENGTH AFTER SEARCH CHAR'
@ '| | | | SEARCH CHAR # IN TRT TABLE'
@ '| | | | | SEARCH CHAR'
@ '| | | | | | STRING'
@ '| | | | | | |'
@ ' '
*
LISTSTR CLI FLAGLIST,C'L'
BNER R9
LA R3,LISTITLE
SR R2,R2
LISTITLL IC R2,0(R3)
MVC LINE+13(0),1(R3)
EX R2,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R3,2(R2,R3)
CLI 0(R3),1
BH LISTITLL
*
LA R0,0(R9)
SR R0,R13
ST R0,12(13)
UNPK LINE(5),14(3,R13)
TR LINE(4),HEX-240
MVI LINE+4,C' '
LA R3,STRINGS
USING STRDSECT,3
LISTSTRM MVC LINE+6(L'ED7),ED7
ED LINE+6(L'ED7),SCOUNT
MVC LINE+16(6),STRDSECT
OC LINE+16(6),=6C'0'
MVC LINE+23(1),SINDEX
MVC LINE+25(1),SCHAR
LH R2,0(R3)
EX R2,LISTMVC
CLI FLAGOUT,C'O'
BNE LISTPUT
CLC =C'OUT',SDDNAME
BNE LISTPUT
LA R1,LINE+31(R2)
MVC 0(3,R1),=C'DD='
MVC 3(4,R1),SDDNAME
LISTPUT PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R3,LSTRING(R3)
C R3,ENDSTRIN
BL LISTSTRM
PUT SYSPRINT,LINE-1
BR R9
ED7 DC X'4020202020202120'
* LISTTR TR LINE+27(0),0(R14) TOEBCDIC
LISTMVC MVC LINE+27(0),SSTRING
DROP 3
* +++++++++++++++++++++++++++++++++++++++++++++++
READAREC LA R10,1(R10)
GET IN
LA R1,0(R1)
ST R1,PUT-12
ST R1,PUT-4
LH R0,DCBLRECL-IHADCB+IN
CLI RECFM,C'V'
BNE NOTVB
LH R0,0(R1)
SH R0,=H'4'
LA R1,4(R1)
NOTVB STM R0,R1,LRECL
*
CLI FLAGTR,C' '
BER R9
L R14,=A(TOASCII)
CLI FLAGTR,C'A'
BE *+8
L R14,=A(TOEBCDIC)
L R2,LRECL
BCTR R2,0
TRLOOP CH R2,=H'255'
BL TRSHORT
TR 0(256,R1),0(R14)
LA R1,256(R1)
SH R2,=H'256'
B TRLOOP
TR 0(0,R1),0(R14)
TRSHORT EX R2,*-6
BR R9
*
WRITAREC L R0,PUT-12
PUT OUT,(0)
LA R11,1(R11)
AP #OUT,P1
BR R9
*
DC F'0'
LRECL DC F'0'
DC F'0'
PUT BAL R9,WRITAREC
GET BAL R9,READAREC
GETGOT L R1,PUT-4
LR R8,R1
AP #IN,P1
LA R4,0(R1)
A R4,LRECL
SR R2,R2
LA R0,255
B TEST
*
L R1,DW
TRYAGAIN LA R1,1(R1)
TEST LR R3,R4
SR R3,R1
AP #TRT,P1
CR R3,R0
BNH TRTSHORT
CLC 0(133,R1),PARM
BE GET
TRT 0(256,R1),TRTTABLE
BNZ TRTFOUND
LA R1,255(R1)
B TRYAGAIN
*
TRT 0(0,R1),TRTTABLE
TRTSHORT EX R3,TRTSHORT-6
BZ GET
TRTFOUND ST R1,DW
LR R5,R2
MH R5,=AL2(LSTRING)
LA R6,STRINGS-LSTRING(R5)
USING STRDSECT,6
NEXTSTR SH R1,SOFFSET
C R1,PUT-4
BL NOT
LH R14,SLENGTH
LA R15,0(R14,R1)
CR R15,R4
BNL NOT
*
EX R14,MVCFIELD
CLI FLAGASCI,C'A'
BNE XOCFIELD
L R15,=A(TOEBCDIC)
TR 12(32,R13),0(R15)
B XOCFIELD
*
MVCFIELD MVC 12(0,R13),0(R1)
CLCFIELD CLC 12(0,R13),SSTRING
OCFIELD OC 12(0,R13),LINE
*
XOCFIELD EX R14,OCFIELD
COMPARE AP #CLC,P1
EX R14,CLCFIELD
BNE NOTFOU
AP SCOUNT,P1
CLI FLAGOUT,C'O'
BNE PUT
*
L R14,SDCBADDR
USING DCBDSECT,14
AP DCBCOUNT,P1
L R0,PUT-12
PUT (14),(0)
B NOT
DROP 14
*
NOTFOU CLC SCHAR,SCHAR+LSTRING
BNE TRYAGAIN-4
NOT LA R6,LSTRING(R6)
C R6,ENDSTRIN
BNL GET
L R1,DW
B NEXTSTR
DROP 6
* +++++++++++++++++++++++++++++++++++++++++++
DC 4F'0'
ERR MVC LINE(5),=C'ERROR'
MSG STM 14,1,ERR-16
LA R0,0(R14)
SR R0,R13
ST R0,DW
UNPK LINE+6(5),DW+2(3)
TR LINE+6(4),HEX-240
MVI LINE+10,C' '
SR R15,R15
IC R15,0(R1)
MVC LINE+12(0),1(R1)
EX R15,*-6
* LA R15,LINE+15(R15)
* MVC 0(8,R15),0(R3)
PUT SYSPRINT,LINE-1
CLI LINE,C'E'
LM 14,1,ERR-16
MVC LINE,LINE-1
BNER R14
OI RC,8
B Z
*
QOFFSET LA 3,STRINGS
LA R2,1
SR R1,R1
XC TRTTABLE,TRTTABLE
*
USING STRDSECT,3
QOFFSETA IC R1,SCHAR
CLI FLAGASCI,C'A'
BNE QOFFSETB
STC R1,DW
L R15,=A(TOASCII)
TR DW(1),0(R15)
IC R1,DW
QOFFSETB LA R4,TRTTABLE(R1)
STC R2,0(R4)
STC R2,6(R3)
TR 6(1,R3),HEX
*
QOFFSETC MVC SDDNAME,=C'OUT'
STC R2,SDDNAME+3
TR SDDNAME+3(1),HEX
CLC SCHAR,SCHAR+LSTRING
LA R3,LSTRING(R3)
LA R2,1(R2)
BE QOFFSETC
C R3,ENDSTRIN
BL QOFFSETA
BCTR R2,0
ST R2,#FILES
BR R9
*
DC F'0'
GETMAIN CLI FLAGOUT,C'O'
BNER R9
ST R9,GETMAIN-4
*
L R0,#FILES
MH 0,=AL2(LDCB)
ST R0,LGETMAIN
GETMAIN R,LV=(0)
ST R1,AGETMAIN
*
LA R4,1
LR R2,R1
USING DCBDSECT,R2
LA R3,STRINGS
*
OPENDCBS ST R2,SDCBADDR
MVC DCBDD,SDDNAME
ZAP DCBCOUNT,P0
MVC DCBRECFM-IHADCB+OUT1(1),DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT1(2),DCBLRECL-IHADCB+IN
MVC DCBDDNAM-IHADCB+OUT1(4),SDDNAME
MVC DCBDCB,OUT1
BAL R9,OPENOUT
LA R2,LDCB(R2)
LA R3,LSTRING(R3)
LA R4,1(R4)
C R3,ENDSTRIN
BL OPENDCBS
L R9,GETMAIN-4
BR R9
DROP 3,2
*
OPENMSG DC CL54'OPENED FOR OUTPUT, RECFM=...LRECL=..... BLKSIZE='
USING IHADCB,2
OPENIN MVC LINE(8),DCBDDNAM
MVC OPENMSG+11(3),=C' IN'
PUSH PRINT
PRINT NOGEN
OPEN ((2),INPUT)
B OPENUNPK
OPENOUT MVC LINE(8),DCBDDNAM
MVC OPENMSG+11(3),=C'OUT'
CLC =H'0',DCBLRECL
BNE OPENOUTO
MVC DCBRECFM,DCBRECFM-IHADCB+IN
MVC DCBLRECL,DCBLRECL-IHADCB+IN
OPENOUTO OPEN ((2),OUTPUT)
POP PRINT
OPENUNPK UNPK OPENMSG+25(3),DCBRECFM(2)
TR OPENMSG+25(2),HEX-240
MVI OPENMSG+27,C' '
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+34(5),DW+5(3)
LH R0,DCBBLKSI
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+48(5),DW+5(3)
MVC LINE+9(L'OPENMSG),OPENMSG
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
DROP 2
*
BUBBLE L R3,ENDSTRIN
LA R0,LSTRING
SR R3,R0
BUBBLEA LA R2,STRINGS
CR R2,R3
BNLR R9
BUBBCLC CLC 7(L'SSTRING,R2),7+LSTRING(R2)
BNH *+22
MVC 12(LSTRING,R13),0(R2)
MVC 0(LSTRING,R2),LSTRING(R2)
MVC LSTRING(LSTRING,R2),12(R13)
LA R2,LSTRING(R2)
CR R2,R3
BL BUBBCLC
SR R3,R0
B BUBBLEA
* --------------------------------------------------------
* FIND THE LEAST FREQUENT CHAR IN THE STRING TO KEY TRT SCAN ON.
* R2 = 2-BYTE LENGTH, FOLLOWED BY STRING
* R4 = CHAR, OFFSET TO CHAR, # BYTES FROM END OF STRING.
* TO NOT OVERFLOW PAST END OF RECORD.
*
* R0 = A(FIRST CHAR OF STRING TO CALC OFFSET)
* R3 = # TIMES TO GO THRU LOOP, TESTING CHARS
* R5 = CHAR TO BE TESTED
* R6 = LOCATION IN FREQ TABLE
* R7 = LOC OF LOWEST ENTRY IN FREQ TABLE
* R1 = OFFSET TO LEAST FREQ CHAR
* R8 = LENGTH AFTER LEAST FREQ CHAR, TO NOT OVERFLOW.
*
QFREQ STM R14,R8,12(R13) OINT TO FIRST BYTE (TO CALC OFFSET)
LA R0,2(R2) POINT TO FIRST BYTE (TO CALC OFFSET)
LA R7,=H'255'+1 AND REALLY HIGH TABLE TARGET VALUE
*
LH R3,0(R2) LENGTH OF STRING
LTR R3,R3 Q. ZERO?
BNZ *+8 NO, OKAY.
EX 0,* YES, LOGIC ERROR
LR R8,R3 DUP STRING LENGTH
STH R3,0(R4)
LA R3,1(R3)
SR R5,R5
* --------------------------------------------------
QFREQLOP IC R5,2(R2) LOAD CHAR
LA R6,FREQTBL(R5) OFFSET IN FREQ TBL
CLC 0(1,R6),0(R7) Q. NEW LOW FREQ
BNL QFREQNOT NO.
MVC 7(1,R4),2(R2) YES, SAVE THE CHAR
LR R7,R6 SAVE ADDR OF LOW FREQ
LA R1,2(R2) POINT TO CHAR
*
QFREQNOT LA R2,1(R2)
BCT R3,QFREQLOP
* --------------------------------------------------
SR R1,R0 CALC OFFSET TO CHAR
STH R1,2(R4) SAVE OFFSET TO CHAR
SR R8,R1 CALC LENGTH AFTER CHAR
STH R8,4(R4) SAVE TO PREVENT OVERFLOW PAST END OF REC.
MVI 6(R4),C' '
LM R14,R8,12(R13)
BR R14
*
CLOSE TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZR R9
CLOSE ((2))
TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BZR R9
MVC LINE(8),DCBDDNAM-IHADCB(R2)
MVC LINE+9(6),=C'CLOSED'
PUT SYSPRINT,LINE-1
BR R9
*
#OUT DC PL5'0',CL16'RECORDS WRITTEN'
#IN DC PL5'0',CL16'RECORDS READ'
#PARMS DC PL5'0',CL16'SCAN PARMS SAVED'
#TRT DC PL5'0',CL16'TRT INSTS USED'
#CLC DC PL5'0',CL16'CLC INSTS USED'
DC X'FF'
ED9 DC X'402020206B2020206B212020'
TOTALS LA R2,#IN
CLI FLAGOUT,C'O'
BE *+8
LA R2,#OUT
TOTALSMV MVC LINE(L'ED9),ED9
ED LINE(L'ED9),0(R2)
MVC LINE+L'ED9+2(16),5(R2)
PUT SYSPRINT,LINE-1
LA R2,21(R2)
LA R2,#CLC-#CLC(R2)
CLI 0(R2),X'99'
BL TOTALSMV
MVC LINE,LINE-1
CLI FLAGOUT,C'S'
BNER R9
LA R3,STRINGS
USING STRDSECT,R3
EX 0,*
DROP R3
BR R9
*
NOPARM OI RC,8
B ZTOTALS
Z MVI FLAGLIST,C'L'
BAL R9,LISTSTR
ZTOTALS BAL R9,TOTALS
CLI FLAGOUT,C'O'
BNE CLOSEIN
PUT SYSPRINT,LINE-1
LA R3,STRINGS
USING STRDSECT,3
CLOSOUT L R2,SDCBADDR
USING DCBDSECT,2
TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BE OUTNOTOP
*
MVC LINE+4(L'ED7),ED7
ED LINE+4(L'ED7),DCBCOUNT
MVC LINE+6+L'ED7(4),DCBDD
CLOSE ((2))
MVC LINE+12+L'ED7(6),=C'CLOSED'
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
OUTNOTOP LA R3,LSTRING(R3)
C R3,ENDSTRIN
BL CLOSOUT
PUT SYSPRINT,LINE-1
DROP 3,2
*
CLOSEIN LA R2,IN
BAL R9,CLOSE
LA R2,OUT
BAL R9,CLOSE
LA R2,SYSPRINT
BAL R9,CLOSE
SR 15,15
IC 15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
*
PRINTDOC LA R4,DOC-1
SR R5,R5
DOCLOOP IC R5,0(R4)
MVC LINE(0),1(R4)
EX R5,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
CLI FLAGDOC,C'D'
BNER R9
LA R4,2(R4,R5)
C R4,=A(ENDDOC)
BL DOCLOOP
BR R9
LTORG
*
#FILES DC F'0'
LGETMAIN DC F'0'
AGETMAIN DC F'0'
P0 DC X'0C'
P1 DC X'1C'
RC DC X'00'
RECFM DC C' '
FLAGLIST DC C' '
FLAGOUT DC C' '
FLAGDOC DC C' '
FLAGASCI DC C' '
FLAGTR DC C' '
SEPAR DC C','
ENDSTRIN DC A(0)
HEX DC C'0123456789ABCDEF',C'GHIJKLMNOPQRSTUVWXYZ'
DW DC 2D'0'
PARMPUT DC C' PARM='
PARM DC CL133' ',CL8' '
LINE DC CL133' '
*
CNOP 0,8
TRTTABLE DS 0XL256
FREQTBL DC 256X'05'
ORG FREQTBL
DC X'191817'
ORG FREQTBL+X'20' BLANK + SPECIAL CHARS
DC X'44',15X'09'
ORG FREQTBL+X'30' ASCII NUMBERS
DC X'20191817161514131211'
ORG FREQTBL+X'40' ASCII UPPER CASE LETTERS
DC X'442407131625100818220405151220230803171921140611040903'
DC 6X'08' SPECIAL CHARS,THEN LOWER CASE LETTERS
DC X'022407131625100818220405151220230803171921140611040903'
DC 5X'08'
ORG FREQTBL+X'80'
DC X'05240713162510081822',6X'05' EBCDIC LOWER CASE
DC X'05040515122023080317',6X'05'
DC X'05051921140611040903',6X'05'
DC 16X'05'
ORG FREQTBL+X'C0'
DC X'05240713162510081822',6X'05' UPPER CASE
DC X'05040515122023080317',6X'05'
DC X'05051921140611040903',6X'05'
DC X'20191817161514131211',6X'05'
ORG
*
PUSH PRINT
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,LRECL=188,RECFM=FT,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM
OUT1 DCB DDNAME=OUT1,DSORG=PS,MACRF=PM
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM
POP PRINT
STRINGS DC 0CL48' ',A((ENDDOC-*-48)/48)
*
DC AL1(L'DOC-1)
DOC DC C'SCANTEXT, ASM &SYSDATE AT &SYSTIME FIND TEXT STRINGS. C
CODE PARM=DOC FOR DESCRIPTION'
@ 'COPY RECORDS THAT CONTAIN STRINGS SPECIFIED IN THE PARM FIELD.'
@ 'THE SEARCH IS DONE FOR A MIX OF UPPER AND LOWER CASE.'
@ 'AND THE INPUT FILE CAN BE EITHER EBCDIC OR ASCII.'
@ ' '
@ 'IF YOU ARE SEARCHING FOR A STRING, YOU CAN CODE JUST THAT STRING'
@ 'IN THE PARM FIELD, AND SCANTEXT WILL SEARCH FOR UPPER AND LOWER'
@ 'CASES OF THAT STRING, AND YOU CAN IGNORE THE REST OF THIS.'
@ ' '
@ 'HOWEVER, I HAVE GONE TO CONSIDERABLE TROUBLE TO ALLOW USERS TO'
@ 'SEARCH FOR MULTIPLE STRINGS IN A SINGLE PASS. AND, YOU CAN SEARCH'
@ 'FOR A STRING THAT CONTAINS A COMMA,BY USING A DIFFERENT DELIMITER.'
@ 'YOU COULD EVEN USE BLANK AS A DELIMITER, "BUT ONLY 1".'
@ ' '
@ 'EVEN BETTER, THE DEFAULT IS TO WRITE ALL SELECTED RECORDS TO THE'
@ '//OUT FILE, BUT YOU CAN SPECIFY "OUTFILES" IN THE PARM, AND THE'
@ 'RECORDS WILL BE WRITTEN TO INDIVIDUAL "//OUT#" FILES.'
@ ' '
@ 'IN ORDER TO ALLOW USERS TO SEARCH FOR A STRING WITH A COMMA, THE'
@ 'PARM FIELD MUST START WITH A COMMA, OR ALTERNATE SEPARATOR.'
@ 'FOLLOWING THAT ARE KEYWORDS, FOLLOWED BY STRINGS. KEYWORDS ARE:'
@ ' '
@ 'LISTSTATS- PRINT THE CONTROL TABLE 4 TIMES DURING PROCESSING'
@ 'ASCIITR - FOR TESTING, TO CHANGE EBCDIC INPUT TO ASCII'
@ 'EBCDICTR - JUST BECAUSE'
@ 'DOC - PRINT THIS DESCRIPTION'
@ 'OUTFILES - CREATE MULTIPLE //OUT# FILES'
@ 'ASCII - INPUT FILE IS ASCII'
@ 'EBCDIC - INPUT FILE IS EBCDIC'
@ ' (THE PROGRAM CHECKS THE FIRST RECORD TO GUESS WHETHER IT IS'
@ ' AN ASCII OR EBCDIC FILE, BUT DOES NOT ALWAYS GET IT RIGHT.)'
@ 'LRECL=##### TO USE A LARGER LRECL FOR THE //IN FILE.'
@ ' '
@ 'FOLLOWING THE KEYWORDS ARE THE SELECT STRINGS.'
@ 'FOR TESTING, I READ AN ASSEMBLER LISTING AND LOOKED FOR'
@ ' '
@ ',MVC,STM,BAL,BUBBLE,QFREQ,TRT,FLAG,EQ,UNPK,USING,DROP,LA R1,DW'
@ '(BUT WHEN I WAS WRITING MULTIPLE OUT FILES, THE LIST WAS SHORTER.)'
@ ' '
@ '//SCAN EXEC PGM=SCANTEXT,PARM=",OUTFILES,MVC,STC,ASSEMBLER"'
@ '//STEPLIB DD DISP=SHR,DSN='
@ '//SYSPRINT DD SYSOUT=*'
@ '//IN DD DISP=SHR,DSN='
@ '//OUT DD SYSOUT=*'
@ '//OUT1 DD SYSOUT=*'
@ '//OUT2 DD SYSOUT=*'
@ '//OUT3 DD SYSOUT=*'
@ ' '
@ 'THERE ARE COUNTS AT THE END OF THE RUN THAT SHOW HOW MANY TIMES'
@ 'EACH STRING WAS FOUND. UNLESS "OUTFILES" IS SPECIFIED, ONLY THE'
@ 'FIRST OCCURRENCE OF A STRING IN A RECORD IS COUNTED. AND, ALL'
@ 'THE RECORDS GO TO THE //OUT FILE, RATHER THAN INDIVIDUAL FILES.'
@ ' '
ENDDOC EQU *
*
*
* THESE CHARACTERS CANNOT BE TRANSLATED FROM EBCDIC TO ASCII AND BACK.
* GENERALLY BECAUSE THERE ARE NO EQUIVALENT ASCII CHARACTERS.
* BUT FOR THE PROGRAM TO WORK, IT MUST TRANSLATE BOTH WAYS,
* SO NONE OF THESE CAN BE INCLUDED IN A STRING SELLECT.
*
UNTRAN DC 256X'00'
ORG UNTRAN+08
DC X'08'
ORG UNTRAN+X'1A'
DC X'1A'
ORG UNTRAN+X'25'
DC X'25'
ORG UNTRAN+X'33'
DC X'33343536'
ORG UNTRAN+X'71'
DC X'71'
ORG UNTRAN+X'61'
DC X'61'
ORG UNTRAN+X'90'
DC X'90'
ORG UNTRAN+X'AD'
DC X'AD'
ORG UNTRAN+X'BF'
DC X'BF'
ORG UNTRAN+X'DA'
DC X'DA'
ORG UNTRAN+X'B8'
DC X'B8'
ORG UNTRAN+X'59'
DC X'59'
ORG UNTRAN+X'31'
DC X'31'
ORG
*
* THIS IS A MORE COMPLETE TABLE OF EBCDIC CHARACTERS THAT
* CANNOT BE TRANSLATED INTO ASCII, AND SO CANNOT BE USED
* IN STRING SELECT PARAMETERS FOR ASCII INPUT FILES.
*
NOTASCII DC X'000000001A001A001A1A1A0000000000'
DC X'000000001A1A001A00001A1A00000000'
DC X'1A1A1A1A1A0000001A1A1A1A1A000000'
DC X'1A1A001A1A1A1A001A1A1A1A00001A1A'
DC X'001A1A1A1A1A1A1A1A1A000000000000'
DC X'001A1A1A1A1A1A1A1A1A000000000000'
DC X'001A1A1A1A1A1A1A1A1A000000000000'
DC X'1A1A1A1A1A1A1A1A1A00000000000000'
DC X'1A0000000000000000001A1A1A1A1A1A'
DC X'1A0000000000000000001A1A1A1A1A1A'
DC X'1A0000000000000000001A1A1A1A1A1A'
DC X'1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A'
DC X'000000000000000000001A1A1A1A1A1A'
DC X'000000000000000000001A1A1A1A1A1A'
DC X'001A00000000000000001A1A1A1A1A1A'
DC X'000000000000000000001A1A1A1A1A1A'
*
*
* HTTPS://WWW.IBM.COM/DOCS/EN/IIS/11.7?TOPIC=TABLESBCDIC-ASCII
*
CNOP 0,8
TOASCII DC X'000102031A091A7F1A1A1A0B0C0D0E0F'
DC X'101112131A1A081A18191A1A1C1D1E1F'
DC X'1A1A1A1A1A0A171B1A1A1A1A1A050607'
DC X'1A1A161A1A1A1A041A1A1A1A14151A1A'
DC X'201A1A1A1A1A1A1A1A1A5B2E3C282B21'
DC X'261A1A1A1A1A1A1A1A1A5D242A293B5E'
DC X'2D1A1A1A1A1A1A1A1A1A7C2C255F3E3F'
DC X'1A1A1A1A1A1A1A1A1A603A2340273D22'
DC X'1A6162636465666768691A1A1A1A1A1A'
DC X'1A6A6B6C6D6E6F7071721A1A1A1A1A1A'
DC X'1A7E737475767778797A1A1A1A1A1A1A'
DC X'1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A'
DC X'7B4142434445464748491A1A1A1A1A1A'
DC X'7D4A4B4C4D4E4F5051521A1A1A1A1A1A'
DC X'5C1A535455565758595A1A1A1A1A1A1A'
DC X'303132333435363738391A1A1A1A1A1A'
*
*
TOEBCDIC DC X'000102031A091A7F1A1A1A0B0C0D0E0F'
DC X'101112133C3D3226181961271C1D1E1F'
DC X'404F7F7B5B6C507D4D5D5C4E6B604B61'
DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
DC X'D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D'
DC X'79818283848586878889919293949596'
DC X'979899A2A3A4A5A6A7A8A9C06AD0A107'
DC 128X'3F' 80-FF 3F
*
*
*
* DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL,BLKSIZE=32767,RECFM=U,EODAD=Z
*UT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,LRECL=110,RECFM=FB,MACRF=PM
*
* DCBD DEVD=DA
*
@@PAD#1 EQU ((*-SCANTEXT)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-SCANTEXT)
ORG *+@@PAD#2
*
DCBDSECT DSECT 0
DCBDCB DS XL104
DCBDD DS CL4
DCBCOUNT DS CL4
LDCB EQU *-DCBDSECT
*
STRDSECT DSECT 0
SLENGTH DS H
SOFFSET DS H
SREMAIN DS H
SINDEX DS C
SCHAR DS C
SSTRING DS CL28
SCOUNT DS PL4
SDDNAME DS CL4
SDCBADDR DS F
LSTRING EQU *-STRDSECT
*
END SCANTEXT