SCAN1

AGO .START MVC

C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANMIN

MVC

MVC MVC MVCMVC MVC MVC

MVC

SET PA="COPY,EDIT,MVC,ABD"

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

SET IN=%G%.MLC

SET OUT=%G%.OUTPUT.OUT.TXT

SET SYSPRINT=%G%.OUTPUT.SYSPRINT.TXT

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

BAT/EZ390 %G%.MLC TEST PARM(%PA%)

YOU CAN ONLY SCAN FOR 1 PARAMETER.

BUT, YOU CAN EDIT THAT PARAMETER.

//SCAN EXEC SCAN1,PARM='MVC' COPIES RECORDS CONTAINING MVC

//STEPLIB DD DISP=SHR,DSN=

//SYSPRINT DD SYSOUT=*

//IN DD DISP=SHR,DSN=

//OUT DD DISP=(,CATLG),DSN=

PARM='EDIT,MVC,WER' SELECTS RECORDS CONTAINING MVC, CHANGES TO WER

PARM='COPY,MVC' COPIES ALL RECORDS COUNTS RECORDS CONTAINING MVC

PARM='COPY,EDIT,MVC,YES' COPIES ALL RECORDS, CHANGES MVC TO YES

THE EDIT STRINGS MUST BE THE SAME LENGTH.

SET LISTING=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANMIN.PRN

SET ATFILE=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANMIN.BREAK.ATFILE.TXT

SET COMMANDS=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANMIN.BREAK.COMMANDS.TXT

SET SYSIN=C:\USERS\LIN\DOCUMENTS\Z390CODE\SCANMIN.BREAK.SYSIN.TXT

BAT/EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)

.START ANOP

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

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

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

MACRO

&LBL APERR &BC,&MSG

&LBL REVB &BC,SYS&SYSNDX

BAL R1,PUTERR

MAKEMSG &MSG

SYS&SYSNDX DS 0H

MEND

MACRO

@ &MSG

LCLA &L

LCLC &C

