AGO .START
SCANFAST WILL EVENTUALLY BE NAMED FASTSCAN.
BESTSCAN IS IT'S PARTNER. RUNS A BIT SLOWER. HAS MANY MORE OPTIONS.
MVC (TEST DATA) ABCDV MVC CLI EQ TXQ MVC RTM
C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANFAST
SET PA="MVC,MVI,STM,ST "
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANFAST
SET IN=%G%.MLC
SET OUT=%G%.OUTPUT.OUT.TXT
ASMLG %G%.MLC TIME(1) PARM(%PA%)
EZ390 %G%.MLC TEST PARM(%PA%)
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANFAST
SET LISTING=%G%.PRN
SET ATFILE=%G%.BREAK.ATFILE.TXT
SET COMMANDS=%G%.BREAK.COMMANDS.TXT
SET SYSIN=&G&.BREAK.SYSIN.TXT
EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)
LOADLOC=FD000 13R%
LRECL=90
LABEL=LOOP*,GET,PUT,FOUND,SHORT,JUST*,
COMMAND= -
COMMAND=L,L 3R% 64,L 5R% 48,T1
COMMAND= -
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANFAST ASMLG
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANFASTT EZ390
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANFASTB BK PTS
COMPRESS=Y
CMDFILE=Y
ATFILE=Y
---------- SAMPLE JCL. FIRST, PARM KEYWORDS. ------------------------
PARM='KEYWORDS, MANY CREATED IN TESTING, ARE:
DOC PRINT BRIEF DESCRIPTION. MUST BE FIRST IN PARM FIELD
TEST SHOW OFFSETS IN PRINT LINES
LIST LIST SELECTED RECORDS TO //SYSPRINT
HEX IF LIST IS ALSO SPECIFIED, PRINT RECORDS IN HEX
FILE=? ? IS APPENDED TO //IN AND //OUT DDNAMES
LRECL=##### MUST BE 5 DIGITS, FORCES //IN AND //OUT LRECL.
(YOU PROBABLY ONLY WANT TO DO THIS WITH RECFM=FT)
CLI USE CLI (CR AND BRANCH) ROUTINE TO TEST FOR SINGLE STRING CHAR.
BXLE USE BXLE ROUTINE FOR SINGLE STRING.
TRT USE A DIFFERENT TRT ROUTINE FOR SINGLE STRING.
||| ALLOWS USER TO CODE MULTIPLE LOGICAL PARM FIELDS.:
NOTE THAT ||| MUSE BE PRECEEDED BY A COMMA, AND THE FOLLOWING
CHARACTER WILL BE THE FIRST CHAR OF THE PARM FIELD FOR THE
NEXT ITERATION. I USED THIS TO DO MULTIPLE TEST RUNS
FOR TIMEING. EG:
PARM='MVC,|||ABC,DEF,|||GHIJK,RSTLNE,|||WHATEVER'
WHEN THERE ARE MULTIPLE ||| RUNS, FILE= AND LRECL= STAY SET
UNLESS THEY'RE CHANGED.
TEST, LIST, AND HEX, ONCE SET, STAY SET AND CANNOT BE CHANGED.
DOC CAN ONLY BE USED THE FIRST TIME, OR IT'LL BE WEIRD.
CLI, BXLE, AND TRT ARE RESET EACH TIME.
ALL OF THOSE MUST PRECEED THE STRINGS TO BE SEARCHED FOR. EG
PARM='LIST,HEX,MVC,MVI,STM,STC,LM'
//LIST EXEC PGM=SCANFAST,PARM='MVC,MVI,STM,STC,LM'
//STEPLIB DD DISP=SHR,DSN=
//SYSPEINT DD SYSOUT=*
//IN DD DISP=SHR,DSN=...
//OUT DD DISP=(,CATLG),DSN=...
THE DEFAULT FOR THE SCAN IS TO TRT UNTIL WE FIND A CHARACTER IN
A/THE STRING. THE QFREQ ROUTINE TRIES TO PICK THE LEAST FREQUENTLY
USED CHARACTER IN EACH STRING. ONCE THAT'S DONE, YOU HAVE TO FIND
THAT CHARACTER. WHEN THERE ARE MULTIPLE INPUT STRINGS, THE PROGRAM
CAN ONLY USE THE DEFAULT TO FIND A CHARACTER FROM ANY OF THE STRINGS.
THE SEARCH IS DONE FOR ALL STRINGS IN JUST ONE SINGLE TEST OF THE REC.
------ YEAH, SOMETIMES I REPEAT MYSELF. I'M 81. GIMME A BREAK --------
WHEN THERE IS ONLY 1 STRING (NEARLY ALL THE TIME) THE USER HAS A
CHOICE WHETHER TO USE:
TRT, TO SCAN FOR THE CHARACTER. (ONLY 1 STRING, SO ONLY 1 CHAR)
CLI, TO SCAN 1 BYTE AT A TIME, LOOKING FOR THE CHARACTER
BXLE, TO LOOP THROUGH THE RECORD, 1 BYTE AT A TIME, LOOKING
FOR THE CHARACTER.
IN MY TESTING, ON Z390, TRT, WHICH IS THE DEFAULT, IS FASTEST.
WHILE UNLIKELY, IT IS POSSIBLE THAT ON A REAL MACHINE, THAT BALANCE
WILL BE DIFFERENT.
THERE IS A TIMER ROUTINE, BUT IT ONLY CALCULATED ELAPSED TIME, NOT
CPU TIME. (ON A SIMULATOR, CLOCK TIME AND CPU TIME ARE THE SAME.)
IF YOU FIND SOMETHING DIFFERENT, I CAN CHANGE IT. SO......
PARM='CLI,STRING' WILL USE THE CLI ROUTINE.
PARM='BXLE,STRING' WILL USE THE BXLE ROUTINT.
PARM='TRT,STRING' WILL USE A 2ND TRT ROUTINE
PARM='STRING' WILL USE THE SHORT TRT ROUTINE.
PARM='STR1,STR2' WILL USE A DIFFERENT TRT ROUTINE THAT IS ABLE
TO FIND AND PROCESS MUILTIPLE DIFFERENT
'LEAST FREQUENT' CHARACTERS IN 1 PASS.
PARM='LIST,STRING WILL LIST THE OUTPUT TO SYSPRINT, RATHER
THAN WRITING IT TO //OUT
PARM='LIST,HEX,STRING WILL LIST THE SELECTED RECORDS IN HEX.
PARM='DOC,??? PRINTS MINIMAL PROGRAM DESCRIPTION.
IT'S MOSTLY THERE BECAUSE I USE THAT AREA
FOR MY CONTROL TABLE.
DOC MUST BE FIRST IF CODED. NONE OF THE OTHER
KEYWORDS ARE ORDER DEPENDENT.
SCANFAST EXAMINES THE ENTIRE RECORD, YOU CANNOT LIMIT THE SEARCH
TO A PART OF A RECORD. BESTSCAN IS MORE VERSITLE, BUT A BIT SLOWER.
WHEN I SEARCHED FOR 6 DIFFERENT STRINGS, THE RUN TIME ONLY INCREASED
BY ABOUT 30% OVER WHAT IT TOOK FOR A SINGLE STRING, PROVIDING THE
STRINGS SEARCH FOR WERE SOMEWHAT UNCOMMON. IF YOUR 'LEAST FREQUENT'
CHARACTERS ARE R, S, AND T, THEN IT'S GONNA RUN A TAD SLOW.
.START ANOP
*
MACRO
&LBL MAKEMSG &MSG
LCLA &L
&L SETA (K'&MSG-3)
&LBL DC AL1(&L),C&MSG
MEND
*
MACRO
&LBL $$LA &R,&F
AIF ('&F'(1,1) EQ '(').ADD0
&LBL LA &R,&F
MEXIT
.ADD0 ANOP
&LBL LA &R,0&F
MEND
*
MACRO
&LBL SORT &FIRST,&END,&ENTLEN,&KEY,&KEYLEN
* SORT FIRST,END,ENTLEN,KEYLOC,KEYLEN
LCLA &N
LCLC &L
&N SETA &SYSNDX
&L SETC 'SYS&N'
&LBL STM 14,4,12(13)
$$LA 14,&ENTLEN LOAD ENTRY LENGTH
$$LA 15,&END
$$LA 1,&FIRST
LA 4,&ENTLEN.(15)
SR 15,14
&L.A LR 3,1
LR 2,1
LA 1,&ENTLEN.(1)
&L.C CLC &KEY.(&KEYLEN,1),&KEY.(2)
BNL *+6
LR 2,1
BXLE 1,14,&L.C
CR 2,3
BE &L.N
MVC 0(&ENTLEN,4),0(2)
MVC 0(&ENTLEN,2),0(3)
MVC 0(&ENTLEN,3),0(4)
&L.N LA 1,&ENTLEN.(3)
LA 0,&ENTLEN.(1)
CR 0,15
BL &L.A
LM 14,4,12(13)
MEND
*
SCANFAST START 0
USING *,13,12
YREGS
STM 14,12,12(13)
ST 15,8(13)
ST 13,4(15)
LR 13,15
LA 11,4095
LA 12,1(11,13)
L R2,0(R1)
BAL R14,SAYHELLO OPEN //SYSPRINT, ASMDATE ETC.
*
LH 3,0(R2)
SH 3,=H'1'
BM NOPARM
CLC =C'DOC,',2(R2)
BNE *+8
BAL R9,PUTDOC
MVC PARM(0),2(2)
EX 3,*-6
MVC DOC(256),DOC-1
MVC SAVEPARM,SAVEPARM-1
BAL R9,TIME
B RESTART
* ----------------------------------------------
DS 0D
TIMEHH DC X'00'
TIMEMM DC X'00'
TIMESS DC HL2'0'
TIMEBIN DC FL4'0'
TIMEPACK DC PL8'0',XL8'00'
EDITTIME DC X'4021207A20207A20204B2020'
EDITSEC DC X'402020206B2020206B2021204B2020'
TIME TIME ,LINKAGE=SVC
LA R1,DW
ST R0,TIMEHH
ZAP DW,P0
MVO DW+6(2),TIMEHH
MP DW,=P'3600'
MVC DW+8,DW
ZAP DW,P0
MVO DW+6(2),TIMEMM
MP DW,=P'60'
AP DW+8,DW
MP DW+8,=P'100'
ZAP DW,P0
MVO DW+5(3),TIMESS
AP DW+8,DW
MVC TIMEPACK,DW+8
OI TIMEPACK+7,X'0F'
*
CLI TIMEPACK+15,0
BE UNPKTIME
MVC DW,TIMEPACK
SP DW,TIMEPACK+8
BM UNPKTIME
*
LA R1,LINE+10
MVC LINE+14(L'EDITSEC),EDITSEC
EDMK LINE+14(L'EDITSEC),DW+2
MVC LINE+15+L'EDITSEC(21),=C'SECONDS, ELAPSED TIME'
MVC LINE+15(54),0(R1)
*
UNPKTIME MVC TIMEPACK+8,TIMEPACK
* UNPK LINE+1(11),TIMEPACK+2(6)
MVC LINE+1(L'EDITTIME),EDITTIME
ED LINE+1(L'EDITTIME),TIMEHH
* PUT SYSPRINT,LINE-1
BAL R14,PUTLINE1
MVC LINE,LINE-1
BR R9
* ----------------------------------------------
RESTART BAL R14,PUTLINE1
BAL R14,PUTPARM1
MVC LINE,LINE-1
B QPARM
* ----------------------------------------------
QPARMNXT BAL R14,PUTPARM1
LA R1,PARM
QPARMNXA LA R1,1(R1)
CLC SPACES(22),0(R1)
BE QPARMNXP-6
CLI 0(R1),C','
BNE QPARMNXA
CLC =C'|||',1(R1)
BNE QPARMNXP-6
MVC SAVEPARM,1(R1)
MVI 0(R1),C' '
MVC 1(99,R1),0(R1)
B QPARMNXP
*
MVC PARM,1(R1)
QPARMNXP BAL R14,PUTPARM1
QPARM CLC =C'DOC,',PARM
BE QPARMNXT
CLC =C'TEST',PARM
BNE *+12
MVI FLAGTEST,C'T'
B QPARMNXT
CLC =C'HEX,',PARM
BNE *+12
MVI FLAGHEX,C'H'
B QPARMNXT
CLC =C'LIST',PARM LIST, ...
BNE *+12
MVI FLAGLIST,C'L'
B QPARMNXT
CLC =C'FILE=',PARM
BNE NFILE
BAL R9,CLOSE
MVC DCBDDNAM-IHADCB+IN+2,PARM+5
MVC DCBDDNAM-IHADCB+OUT+3,PARM+5
B QPARMNXT
*
NFILE CLC =C'LRECL=',PARM
BNE NLRECL
BAL R9,CLOSE
MVC DW(6),PARM+6
NC DW(5),=C'00000'
CLC DW(6),=C'00000,'
BNE BADLRECL
PACK DW,PARM+6(5)
CVB R1,DW
STH R1,DCBLRECL-IHADCB+IN
STH R1,DCBLRECL-IHADCB+OUT
B QPARMNXT
*
NLRECL CLC =C'CLI,',PARM
BE MVCCLI
CLC =C'TRT,',PARM
BE MVCCLI
CLC =C'BXLE,',PARM
BE MVCCLI
B CHK4COMA
MVCCLI MVC FLAGCLI(4),PARM
CLI FLAGCLI+3,C','
BNE QPARMNXT
MVI FLAGCLI+3,C' '
B QPARMNXT
*
CHK4COMA CLI PARM,X'80'
BH USECOMMA NO, USE COMMA
CLI PARM,C'|'
BE USECOMMA
MVC PARMCLI+1(1),PARM
MVC PARM,PARM+1 ERASE 1ST PARMCHAR
* ---------------------------------------------
USECOMMA LA R5,DOC POINT TO TABLE TO SAVE PARMS
USING DSECT,R5
LOOP0 BAL R14,PUTPARM1
LA R1,PARM
*
LA R1,1(R1)
PARMCLI CLI 0(R1),C','
BE PARMFND
CLC 0(11,R1),PARM+101
BNE PARMCLI-4
PARMFND LA R6,1(R1) NEXT PLACE IN PARM TO LOOK
LR R14,R1
S R14,=A(PARM) STRING LENGTH
SH R14,=H'1' -1
BM PARMLEN0 ERROR IF LENGTH=0
CH R14,=AL2(L'DSTRING)
BNL PARMLONG
XC DOFF(7),DOFF
MVC DSTRING,PARM+100 SPACES
STH R14,DSTRING-2 SAVE LENGTH-1
MVC DSTRING(0),PARM SAVE STRING
EX R14,*-6
ZAP D#,P0 ZERO COUNT
AP #STRINGS,P1
CP #STRINGS,=P'12'
BH #STRERR
*
LA R2,DSTRING-2 POINT TO LEN/STRING
LA R4,DCHAR AND PLACE TO STORE SEARCH CHAR
BAL R14,QFREQ GO GET LEAST FREQUENT CHAR
*
MVC DLEN,DLEN+1
MVC DSTRING-1(1),DCHAR
LH R1,DLEN
SH R1,DOFF
STH R1,DREST
*
LA R5,LDSECT(R5)
MVC PARM(100),0(R6)
CLC =C'|||',PARM
BNE QPARMEND
MVC SAVEPARM,PARM
MVI PARM,C' '
MVC PARM+1(111),PARM
QPARMEND CLC PARM(22),PARM+99
BNE LOOP0
*
LR R0,R5
S R0,=A(DOC)
CVD R0,16(R13)
OI 23(R13),X'0F'
MVC LINE+1(18),=C'TBL USED ... BYTES'
UNPK LINE+10(3),22(2,R13)
BAL R14,PUTLINE
* ---------------------------------------------
MVI 0(R5),X'FF'
CP #STRINGS,P1
BE LISTBL-4
* ---------------------------------------------
LR R7,R5 SAVE END OF TBL ADDR
LA R5,DOC 5 = TABLE
LA R6,DSTRING-1
SORT SORT (R5),(R7),LDSECT,DSTRING-1-DSECT,LSTRING
* SORT (R5),(R7),48,(R6),33
MVI 0(R7),0
MVC 1(L'DSECT,R7),0
MVI 0(R7),X'FF' YES, INDICATE END.
MVC LINE,LINE-1
B LISTBL
* ---------------------------------------------------------
CONV# LH R15,0(R1) OKAY, GONNA USE //SYSPRINT
CVD R15,DW MIGHT AS WELL SHOW TABLE.
OI DW+7,X'0F'
UNPK 0(3,R2),DW+6(2)
LA R1,2(R1)
LA R2,4(R2)
BR R9
*
LA R7,DOC+LDSECT
LISTBL LA R5,DOC
MVC LINE+1(1),DCHAR
LA R2,LINE+3
LA R1,DOFF
BAL R9,CONV#
BAL R9,CONV#
LA R1,DLEN
BAL R9,CONV#
MVC 0(0,R2),DSTRING
EX R15,*-6
BAL R14,PUTLINE
LA R5,LDSECT(R5)
CR R5,R7
BL LISTBL+4
* -----------------------------SET UP THE SEARCH TABLE-----
XC INDEX,INDEX
LA R5,DOC 5 = TABLE
CP #STRINGS,P1
BE JUST1INI
LA R0,#DSECT
LR R3,R0 R3 WILL BE NON-0 CCHAR
LOOP1 SR R1,R1
IC R1,DCHAR LOAD SEARCH CHAR
LA R2,INDEX(R1) LOC IN SEARCH TABLE
CLI 0(R2),0
BNE *+8
STC R3,0(R2) STORE NON-ZERO
*
AR R3,R0 NEXT NON-ZERO
LA R5,LDSECT(R5) NEXT TBL ENTRY
CR R5,R7 Q. END OF TBL
BL LOOP1 NO, LOOP
* ---------------------------------------------------------
LA R2,IN
BAL R9,OPENIN
LA R2,OUT
BAL R9,OPENOUT
B GET AND START
*
SAYHELLO ST R14,DW
PUSH PRINT
PRINT NOGEN
OPEN (SYSPRINT,OUTPUT)
POP PRINT
MVC LINE+1(L'HELLO),HELLO
L R14,DW
B PUTLINE
* PUTLINE ST R14,SAYHELLO-4
* PUT SYSPRINT,LINE
* MVC LINE,LINE-1
* L R14,SAYHELLO-4
* BR R14
HELLO DC C'SCANFAST VER(01.02) &SYSDATE &SYSTIME, BY LIN LYONS, COPIES X
RECORDS CONTAINING STRING(S) SPECIFIED IN THE PARM FIELD.
.'
*
DC 5F'0'
PUTPARM1 STM R14,R2,PUTPARM1-20
LA R2,PARM-1
CLI FLAGTEST,C'T'
BE PUTLOC
B PRINTR2
PUTPARMZ LM R14,R2,PUTPARM1-20
BR R14
PUTLINE STM R14,R2,PUTPARM1-20
LA R2,LINE
CLI FLAGTEST,C'T'
BE PUTLOC
B PRINTR2
PUTLINE1 STM R14,R2,PUTPARM1-20
LA R2,LINE-1
CLI FLAGTEST,C'T'
BE PUTLOC
PRINTR2 PUT SYSPRINT,(2)
C R2,=A(PARM-1)
BE PUTPARMZ
MVC LINE,LINE-1
B PUTPARMZ
PUTLOC SH R2,=H'5'
SR R14,R13
ST R14,12(R13)
UNPK 1(5,R2),14(3,R13)
TR 1(4,R2),HEX-240
MVI 5(R2),C' '
PUT SYSPRINT,(2)
MVC 0(5,R2),SPACES
C R2,=A(PARM)
BNH PUTPARMZ
MVC LINE,LINE-1
B PUTPARMZ
*
PUTDOC LA R4,DOC
MVC LINE+1(L'DOC),0(R4)
PUT SYSPRINT,LINE
LA R4,L'DOC(R4)
C R4,=A(ENDDOC)
BL PUTDOC+4
MVC LINE,LINE-1
BR R9
* -------------------------------------------------
OPENX DC 0F'0',X'85',AL3(OPENX+4)
CLI DCBRECFM-IHADCB(1),0 Q. BLANK DCB?
BNE 0(14) NO, JUST RETURN.
CNOP 0,4 ASSURE ALIGNMENT
BAL 15,16(R15) LOAD A(DCB TO COPY FROM)
DC A(IN) AND COPY RECFM+LRECL.
MVC DCBRECFM-IHADCB(1,1),DCBRECFM-IHADCB(15)
MVC DCBLRECL-IHADCB(2,1),DCBLRECL-IHADCB(15)
BR 14
*
PUSH PRINT
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,LRECL=2255,RECFM=FT,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,LRECL=80,RECFM=FT
*UT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,EXLXT=OPENX
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,LRECL=133,RECFM=FT
*
USING IHADCB,2
OPENIN TM DCBOFLGS,DCBOFOPN
BOR R9
MVC OPENMSG+1(8),DCBDDNAM
OPEN ((2),INPUT)
B OPENUNPK
*
OPENMSG DC C' ........ OPENED, RECFM=.. LRECL=..... BLKSIZE=..... '
OPENOUT TM DCBOFLGS,DCBOFOPN
BOR R9
MVC OPENMSG+1(8),DCBDDNAM
OPEN ((2),OUTPUT)
POP PRINT
*
OPENUNPK UNPK OPENMSG+24(3),DCBRECFM(2)
TR OPENMSG+24(3),HEX-240
MVI OPENMSG+26,C' '
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+33(5),DW+5(3)
LH R0,DCBBLKSI
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+47(5),DW+5(3)
MVC LINE(L'OPENMSG),OPENMSG
BAL R14,PUTLINE
BR R9
DROP R2
*
BAL 1,ERRM
MAKEMSG 'TEST'
*
#STRERR BAL R1,ERRM
MAKEMSG 'TOO MANY PARM STRINGS, MAX=12'
PARMLONG BAL R1,ERRM
MAKEMSG 'PARM STRING TOO LONG, MAX=35'
PARMQQQ BAL R1,ERRM
MAKEMSG 'PARM KEYWORD ERROR'
NOPARM BAL R1,ERRM
MAKEMSG 'PARM MISSING'
BADLRECL BAL R1,ERRM
MAKEMSG 'FILE=##### MUST BE EXACTLY 5 DIGITS'
PARMLEN0 BAL R1,ERRM
MAKEMSG 'PARM STRING LENGTH=0'
ERRM MVC LINE,LINE-1
IC R14,0(R1)
MVC LINE+1(0),1(R1)
EX R14,*-6
BAL R14,PUTLINE
OI RC+1,12
B EXIT
*
* ====================== ALL THAT WAS BEFORE READING FILE=========
* NEXT IS THE END OF FILE STUFF.
*
P0 DC X'0F'
P1 DC X'1F'
EDIT9 DC X'402020206B2020206B212020'
JUST1FLG EQU *+4
#STRINGS DC PL5'0',CL19'PARM STRINGS SAVED '
#IN DC PL5'0',CL19'//IN RECORDS READ '
#TRT DC PL5'0',CL19'TRT INSTRUSTIONS '
#FOUND DC PL5'0',CL19'SEARCH CHAR FOUND '
#CLC DC PL5'0',CL19'CLC INSTRUCTIONS '
#OUT DC PL5'0',CL19'OUT RECORDS WRITTEN'
DC X'FF'
*
* PRINT GEN
ENDSEPAR DC C'-------- END OF RUN, DIDN''T ABEND (YET) --------'
CLOSE LA R2,IN
LA R3,2
CLOSETM TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZ NCLOSE
CLOSE ((2))
MVC LINE+1(8),DCBDDNAM-IHADCB(R2)
MVC LINE+10(6),=C'CLOSED'
BAL 14,PUTLINE
* FREEPOOL ((2))
NCLOSE LA R2,OUT
BCT R3,CLOSETM
BR R9
*
Z BAL R9,CLOSE
*
MVC LINE+1(L'ENDSEPAR),ENDSEPAR
BAL R14,PUTLINE
*
LA R5,DOC
PRINT# MVC LINE(L'EDIT9),EDIT9
ED LINE(L'EDIT9),D#
LH R1,DLEN
MVC LINE+L'EDIT9+2(0),DSTRING
EX R1,*-6
BAL R14,PUTLINE
LA R5,LDSECT(R5)
CLI 0(R5),X'FF'
BNE PRINT#
*
LA R2,#STRINGS
EDIT# MVC LINE(L'EDIT9),EDIT9
ED LINE(L'EDIT9),0(R2)
ZAP 0(L'#IN,R2),P0
MVC LINE+L'EDIT9+2(19),5(R2)
BAL R14,PUTLINE
LA R2,#IN-#STRINGS(R2)
CLI 0(R2),X'FF'
BL EDIT#
BAL R9,TIME
*
CLI SAVEPARM,C'|'
BNE EXIT
MVI LINE+1,C'-'
MVC LINE+2(62),LINE+1
BAL R14,PUTLINE
MVC PARM(98),SAVEPARM+3
MVC SAVEPARM,SAVEPARM-1
MVC FLAGCLI,SPACES
NI NOPJUST1+1,X'0F'
* MVC FLAGHEX,SPACES
* MVC FLAGLIST,SPACES
B RESTART
*
EXIT CLOSE SYSPRINT
LH 15,RC
L R13,4(R13)
L 14,12(13)
LM 0,12,20(13)
BR 14
* ===================== AND THIS IS FILE PROCESSING --------------
* INIT RTN FOR JUST 1 STRING.
LA R1,1(R1,R3)
TRT LR R3,R4
SR R3,R1
BM GET
CR R3,R6
BL *+8
LA R3,255
AP #TRT,P1
EX R2,TRTTRT
BZ TRT-4
AP #FOUND,P1
LR R3,R1
SH R3,DOFF
AP #CLC,P1
TRTCLC CLC 0(0,R1),DSTRING
BE PUT
LA R1,1(R1)
B TRT
TRTTRT TRT 0(0,R1),INDEX
* --------------------------------
CLI CLI 0(R3),0
BNE CLINEXT
AP #CLC,P1
LR R1,R3
SH R1,DOFF
CLICLC CLC 0(0,R1),DSTRING
BE PUT
CLINEXT LA R3,1(R3)
CR R3,R4
BNH CLI
B GET
* -------------------------------
*
BXLE LA R14,1
LR R15,R4
BXLECLI CLI 0(R1),0
BNE BXLEBXLE
LR R2,R1
SH R2,DOFF
AP #CLC,P1
BXLECLC CLC 0(0,R2),DSTRING
BE PUT
BXLEBXLE BXLE R1,R14,BXLECLI
B GET
* ----------------------------------------------------------
FLAGCLI DS 0CL4
JUST1MSG DC C' USED'
JUST1INI LA R6,256
OI NOPJUST1+1,X'F0'
CLI FLAGCLI,C' '
BE JUST1A
*
LH R0,DLEN
MVC CLI+1(1),DCHAR
MVC BXLECLI+1(1),DCHAR
STC R0,CLICLC+1
STC R0,BXLECLC+1
STC R0,TRTCLC+1
*
JUST1M MVC LINE+1(9),JUST1MSG
BAL R14,PUTLINE
JUST1A SR R1,R1
IC R1,DCHAR LOAD LEAST FREQ CHAR
LA R1,INDEX(R1) CALC IT'S OFFSET IN TRT TBL
MVI 0(R1),C'A' MAKE IT NON-ZERO
OI JUST1FLG,X'0F' MAKE FLAG EASY TO TEST
LA R2,IN
BAL R9,OPENIN
LA R2,OUT
BAL R9,OPENOUT
B GET AND GO READ A RECORD
* -------------------------------------------------------
JUST1 AH R1,DOFF R4 = END
SH R4,DREST R15= LENGTH
CLI FLAGCLI,C'C'
BE CLI
CLI FLAGCLI,C'T'
BE TRT
CLI FLAGCLI,C'B'
BE BXLE
B JUST1QL
*
JUST1256 AP #TRT,P1
TRT 0(256,R1),INDEX MISS IN TRT 256, BUMP LOC
BZ JUST1QL-4
BAL R9,JUST1F
LA R1,1(R1)
B JUST1QL
*
LA R1,256(R1)
JUST1QL LA R0,256(R1)
CR R0,R4
BL JUST1256
LR R0,R4
SH R0,=H'1'
*
JUST1S LR R2,R0
SR R2,R1
BM GET
AP #TRT,P1 COUNT # TRT
EX R2,JUST1TRT FIND CHAR
BZ GET NOT FOUND, GET NEXT REC
BAL R9,JUST1F YES FOUND, GO DO CLE.
LA R1,1(R1)
B JUST1S
JUST1TRT TRT 0(0,R1),INDEX
*
DC F'0' R1 = R3 = BEG
JUST1F AP #FOUND,P1
ST R1,JUST1F-4 SAVE LOC
SH R1,DOFF BACK UP TO BEF OF STRING
LH R2,DLEN LOAD LENGTH OF STRING-1
AP #CLC,P1 COUNT
EX R2,JUST1CLC Q. STRING MATCH?
BE PUT YES, GO WRITE IT
L R1,JUST1F-4 BUMP BY 1
BR R9
JUST1CLC CLC 0(0,R1),DSTRING
*
* ------------------------------MAYBE WE CAN PRINT RECS TO SYSPRINT--
LIST OI #IN+4,X'0F'
UNPK LINE+1(7),#IN+1(4)
L R3,PUT-4
LR R2,R3
CLI FLAGHEX,C'H'
BE LHEX
LISTA LA R1,R4
SR R1,R2
CH R1,=H'51'
BL LISTL
MVC LINE+9(50),0(R2)
BAL R14,PUTLINE
LA R2,50(R2)
B LISTA
*
MVC LINE+11(0),0(R2)
LISTL SH R1,=H'1'
BM GET
*** MVC LINE+1(61),LINE
EX R1,LISTL-6
BAL R14,PUTLINE
B GET
* ---------------------------------
MVC 12(32,R13),0(R3)
MVC LINE+81(0),0(R3)
LHEX MVI 12(R13),C'<'
MVC 13(63,R13),12(R13)
LR R1,R4
SR R1,R3
SH R1,=H'1'
BM GET
CH R1,=H'63'
BL *+8
LA R1,63
EX R1,LHEX-6
EX R1,LHEX-12
MVI LINE+80,C'*'
LA R15,LINE+82(R1)
MVI 0(R15),C'*'
*
LHEXA LA R2,12(R13)
LA R14,LINE+9
LA R0,8
LHEXU UNPK 0(9,R14),0(5,R2)
TR 0(8,R14),HEX-240
MVI 8(R14),C' '
LA R14,9(R14)
LA R2,4(R2)
* CR R2,R4
* BNL LHEXP
BCT R0,LHEXU
LHEXP BAL R14,PUTLINE
LA R3,64(R3)
CR R3,R4
BL LHEX
B GET
* -----------NEXT IS WRITE/READ RTN, AND MULTI STRING PROC----------
DC F'0'
PUT AP #OUT,P1
AP D#,P1
CLI FLAGLIST,C' '
BNE LIST
L R0,PUT-4
PUT OUT,(0) WRITE
GET GET IN READ
AP #IN,P1
POP PRINT
ST R1,PUT-4
LA R3,0(R1) A-RECORD
LH R4,DCBLRECL-IHADCB+IN LENGTH
LR R15,R4 R15=LENGTH
LA R4,0(R3,R4) R4=END
LR R14,R3 R14=SCAN LOC
NOPJUST1 NOP JUST1
B LOOP2+8
*
DC F'0'
LOOP2 L R14,LOOP2-4 NEXT REC LOC TO SCAN
LA R14,1(R14) NEXT REC LOC TO SCAN
SR R2,R2
LA R0,256
LOOP2C CR R15,R0 Q. LENGTH LESS THAN 256
BL SHORT YES, DO SHORT TRT
AP #TRT,P1
TRT 0(256,R14),INDEX Q. FIND SEARCH CHAR
BNZ FOUND YES, GO COMPAREARE
AR R14,R0 NO, BUMP LOC
SR R15,R0 DECREMENT LENGTH LEFT
BNP GET
B LOOP2C
* -------------------------- FOUND A CHAR, NOW DO CLC----------
CLC DSTRING(0),0(2)
FOUND AP #FOUND,P1
ST R1,LOOP2-4
SH R2,=AL2(#DSECT) OFFSET INDEX INTO DATA TBL
MH R2,=H'16' OFFSET LOC IN DATA TBL
*** SLL R2,4
LA R5,DOC(R2) TBL ENTRY
CLI DLEN+1,0 Q. LOOKING FOR A SINGLE CHAR?
BE PUT FOUND IT, GO WRITE.
*
FOUND2 LR R2,R1
SH R2,DOFF Q. STRING START BEFORE BEG OF REC?
CR R2,R3 YES, SKIP IT
BL NOTTHIS
*
LH R6,DLEN
LA R0,1(R2,R6) Q. STRING GO PAST END OF REC
CR R0,R4 YES, SKIP IT
BH NOTTHIS
AP #CLC,P1
EX R6,FOUND-6 Q. FOUND?
BE PUT
NOTTHIS CLC DCHAR,DCHAR+LDSECT
BNE LOOP2
LA R5,LDSECT(R5)
CLI 0(R5),X'FF'
BE LOOP2
B FOUND2
*
TRT 0(0,R14),INDEX
SHORT AP #TRT,P1 COUNT # TRT INSTS
EX R15,SHORT-6 Q. FOUND CHAR
BZ GET NO, READ NEXT REC
B FOUND YES, TEST STRING
*
* ========================= GET LEAST FREQ USED CHAR =============
*
QFREQ STM R14,R6,12(R13) R2,LENGTH/STRING
QFREQFF XC 0(3,R4),0(R4) ZERO OFFSET, DEFAULT TO 1ST CHAR
MVC 0(1,R4),2(R2) AND SAVE THE CHAR
SR R1,R1
IC R1,2(R2) LOAD FREQ OF CHAR
LA R14,QFREQTBL(R1) GET LOC IN FREQ TBL
MVC 64(1,R13),0(R14) SAVE THAT.
*
* R4 = OFFSET(2) AND CHAR(1)
* R3 = H'LEN-1' AND STRING
LH R1,0(R2) LOAD LENGTH-1
LA R1,1(R1) CALC REAL LENGTH
LA R2,2(R2) POINT TO STRING
LR R0,R2 SAVE STRING ADDR
LA R14,QFREQTBL ADDR OF FREQ TABLE THAT I MADE UP.
*
QFREQ10 SR R15,R15
IC R15,0(R2) GET CHAR
AR R15,R14 GET LOC IN TABLE
CLC 64(1,R13),0(R15) Q.NEW CHAR LESS FREQ
BNH QFREQ20 NO.
MVC 64(1,R13),0(R15) YES, SAVE FREQ
MVC 0(1,R4),0(R2) SAVE CHAR
LR R15,R2 CALC OFFSET FROM
SR R15,R0 BEG OF STRING
STH R15,1(R4) AND SAVE THAT.
*
QFREQ20 LA R2,1(R2) BUMP CHAR
BCT R1,QFREQ10 LOOP THROUGH STRING
LH R0,0(R2)
SH R0,0(R4)
STH R0,3(R4)
LM R14,R6,12(R13) LOAD REGS
BR R14 AND RETURN
*
LTORG
QFREQFQ DC C' '
QFREQRC DC H'0'
*
DW DC 4D'0'
INDEX DC XL256'00'
QFREQTBL DS 0XL256
DC X'5431292B2C4E2A2C2D23342027222336442428242125211F28213D2620212122'
DC X'2A2221283921242224252523292020213024213335262F242920252126202022'
DC X'944120222C37244723232089465A4522482024202E2021203127323C4B593227'
DC X'77842420222024202220267F497A38533B2220202420202122336B5066656A5D'
DC X'3E917C8886937D818A8E2120202020214258748B878F9083518C20202B212120'
DC X'25318D9285768263804D2220224A2020272021202220202127212120214B2021'
DC X'286E62685F60575556693F40302021223A4C5564675E5B5F4361292625212224'
DC X'35226F70524C5C3F4F3A23202A2020207B7E797273716D6C7578232120212427'
* ===================================================================
LTORG
HEX DC C'0123456789ABCDEF'
RC DC H'00'
FLAGTEST DC C' '
FLAGLIST DC C' '
FLAGHEX DC C' '
DC CL6' '
PARM DC CL135' '
SPACES DC CL45' '
LINE DC CL135' ',CL45' '
*
DOC DC CL64'//SCAN EXEC PGM=SCANFAST,PARM="YOUR NAME,BOSS''S NAME '
DC C'//STEPLIB DD DISP=SHR,DSN= COPY/PRINT RECORDS THAT '
DC C'//SYSPRINT DD SYSOUT=* CONTAIN EITHER OF THE TWO '
DC C'//OUT DD SYSOUT=* STRINGS SPECIFIED IN THE PARM.'
DC C'//IN DD DISP=SHR,DSN= '
DC C' '
DC C' IF THERE IS A COMMA IN THE STRING, THEN SPECIFY A DIFFERENT '
DC C' SEPARATOR AS THE FIRST CHARACTER IN THE PARM. EG '
SAVEPARM DS 0CL104
DC C' PARM=":LAST,FIRST:NAME,BOSS" '
DC C' PARM="LIST,HEX,??" WILL PRINT RECORDS, IN HEX TO SYSPRINT'
*DC C' '
*DC C'//STEPLIB DD DISP=SHR,DSN= PARM="DOC" WILL PRINT THIS '
*DC C'//SYSPRINT DD SYSOUT=* PROGRAM DESCRIPTION. "," IS '
*DC C'//OUT DD SYSOUT=* THE STRING SEPARATOR UNLESS '
*DC C'//IN DD DISP=SHR,DSN= A CHAR BETWEEN X"40" AND X"80"'
*DC C' IS FIRST IN THE PARM FIELD. '
*DC C' EG, YOU COULD CODE .... '
*DC C' PARM="DOC,:MVC:MVI: ETC, OR, '
*DC C' PARM="DOC,MVC,MVI, ETC, OR, '
*DC C' PARM=",.INDEX,$WHATEVER, ETC. OR, '
*DC C' PARM=":MVC,ABC:STM:LM: ETC. '
*DC C' PARM="DOC,LIST,STRING " ETC. '
*DC C' '
*OC DC CL64'SCANFAST SCANS A FILE, FINDING AND COPYING RECORDS THAT '
*DC C'CONTAIN CHARACTER STRINGS SPECIFIED IN THE PARM FIELD. '
*DC C'SCANFAST CAN FIND MULTIPLE PARMS IN A SINGLE PASS, COPYING '
*DC C'RECORDS THAT CONTAIN THE SPECIFIED STRINGS, LOOKING FOR THE '
*DC C'LEAST FREQUENTLY USED CHARACTER IN EACH STRING. THE PROGRAM IS '
*DC C'WRITTEN TO SCAN FOR MULTIPLE STRINGS. IF THERE IS ONLY 1, WHICH '
*DC C'WILL BE MOST OF THE TIME, THEN A SHORTER ROUTINE IS USED. '
*DC C' '
*DC C'//SCAN EXEC PGM=SCANFAST,PARM="MVC,MVI,STM,ST,USING" '
*DC C'//STEPLIB DD DISP=SHR,DSN= PARM="DOC" WILL PRINT THIS '
*DC C'//SYSPRINT DD SYSOUT=* PROGRAM DESCRIPTION. "," IS '
*DC C'//OUT DD SYSOUT=* THE STRING SEPARATOR UNLESS '
*DC C'//IN DD DISP=SHR,DSN= A CHAR BETWEEN X"40" AND X"80"'
*DC C' IS FIRST IN THE PARM FIELD. '
*DC C' EG, YOU COULD CODE .... '
*DC C' PARM="DOC:MVC:MVI: ETC, OR, '
*DC C' PARM="DOC,MVC,MVI, ETC, OR, '
*DC C' PARM=",.INDEX,$WHATEVER, ETC. OR, '
*DC C' PARM=":MVC,ABC:STM:LM: ETC. '
*DC C' PARM="DOCLIST,STRING " ETC. '
*DC C'-------------------THERE ARE 3 RELATED PROGRAMS-----------------'
*DC C'SCANFAST SCANS USING PARM= STRINGS. IT IS FAST BECAUSE IT USES A'
*DC C' TRT INSTRUCTION, TO SCAN FOR ALL STRINGS SIMULTANEOUSLY. '
*DC C'SCANSTR SCANS FOR CHAR, HEX, OR PACKED DATA. IT IS MORE VERSITAL'
*DC C' USES IF AND OR LOGIC, BUT RUNS A BIT SLOWER. '
*DC C'SCANEDIT IS THE MOST VERSITAL, CAN CREATE MULTIPLE OUTPUT FILES,'
*DC C' AND CAN EDIT DATA. '
*DC C' '
ENDDOC EQU *
*
DSECT DSECT 0
D# DS PL5
DCHAR DS C
DOFF DS HL2
DREST DS HL2 <-- MUST BE AFTER CHAROFF IN QFREQ RTN
DLEN DS H
DS C
DSTRING DS CL35 CL19 = MAKE DSECT = 32 OR 48
LSTRING EQU L'DSTRING
LDSECT EQU *-DSECT
#DSECT EQU LDSECT/16
* ------------------------------------------------------------
END SCANFAST