SCANTEXT

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

| | | | | | |

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

| | | | | | |

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

| | | | | | |

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

| | | | | | |

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

| | | | | | |

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'1A1A1A1A1A1A1A1A1A00000000000000'

DC X'1A0000000000000000001A1A1A1A1A1A'

DC X'1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A1A'

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