&L SETA (K'&MSG)

&L SETA (&L-1)

.LOOP ANOP

&C SETC '&MSG'(&L,1)

.* MNOTE ,'C=&C L=&L'

AIF ('&C' NE ' ').DC

AIF (&L LT 2).DC

&L SETA &L-1

AGO .LOOP

.DC DC AL1(&L-1),CL&L&MSG

MEND

MACRO

&LBL MAKEMSG &MSG

LCLA &L

&L SETA (K'&MSG-3)

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

MEND

SCAN1 START 0

USING *,13,12

YREGS

STM 14,12,12(13)

ST 15,8(13)

ST 13,4(15)

LA 13,0(15)

LA 11,4095

LA 12,1(11,13)

L R2,0(R1)

LH R3,0(R2)

CLI 1(R2),5

BL OPEN

CLC =C'TEST,',2(R2)

BNE OPEN

MVI FLAGTEST,C'T'

LA R2,5(R2)

SH R3,=H'5'

PUSH PRINT

PRINT NOGEN

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

POP PRINT

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

PUTINI PUT SYSPRINT,INIMSG

CH R3,=H'4'

BL NOTDOC

CLC =C'DOC',2(R2)

BNE NOTDOC

LA R5,DOC

L R6,=A(ENDDOC-1)

SR R7,R7

LA R8,99

MVCDOC IC R7,0(R5)

CR R7,R8

BNL *+16

MVC INIMSG+1(88),INIMSG

MVC INIMSG+1(0),1(R5)

EX R7,*-6

PUT SYSPRINT,INIMSG

LA R5,2(R5,R7)

LR R8,R7

CR R5,R6

BL MVCDOC

LA R2,4(R2)

SH R3,=H'4'

NOTDOC MVC TRTPACK+16(144),TRTPACK

MVI SPACES,C' '

MVC SPACES+1,SPACES

MVC LINE(256),SPACES

MVC SAVEPARM(256),SPACES

MVC LINE(256),SPACES

XC PARMLEN-2(4),PARMLEN-2

MVC PARM(256),SPACES

XC INDEX,INDEX

* NOTDOC MVC TRTPACK+16(144),TRTPACK

* MVI PARM,C' '

* MVC PARM+1(SAVEPARM-PARM-1),PARM

* XC PARM-4(4),PARM-4

* MVI SAVEPARM-1,C' '

* MVC SAVEPARM(159),SAVEPARM-1

SH R3,=H'1'

BM NOPARM

MVC PARM(0),2(R2)

EX R3,*-6

B RESTART

NOPARM OI RC,12

BAL R1,PUTERR NO PARM SPECIFIED

MAKEMSG 'PARM= MISSING'

B Z

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

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'

* TIMEDW XC DW,DW

* SLL R0,4

* ST R0,DW+4

* OI DW+7,X'0F'

* SR R0,R0

* BR R14

TIME TIME ,LINKAGE=SVC

LA R1,DW

ST R0,TIMEHH

SR R0,R0

* IC R0,TIMEHH

* BAL R14,TIMEDW

ZAP DW,P0

MVO DW+6(2),TIMEHH

MP DW,=P'3600'

MVC DW+8,DW

* IC R0,TIMEHH

* BAL R14,TIMEDW

ZAP DW,P0

MVO DW+6(2),TIMEMM

MP DW,=P'60'

AP DW+8,DW

MP DW+8,=P'100'

* LH R1,TIMESS

* BAL R14,TIMEDW

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+15+L'EDITSEC-4

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,PUTLINE

MVC LINE,LINE-1

BR R9

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

RESTART XC INDEX,INDEX

MVC FLAGS,SPACES

MVC APTYPE(4),SPACES

XC APEND,APEND

LA R1,PARM

BAL R14,PUTPARM

RESTARTL LA R1,1(R1)

CLC SPACES(11),0(R1)

BE SAVELEN

CLC =C'|||',0(R1)

BNE RESTARTL

MVC SAVEPARM(188),0(R1)

LA R2,PARM+188

SR R2,R1

MVI 0(R1),C' '

MVC 1(0,R1),0(R1)

EX R2,*-6

SAVELEN S R1,=A(PARM+1)

LR R3,R1

BAL R14,PUTPARM

OI PUTAGAIN+1,X'F0'

CLI PARM,C','

BNE QCOPY

BAL R1,PUTERR

MAKEMSG 'CANNOT START PARM WITH ","'

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

ISITQUOT MVI FLAGQUOT,C' '

CLI 0(R8),C'C'

BE CHKQ02

CLI 0(R8),C'X'

BE CHKQ02

CLI 0(R8),C'P'

BE CHKQ02

BR R14

CHKQ02 CLI 1(R8),C'"'

BE CHKQ04

CLI 1(R8),C''''

BE CHKQ04

CLI 1(R8),C'*'

BE CHKQ04

BR R14

CHKQ04 MVI FLAGQUOT,C'Q'

BR R14

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

MVI FLAGALL,C'A'

SAVEFLAG MVC 0(1,R14),PARM

NI PUTAGAIN+1,X'0F'

BUMPPARM LA R1,PARM

LA R1,1(R1)

CLI 0(R1),C','

BH BUMPPARM+4

MVC PARM,1(R1)

S R1,=A(PARM-1)

LH R3,PARMLEN

SR R3,R1

STH R3,PARMLEN

CLI PARM,C' '

BNE QCOPY

BAL R1,PUTERR PARM= SEARCH ARG MISSING

MAKEMSG 'PARM= SEARCH ARG MISSING'

* MVC PARM,1(R1)

* SAVPARML STH R3,PARMLEN

* STH R3,PARMLEN-2

* * MVC SAVESTR,SPACES

* MVC SAVESTR+1(0),PARM

* EX R3,*-6

* STC R3,SAVESTR

QCOPY STH R3,PARMLEN

LA R14,FLAGCOPY

CLC =C'COPY,',PARM

BE SAVEFLAG

LA R14,FLAGLIST

CLC =C'LIST,',PARM

BE SAVEFLAG

LA R14,FLAGEDIT

CLC =C'EDITALL',PARM

BE SAVEFLAG-4

CLC =C'EDIT,',PARM

BE SAVEFLAG

LA R14,FLAGTEST

CLC =C'TEST,',PARM

BE SAVEFLAG

LA R14,FLAGWTO

CLC =C'WTO,',PARM

BE SAVEFLAG

PUTAGAIN NOP *+8

BAL R14,PUTPARM

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

LA R3,PARM

LA R3,1(R3)

CLC SPACES(11),0(R3)

BNE *-10

S R3,=A(PARM+1) MVC...

STH R3,PARMLEN

LA R8,PARM

BAL R14,ISITQUOT

CLI FLAGQUOT,C'Q'

BE ANALPARM

CLI FLAGEDIT,C'E'

BNE SAVELENG

TM PARMLEN+1,0 Q. ODD # CHARS IN STRING? FROM,TOOO

BZ QEDIT1 YES, GOOD

BAL R1,PUTERR EDIT OPERANDS NOT SAME LENGTH

MAKEMSG 'EDIT FROM/TO MUST BE SAME LENGTH'

QEDIT1 SRL R3,1 06 MVC,TOO 04 ME,TO

LA R14,PARM(R3) 03 02

BCTR R3,0

CLI 0(R14),C','

BE SAVELENG

BAL R1,PUTERR EDIT OPERANDS NOT SAME LENGTH

MAKEMSG 'EDIT FROM/TO MUST BE SAME LENGTH'

SAVELENG STH R3,PARMLEN

STH R3,PARMLEN-2

STC R3,CLC+1

STC R3,FOUNDMVC+1

LA R4,CHAR

LA R2,PARM-2

BAL R14,QFREQ

SR R4,R4

IC R4,CHAR

LA R5,INDEX(R4)

MVI 0(R5),C'A'

* C'MVCL' R3=3 LENGTH-1

LH R5,OFFSET R5=1 BACK UP TO THE FRONT

LR R6,R3 R6=3

SR R6,R5 R6=2 END LOC SO WE DON'T S0C5

STH R6,LASTPOSS

B GET

ADDR DC F'0'

NOTFOUND DS 0H

PUT L R2,ADDR

CLI FLAGCOPY,C'C'

BE PUTPUT

CLI FLAGFND,C'F'

BNE GET

PUTPUT AP #OUT,=P'1'

PUT OUT,(2)

CLI FLAGLIST,C'L'

BNE GET

CLI FLAGFND,C'F'

BNE GET

LA R1,130

LH R0,DCBLRECL-IHADCB+IN

CR R1,R0

BL *+6

LR R1,R0

BCTR R1,0

MVC LINE(0),0(R2)

EX R1,*-6

BAL R14,PUTLINE

GET GET IN

LA R1,0(R1)

LR R11,R1

AP #IN,=P'1'

MVI FLAGFND,C' '

ST R1,ADDR

LH R10,DCBLRECL-IHADCB+IN

TM DCBRECFM-IHADCB+IN,X'80'

BO *+8

LH R10,0(R1) RECFM=VB LENGTH

AR R10,R1

AH R1,OFFSET

SH R10,LASTPOSS

LA R7,256

LH R9,PARM-2

B LOOP

LA R1,256(R1)

LOOP LR R2,R10

SR R2,R1

SH R2,=H'1'

BM NOTFOUND

CR R2,R7

BL SHORT

TRT 0(256,R1),INDEX

BZ LOOP-4

* AP #CHARFND,=P'1'

B CLCIT

TRT TRT 0(0,R1),INDEX

SHORT AP #TRT,P1

EX R2,TRT

BZ NOTFOUND

CLCIT LR R2,R1

S R2,OFFSET

AP #CLC,P1

CLC CLC 0(0,R2),PARM

BE FOUND

CLCNXT LA R1,1(R1)

B LOOP

FOUND AP #CLCFND,=P'1'

MVI FLAGFND,C'F'

CLI FLAGEDIT,C'E'

BNE PUT

LA R14,PARM+2(R3)

FOUNDMVC MVC 0(0,R2),0(R14)

AP #CHANGES,=P'1'

CLI FLAGALL,C'A'

BNE PUT

B CLCNXT

PUTR1 MVC LINE,LINE-1

STM R14,R1,PUTPARM-16

IC R15,0(R1)

MVC LINE(0),1(R1)

EX R15,*-6

B PUTLINE+4

DC 4F'0'

PUTPARM MVC LINE,PARM

PUTLINE STM R14,R1,PUTPARM-16

CLI FLAGWTO,C'W'

BNE NOTWTO

MVC LINE-5(4),=H'90,0'

WTO MF=(E,LINE-5)

MVC LINE-5(5),LINE-6

NOTWTO LA R0,LINE-1

CLI FLAGTEST,C'T'

BNE PUTLINEP

* CLI LINE,C'('

* BE PUTLINEP

L R14,PUTERR-4

LTR R14,R14

BNZ *+8

L R14,PUTPARM-16

LA R14,0(R14)

SR R14,R13

ST R14,12(R13)

MVC LINE-7(6),=C'(....)'

UNPK LINE-6(5),14(3,R13)

TR LINE-6(4),HEX-240

MVI LINE-2,C')'

LA R0,LINE-8

PUTLINEP PUT SYSPRINT,(0)

MVC LINE-7(166),LINE-8

LM R14,R1,PUTPARM-16

BR R14

DC 2F'0'

PUTERR ST R1,PUTERR-4

OI RC,12

MVC LINE,LINE-1

SR R2,R2

IC R2,0(R1)

MVC LINE(0),1(R1)

EX R2,*-6

* LA R1,LINE+3(R2)

* LH R2,PARM-2

* MVC 0(0,R1),PARM

EX R2,*-6

BAL R14,PUTLINE

B Z

MVC 0(0,R4),0(R15)

TRT 0(0,R15),ISITCHAR

PRINTSTR EX R3,PRINTSTR-6

BNZ PRINTSTX

CH R3,=H'22'

BL *+8

EX 0,*

EX R3,PRINTSTR-12

LA R4,3(R3,R4)

LA R15,2(R3,R15)

BR R9

PRINTSTX LA R0,1(R3)

UNPK 0(3,R4),0(2,R15)

TR 0(2,R4),HEX-240

LA R4,2(R4)

LA R15,1(R15)

BCT R0,PRINTSTX+4

MVI 0(R4),C' '

LA R4,1(R4)

BR R9

DC F'0'

Z MVC LINE,LINE-1

CLI RC,0

BNE NOTOTALS

LA R10,PARMLEN

LA R11,LINE

MVC LINE-7,LINE-8

* OI #IN+4,X'0F'

* OI #CLCFND+4,X'0F'

* OI #CHANGES+4,X'0F'

* UNPK MSG+6(9),#CLCFND

* UNPK MSG+25(9),#IN

LH R3,PARMLEN

LA R0,1(R3)

CVD R0,DW

OI DW+7,X'0F'

UNPK LINE-1(3),DW+6(2)

MVI LINE-1,C' '

MVC LINE+3(3),=C'( )'

LA R15,CHAR

LA R4,LINE+4

SR R3,R3

BAL R9,PRINTSTR

LA R4,LINE+7

CLI LINE+5,C')'

BE *+12

MVI LINE+6,C')'

LA R4,LINE+8

LH R3,PARMLEN

LA R15,PARM

BAL R9,PRINTSTR

CLI FLAGEDIT,C'E'

BNE *+8

BAL R9,PRINTSTR

* LA R15,PARM

* LA R4,LINE+5

* BAL R9,PRINTSTR

* *

* MVC LINE+5(0),PARM

* EX R3,*-6

* LA R4,LINE+7(R3)

* MVC 0(3,R4),=C'( )'

* MVC 1(1,R4),CHAR

* LA R4,3(R4)

* CLI APTYPE,C'E'

* BL MOVECHAR

* *

* LA R0,1(R3)

* LA R15,PARM

* LA R4,LINE+5

* MVC LINE+4(88),SPACES

* UNPKTOTL UNPK 0(3,R4),0(2,R15)

* TR 0(2,R4),HEX-240

* LA R4,2(R4)

* LA R15,1(R15)

* BCT R0,UNPKTOTL

* MVC 0(2,R4),=C' ('

* UNPK 2(3,R4),CHAR(2)

* TR 2(2,R4),HEX-240

* MVI 4(R4),C')'

* LA R4,5(R4)

* *

* MOVECHAR MVC PUTERR-4(4),X0

* * MVC 1(L'MSG,R4),MSG

* * PUTTOT PUT SYSPRINT,LINE-1

* * MVC 1(88,R4),0(R4)

* * PUT SYSPRINT,LINE-1

* * B NOTOTALS

* * HEXTOT LA R0,1(R2)

* * LA R14,LINE

* * LA R15,PARM

* * UNPKSTR UNPK 0(3,R14),0(2,R15)

* * TR 0(2,R14),HEX-240

* * LA R14,2(R14)

* * LA R15,1(R15)

* * BCT R0,UNPKSTR

* * MVC 0(5,R14),=C' ( )'

* * UNPK 2(3,R14),CHAR(2)

* * TR 2(2,R14),HEX-240

* * MVI 4(R14),C')'

* * MVC 6(L'MSG,R14),MSG

* * CP #CHANGES,P0

* * BE *+16

* * UNPK 7+L'MSG(9,R14),#CHANGES

* * MVC 17+L'MSG(16,R14),=C'STRINGS CHANGED'

* * *

* * BAL R14,PUTLINE

* * B PUTTOT+4

MVC 0(6,R4),=C' USED '

LA R4,6(R4)

ST R4,Z-4

SR R2,R2

LA R3,#TRT

TOTLOOP MVC 1(10,R4),EDIT9

LA R1,9(R4)

EDMK 1(10,R4),0(R3)

ZAP 0(5,R3),P0

MVC 0(11,R4),0(R1)

LA R0,11(R4)

SR R0,R1

AR R4,R0

* LA R4,1(R4)

* CLI 0(R4),C' '

* BNE *-8

IC R2,5(R3)

MVC 1(0,R4),6(R3)

EX R2,*-6

LA R4,3(R4,R2)

LA R3,7(R3,R2)

CLI 0(R3),X'99'

BL TOTLOOP

BAL R14,PUTLINE

CLI 0(R3),X'FF'

BE NOTOTALS

LA R3,1(R3)

L R4,Z-4

B TOTLOOP

NOTOTALS BAL R9,TIME

CLI SAVEPARM,C'|'

BNE CLOSE

ZAP #IN,=P'0'

ZAP #CLCFND,=P'0'

MVI RC,0

* MVC DOC(64),PARM-2

CLOSE (IN,,OUT)

OPEN (IN,INPUT,OUT,OUTPUT)

MVC PARM(188),SAVEPARM+3

MVC SAVEPARM(188),SAVEPARM-1

MVC LINE,LINE-1

MVI LINE,C'-'

MVC LINE+1(70),LINE

BAL R14,PUTLINE

B RESTART

MSG DC C'FOUND ......... TIMES IN ......... RECORDS.'

CLOSE CLOSE (IN,,OUT,,SYSPRINT)

EXIT LH R15,RC-1

L 13,4(13)

L 14,12(13)

LM 0,12,20(13)

BR 14

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

* 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 YES, 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=80,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

POP PRINT

* ROUTINE TO PROCESS CHAR, HEX, PACKED STRINGS.

* INPUT = LENGTH-1 AND THE FIELD (1 OR 2 STRINGS)

* EXPECTED INPUT == 05C'ABC' 09X"C1C2C3" 05P'123'

* OUTPUT == 'C02ABC "X02ABC 'P070000000000123

* **NOT C R8,=A(PARM)

* APNOT CP AP#,P1

* * BE *+8

* * BAL R14,APERR BOTH EDIT OPER MUST BE QUOTED OR NOT QUOTED

* APERR BE,'BOTH EDIT OPER MUST BE QUOTED OR NOT QUOTED'

* APNOT LM R1,R9,ANALPARM-36 R2=0, NOT FOUND

* BR R9

AP90 MVC 0(3,R8),SPACES

LH R3,PARMLEN

B SAVELENG

* LM R1,R9,ANALPARM-36

* SR R2,R2 R2=0, NOT FOUND

* BR R9

DC 9F'0'

ANALPARM STM R1,R9,ANALPARM-36

LA R8,PARM

LR R7,R8

MVC APTYPE(4),SPACES

LH R3,PARMLEN

LA R0,0(R8,R3)

BCTR R0,0

ST R0,APEND

ZAP AP#,P0

B APAGAIN

AP# DC PL1'0'

APSIGN DC C' '

APTYPE DC 2CL2' '

APEND DC F'0'

APLOOP MVI 0(R8),C' '

LA R8,1(R8)

CLI FLAGEDIT,C'E' Q. EDIT?

* BE *+8 YES

* BAL R14,APERR 2 ARGS, BUT NOT EDIT.

APERR BNE,'2 ARGS, BUT NOT EDIT.'

APAGAIN BAL R14,ISITQUOT

CLI FLAGQUOT,C'Q'

APERR BNE,'BOTH ARGUMTNTS MUST OR MUST MOT BE QUOTED'

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

AP02 AP AP#,P1

CP AP#,P1

BNE *+12

LR R7,R8

MVC APTYPE,0(R8) SAVE BOTH C"

MVC AP03CLI+1(1),1(R8)

CP AP#,P2

APERR BH,'MORE THAN 2 ARGUMENTS'

LA R6,1(R8)

AP02L LA R6,1(R6)

AP03CLI CLI 0(R6),0

** CLC 0(1,R6),1(R8)

BE AP04

CLC SPACES(11),0(R6)

* BNE AP02L

* BAL R14,APERR MISSING ENDING "

APERR BE,'MISSING ENDING "'

B AP02L

AP04 LR R3,R6

SR R3,R8

SH R3,=H'3' C"ABC",C

STH R3,PARMLEN-2

CLI 0(R8),C'C'

BNE APNOTC

* -------------------CHAR ROUTINE-----------------

MVC 0(0,R7),2(R8)

EX R3,*-6

LA R7,2(R7,R3) NEXT AVAILABLE LOC

LA R8,1(R6)

APSAVLEN CP AP#,P1

BNE APCLCLEN

STH R3,PARMLEN

CLI 0(R8),C','

BE APLOOP

CLI FLAGEDIT,C' '

APERR BNE,'EDIT W/O SECOND OPERAND'

CLI 1(R8),C' '

BE AP90

APERR B,'BAD CONTINUATION'

APCLCLEN CP AP#,P2

* BE *+8

APERR BNE,'MORE THAN 2 ARGUMENTS'

CH R3,PARMLEN

BE AP90

* BAL R14,APERR FROM/TO LENGTHS DON'T MATCH

APERR B,'FROM/TO LENGTHS DO NOT MATCH'

* ---------------------HEX ROUTINE-----------------

TRT 2(0,R8),ISITHEX

APNOTC CLI 0(R8),C'X' X'C1C2',

BNE APNOTX

TM PARMLEN-1,1 Q. ODD # DIGITS?

* BO *+8

* BAL R14,APERR ODD # HEX DIGITS

APERR BZ,'ODD # OF HEX DIGITS'

EX R3,APNOTC-6

* BZ *+8

* BAL R14,APERR INVALID HEX

APERR BNZ,'INVALID HEX DIGIT'

LA R3,1(R3)

SRL R3,1

LR R0,R3

SH R3,=H'1'

* BNM *+8

* BAL R14,APERR NEX LENGTH=0

APERR BM,'HEX LENGTH=0'

LA R8,2(R8)

PACKHEX TRT 0(2,R8),ISITHEX

* BZ *+8

* BAL R14,APERR INVALID HEX

APERR BNZ,'INVALID HEX'

TR 0(2,R8),MAKEHEX

PACK 0(2,R7),0(3,R8)

LA R7,1(R7)

LA R8,2(R8)

BCT R0,PACKHEX

LA R7,1(R7)

LA R8,1(R8)

B APSAVLEN

* ------------------PACKED ROUTINE-----------------

** PACK 0(0,R7),2(0,R8)

PACK 0(0,R7),12(0,R13)

TRT 2(0,R8),ISIT# R8=FROM

APNOTX MVC APSIGN,2(R8) R7=TO

CLI 2(R8),C'-' R7=TO

BNE NOTMINUS

SH R3,=H'1'

MVC 2(55,R8),3(R8)

L R0,APEND

BCTR R0,0

ST R0,APEND

NOTMINUS EX R3,APNOTX-6 R7=TO

* BZ *+8 R3=LEN-1

* BAL R14,APERR P'###' NOT NUMERIC

APERR BNZ,'P"###" NOT NUMERIC'

LR R1,R3 FROM LENGTH-1

LA R3,1(R3)

SRL R3,1

LR R14,R3

SLL R14,4

LA R15,0(R1,R14)

MVC 12(48,R13),2(R8)

EX R15,APNOTX-12

LA R8,4(R8,R1) P'123',

LA R7,0(R7,R3)

NI 0(R7),X'FD'

CLI APSIGN,C'-'

BE *+8

NI 0(R7),X'FC'

LA R7,2(R7)

MVI FLAGPACK,C'P'

B APSAVLEN

* DC F'0'

* APERR LA R14,0(R14)

* SH R14,=H'4'

* ST R14,APERR-4

* SR R14,R13

* ST R14,12(R13)

* UNPK APERRMSG+2(5),14(3,R13)

* TR APERRMSG+2(4),HEX-240

* MVI APERRMSG+6,C')'

* S R8,=A(PARM)

* LA R1,LINE(R8)

* MVI 0(R1),C'!'

* BAL R14,PUTLINE

* ** MVC APERRQQ,0(R2)

* BAL R1,PUTERR

* APERRMSG MAKEMSG '(....), STRING SYNTAX ERROR'

* DC AL1(L'APERRMSG-1) +L'APERRQQ)

* APERRMSG DC C'(....), STRING SYNTAX ERROR'

* APERRQQ DC CL16' '

* ========================= 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

P0 DC P'0'

P1 DC P'1'

P2 DC P'2'

QFREQFQ DC C' '

QFREQRC DC H'0'

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

FLAGWTO DC C' '

FLAGTEST DC C' '

FLAGS DS 0CL6

FLAGLIST DC C' '

FLAGCOPY DC C' '

FLAGEDIT DC C' '

FLAGALL DC C' '

FLAGPACK DC C' '

FLAGFND DC C' '

FLAGQUOT DC C' '

* ??? USED #### TRTS AND ### CLCS TO FIND ### STRINGS IN ### RECORDS

EDIT9 DC X'40202020202020202120'

#TRT DC PL5'0',AL1(07),CL8'TRTS AND'

#CLC DC PL5'0',AL1(11),CL12'CLCS TO FIND'

#CLCFND DC PL5'0',AL1(09),CL10'STRINGS IN'

#IN DC PL5'0',AL1(07),CL8'RECORDS.',X'FE'

#CHANGES DC PL5'0',AL1(15),CL16'STRINGS CHANGED,'

#OUT DC PL5'0',AL1(14),CL15'RECORDS WRITTEN',X'FF'

DS 0H

DC X'00'

RC DC X'00',C' '

CHAR DC C' '

OFFSET DC HL2'0'

LASTPOSS DC HL2'0'

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

INIMSG DC CL133' SCAN1 (EDIT2) V01.02 &SYSDATE &SYSTIME'

ISITCHAR EQU *-64

DC X'00',11C' ',4X'00'

DC X'00',8C' ',7X'00'

DC 2X'00',8C' ',6X'00'

DC 9C' ',7X'00'

DC C' ',9X'00',6C' '

DC C' ',8X'00',6C' '

DC 16C''

DC C' ',9X'00',6C' '

DC C' ',8X'00',6C' '

DC 10X'00',6C' '

* THIS GOES WITH ANALPARM ROUTINE

ISITHEX EQU *-192

DC C' ',XL6'00',9C' ' ISIT HEX LINE

MAKEHEX EQU *-192

DC X'40FAFBFCFDFEFF',9C' ' MAKE HEX LINE

DC CL16' '

DC 10X'00',6C' ' ISIT HEX LINE

DC C'0123456789',CL6' ' MAKE HEX LINE

CNOP 6,0

HEX DC C'0123456789ABCDEF',C' '

DS 0D

ISIT# EQU *-240

X0 EQU *

TRTPACK DC X'00000000000000000000080804040804'

DS XL144

SPACES DS CL96

LINE DS CL133,CL123,CL33

SAVEPARM DS CL133,CL123,CL33

DS H

PARMLEN DS H

PARM DS CL133,CL123

DW DS 2D

SAVESTR DS CL48

INDEX DS XL256

ORG TRTPACK+16

DOC EQU *

@ 'SCAN1 WAS WORKING AT 200 LINES OF CODE, AND 2K'

@ 'ADDING QUOTES, OPIONS, AND TOTALS, NOW 1,000 LINES AND 7K'

@ ' '

@ '//SCAN EXEC PGM=SCAN1,PARM="MVC" COPY RECS CONTAINING MVC'

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

@ '//SYSPRINT DD SYSOUT=*'

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

@ '//OUT DD DISP=(,CATLG),DSN= '

@ ' '

@ 'PARM=DOC PRINT PROGRAM DESCRIPTION (MUST BE FIRST IN PARM'

@ ' =COPY ALL RECORDS'

@ ' =LIST PRINTS RECORDS ON //SYSPRINT'

@ ' =TEST PRINT LOCATIONS OF (ERROR/ALL) MSGS'

@ ' =EDIT (REPLACE, REALLY) ONE STRING WITH ANOTHER OF SAME LEN'

@ ' =EDITALL REPLACE ALL STRINGS IN THE RECORD'

@ ' ||| ALLOWS MULTIPLE (TEST) RUNS, USING SAME FILE, AND'

@ ' DIFFERENT PARM FIELDS. I PUT THE ||| IN FOR TESTING,'

@ ' AND LEFT IT. EG: IF YOU CODE ...'

@ ' '

@ 'PARM=''MVC|||EDIT,MVC,XYZ|||EDITALL,MVC,XYZ|||EDITALL,MV,MM'''

@ ' THE FIRST PASS WILL FIND ALL RECORDS CONTAINING MVC'

@ ' THE SECOND PASS WILL CHANGE THE FIRST MVC TO XYZ'

@ ' THE THIRD PASS WILL CHANGE EVERY MVC IN EACH RECORD.'

@ ' THE FORTH PASS WILL CHANGE MVVVVVVVV TO MMMMMMMMM'

@ ' '

@ 'PARM="DOC,COPY,EDIT,MVC,YES" DOC,MUST BE FIRST, COPY ENTIRE FILE'

@ ' CHANGE FIRST MVC YES IN EACH RECORD'

@ 'PARM="DOC,MVC" PRINT DOC, FIND MVC RECORDS.'

@ 'PARM="EDIT,MVC,WER" SELECT RECS CONTAINING MVC, CHANGE TO WER'

@ 'PARM="COPY,MVC" COPY ALL RECS,COUNT RECORDS CONTAINING MVC'

@ 'PARM="COPY,EDIT,MVC,YES" COPY ALL RECORDS, CHANGE MVC TO YES'

@ ' (THE EDIT STRINGS MUST BE THE SAME LENGTH)'

@ 'PARM="SAVE|||PARM|||SAVEPARM|||EDIT,SAVE,OOPS"'

@ ' ||| IS A PARM SEPARATER. THIS SCANS THE SAME //IN FILE'

@ ' 4 TIMES LOOKING FOR "SAVE", THEN "PARM", THEN'

@ ' "SAVEPARM" AND LAST EDITING "SAVE" TO "OOPS"'

@ ' '

@ 'CAN HAVE QUOTED STRINGS IN PARM. EG'

@ ' '

@ 'PARM C"PUT,LINE" FIND PUT,LINE STRINGS.'

@ 'PARM EDIT,C"PUT",C"NOP" FIND AND CHANGE PUT TO NOP'

@ ' AGAIN, STRINGS MUST BE SAME LENGTH'

@ 'AND YOU CAN HAVE PACKED AND HEX STRINGS. EG:'

@ ' X"C1C2C3" MUST HAVE EVEN # HEX DIGITS'

@ ' P"123" PACKED 123 LENGTH =2'

@ ' P"-1234" PACKED NEGATIVE -1234 LENGTH =3'

@ ' FOR PACKED #S, THE SIGN MUST BE ###C OR ###D (MINUS)'

@ ' NOT ###F, WHICH IS USED FOR PRINTING.'

@ ' '

@ ' IF YOU ARE DOING AN EDIT, THEN EITHER BOTH OR'

@ ' NEITHER STRINGS MUST BE QUOTED. AND SAME LENGTH.'

@ ' '

@ 'ONE OF A SET OF SCAN PROGRAMS:'

@ 'FASTSCAN SCAN FOR MULTIPLE STRINGS IN 1 PASS OF FILE.'

@ 'MYSCAN SCAN/EDIT WITH SEVERAL OPTIONS'

@ 'SCANFREQ READ A FILE, CALC CHAR FREQUENCY.'

@ 'SCAN1 ONLY 1 ARGUMENT, SPECIFIED IN PARM FIELD'

ENDDOC EQU *

ORG

END SCAN1