SCANFAST

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