RACHAEL
AGO .START
IBM ASSEMBLY LANGUAGE PROGRAM TO SCAN A SEQUENTIAL FILE FOR STRING
EMAIL ME AND i'LL EMAIL YOU THE PROGRAM.
THIS STUPID SITE DOESN'T CUT+PASTE CORRECTLY.
THIS FIRST SECTION WAS WRITTEN TO FACILITATE TESTING ON Z390.ORG
SET SYSPRINT=C:\USERS\LIN\DOCUMENTS\Z390CODE\RACHAEL.SYSPRINT.TXT
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\RACHAEL.MLC
ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\RACHAEL.MLC TEST PARM('$C"MVC"')
C:\USERS\LIN\DOCUMENTS\Z390CODE\RACHAEL
SET path=C:\USERS\LIN\DOCUMENTS\Z390CODE\
SET SYSPRINT=RACHAEL.SYSPRINT.TXT
SET IN=RACHAEL.MLC
EZ390 RACHAEL.MLC TEST PARM(C'"MVC"')
--------------------------------------NOTES--------------
RACHAEL WAS WRITTEN USING SPFLITE, TO BE TESTED ON Z390.ORG
YOU'LL WANT TO FIX THE SYSPRINT DCB.
YOU CAN USE DEVTYPE TO DETERMINE WHETHER THERE'S A DD CARD.
ALL MY FIRST REPORTS WERE DONE VIA WTO.
THE PADDING AT THE END ROUNDS THE PGM UP TO A 4K BOUNDARY,
WHICH MAKES TESTING ON Z390 EASIER (FOR ME AT LEAST).
YOU CAN TAKE IT OUT. THERE'S NO BENEFIT ON A MAINFRAME.
MANY YEARS AGO, I WROTE A PROGRAM TO SCAN A LARGE TAPE FILE FOR
A STRING (OR MULTIPLE STRINGS) SPECIFIED IN THE PARMFIELD.
JOE BLANK'S DUMPER PROGRAM, THAT WAS LATER RENAMED FILEAID WAS BETTER.
BUT, AT 80 YEARS OLD, THIS IS JUST MENTAL EXERCISE NOW.
SPECIFY THE CHARACTER, OR HEX, STRING IN THE PARM FIELD, AND THE
SCAN GOES PRETTY FAST. I USE A TABLE THAT I MADE UP ON THE FLY TO
SELECT THE LEAST FREQUENTLY CHARACTER TO SEARCH ON, AND ONLY DO A
COMPARE WHEN I'VE FOUND ONE.
IT SEEMS TO RUN FAIRLY WELL. IF YOU FIND A BUG, LET ME KNOW.
.START ANOP
RACHAEL START 0 REWRITE OF MY CABUNCH PROGRAM
DC 18F'-1' TO SEE IF I CAN STILL CODE ANYTHING.
ORG RACHAEL SO FAR, NOT LOOKING GOOD.
USING *,13,12
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
BR EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
SAVE (14,12)
ST R15,8(R13)
ST R13,4(R15)
LA R13,0(R15)
LA R10,4015
LA R12,1(R10,R13)
L R1,0(R1)
LH R2,0(R1)
SH R2,=H'1'
BM NOPARM
MVC PARMFLD(0),2(R1)
EX R2,*-6
B BEGIN
NOPARMM DC H'18,0',C'PARM= REQUIRED'
NOPARM LA R1,NOPARMM
BAL R14,REPORT
B DOCEND12
ORG
*
PUSH PRINT
PRINT NOGEN
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FB,LRECL=133
IN DCB DDNAME=IN,DSORG=PS,MACRF=GM,EODAD=EOD,LRECL=80,RECFM=FT
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM
NOT DCB DDNAME=NOT,DSORG=PS,MACRF=PM
POP PRINT
*
ENDREC DC A(RECORD+80)
RC DC X'00'
DW DC D'0'
SPACES DC CL32' '
LINEWTO DC H'88,0',C' '
LINE DC 2CL133' '
ED5 DC X'402020206B2020206B212020'
*
QHEX EQU *-193
DC 6X'00',41C' ',10X'00',6C' '
TRHEX EQU *-193
DC X'0A0B0C0D0E0F',41C' ',X'00010203040506070809'
*
#RECORDS DC PL8'0',CL24' RECORDS READ'
#CLC DC PL8'0',CL24' STRING COMPARES DONE'
#FOUND DC PL8'0',CL24' STRINGS FOUND'
#NOTFND DC PL8'0',CL24' RECORDS W/O STRING'
DC X'FF'
* ------------------------------------------------------
COUNTS LA R2,#RECORDS
MVC LINE,LINE-1
COUNTSL MVC LINE(L'ED5),ED5
EDMK LINE(L'ED5),3(R2)
MVC LINE+L'ED5(24),8(R2)
LA R1,LINEWTO
BAL R14,REPORT
LA R2,32(R2)
CLI 0(R2),0
BE COUNTSL
BR R9
* -----------------------------------------------------
EOD BAL BR,COUNTS
B END
ODDHEXM DC H'27,0',C'HEX MUST BE EVEN # ( )'
ODDHEX LA R1,ODDHEXM
MVC ODDHEXM+24(2),0(R14)
BAL R14,REPORT
B DOCEND12
BADHEXM DC H'26,0',C'INVALID HEX DIGIT (..)'
BADHEX LA R1,BADHEXM
MVC BADHEXM+23(2),0(R14)
BAL R14,REPORT
DOCEND12 MVI RC,12
DOCEND BAL R9,PRINTDOC
END BAL BR,CLOSE
SR 15,15
IC 15,RC
L R13,4(R13)
L 14,12(13)
LM 0,12,20(13)
BR R14
* --------------------------------------------------
PRINTDOC LM R2,R3,=A(DOC,ENDDOC-3)
MVC LINE,LINE-1
CLC =C'RACH ',0(R2) Q. DID WE OVERLAY THE DOC
BNER R9 YES, DON'T TRY TO PRINT IT
PRINTDOL MVC LINE(LDOC),0(R2)
LA R1,LINEWTO
BAL R14,REPORT
LA R2,LDOC(R2)
CR R2,R3
BL PRINTDOL
BR R9
* ---------------------------------------------------
MVC LINE(0),4(R1)
REPORT ST R14,DW+4
ST R1,DW
TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BZR R14
*
* WTO MF=(E,(1))
* BO REPORT2
* OPEN (SYSPRINT,OUTPUT)
REPORT2 L R1,DW
C R1,=A(LINEWTO)
BE REPORT4
LH R14,0(R1)
SH R14,=H'5'
MVC LINE,LINE-1
EX R14,REPORT-6
REPORT4 PUT SYSPRINT,LINE
MVC LINE,LINE-1
L R14,DW+4
BR R14
* ---------------------------------------------------
PUSH PRINT
PRINT NOGEN
OPENIN MVC OPENMSGT(8),DCBDDNAM-IHADCB(R2)
OPEN ((2),INPUT)
B OPENM
OPENOUT MVC OPENMSGT(8),DCBDDNAM-IHADCB(R2)
OPEN ((2),OUTPUT)
POP PRINT
*PENM WTO MF=(E,OPENMSG)
OPENM LA R1,OPENMSG
*
LH R0,DCBLRECL-IHADCB(R2)
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSGT+23(5),DW+5(3)
LH R0,DCBBLKSI-IHADCB(R2)
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSGT+37(5),DW+5(3)
UNPK OPENMSGT+49(3),DCBRECFM-IHADCB(2,R2)
TR OPENMSGT+49(2),HEX-240
MVI OPENMSGT+51,C' '
*
BAL R14,REPORT
BR R3
OPENMSG DC AL2(L'OPENMSGT+4,0)
OPENMSGT DC C'12345678 OPENED, LRECL=..... BLKSIZE=,,,,, RECFM=XXX'
*PENMSG DC H'19,0',C'12345678 OPENED'
*
OPENPRT LA R2,IN
MVC OPENMSG+4(8),DCBDDNAM-IHADCB(R2)
OPEN (IN,INPUT)
MVC DCBLRECL-IHADCB+SYSPRINT,DCBLRECL-IHADCB+IN
MVC DCBBLKSI-IHADCB+SYSPRINT,DCBBLKSI-IHADCB+IN
MVC DCBRECFM-IHADCB+SYSPRINT,DCBRECFM-IHADCB+IN
OPEN (SYSPRINT,OUTPUT)
BAL R3,OPENM
BR R9
* ---------------------------- 'CLOSED '
CLOSEMSG DC H'21,0',C'12345678 NOT OPEN'
*
CLOSEIT MVC CLOSEMSG+13(8),=C'NOT OPEN'
TM DCBOFLGS-IHADCB(R3),DCBOFOPN
BZ WTOCLOSE-6
CLOSE ((3))
MVC CLOSEMSG+13(8),=C'CLOSED '
*
MVC CLOSEMSG+4(8),DCBDDNAM-IHADCB(R3)
*TOCLOSE WTO MF=(E,CLOSEMSG)
WTOCLOSE LA R1,CLOSEMSG
BAL R14,REPORT
BR R2
CLOSE LA R3,IN
BAL R2,CLOSEIT
LA R3,OUT
BAL R2,CLOSEIT
LA R3,NOT
BAL R2,CLOSEIT
LA R3,SYSPRINT
BAL R2,CLOSEIT
BR R9
* ----------------------------------------
BEGIN BAL R9,OPENPRT
BAL R9,QPARM
LOOP BAL R9,READ
BAL R9,SCAN
B LOOP
*
READ MVC RECORD,RECORD-1
GET IN,RECORD
AP #RECORDS,=P'1'
LH R14,DCBLRECL-IHADCB+IN
LA R14,RECORD(R14)
ST R14,ENDREC
BR R9
*
USING DSECT,4
SCAN LA R5,RECORD
L R6,ENDREC
S R6,DLEN
LA R4,SRCHTBL
LA R0,255
MVC SCANCLI+1(1),DCHAR
*
SCAN10 L R14,DFREQLOC
AR R14,R5
USECLI B SCANCLI
*
USETRT L R1,DTRTADDR
LR R2,R6
SR R2,R14
BM NOTFND
BCTR R2,0
CR R2,R0
BL *+6
LR R2,R0
EX R2,SCANTRT
BNZ TRTFND
LA R5,1(R2,R5)
B SCAN10
SCANTRT TRT 0(0,R14),0(R1)
*
SCANCLI CLI 0(R14),C' '
SCANCLIB BE CHARFND
LA R14,1(R14)
LA R5,1(R5)
CR R5,R6
BNH SCANCLI
B NOTFND
*
TRTFND LR R5,R1
S R5,DFREQLOC
*
CHARFND L R15,DLEN
AP #CLC,=P'1'
EX R15,COMPSTR
BE FOUND
LA R5,1(R5)
B SCAN10
COMPSTR CLC DSTRING(0),0(R5)
*
FOUND AP #FOUND,=P'1'
TM DCBOFLGS-IHADCB+OUT,DCBOFOPN
BZ WRITFND
PUT OUT,RECORD
BR R9
*RITFND WTO MF=(E,RECORD-5)
WRITFND LA R1,RECORD-5
BAL R14,REPORT
BR R9
NOTFND AP #NOTFND,=P'1'
TM DCBOFLGS-IHADCB+NOT,DCBOFOPN
BZR R9
PUT NOT,RECORD
BR R9
*
* ALL THE CODE FROM HERE TO THE END IS PARM FIELD PEOCESSING.
*
WTOPARM DC H'139,0',C'RACHAEL, 01.01 &SYSDATE &SYSTIME PARM='
PARMFLD DC CL104' '
QPARM ST R9,QP90-4
* WTO MF=(E,WTOPARM)
* LA R1,WTOPARM
* BAL R14,REPORT
*
QP02 CLI PARMFLD,C'A' THIS SECTION DOES THE COMMA
BNL QDD SUBSTITUTE PROCESSING.
SR R1,R1
IC R1,PARMFLD
LA R14,FIXCOMMA(R1)
MVI 0(R14),C','
TR PARMFLD,FIXCOMMA
MVC PARMFLD,PARMFLD+1
* WTO MF=(E,WTOPARM)
LA R1,WTOPARM
BAL R14,REPORT
B QDD
*
QDDLOOP MVC PARMFLD,PARMFLD+4
QDD CLC =C'OUT',PARMFLD
BNE NOTDDOUT
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
MVC DCBBLKSI-IHADCB+OUT,DCBBLKSI-IHADCB+IN
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
LA R2,OUT
BAL R3,OPENOUT
B QDDLOOP
*
NOTDDOUT CLC =C'NOT',PARMFLD
BNE NOTDDNOT
MVC DCBLRECL-IHADCB+NOT,DCBLRECL-IHADCB+IN
MVC DCBBLKSI-IHADCB+NOT,DCBBLKSI-IHADCB+IN
MVC DCBRECFM-IHADCB+NOT,DCBRECFM-IHADCB+IN
LA R2,NOT
BAL R3,OPENOUT
B QDDLOOP
* ------------------------------------------------------
NOTDDNOT CLC =C'TRT',PARMFLD
BNE *+12
NI USECLI+1,X'0F'
B QDDLOOP
CLC =C'CLI',PARMFLD
BNE QP10
OI USECLI+1,X'F0'
B QDDLOOP
* ------------------------------------------------------
QP10 LA R3,PARMFLD
LA R4,SRCHTBL
XC 0(LDSECT,R4),0(R4)
USING DSECT,4
CLC =C'MAX=',PARMFLD
BNE *+8
EX 0,* TO BE ADDED LATER
*
CLI 0(R3),C'+' Q. IS LOCATION AN OFFSET?
BNE *+14
MVC DPLUS,0(R3) YES, SAVE THE FLAG
LA R3,1(R3)
*
CLI 0(R3),C'0' Q. LOCATION, LENGTH SPECIFIED?
BL QPSTRING NO, GO LOOK AT STRING.
LA R2,DFROM YES, POINT TO FIELD.
QP12 BAL R9,GET#R3 GET THE #
ST R0,0(R2) SAVE
CLI 0(R3),C','
BE *+8
BAL R14,PARMERR INVALID LOC/LEM DELIMITER
LA R3,1(R3) POINT PAST ,
CLI 0(R3),C'0' Q. LENGTH?
BL QPSTRING NO, GO GET STRING
LA R0,DFROM
CR R2,R0
BE *+8
BAL R14,PARMERR LENGTH SPECIFICATION ERROR
LA R2,DTO
B QP12
*
PARMERRW DC AL2(L'PARMERRM+4,0)
PARMERRM DC C'PARM ERROR .... AT (...) ........ '
PARMERR MVC PARMERRM+25(8),0(R3)
LA R14,0(R14)
SR R14,R13
SH R14,=H'4'
ST R14,DW
UNPK PARMERRM+11(5),DW+2(3)
TR PARMERRM+11(4),HEX-240
MVI PARMERRM+15,C' '
*
LA R0,PARMFLD
SR R3,R0
CVD R3,DW
OI DW+7,X'0F'
UNPK PARMERRM+20(3),DW+6(2)
* WTO MF=(E,PARMERRW)
LA R1,PARMERRW
BAL R14,REPORT
B DOCEND12
HEX DC C'0123456789ABCDEF'
*
GET#R3 CLI 0(R3),C'0' CONVERT THE # POINTED TO BY R4
BNL *+8 INTO PACKED AND BINARY
BAL R14,PARMERR INVALID LOC, LEN ##
LR R14,R3
LR R15,R14
LA R15,1(R15)
CLI 0(R15),C'0'
BNL *-12
LR R1,R15
SR R15,R14
BCTR R15,0
PACK DW,0(0,R14)
EX R15,*-6
CVB R0,DW
LR R3,R1
BR R9
*
QPSTRING MVC DDATATYP,0(R3)
MVC DSTRING,SPACES
CLI 0(R3),C'C'
BE QPCHAR
CLI 0(R3),C'X'
BE *+8
BAL R14,PARMERR INVALID DATA TYPE
*
LA R15,DSTRING
SR R1,R1
MVC 12(57,R13),1(R3)
LA R14,13(R13)
PACKHEX TRT 0(2,R14),QHEX
BNZ BADHEX
TR 0(2,R14),TRHEX
PACK 0(2,R15),0(3,R14)
LA R1,1(R1)
LA R15,1(R15)
LA R14,2(R14)
MVI 0(R15),C' '
LA R3,2(R3)
CLC 1(1,R14),12(R13)
BE ODDHEX
CLC 0(1,R14),12(R13)
BNE PACKHEX
SH R1,=H'1'
ST R1,DLEN
C R1,=A(L'DSTRING)
BL QPCHARZ
LA R1,LONGSTR
BAL R14,REPORT
BAL R14,PARMERR
LONGSTR DC H'27,0',C'SEARCH STRING TOO LONG.'
*
QPCHAR LA R14,1(R3)
QPCHARL LA R14,1(R14)
CLC 1(1,R3),0(R14)
BE QPCHARE
CLC SPACES(32),0(R14)
BNE QPCHARL
BAL R14,PARMERR MISSING STRING END DELIMITER
*
QPCHARE LA R0,3(R3)
LR R1,R14
SR R1,R0
MVC DSTRING(0),2(R3)
EX R1,*-6
ST R1,DLEN
*
QPCHARZ BAL R9,LISDSECT
* CLC 1(6,R14),SPACES
* BE QFREQ
* EX 0,* MULTIPLE PARMS TO BE DONE LATER.
B QFREQ
*
LISDSECT LR R1,R4
LA R0,7
LA R15,LINE
MVC LINE,LINE-1
LISDSECL UNPK 0(9,R15),0(5,R1)
TR 0(8,R15),HEX-240
MVI 8(R15),C' '
LA R1,4(R1)
LA R15,9(R15)
BCT R0,LISDSECL
CLI DDATATYP,C'C'
BE LISDSECC
CLI DDATATYP,C'X'
BE *+8
EX 0,* INVALID DATA TYPE
L R14,DLEN
LA R0,1(R14)
LISDUNPK UNPK 0(3,R15),0(2,R1)
TR 0(2,R15),HEX-240
LA R15,2(R15)
LA R1,1(R1)
BCT R0,LISDUNPK
MVI 0(R15),C' '
B LISDSECC+6
*
LISDSECC MVC 0(28,R15),0(R1)
WTO MF=(E,LINEWTO)
LA R1,LINEWTO
BAL R14,REPORT
MVC LINE,LINE-1
BR R9
*
QFREQ LA R4,SRCHTBL
L R0,DLEN
LA R2,DSTRING
LR R1,R2
SR R3,R3
MVI DCHARFQ,C'0'
QF10 SR R15,R15
IC R15,0(R2)
L R14,=A(FREQTBL)
AR R14,R15
CLC 0(1,R14),DCHARFQ
BNL QF20
MVC DCHARFQ,0(R14)
MVC DCHAR,0(R2)
LR R14,R2
SR R14,R1
ST R14,DFREQLOC
*
QF20 LA R2,1(R2)
BCT R0,QF10
*
L R14,=A(TRTABLE+256)
SR R15,R15
IC R15,DCHAR
SR R14,R15
ST R14,DTRTADDR
*
BAL R9,LISDSECT
B QP90
*
DC F'0'
QP90 L R9,QP90-4
BR R9
*
LTORG
FIXCOMMA DC 256AL1(*-FIXCOMMA)
*
WTOLRECL DC H'80,0',C'LRECL='
LRECL DC CL5' '
DC C' PRECL='
PRECL DC CL5' '
*
DC H'88,0'
DC C' '
RECORD DS 0CL120
*
CNOP 0,8
FREQTBL DC 256X'05'
ORG FREQTBL
DC X'151413'
ORG FREQTBL+X'20' BLANK + SPECIAL CHARS
DC X'15',15X'09'
ORG FREQTBL+X'30' ASCII NUMBERS
DC X'14',9X'12',6X'09'
ORG FREQTBL+X'40' ASCII UPPER CASE LETTERS
DC X'091411111114111111141011121212141110121212131010091309'
DC 6X'08' SPECIAL CHARS,THEN LOWER CASE LETTERS
DC X'091411111114111111141011121212141110121212131010091309'
DC 5X'08'
ORG FREQTBL+X'80'
DC X'05141111111411111114',6X'05' EBCDIC LOWER CASE
DC X'05111112131314110013',6X'05' "
DC X'05051313120909081209',6X'05' "
DC 16X'05'
ORG FREQTBL+X'C1'
DC X'141212121412121214',6X'05' UPPER CASE
DC X'05121212141414120914',6X'05'
DC X'05051414121111090909',6X'05'
DC X'15151413131313131313',6X'05'
ORG
TRTABLE DC 2XL256'00'
*
SRCHTBL DC 3CL4' '
*
DOC DC CL64'RACHAEL, VER 01.01, ASM &SYSDATE AT &SYSTIME'
DC C'SCANS A SEQUENTIAL FILE FOR A PARAMETER SPECIFIED IN THE PARM '
DC C' '
DC C' PARM= C"ABC" LIST RECS CONTAINING STRING ON SYSPRINT '
DC C' PARM= OUT,C"ABC" WRITE RECS CONTAING STRING TO //OUT '
DC C' PARM= NOT,X"C4C5C6" WRITE RECS NOT CONTAINING STRING TO //NOT '
DC C' PARM= OUT,NOT,C"BOTH" WRITE BOTH FILES '
DC C' '
DC C' PARM=C"ABC" '
DC C' PARM=X"C1C2C3" '
*DC C' PARM=3,C"123" LOCATION 3 MUST BE "123" '
*DC C' PARM=3,9,C"ABC" STRING "ABC" MUST START IN LOC 3-9 '
*DC C' PARM=123 -- ERROR, MUST BE QUOTED '
*DC C' PARM="123",+1,9,ABC '
DC C' '
DC C'//SYSPRINT DD SYSOUT=* PRINT FILE '
DC C'//IN DD DSN= INPUT FILE '
DC C'//OUT DD DSN= OUTPUT (SELECTED) FILE '
DC C'//NOT DD DSN= OUTPUT (NOT SELECTED) FILE '
*DC C' '
LDOC EQU 64
* ----------------------------------
DSECT DSECT 0
DFROM DS F FROM LOC TO CHECK
DTO DS F TO LOC TO CHECK
DLEN DS F LENGTH OF STRING
DFREQ DS F SEARCH CHAR ADDR
DFREQLOC DS F # BYTES TO BACK UP FOR STRING COMPARE
DTRTADDR DS F ADDR OF TRT TABLE TO DO SCAN
DPLUS DS C + = OFFSET FROM PRIOR TEST
DCHAR DS C CHAR TO SEARCH FOR
DCHARFQ DS X FREQUENCY OF CHAR
DDATATYP DS C DATA TYPE, C(HAR) (HE)X
DSTRING DS CL36 STRING
LDSECT EQU *-DSECT =64
RACHAEL CSECT
* ----------------------------------
ENDDOC DC X'00'
*
@@PAD#1 EQU ((*-RACHAEL)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-RACHAEL)
ORG *+@@PAD#2
*
END RACHAEL