PSCAN1, PSCAN2, and?

Feeling not so bright, I wrote a couple more programs. Again, like everything else lately, file scan programs. If you're NOT an old IBM programmer, maybe some background is in order. When I punch cards (okay, maybe that far back) or type stuff on my terminal, I can create a program I want to run, and then create the control cards (yeah we old guys still call 'em cards) to assemble, or compile the program and then run it. Those control cards are called JCL, or Job Control Language. We'll do one example of JCL to run a program after it's been compiled.

//RUNIT EXEC PGM=PSCAN2,PARM='MVC,Z390,WHATEVER'
//STEPLIB DD DISP=SHR,DSN=
//SYSPRINT DD SYSOUT=*

//IN DD DISP=SHR,DSN=MY.LISTING

//OUT DD SYSOUT=*

Notes:
RUNIT EXEC tells the system to run the PGM= program. PARM= provides some data I want to use.

STEPLIB is the run library where the program is stored.

SYSPRINT is the traditional name for a print file. (SYSOUT is also used.)

DISP=SHR indicates that the file exists. For a new file, you'd code DISP=(NEW,CATLG) catlg puts it in an index.
IN is the file I'm going to read, in this case a listing of my program.

OUT is the file I'm going to write.

SYSOUT=* means that the file will be written to paper, or my terminal.

I use the Z390 simulator for testing. It's a 'pretend operating system' that allows me to assemble and execute what I've written. It's really pretty amazing.

In the olden days, there were programs to read files and copy selected records. I assume they still do that, but it's been 20+ years since I've been in a data center. In any case, it's a task I like doing -- writing a program that can select records based on the content of those records, and copy them to output files. I'm working on one that I've long thought about, but this week I needed a break, because I didn't feel up to the task of that program. SO, I wrote 2 programs, PSCAN1 and PSCAN2. They both read a file and copy selected records that contain the character strings I specify in the PARM field. (see above.)

Maybe it's time for a bit of philosophy:
1) In any scan, the object is to minimize the number of string compares. Those are what takes time.
2) You can scan for a single thing, or for several different things. When it's 1 thing, you just look. But when you're looking for various different things, there is another problem:
2a) Are you looking through the entire record, or
2b) Are you looking at different places for different things.

Both of these programs look through the entire record for 1 single, or several different, things. The main idea is that the area being scanned is the same for all of them. There is an IBM instruction that makes that, not only possible, but fairly easy. That's what I use. In both these cases, I scan the entire record looking for all the requested strings at the same time.

