html_search_pgm
This file contains 4 sample programs, all of which have been tested, and work. The first is a simple copy, copying all the records from the IN file to the OUT file. The second is a minimal search program, copying only records that contain a specified character string. The third is a fully functional search program that does the search based on the least frequently used character in the search string, and reporting statistics on how the program performed. The forth program was an exercise to see if I could still code. The answer is, just barely. But the program is able to compare timing, using either TRT or CLI to look for a character in the string.
First is a simple copy program.
COPY START 0
YREGS
USING *,13
B 20(R15) ALL PROGRAMS HAVE A SAVE AREA POINTED TO
DC 4F'0' BY REGISTER-13. OUR SAVE AREA IS CHAINED
STM 14,12,12(13) TO OUR CALLER'S SAVE AREA. I'VE CHEATED
ST 13,4(15) A BIT AND USED REG-13 AS BOTH S/A ADDR,
ST 15,8(13) AND ALSO MY BASE REGISTER.
LR 13,15 I DIDN'T NEED IT, IT'S JUST HABIT.
*
OPEN (IN,INPUT) NEXT, WE'LL OPEN BOTH FILES
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
OPEN (OUT,OUTPUT)
GET GET IN READ
LR R0,R1 LOAD RECORD ADDR INTO REG-0
PUT OUT,(0) WRITE
B GET AND LOOP TO READ AGAIN.
Z CLOSE (IN,,OUT) CLOSE BOTH FILES.
L 13,4(13)
LM 14,12,12(13) RESTORE OUR CALLER'S REGISTERS,
SR 15,15
BR 14 AND RETURN. WE'RE DONE.
* FILES ARE CONTROLLED BY DATA CONTROL BLOCKS, OR DCB'S
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,LRECL=133,RECFM=FT,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM
END SEARCH
------------------------------------------------------
Next is a very basic search program. The user specifies a character string, and the program copies only the records that contain that character string. In this program, we scan each record, looking for the first character of the specified string, and when we find it, we compare the entire string. It works best if that first character is less frequently used. If it's a blank, then the program will run slow.
SEARCH START 0
YREGS
USING *,13
B 20(R15)
DC 4F'0'
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R3,0(R1)
LH R2,0(R3)
SH R2,H1
BM NOPARM
ST R2,PARMLEN
STC R2,CLC+1
MVC PARM(0),2(R3)
EX R2,*-6
MVC CLI+1(1),PARM
PUSH PRINT
PRINT NOGEN
OPEN (IN,INPUT)
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
OPEN (OUT,OUTPUT)
POP PRINT
GET GET IN
LR R0,R1
LH R3,DCBLRECL-IHADCB+IN
S R3,PARMLEN
LA R3,0(R1,R3)
CLI CLI 0(R1),0
BNE BUMP
CLC CLC 0(0,R1),PARM
BE FOUND
BUMP LA R1,1(R1)
CR R1,R3
BNH CLI
B GET
FOUND PUT OUT,(0)
B GET
NOPARM LA R2,8
B RETURN
Z CLOSE (IN,,OUT)
SR R2,R2
RETURN L 13,4(13)
LR R15,R2
L 14,12(13)
LM 0,12,20(13)
BR 14
H1 DC H'1'
PARMLEN DC F'0'
PARM DC CL100' '
PUSH PRINT
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,LRECL=133,RECFM=FT,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM
POP PRINT
END SEARCH
----------------------------------------------------
This is a search program, to be used in my website. Written in one single evening. It's not perfect. I think it's subject to a S0C5, looking past the end of the buffer. That'd be fixable if someone were interested. I like the report. Tells you the program version, string, and scan char, and run start, end, and elapsed time, and record counts. The timing routine, and the frequency table are from other projects. The timing routine is especially long and confusing, but I do find it nice to know how long a run takes.
SEARCH, ASM 03/03/23 AT 19.30 SEARCH CHAR=V PARM="MVC"
IN OPENED INPUT, RECFM=A0, LRECL=00133 BLKSIZE=00000
OUT OPENED OUTPUT, RECFM=A0, LRECL=00133 BLKSIZE=00000
START/END/ELAPSED TIMES 19:30:16.28 19:30:16.41 0:00:00.13
486 RECORDS READ
77 CLC INSTRUCTIONS USED
55 RECORDS COPIED
Minimal internal documentation is displayed when the PARM is missing, or when invalid hex data is specified in the PARM field.
PARM= IS REQUIRED
SEARCH, ASM 03/03/23 AT 19.30
PARM="ABC" OR PARM=X"C1C2C3" SEARCH ARGUMENT MISSING, OR BAD
//SEARCH EXEC PGM=SEARCH,PARM="DEF" OR PARM="X"C4C5C6"
//STEPLIB DD DISP=SHR,DSN=
//SUSPRINT DD SYSOUT=*
//IN DD DISP=SHR,DSN=
//OUT DD SYSOUT=*
YOU CAN ONLY SEARCH FOR ONE STRING, EITHER CHARACTER OR HEX,
SPECIFIED IN THE PARM FIELD. SEARCH DOES TRY TO PICK THE LEAST
FREQUENTLY USED CHARACTER, AND ONLY DO A CLC WHEN THAT CHARACTER
IS FOUND.
The first dozen lines or so are commands to use Z390 simulator.
The first actual instruction would be the "MACRO" instruction.
M AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\SEARCH
SET PA="MVC "
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\SEARCH
SET IN=%G%.PRN
SET OUT=%G%.OUT.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1) PARM(%PA%)
MVC
MVCABC
.START ANOP
*
MACRO
&LBL $ &FLD
LCLA &M,&N
&N SETA K'&FLD
&M SETA &N-3
&LBL DC AL1(&M),C&FLD
MEND
*
SEARCH START 0
YREGS
USING *,13
B 60(R15)
DC 14F'0'
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R3,0(R1)
SR R8,R8
PUSH PRINT
PRINT NOGEN
OPEN (SYSPRINT,OUTPUT)
BAL R9,CALCTIME GO SAVE START TIME.
*
RESTART LH R2,0(R3)
SH R2,=H'1'
BM NOPARM
ST R2,PARMLEN
MVC PARM(0),2(R3)
EX R2,*-6
CLC =C'TESTPARMS',PARM
BE TESTPARM
*
QPARM CLC =C'X"',PARM
BE TRYHEX
CLC =C'X''',PARM
BNE NOTHEX
TRYHEX MVI FLAGHEX,C'X'
LA R3,PARM+2
LA R2,STRING
MVCHEX MVC DW(2),0(R3)
TRT DW(2),TESTHEX
BNZ BADHEX
TR DW(2),TRHEX
PACK 0(2,R2),DW(3)
LA R2,1(R2)
MVI 0(R2),C' '
LA R3,2(R3)
CLC 0(1,R3),PARM+1
BNE MVCHEX
S R2,=A(STRING+1)
ST R2,PARMLEN
LA R14,1(R2)
SLL R14,1
BCTR R14,0
LA R1,PARM+2
EX R14,NOTHEX-6
LA R1,IDMSG+55(R14)
MVI 0(R1),C'"'
B QFREQ
*
MVC IDMSG+54(0),0(R1)
NOTHEX MVC STRING,PARM
LA R1,PARM
STC R2,CLC+1
EX R2,NOTHEX-6
LA R1,IDMSG+55(R2)
MVI 0(R1),C'"'
*
QFREQ MVI LINE-1,C' ' MVC
MVC LINE(99),STRING THIS SECTION FINDS THE LEAST MVC
TR LINE(99),FREQTBL FREQUENTLY USED CHAR IN THE MVC
LA R1,LINE PARM FIELD. IT PUTS THAT CHAR MVC
LR R2,R1 INTO THE CLI INSTRUCTION THAT MVC
LA R1,1(R1) DOES THE REAL SCAN. MVC
FREQCLC CLC 0(1,R1),0(R2) MVC
BNL *+6 MVC
LR R2,R1
LA R1,1(R1)
CLC 1(12,R1),0(R1)
BNE FREQCLC
S R2,=A(LINE)
ST R2,BACKUP
MVC LINE,LINE-1 CLEAN UP OUR BUTT.
*
LA R14,STRING(R2)
MVC CLI+1(1),0(R14)
MVC IDMSG+44(1),0(R14)
CLI FLAGHEX,C'X'
BNE PUTID
L R1,BACKUP
SLL R1,1
LA R1,PARM+2(R1)
MVC IDMSG+44(2),0(R1)
PUTID PUT SYSPRINT,IDMSG-1
*
*
B OPEN
*
PUSH USING
USING IHADCB,2
OPENIN MVC OPENM+2(8),DCBDDNAM
MVC OPENM+18(3),=C' IN'
TM DCBOFLGS,DCBOFOPN
BO OPENLIST
OPEN ((2),INPUT)
B OPENLIST
OPENOUT TM DCBOFLGS,DCBOFOPN
BO OPENLIST
MVC OPENM+2(8),DCBDDNAM
MVC OPENM+18(3),=C'OUT'
OPEN ((2),OUTPUT)
B OPENLIST
POP PRINT
OPENLIST UNPK OPENM+32(3),DCBRECFM(2)
TR OPENM+32(2),HEX-240
MVI OPENM+34,C','
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENM+42(5),DW+5(3)
LH R0,DCBBLKSI
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENM+56(5),DW+5(3)
PUT SYSPRINT,OPENM
BR R9
*
OPEN LA R2,IN
BAL R9,OPENIN
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
MVC DCBLRECL-IHADCB+OUT,DCBLRECL-IHADCB+IN
LA R2,OUT
BAL R9,OPENOUT
*
*
*
LA R2,STRING(R2)
L R0,PARMLEN
S R0,PARMLEN
LR R1,R0
BCTR R1,0
ST R1,LASTCLC
A R0,BACKUP
ST R0,LASTBYTE
GET GET IN
AP #IN,P1
LR R5,R1
LA R2,0(R5)
LH R3,DCBLRECL-IHADCB+IN
LA R6,0(R5,R3)
S R6,LASTCLC
LA R3,0(R2,R3)
S R3,LASTBYTE
A R2,BACKUP
CLI CLI 0(R2),0
BNE BUMP
LR R1,R2
S R1,BACKUP
** C R1,LASTCLC
** BNL GET
AP #CLC,P1
CLC CLC 0(0,R1),STRING
BE FOUND
BUMP LA R2,1(R2)
CR R2,R6
BNH CLI
B GET
*
FOUND PUT OUT,(5)
AP #OUT,P1
B GET
*
#IN DC PL5'0'
$ 'RECORDS READ'
#CLC DC PL5'0'
$ 'CLC INSTRUCTIONS USED'
#OUT DC PL5'0'
$ 'RECORDS COPIED'
DC X'FF'
TOTALS LA 2,#IN
SR R3,R3
TOTLOOP MVC LINE,LINE-1
MVC LINE(L'ED),ED
ED LINE(L'ED),0(R2)
ZAP 0(5,R2),=P'0'
IC R3,5(R2)
MVC LINE+2+L'ED(0),6(R2)
EX R3,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R2,7(R2,R3)
CLI 0(R2),99
BL TOTLOOP
BR R9
ED DC X'402020206B2020206B212020'
*
BADHEX MVC LINE(16),=C'INVALID HEX CHAR'
B *+10
NOPARM MVC LINE(17),=C'PARM= IS REQUIRED'
PUT SYSPRINT,LINE-1
MVC LINE(30),IDMSG
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R2,DOC
SR R3,R3
B DOCLOOP
DOCMVC MVC LINE+1(0),1(R2)
DOCLOOP LA R2,2(R2,R3)
CLI 0(R2),99
BNL RC8
IC R3,0(R2)
EX R3,DOCMVC
DOCPUT PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
B DOCLOOP
DOC $ ' '
$ 'PARM="ABC" OR PARM=X"C1C2C3" SEARCH ARGUMENT MISSING, OR BAD'
$ '//SEARCH EXEC PGM=SEARCH,PARM="DEF" OR PARM="X"C4C5C6" '
$ '//STEPLIB DD DISP=SHR,DSN='
$ '//SUSPRINT DD SYSOUT=*'
$ '//IN DD DISP=SHR,DSN='
$ '/OUT DD SYSOUT=*'
$ 'YOU CAN ONLY SEARCH FOR ONE STRING, EITHER CHARACTER OR HEX,'
$ 'SPECIFIED IN THE PARM FIELD. SEARCH DOES TRY TO PICK THE LEAST'
$ 'FREQUENTLY USED CHARACTER, AND ONLY DO A CLC WHAT THAT CHARACTER'
$ 'IS FOUND.'
DC X'FF'
*
RC8 LTR R8,R8
BNZ TESTPARM+4
OI RC,8
B NOCLO
*
Z BAL R9,CALCTIME
BAL R9,TOTALS
LTR R8,R8
BNZ TESTPARM+4
*
CLOSE CLOSE (IN,,OUT)
CP #OUT,P0
BNE NOCLO
OI RC,2
NOCLO CLOSE (SYSPRINT)
SR 15,15
IC 15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
*
TESTPARM LA R8,TESTPTBL-12
LA R8,12(R8)
CLI 0(R8),0
BNE CLOSE
*
TM DCBOFLGS-IHADCB+IN,DCBOFOPN
BZ TESTPNCL
PUSH PRINT
PRINT NOGEN
CLOSE IN
OPEN (IN,INPUT)
POP PRINT
TESTPNCL LR R3,R8
MVI FLAGHEX,C' '
MVI LINE-1,C' '
MVC LINE,LINE-1
MVI LINE,C'-'
MVC LINE+1(60),LINE
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
MVC PARM,LINE-1
MVC STRING,LINE-1
MVC IDMSG+44(2),LINE-1
MVC IDMSG+54(50),LINE-1
CLI 0(R3),0
BE RESTART
SR R8,R8
B CLOSE
LTORG
TESTPTBL DC H'3',CL10'MVC'
DC H'9',CL10'X"D4E5C3"'
DC H'4',CL10' MVC'
DC H'4',CL10'MVC '
DC H'5',CL10' MVC '
DC H'0',CL10' '
DC H'8',CL10'X"D4E5C"'
DC H'9',CL10'X"D4E5C,"'
DC H'9',CL10'X"D4E5C3'''
DC H'3',CL10'MVC'
DC X'FF'
FLAGHEX DC C' '
P0 DC X'0C'
P1 DC X'1C'
RC DC X'00'
HEX DC C'0123456789ABCDEF'
DW DC 2D'0'
PARMLEN DC F'0'
BACKUP DC F'0'
LASTCLC DC F'0'
LASTBYTE DC F'0',C' '
OPENM DC CL66' ........ OPENED OUTPUT, RECFM=.., LRECL=..... BLKSIZE='
DC CL67' '
IDMSG DC C' SEARCH, ASM &SYSDATE AT &SYSTIME '
DC C'SEARCH CHAR= PARM="',CL90' '
LINE DC CL133' '
PARM DC CL102' '
STRING DC CL102' '
TESTHEX EQU *-193
DC 6X'00',CL43' ',10X'00',CL6' '
TRHEX EQU *-193
DC X'0A0B0C0D0E0F',CL41' ',X'00010203040506070809'
CNOP 0,8
*
FREQTBL DC AL1(255,254,157,156,155,154,153,152)
DC AL1(151,150,149,148,147,146,145,144)
DC AL1(143,142,141,140,139,138,137,136)
DC AL1(135,134,133,132,131,130,129,128)
DC AL1(127,126,125,124,123,122,121,120)
DC AL1(119,118,117,116,115,114,113,112)
DC AL1(111,110,109,108,107,106,105,104)
DC AL1(103,102,101,100,099,098,097,096)
*
DC AL1(251,095,094,093,092,091,090,089)
DC AL1(088,087,086,213,163,179,174,168)
DC AL1(181,085,084,083,082,081,080,079)
DC AL1(078,077,157,184,180,178,167,182)
DC AL1(177,160,076,075,074,073,072,071)
DC AL1(070,069,068,214,183,175,162,161)
DC AL1(067,066,065,064,063,062,061,060)
DC AL1(059,159,165,185,186,166,176,164)
*
DC AL1(058,210,193,201,202,212,198,196)
DC AL1(204,208,057,056,055,054,053,052)
DC AL1(051,189,191,203,199,207,209,197)
DC AL1(188,205,050,049,048,047,046,045)
DC AL1(044,158,206,211,200,192,195,190)
DC AL1(194,187,043,042,041,173,040,039)
DC AL1(038,037,036,035,034,033,032,031)
DC AL1(030,029,028,027,026,172,025,024)
*
DC AL1(170,248,231,239,240,250,236,234)
DC AL1(242,246,023,022,021,020,019,018)
DC AL1(169,227,229,241,237,245,247,235)
DC AL1(226,243,017,016,015,014,013,012)
DC AL1(171,011,244,249,238,230,233,228)
DC AL1(232,225,010,009,008,007,006,005)
DC AL1(224,223,222,221,220,219,218,217)
DC AL1(216,215,004,003,002,001,252,253)
* DC AL1( )
FREQTE EQU *
*
* 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'221411111114111111141011121212141110121212131010091309'
* 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
*
PUSH PRINT
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,EODAD=Z,MACRF=GL,LRECL=133,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
*
CALCTIME MVC LINE,LINE-1
* PUT SYSPRINT,LINE-1
TIME DEC
CLI THISTIME+7,0
MVC LASTTIME,THISTIME
STM 0,1,THISTIME
BER 9
XC ELAPTIME,ELAPTIME
CLC THISTIME+5(3),LASTTIME+5 Q. SAME DAY?
BNE CALCTPR2 NO, DON'T CALC ELAP
MVC CALCTIMH(11),CALCTIMH+11
*
CLC THISTIME,LASTTIME
BL CALCTERR
*
MVO CALCTIMS,THISTIME+2(2) DO SECONDS FIRST.
MVO CALCTIMA,LASTTIME+2(2)
SP CALCTIMS,CALCTIMA ELAPSED SECONDS
BNM *+14 POSITIVE, OKAY
AP CALCTIMA,=P'6000' NO, ADD 60 SECONDS
MVI CALCTFLG,X'1C' SET MINUTES=-1
*
MVO CALCTIMM,THISTIME+1(1) MINUTES
MVO CALCTIMA,LASTTIME+1(1)
SP CALCTIMM,CALCTFLG (SET TO ZERO
MVI CALCTFLG,X'0C'
SP CALCTIMM,CALCTIMA SUBT 1 IF SECONDS = MINUS
BNM *+14
AP CALCTIMM,=P'60' NO, ADD 60 MINUTES
MVI CALCTFLG,X'1C' SET HOURS=-1
*
MVO CALCTIMH,THISTIME(1) HOURS
MVO CALCTIMA,LASTTIME(1)
SP CALCTIMH,CALCTFLG
SP CALCTIMH,CALCTIMA SUBT 1 IF SECONDS = MINUS
*
LM 0,1,CALCTIMS-5 HHHCMMMCSSSSSC
SRDL 0,4 HHHCMMMCSSSSS
STH 1,ELAPTIME+2
SRDL 0,24 HHHCMMMCSSSSS
STC 1,ELAPTIME+1
SRL 1,16
STC 1,ELAPTIME
*
LA R0,3
B CALCTPR3
*
CALCTERR WTO ' END TIME EARLIER THAN START'
CALCTPR2 LA R0,2
CALCTPR3 LA R14,LASTTIME
LA R15,LINE+1+L'CALCTMSG
*
MVC LINE+1(L'CALCTMSG),CALCTMSG
CALCTEDI MVC 0(L'CALCTEDP,R15),CALCTEDP
ED 0(L'CALCTEDP,R15),0(R14)
LA R14,8(R14)
LA R15,L'CALCTEDP(R15)
BCT R0,CALCTEDI
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
PUT SYSPRINT,LINE-1
BR 9
*
CALCTEDP DC X'4021207A20207A20204B2020'
CALCTMSG DC C'START/END/ELAPSED TIMES'
*
DS 0D
LASTTIME DC XL8'00'
THISTIME DC XL8'00'
ELAPTIME DC XL8'00'
*
CALCTIMH DC PL2'0'
CALCTIMM DC PL2'0'
CALCTIMS DC PL3'0'
*
CALCTFLG DC X'0C'
*
CALCTIMA DC PL3'0'
*
DC 2PL2'0',PL3'0',PL1'0',PL3'0'
LTORG
*
@@PAD#1 EQU ((*-SEARCH)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-
(*-SEARCH)
ORG *+@@PAD#2
*
END SEARCH
------------------------------------------------------------
I wrote it again, to compare using CLI vs TRT to find
the selected character. TRT is faster running on Z390,
but by less than 10%. That was a bit surprising.
Just barely under 4k.
AGO .START
C:\USERS\LIN\DOCUMENTS\Z390CODE\PARMSCAN
SET PA="DOC,TIMECLI,2,MVC"
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PARMSCAN
SET IN=%G%.PRN.TXT
SET OUT=%G%.OUT.TXT
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1) PARM(%PA%)
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\PARMSCAN
SET LISTING=%G%.PRN.TXT
SET LISTING=%G%.BREAK.ATFILE.TXT
SET LISTING=%G%.BREAK.COMMANDS.TXT
SET LISTING=%G%.BREAK.SYSIN.TXT
BAT\EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)
LOADLOC=FF000 13R%
LRECL=90
LABEL=QP*,GET,Z,NOPARM,
COMMAND=
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\PARMSCAN ASMLG
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\PARMSCANT EZ390
COMMAND=C:\USERS\LIN\DOCUMENTS\Z390CODE\PARMSCANB BK PTS
COMPRESS=Y
CMDFILE=Y
ATFILE=Y
.START ANOP
*
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
*
PARMSCAN START 0
YREGS
USING *,13
DS 18F
ORG *-72
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15
L R1,0(R1)
LH R3,0(R1)
SH R3,=H'1'
BM NOPARM
MVC PARM(0),2(R1)
EX R3,*-6
PUSH PRINT
PRINT NOGEN
OPEN (SYSPRINT,OUTPUT)
POP PRINT
B PUTPARM
DC 3F'0' 'CAUSE PUT USES SAVE AREA.
PUTPARM PUT SYSPRINT,WTOPARM+4
* ------------------------------ NEXT DO PARM FIELD PARSING -----
CLC =C'DOC,',PARM Q. PROGRAM DESCRIPTION?
BNE NOTDOC NO
MVI FLAGDOC,C'D'
MVC PARM,PARM+4
SH R3,=H'4'
NOTDOC CLC =C',=',PARM Q. CHANGE SEPARATOR FROM , TO ??
BNE QP00 NO.
MVC QCOMMA,PARM+2 YES, SAVE IT, AND ALSO CALC
LH R14,QCOMMA-1 THE TRT ADDRESS TO USE
LA R15,TRTTABLE-256(R14)
MVC PARM,PARM+3 ,=:USETRT
SH R3,=H'3'
*
QP00 CLC =C'USE',PARM
BE QP02
LA R1,PARM
LA R14,1(R3)
CLI PARM,C'1'
BL QP01
CLC QCOMMA,PARM+1
BNE QP01
LA R1,2(R1)
SH R14,=H'2'
QP01 CLC QCOMMA,0(R1)
BE QP06E
LA R1,1(R1)
BCT R14,QP01
B QP06
*
QP02 LA R15,BTRT
CLC =C'USETRT',PARM USE TRT TO SCAN FOR CHAR
BE QP04 YES
MVI #TRT,X'FF'
LA R15,BCLI
CLC =C'USECLI',PARM USE CLI TO SCAN FOR CHAR
BE QP04 YES
B NOPARM
*
QPARMMSG CVD R3,DW
OI DW+7,X'0F'
UNPK PARMMSG+5(3),DW+6(2)
MVC LINE(L'PARMMSG),PARMMSG
MVC LINE+L'PARMMSG+1(44),PARM
* WTO MF=(E,WTOLINE)
* WTO MF=(E,WTOPARM)
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
*
PARMMSG DC C'XXX, LLL, ?, #, '
QP04 MVC QTEST(4),0(R15) USECLI,2,IF /TESTCLI,2,EYE
MVC PARMMSG(3),PARM+3
MVC PARM,PARM+7
SH R3,=H'7'
BAL R9,QPARMMSG
B QP06
*
QP06E MVC LINE(20),=C'POSSIBLE PARM= ERROR'
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
QP06 MVC USECLIB+1(1),PARM
MVC PARMMSG+10(1),PARM
CLI PARM,C'1'
BL QP08
CLC QCOMMA,PARM+1
BNE QP08
IC R1,PARM
N R1,=F'15'
LR R0,R1
BCTR 0,0
STH R0,OFFSET
STC R0,PARMMSG+13
OI PARMMSG+13,C'0'
MVC PARM,PARM+2
SH R3,=H'2'
BAL R9,QPARMMSG
*
LH R1,OFFSET
LA R1,PARM(R1)
MVC USECLIB+1(1),0(R1)
MVC PARMMSG+10(1),0(R1)
*
QP08 STC R3,CLCFOUND+1
SR R2,R2
IC R2,USECLIB+1
LA R1,TRTTABLE
SR R1,R2
ST R1,QTRT
BAL R9,QPARMMSG
*
LA R1,PARM
LA R0,1(R3)
MVI 12(13),X'FF'
SR R14,R14
IC R14,0(R1)
EX 0,QP10L
B QP10M
QP10L LA R15,QFREQTBL(14)
CLC 0(1,R15),12(R13)
BNL *+14
QP10M MVC 12(1,R13),0(R15)
ST R15,16(R13)
LA R1,1(R1)
IC R14,0(R1)
BCT R0,QP10L
L R14,16(R13)
S R14,=A(QFREQTBL)
STC R14,QSCANFOR+L'QSCANFOR-1
CLC USECLIB+1(1),QSCANFOR+L'QSCANFOR-1
BE QP90
MVC LINE(L'QSCANFOR),QSCANFOR
PUT SYSPRINT,LINE-1
MVI FLAGDOC,C'D'
MVC LINE,LINE-1
B QP90
QSCANFOR DC C'SHOULDN''T YOU SCAN FOR ?'
* --------------------------- END OF PARM, OPEN FILES, ETC
QP90 BAL R9,CALCTIME
LA R2,IN
BAL R9,OPENIN
LA R2,OUT
BAL R9,OPENOUT
BAL R9,PRINTDOC
B GET
*
PUSH PRINT
PRINT NOGEN
OPENIN TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BOR R9
MVC OPENMSG+7(8),DCBDDNAM-IHADCB(R2)
MVC OPENMSG+14(3),=C' IN'
OPEN ((2),INPUT)
B OPENLIST
OPENOUT TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BOR R9
MVC OPENMSG+14(3),=C'OUT'
MVC OPENMSG+7(8),DCBDDNAM-IHADCB(R2)
OPEN ((2),OUTPUT)
POP PRINT
*
OPENLIST UNPK OPENMSG+29(3),DCBRECFM-IHADCB(2,R2)
TR OPENMSG+29(2),HEX-240
MVI OPENMSG+31,C' '
LH R0,DCBLRECL-IHADCB(2)
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+38(5),DW+5(3)
LH R0,DCBBLKSI-IHADCB(2)
CVD R0,DW
OI DW+7,X'0F'
UNPK OPENMSG+52(5),DW+5(3)
MVC LINE(L'OPENMSG),OPENMSG
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
*
OPENMSG DC C'OPEN //........ OUTPUT RECFM=FT LRECL=12345 BLKSIZE=543
321'
*
BCLI B USECLI
BTRT B USETRT
* ----------------------- INIT DONE, READ, SCAN, WRITE RECORDS ----
DC F'0'
PUT L 0,PUT-4
PUT OUT,(0)
AP #OUT,P1
GET GET IN
AP #IN,P1
LA R1,0(R1)
LR R3,R1
ST R3,PUT-4
LH R0,OFFSET
LH R4,DCBLRECL-IHADCB+IN
LA R4,0(R3,R4)
BCTR R4,0
LR R15,R4
SR R15,R3
L R14,QTRT
* ---------------------- GO DO EITHER THE CLI OR TRT SCAN -------
QTEST B USETRT
* -------------------------------TRT-------------------
QTRT DC A(0)
OFFSET DC H'0'
USETRTT TRT 0(0,R1),0(R14)
USETRT LR R2,R4
SR R2,R1
BNP GET
CH R2,=H'256'
BL *+8
LA R2,255
AP #TRT,=P'1'
EX R2,USETRTT
BNZ USETRTC
LA R1,256(R1)
CR R1,R4
BL USETRT
B GET
USETRTC BAL R9,QFOUND
B USETRT
* --------------------------------CLC------------------
QFOUND SH R1,OFFSET
C R1,PUT-4
BL QFOUNDN
LR R0,R4
SH R0,OFFSET
CR R1,R0
BH GET
AP #CLC,P1
CLCFOUND CLC PARM(0),0(R1)
BE PUT
QFOUNDN AH R1,OFFSET
LA R1,1(R1)
BR R9
* ----------------------------------CLI----------------
USECLI LA R14,1
LR R15,R4
USECLIB CLI 0(R1),C' '
BNE CLIBXLE
BAL R9,QFOUND
CLIBXLE BXLE R1,R14,USECLIB
B GET
* -------------------------- CALLED ROUTINES ----------
DC X'00'
QCOMMA DC C','
*
CLOSE TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZR R9
PUSH USING
PRINT NOGEN
CLOSE ((2))
TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN
BZR R9
MVC LINE(8),DCBDDNAM-IHADCB(R2)
MVC LINE+9(6),=C'CLOSED'
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR R9
POP USING
*
DCBS DC A(IN,OUT,SYSPRINT),X'FF'
PRINTDOC LA R4,DOC-1
CLI DOC,0
BER R9
SR R5,R5
MVCDOC IC R5,0(R4)
MVC LINE(0),1(R4)
EX R5,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
CLI FLAGDOC,C'D'
BNE PRINTD90
LA R4,2(R4,R5)
C R4,=A(ENDDOC)
BL MVCDOC
PRINTD90 MVI DOC-1,0
MVC DOC(256),DOC-1
MVC DOC+256(256),DOC
MVI TRTTABLE,C','
BR R9
* ---------------------------ERROR --------------------
NOPARM OI RC,8
LA R2,SYSPRINT
BAL R9,OPENOUT
MVC LINE(14),=C'PARM ERROR AT '
MVC LINE+14(44),PARM
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
MVI FLAGDOC,C'D'
BAL R9,PRINTDOC
B Z
* ------------------DONE. COUNTS, TIME, CLOSE FILES, EXIT ---------
Z BAL R9,CALCTIME
BAL R9,TOTALS
LA R3,DCBS
Z2 L R2,0(R3)
BAL R9,CLOSE
LA R3,4(R3)
CLI 0(R3),0
BE Z2
*
SR 15,15
IC 15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
*
ED9 DC X'402020206B2020206B212020'
TOTALS LA R2,#IN
MVC LINE(L'ED9),ED9
ED LINE(L'ED9),0(R2)
ZAP 0(5,R2),P0
MVC LINE+L'ED9+1(23),5(R2)
PUT SYSPRINT,LINE
LA R2,28(R2)
CLI 0(R2),X'99'
BL TOTALS+4
MVC LINE,LINE-1
BR R9
* ------------------------ CALCTIME IS A COMMON ROUTINE -----------
CALCTIME TIME DEC
CLI THISTIME+7,0
MVC LASTTIME,THISTIME
STM 0,1,THISTIME
BER 9
XC ELAPTIME,ELAPTIME
CLC THISTIME+5(3),LASTTIME+5 Q. SAME DAY?
BNE CALCTPR2 NO, DON'T CALC ELAP
MVC CALCTIMH(11),CALCTIMH+11
*
CLC THISTIME,LASTTIME
BL CALCTERR
*
MVO CALCTIMS,THISTIME+2(2) DO SECONDS FIRST.
MVO CALCTIMA,LASTTIME+2(2)
SP CALCTIMS,CALCTIMA ELAPSED SECONDS
BNM *+14 POSITIVE, OKAY
AP CALCTIMA,=P'6000' NO, ADD 60 SECONDS
MVI CALCTFLG,X'1C' SET MINUTES=-1
*
MVO CALCTIMM,THISTIME+1(1) MINUTES
MVO CALCTIMA,LASTTIME+1(1)
SP CALCTIMM,CALCTFLG (SET TO ZERO
MVI CALCTFLG,X'0C'
SP CALCTIMM,CALCTIMA SUBT 1 IF SECONDS = MINUS
BNM *+14
AP CALCTIMM,=P'60' NO, ADD 60 MINUTES
MVI CALCTFLG,X'1C' SET HOURS=-1
*
MVO CALCTIMH,THISTIME(1) HOURS
MVO CALCTIMA,LASTTIME(1)
SP CALCTIMH,CALCTFLG
SP CALCTIMH,CALCTIMA SUBT 1 IF SECONDS = MINUS
*
LM 0,1,CALCTIMS-5 HHHCMMMCSSSSSC
SRDL 0,4 HHHCMMMCSSSSS
STH 1,ELAPTIME+2
SRDL 0,24 HHHCMMMCSSSSS
STC 1,ELAPTIME+1
SRL 1,16
STC 1,ELAPTIME
*
LA R0,3
B CALCTPR3
*
CALCTERR WTO ' END TIME EARLIER THAN START'
CALCTPR2 LA R0,2
CALCTPR3 LA R14,LASTTIME
LA R15,LINE+1+L'CALCTMSG
*
MVC LINE+1(L'CALCTMSG),CALCTMSG
CALCTEDI MVC 0(L'CALCTEDP,R15),CALCTEDP
ED 0(L'CALCTEDP,R15),0(R14)
LA R14,8(R14)
LA R15,L'CALCTEDP(R15)
BCT R0,CALCTEDI
*
* UNPK 2(5,15),ELAPTIME(3)
* UNPK 6(5,15),ELAPTIME+2(3)
* TR 2(8,15),HEX-240
* MVI 10(15),C' '
*
* WTO MF=(E,WTOLINE)
PUT SYSPRINT,LINE
* MVI LINE+1,C'-'
* MVC LINE+2(58),LINE+1
* WTO MF=(E,WTOLINE)
MVC LINE,LINE-1
WTO MF=(E,LINE-5)
BR 9
*
CALCTEDP DC X'4021207A20207A20204B2020'
CALCTMSG DC C'START/END/ELAPSED TIMES'
*
DS 0D
LASTTIME DC XL8'00'
THISTIME DC XL8'00'
ELAPTIME DC XL8'00'
*
CALCTIMH DC PL2'0'
CALCTIMM DC PL2'0'
CALCTIMS DC PL3'0'
*
CALCTFLG DC X'0C'
*
CALCTIMA DC PL3'0',2PL2'0',PL3'0',PL1'0',PL3'0'
* -------------------------------------------
LTORG
FLAGDOC DC C' '
P0 DC X'0C'
P1 DC X'1C'
P2 DC X'2C'
RC DC X'00'
HEX DC C'0123456789ABCDEF'
DW DC 2D'0'
#IN DC PL5'0',CL23'RECORDS READ'
#CLC DC PL5'0',CL23'CLC INSTRUCTIONS DONE'
#OUT DC PL5'0',CL23'RECORDS WRITTEN'
#TRT DC PL5'0',CL23'TRT INSTRUCTIONS USED'
DC X'FF'
*
*
WTOPARM DC H'80,0',C' PARM= '
PARM DC CL102' '
WTOLINE DC H'80,0',C' LINE= '
LINE DC CL133' '
PUSH PRINT
PRINT NOGEN
*YSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,RECFM=FT,MACRF=PM,LRECL=133
IN DCB DDNAME=IN,DSORG=PS,RECFM=FT,MACRF=GL,LRECL=255,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,RECFM=FT,MACRF=PM,LRECL=255
POP PRINT
*
QFREQTBL EQU *
DC X'5431292B2C4E2A2C2D23342027222336442428242125211F28213D2620212122'
DC X'2A2221283921242224252523292020213024213335262F242920252126202022'
DC X'944120222C37244723232089465A4522482024202E2021203127323C4B593227'
DC X'77842420222024202220267F497A38533B2220202420202122336B5066656A5D'
DC X'3E917C8886937D818A8E2120202020214258748B878F9083518C20202B212120'
DC X'25318D9285768263804D2220224A2020272021202220202127212120214B2021'
DC X'286E62685F60575556693F40302021223A4C5564675E5B5F4361292625212224'
DC X'35226F70524C5C3F4F3A23202A2020207B7E797273716D6C7578232120212427'
*
TRTTABLE EQU *+256
DC AL1(L'DOC-1)
DOC DC C'PARMSCAN, ASM &SYSDATE &SYSTIME, SCAN SEQUENTIAL //IN FILE, COP
PY RECORDS CONTAING PARM= DATA STRING TO //OUT FILE.'
@ '------ DESCRIPTION ------'
@ 'READ THE FLAG //IN FILE, COPY RECORDS CONTAINING THE'
@ 'SPECIFIED CHARACTER STRING TO //OUT. USER CAN SPECIFY WHICH'
@ 'CHARACTER TO SCAN FOR, (HOPEFULLY THE LEAST FREQUENT) AND ONLY DO'
@ 'THE CLC WHEN THAT CHAR IS FOUND, FIRST CHECKING TO INSURE THAT THE'
@ 'STRING DOES NOT START BEFORE THE BEGINNING, NOR FLOW OVER THE END,'
@ 'OF THE RECORD.'
@ ' '
@ 'CAN TEST TO SEE WHETHER CLI OR TRT RUN FASTER. (TRT BY A HAIR)'
@ ' '
@ 'PARM = BLANK = ERROR'
@ 'PARM = "DOC," (MUST BE FIRST) PRINT THIS DOCUMENTATION.'
@ 'PARM = ",=?" USE ? (OR WHATEVER) FOR PARM DELIMITER INSTEAD OF ,'
@ 'PARM = "ABC" LOOK FOR CHAR A AND DO COMPARE.'
@ 'PARM = "2,ABC" LOOK FOR CHAR "B" TO RUN FASTER.'
@ 'PARM = "USECLI,3,ABC" USE CLI TO LOOK FOR "C" AND COMPARE.'
@ 'PARM = "USETRT,2,EYE" USE TRT TO LOOK FOR "Y" AND COMPARE.'
@ 'PARM = "DOC,,=;USECLI;2;MVC" DO ALL OF THAT.'
@ ' '
@ 'IF YOU USE THE OFFSET TO THE LEAST FREQUENT CHAR, IT RUNS FASTER.'
@ ' '
@ '//SCAN EXEC PGM=PARMSCAN,PARM="2,EXEC"'
@ '//STEPLIB DD DISP=SHR,DSN='
@ '//SYSPRINT DD SYSOUT=*'
@ '//IN DD DISP=SHR,DSN='
@ '//OUT DD SYSOUT=*'
@ '------ END OF DESDRIPTION ------'
*@ 'PARM =
ENDDOC EQU *
* DCBD DEVD=DA
*
@@PAD#1 EQU ((*-PARMSCAN)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-PARMSCAN)
ORG *+@@PAD#2
*
END PARMSCAN
End of file.