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
| | | | | |-STRING--
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