PSCAN1 uses the first character of a string to find possible strings in the file, and when a valid first character is found, it then tests to see if the entire string follows. That is far faster than checking the entire string against every character in the file. When doing this, you don't want to start your string with a blank, because there are lots of them, and it'd run slow. (Besides, it won't let you.) I've tested it, and it runs fine.

PSCAN2 is similar, but rather than look for the first character, it first scans each string, (there can be several) and tries to pick the character in that string that occurs in normal text, least frequently. By doing that, we're able to do fewer longer compares. And, for example, if you look for "EQUAL", there are way fewer "Q"s in normal text than "E"s, so the program runs faster.

PSCAN1 took me about a day to write, and is about 100 statements.
PSCAN2 took me nearly a week, with lots of stupid mistakes, and is about 400 statements. (Seemed longer than that with all the gnashing of teeth over some really dumb mistakes.) BUT, I did find a nice character frequency table in Wikipedia, that I used, and also saved elsewhere.

For PSCAN1, the report if pretty minimal. PSCAN2 is more verbose:
Following the 2 sample reports is the code for both programs.
It's written to run on Z390, and the DCB's would need to be changed for MVS.

PSCAN1, ASM 06/24/23 20.12, PARM= USING,LM,STM,MVC,MVI,ABEND,FIX

ABEND 1 = NO PARM FIELD.

ABEND 2 = SEARCH STRING IMPOSSIBLY LONG

ABEND 3 = SEARCH STRING LENGTH=0

ABEND 4 = SEARCH STRING LONGER THAN 29

ABEND 5 = TOO MANY SEARCH ARGS. 15=MAX

421 RECORDS READ

42 RECORDS WRITTEN

03 USING

01 LM

01 STM

11 MVC

02 MVI

24 ABEND

00 FIX

PSCAN2, ASM 06/24/23 19.18 PARM= USING,PUSH,POP,PRINT,MVC,LM,STM,TRT,MVI,Z390,EQU 1,EQU 2,ABEND,QUICK

READ A FILE, COPY RECORDS WITH STRINGS SPECIFIED IN THE PARM FIELD.

READ //IN, LOOK FOR STRINGS SPECIFIED IN PARM FIELD,

COPY THOSE RECORDS TO //OUT

CANNOT HAVE A COMMA IN A STRING. MAX STRING LENGTH=32

CAN HAVE UP TO 15 STRINGS. IN THE PARM= FIELD.

CAN GET AWAY WITH A COUPLE SPACES. EG, IN A LISTING:

// EXEC PGM=PSCAN2,PARM="MVC,STM,EQU 2"

//SYSPRINT DD SYSOUT=*

//IN DD DISP=SHR,DSN=

//OUT DD SYSOUT=*

IF THERE ARE 2 STRINGS IN A REC, THE 2ND IS NOT COUNTED.

# RECORDS

| BYTES BEFORE SCAN BYTE (IE SCAN CHAR OFFSET)

| | STRING LENGTH-1

| | | BYTES FROM SCAN CHAR TO END

| | | | SCAN CHAR

00000 00004 00004 00001 G USING

00000 00000 00003 00004 P PUSH

00000 00000 00002 00003 P POP

00000 00000 00004 00005 P PRINT

00000 00001 00002 00002 V MVC

00000 00001 00001 00001 M LM

00000 00002 00002 00001 M STM

00000 00001 00002 00002 R TRT

00000 00001 00002 00002 V MVI

00000 00000 00003 00004 Z Z390

00000 00001 00006 00006 Q EQU 1

00000 00001 00006 00006 Q EQU 2

00000 00001 00004 00004 B ABEND

00000 00000 00004 00005 Q QUICK

-------- AFTER BUBBLING --------

00000 00001 00004 00004 B ABEND

00000 00004 00004 00001 G USING

00000 00001 00001 00001 M LM

00000 00002 00002 00001 M STM

00000 00000 00002 00003 P POP

00000 00000 00004 00005 P PRINT

00000 00000 00003 00004 P PUSH

00000 00001 00006 00006 Q EQU 1

00000 00001 00006 00006 Q EQU 2

00000 00000 00004 00005 Q QUICK

00000 00001 00002 00002 R TRT

00000 00001 00002 00002 V MVC

00000 00001 00002 00002 V MVI

00000 00000 00003 00004 Z Z390

658 RECORDS READ

124 RECORDS WRITTEN

18 ABEND

1 USING

4 LM

4 STM

2 POP

23 PRINT

2 PUSH

7 EQU 1

1 EQU 2

0 QUICK

19 TRT

22 MVC

1 MVI

20 Z390

------------ Source code for PSCAN1 ---------------------------

AGO .START

I USE THIS STUFF IN Z390 TESTING.

C:\USERS\LIN\DOCUMENTS\Z390CODE\PSCAN1

SET PA="USING,DROP,LM,STM,END,WHATEVER"

SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PSCAN1

SET IN=C:\USERS\LIN\DOCUMENTS\BUSHSTUFF.TXT

SET OUT=%G%.OUT.TXT

BAT\ASMLG %G%.MLC TIME(1) PARM(%PA%)

.START ANOP

* ------------------- SET UP, SAVE PARM AND SCAN PARMS ---------

PSCAN1 START 0

YREGS

USING *,13 ABEND 1 = NO PARM FIELD.

B 72(R15) ABEND 2 = SEARCH STRING IMPOSSIBLY LONG

DC 17F'0' ABEND 3 = SEARCH STRING LENGTH=0

STM 14,12,12(13) ABEND 4 = SEARCH STRING LONGER THAN 29

ST 13,4(15) ABEND 5 = TOO MANY SEARCH ARGS. 15=MAX

ST 15,8(13)

LR 13,15

L R2,0(R1)

LH R3,0(R2)

SH R3,=H'1' WE HW LENGTH-1 AND SEARCH ARG

LA R4,TABLE FOR EACH ARG.

SR R6,R6 R6 = MAX ARG LENGTH

SR R7,R7 R7 = ARE #

BNM SAVPARM SO WE ONLY CLC STRINGS AT OR AFTER IT.

LA R5,1 ABEND # 1 = NO PARM

ABEND ABEND (5)

MVC PARM(0),2(R2)

SAVPARM EX R3,*-6 MOVE PARM TO W/A

PUSH PRINT

PRINT NOGEN

OPEN OPEN (IN,INPUT,OUT,OUTPUT,SYSPRINT,OUTPUT) OPEN FILES

POP PRINT

PUT SYSPRINT,PARM-7

SR R0,R0

SAVPARML LA R5,2

TRT PARM,FINDEND

BZ ABEND

LA R5,3

LA R2,0(R1) CALC LENGTH-1 OF ARG

S R2,=A(PARM+1)

BNP ABEND LENGTH=NEG, ERROR

LA R5,4 Q. ARG LONGER THAN 29?

CH R2,=AL2(L'TABLE-3) YES, ABEND

BNL ABEND

LA R7,1(R7) COUNT ARG

LA R5,5

CLI 0(R4),C' ' Q. TABLE OVERFLOW?

BNE ABEND YES, "WHY THAT MANY???"

MVC 6(0,R4),PARM MOVE ARE TO TABLE

EX R2,*-6

STH R2,4(R4) STORE LENGTH-1

ST R0,0(R4)

LA R4,L'TABLE(R4) BUMP TABLE INDEX

CR R6,R2 Q. LONGEST ARG SO FAR?

BL *+6 NO.

LR R6,R2 YES, SAVE IT.

SR R14,R14

IC R14,PARM LOAD FIRST CHAR OF STRING

LA R14,TRTABLE(R14) CALC OFFXET IN TRT TABLE

CLI 0(R14),0 Q. FIRST TIME THIS CHAR?

BNE *+8 NO, DON'T STORE

STC R7,0(R14) YES, STORE INDEX

MVC PARM,1(R1) MVC NEXT ARG TO BEG OF PARM

CLI PARM,C' ' Q. END OF ARGS?

BNE SAVPARML NO, LOOP

MVI 0(R4),X'FF' YES, SET END FLAG

LA R6,1(R6) CALC MAX LENGTH

LA R7,255 ONLY TRT 255 BYTES AT A TIME

SR R8,R8

SR R9,R9

B GET GO READ.

* ------------------- READY, LETS READ, TEST, AND WRITE --------

DC F'0' REC ADDR

PUT LA R0,1

A R0,0(R4)

ST R0,0(R4)

L R0,PUT-4 LOAD REC ADDR

PUT OUT,(0) WRITE IT

LA R9,1(R9)

GET GET IN READ A REC

LA R8,1(R8)

LA R3,0(R1) SAVE IT'S ADDR

ST R3,PUT-4 TWICE, JUST TO BE SURE.

LH R5,DCBLRECL-IHADCB+IN LOAD LRECL

LA R5,0(R3,R5) R3=REC ADDR

SR R5,R6 R5=LAST USEABLE LOC

LR R1,R3 -LENGTH OF LONGEST = END

TRTLOOP LR R2,R5 END

SR R2,R1 - START / CURRENT = LENGTH

CR R2,R7 Q. LONGER THAN 255

BL SHORT NO, JUST GO TEST SHORT

TRT 0(255,R1),TRTABLE TEST 255 BYTES

BNZ CHECK A FIRST CHAR COUNT, GO CLC

LA R1,255(R1) NOT FOUND, BUMP

B TRTLOOP AND LOOP

TRT 0(0,R1),TRTABLE

SHORT EX R2,SHORT-6 TEST SHORT

BZ GET NOT FOUND, JUST GO READ

B CHECK YES, GO DO CLC'S

CLC CLC 0(0,R1),6(R4)

CHECK LA R4,TABLE POINT TO ARG TABLE

N R2,=F'31' R2 = INDEX INTO ARG TABLE

BCTR R2,0 START WITH 0, NOT 1

SLL R2,5 MULT BY 32

LA R4,0(R2,R4) CALC ARG TABLE ENTRY LOC

CHECKLH LH R15,4(R4) LOAD ENTRY LENGTH

EX R15,CLC Q. DOES THIS ENTRY MATCH?

BE PUT YEAH, GO WRITE

LA R4,L'TABLE(R4) NO, BUMP TO NEXT

CLI 0(R4),99 Q. END OF ARG TABLE?

BL CHECKLH NO, TRY NEXT

LA R1,1(R1) POINT TO NEXT BYTE

CR R1,R5 Q. END OF RECORD

BNH TRTLOOP NO, GO TEST

B GET YES, GO READ.

* ---------------------- ALL DONE, CLOSE FILES AND EXIT -------

EDIT9 DC X'402020206B2020206B212020'

Z LA R4,TABLE-64

MVC PARM,PARM-1

ST R8,#READ

ST R9,#WRITTEN

TOTALS L R0,0(R4)

CVD R0,16(R13)

MVC PARM(L'EDIT9),EDIT9

ED PARM(L'EDIT9),19(R13)

LH R1,4(R4)

MVC PARM+L'EDIT9+2(0),6(R4)

EX R1,*-6

PUT SYSPRINT,PARM-1

MVC PARM,PARM-1

LA R4,L'TABLE(R4)

CLI 0(R4),99

BL TOTALS

CLOSE (IN,,OUT,,SYSPRINT)

L 13,4(13)

LM 14,12,12(13)

SR R15,R15

BR 14

LTORG

PUSH PRINT

PRINT NOGEN

IN DCB DDNAME=IN,DSORG=PS,EODAD=Z,MACRF=GL,LRECL=3990,RECFM=FT

OUT DCB DDNAME=OUT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM,

SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

POP PRINT

DC C' PARM='

DC C' '

PARM DC CL101' ',CL33' '

TRTABLE DC XL256'00'

#READ DC F'0',HL2'17',CL26'RECORDS READ'

#WRITTEN DC F'0',HL2'17',CL26'RECORDS WRITTEN'

TABLE DC 16CL32' ',X'FF'

FINDEND DC 64X'00',C' ',191X'00'

ORG FINDEND+C','

DC C','

ORG

* DCBD DEVD=DA

@@PAD#1 EQU ((*-PSCAN1)/4096+1)*4096

@@PAD#2 EQU @@PAD#1-(*-PSCAN1)

ORG *+@@PAD#2

END PSCAN1

---------------------- Source code for PSCAN2 -------------

AGO .START

I USE THIS STUFF IN Z390 TESTING.

C:\USERS\LIN\DOCUMENTS\Z390CODE\PSCAN2

SET PA="USING,DROP,LM,STM,END,WHATEVER"

SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PSCAN2

SET IN=C:\USERS\LIN\DOCUMENTS\BUSHSTUFF.TXT

SET OUT=%G%.OUT.TXT

BAT\ASMLG %G%.MLC TIME(1) PARM(%PA%)

.START ANOP

* ---------------------------------------

MACRO

&LBL @ &MSG

LCLA &L

&L SETA (K'&MSG-3)

&LBL DC AL1(&L),C&MSG

MEND

* ---------------------------------------

* ------------------- SET UP, SAVE PARM AND SCAN PARMS ---------

PSCAN2 START 0

YREGS

USING *,13 ABEND 1 = NO PARM FIELD.

* B 72(R15) ABEND 2 = SEARCH STRING IMPOSSIBLY LONG

* DC 17F'0' ABEND 3 = SEARCH STRING LENGTH=0

STM 14,12,12(13) ABEND 4 = SEARCH STRING LONGER THAN 29

ST 13,4(15) ABEND 5 = TOO MANY SEARCH ARGS. 15=MAX

ST 15,8(13) ABEND 6 = BLANKS IN STRING

LA 13,0(15) ABEND 7 = SEARCH STRING START=BLANKS

SR 14,14

L R2,0(R1)

LH R3,0(R2)

SH R3,=H'1' WE HW LENGTH-1 AND SEARCH ARG

LA R4,TABLE FOR EACH ARG.

ST R4,ATABLE

SR R6,R6 R6 = MAX ARG LENGTH

SR R7,R7 R7 = ARE #

BNM SAVPARM SO WE ONLY CLC STRINGS AT OR AFTER IT.

LA R5,1 ABEND # 1 = NO PARM

B ABEND

MVC PARM(0),2(R2)

SAVPARM EX R3,*-6 MOVE PARM TO W/A

PUSH PRINT

PRINT NOGEN

OPEN OPEN (IN,INPUT,OUT,OUTPUT,SYSPRINT,OUTPUT) OPEN FILES

POP PRINT

PUT SYSPRINT,PARMPRT

LA R11,TRTABLE

B PUTLINE

ABEND ABEND (5)

MVC LINE(0),1(R11)

MOVEDOC IC R7,0(R11)

EX R7,MOVEDOC-6

LA R11,2(R11,R7)

PUTLINE PUT SYSPRINT,LINE-1

MVC LINE,LINE-1

CLI 0(R11),64

BL MOVEDOC

PUT SYSPRINT,LINE-1

SR R7,R7

SR R0,R0

SAVPARML LA R5,7

CLC PARM(2),PARM+101

BE ABEND

LA R5,2

TRT PARM,FINDEND

BZ ABEND

TESTSPA CLI 0(R1),C','

BE TESTLEN

CLC 0(11,R1),PARM+99

BE TESTLEN

TRT 1(33,R1),FINDEND

B TESTSPA

TESTLEN LA R5,3

LA R2,0(R1) CALC LENGTH-1 OF ARG

S R2,=A(PARM+1)

BNP ABEND LENGTH=NEG, ERROR

LA R5,4 Q. ARG LONGER THAN 29?

CH R2,=AL2(LTABLE-14) YES, ABEND

BNL ABEND

LA R7,1(R7) COUNT ARG

LA R5,5

CLI 0(R4),C' ' Q. TABLE OVERFLOW?

BNE ABEND YES, "WHY THAT MANY???"

XC 0(12,R4),0(R4)

MVC 12(0,R4),PARM MOVE ARE TO TABLE

EX R2,*-6

STH R2,10(R4) STORE LENGTH-1

STH R2,6(R4)

LA R4,LTABLE(R4) BUMP TABLE INDEX

* CR R6,R2 Q. LONGEST ARG SO FAR?

* BL *+6 NO.

* LR R6,R2 YES, SAVE IT.

* SR R14,R14

* IC R14,PARM LOAD FIRST CHAR OF STRING

* LA R14,TRTABLE(R14) CALC OFFXET IN TRT TABLE

* CLI 0(R14),0 Q. FIRST TIME THIS CHAR?

* BNE *+8 NO, DON'T STORE

* STC R7,0(R14)( YES, STORE INDEX

MVC PARM,1(R1) MVC NEXT ARG TO BEG OF PARM

CLI PARM,C' ' Q. END OF ARGS?

BNE SAVPARML NO, LOOP

LA R5,6

CLC PARM(44),PARM+45

BNE ABEND

MVI 0(R4),X'FF' YES, SET END FLAG

ST R4,ATABLE+4

BAL R14,QFREQ

BAL R14,LIST

BAL R14,BUBBLE

MVC LINE(35),=CL35'-------- AFTER BUBBLING --------'

PUT SYSPRINT,LINE-1

MVC LINE,LINE-1

BAL R14,LIST

SETUP LA R6,1(R6) CALC MAX LENGTH

LA R7,255 ONLY TRT 255 BYTES AT A TIME

SR R8,R8

SR R9,R9

B GET GO READ.

* ------------------- READY, LETS READ, TEST, AND WRITE --------

DC F'0' REC ADDR

PUT LA R0,1

A R0,0(R4)

ST R0,0(R4)

L R0,PUT-4 LOAD REC ADDR

PUT OUT,(0) WRITE IT

LA R9,1(R9)

GET GET IN READ A REC

LA R8,1(R8)

LA R3,0(R1) SAVE IT'S ADDR

ST R3,PUT-4 TWICE, JUST TO BE SURE.

LH R5,DCBLRECL-IHADCB+IN LOAD LRECL

LA R5,0(R3,R5) R3=REC ADDR

SR R6,R5 R6=END OF BUFFER

SH R5,=H'1' R5=LAST USEABLE LOC

LR R1,R3 -LENGTH OF LONGEST = END

TRTLOOP LR R2,R5 END

SR R2,R1 - START / CURRENT = LENGTH

CR R2,R7 Q. LONGER THAN 255

BL SHORT NO, JUST GO TEST SHORT

TRT 0(255,R1),TRTABLE TEST 255 BYTES

BNZ CHECK A FIRST CHAR COUNT, GO CLC

LA R1,255(R1) NOT FOUND, BUMP

B TRTLOOP AND LOOP

TRT 0(0,R1),TRTABLE

SHORT EX R2,SHORT-6 TEST SHORT

BZ GET NOT FOUND, JUST GO READ

B CHECK YES, GO DO CLC'S

CLC CLC 0(0,R14),12(R4)

CHECK LA R4,TABLE POINT TO ARG TABLE

N R2,=F'255' R2 = INDEX INTO ARG TABLE

SH R2,=H'3' START WITH 0, NOT 1

SLL R2,4 MULT BY 32

LA R4,TABLE(R2) CALC ARG TABLE ENTRY LOC

CLI 0(R1),C'Q'

BNE CHECKLH

NOPR 0

CHECKLH LH R15,6(R4) LOAD ENTRY LENGTH

LR R14,R1

SH R14,4(R4)

LR R0,R1

AH R0,8(R4)

CR R0,R5

BNL CHECKNEX

EX R15,CLC Q. DOES THIS ENTRY MATCH?

BE PUT YEAH, GO WRITE

CHECKNEX CLC 11(1,R4),LTABLE+11(R4) NO, BUMP TO NEXT

BNE NOT

LA R4,LTABLE(R4) NO, BUMP TO NEXT

C R4,ATABLE+4 Q. END OF ARG TABLE?

BL CHECKLH NO, TRY NEXT

NOT LA R1,1(R1) POINT TO NEXT BYTE

CR R1,R5 Q. END OF RECORD

BNH TRTLOOP NO, GO TEST

B GET YES, GO READ.

* ---------------------- ALL DONE, CLOSE FILES AND EXIT -------

EDIT9 DC X'402020206B2020206B202120'

Z LA R4,TABLE-LTABLE-LTABLE

MVC PARM,PARM-1

ST R8,#READ

ST R9,#WRITTEN

TOTALS L R0,0(R4)

CVD R0,16(R13)

MVC PARM(L'EDIT9),EDIT9

ED PARM(L'EDIT9),19(R13)

LH R1,6(R4)

MVC PARM+L'EDIT9+2(0),12(R4)

EX R1,*-6

PUT SYSPRINT,PARM-1

MVC PARM,PARM-1

LA R4,LTABLE(R4)

C R4,ATABLE+4

BL TOTALS

CLOSE (IN,,OUT,,SYSPRINT)

L 13,4(13)

LM 14,12,12(13)

SR R15,R15

BR 14

LIST MVC TRTABLE(256),TRTABLE-1

STM R14,R6,12(R13)

L R2,ATABLE

LA R4,3

LISTA LA R1,2(R2)

LA R3,PARM

SR R5,R5

LA R0,4

LISTLH LH R14,0(R1)

CVD R14,32(R13)

OI 39(R13),X'0F'

UNPK 0(5,R3),37(3,R13)

LA R3,6(R3)

LA R1,2(R1)

BCT R0,LISTLH

LH R1,6(R2)

MVC 2(1,R3),11(R2)

MVC 4(0,R3),12(R2)

EX R1,*-6

PUT SYSPRINT,PARM-1

IC R5,11(R2)

LA R6,TRTABLE(R5)

CLI 0(R6),0

BNE *+8

STC R4,0(R6)

LA R4,3(R4)

MVC PARM,PARM-1

LA R2,LTABLE(R2)

C R2,ATABLE+4

BL LISTA

PUT SYSPRINT,PARM-1

LM R14,R6,12(R13)

BR R14

BUBBLE STM R1,R3,12(R13)

LA R1,LTABLE

L R3,ATABLE+4

BUBBLEA L R2,ATABLE

SR R3,R1

CR R2,R3

BL BUBBLEC

LM R1,R3,12(R13)

BR R14

BUBBLEC CLC 11(LTABLE-14,R2),11+LTABLE(R2)

BL BUBBLEN

MVC 24(LTABLE,R13),0(R2)

MVC 0(LTABLE,R2),LTABLE(R2)

MVC LTABLE(LTABLE,R2),24(R13)

BUBBLEN LA R2,LTABLE(R2)

CR R2,R3

BL BUBBLEC

B BUBBLEA

* INPUT =R2= AL2(LENGTH-1),C'TEXT'

* OUTPUT =R3= CL2'CHAR',AL2(LEN TO BACK,LEN-1,LEN AFTER CHAR,TRT-ADDR

QFREQ STM R0,R9,12(R13)

* XC TRTABLE(256),TRTABLE

L R2,ATABLE LL(TEXT), FIRST,TOTAL,END LENGTHS

QFREQ$ LH R4,10(R2)

STH R4,6(R2) SAVE

LA R4,1(R4) TOTAL LENGTH

LR R3,R2

LA R2,12(R2) FIRST TEXT

LR R5,R2 FIRST TEXT

LA R6,0(R4,R5) END OF STRING

LA R9,255

SR R7,R7

SR R8,R8

LR R10,R5

QFREQA IC R7,0(R5) CHAR

IC R8,QFREQTBL(R7) FREQ VALUE

CR R8,R9 Q. LESS FREQ

BNL QFREQB NO

LR R9,R8 YES, SAVE FREQ VALUE

MVC 11(1,R3),0(R5) SAVE NEW CHAR

LR R0,R5 LOAD CURR ADDR

SR R0,R10 CALC OFFSET FROM START

STH R0,4(R3) SAVE START OFFSET

LR R0,R6 LOAD END LOC

SR R0,R5 CALC LAST CHAR LOC

STH R0,8(R3) SAVE TO NOT RUN OVER END OF REC

QFREQB LA R5,1(R5) BUMP POINTER

BCT R4,QFREQA LOOP THRU # CHARS

LA R2,LTABLE(R3)

C R2,ATABLE+4

BL QFREQ$

LM R0,R9,12(R13) RELOAD REGS

BR R14 AND RETURN

* IC R7,0(R3) LOAD LEAST FREQ CHAR

* LA R0,TRTABLE TRTABLE ADDR

* SR R0,R7 CALC ADDR TO DO TRT

* ST R0,8(R3) SAVE ADDR TO DO TRT

LTORG

PUSH PRINT

PRINT NOGEN

IN DCB DDNAME=IN,DSORG=PS,EODAD=Z,MACRF=GL,LRECL=199,RECFM=FT

OUT DCB DDNAME=OUT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM,

SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

POP PRINT

ATABLE DC 2F'0'

PARMPRT DC C' PSCAN2, ASM &SYSDATE &SYSTIME PARM= '

PARM DC CL101' ',CL33' '

LINE DC CL133'READ A FILE, COPY RECORDS WITH STRINGS SPECIFIED IN

N THE PARM FIELD.'

DC X'00'

TRTABLE EQU *

DOC @ 'READ //IN, LOOK FOR STRINGS SPECIFIED IN PARM FIELD,'

@ 'COPY THOSE RECORDS TO //OUT'

@ 'CANNOT HAVE A COMMA IN A STRING. MAX STRING LENGTH=32'

@ 'CAN HAVE UP TO 15 STRINGS. IN THE PARM= FIELD.'

@ 'CAN GET AWAY WITH A COUPLE SPACES. EG, IN A LISTING:'

@ '// EXEC PGM=PSCAN2,PARM="MVC,STM,EQU 2"'

@ '//SYSPRINT DD SYSOUT=*'

@ '//IN DD DISP=SHR,DSN='

@ '//OUT DD SYSOUT=*'

@ 'IF THERE ARE 2 STRINGS IN A REC, THE 2ND IS NOT COUNTED.'

@ ' '

@ '# RECORDS'

@ '| BYTES BEFORE SCAN BYTE (IE SCAN CHAR OFFSET)'

@ '| | STRING LENGTH-1'

@ '| | | BYTES FROM SCAN CHAR TO END'

@ '| | | | SCAN CHAR'

@ '| | | | | |-STRING--'

DC X'FF'

#READ DC F'0',4HL2'17',CL36'RECORDS READ'

#WRITTEN DC F'0',4HL2'17',CL36'RECORDS WRITTEN'

TABLE DC 16CL48' ',X'FF'

LTABLE EQU 48

FINDEND DC 64X'00',C' ',191X'00'

ORG FINDEND+C','

DC C','

ORG

QFREQTBL DS 0D

FREQTBL DC X'222120',253X'02'

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

@@PAD#1 EQU ((*-PSCAN2)/4096+1)*4096

@@PAD#2 EQU @@PAD#1-(*-PSCAN2)

ORG *+@@PAD#2

END PSCAN2

end