Detailed post is in https://www.linkedin.com/pulse/akbkok-editview-line-commands-dan-dirkse-7ggxc/?trackingId=YR5Rcy3Pszw4gDRa8TrCFA%3D%3D
Monday, December 9, 2024
Wednesday, November 27, 2024
Wrapping lines when PC file uploaded to Mainframe
When trying to upload a notepad/CSV file that contains lines shorter than 80 characters to a mainframe file with LRECL of 80, the lines from the notepad or CSV file will be stored continuously in the mainframe file, with delimiter x'25', instead of individual records.
The below job can used to extract the individual lines from the uploaded file and store them as separate record in a output file
//COB EXEC PGM=IGYCRCTL
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT4 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT5 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT6 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT7 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT8 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT9 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT10 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT11 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT12 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT13 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT14 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT15 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT16 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT17 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT18 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT19 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSUT20 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSMDECK DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSLIN DD DSN=&&LOADSET,UNIT=SYSDA,DISP=(MOD,PASS),
// SPACE=(TRK,(3,3)),DCB=BLKSIZE=800
//SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO INFILE.
SELECT OUTPUT-FILE ASSIGN TO OUTFILE.
DATA DIVISION.
FILE SECTION.
FD INPUT-FILE.
01 INPUT-REC.
05 IN-CHAR PIC X(01) OCCURS 80 TIMES.
FD OUTPUT-FILE.
01 OUTPUT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 WS-REC.
05 WS-CHAR PIC X(01) OCCURS 80 TIMES.
01 WS-IN PIC S9(04) COMP.
01 WS-OUT PIC S9(04) COMP.
01 WS-EOF PIC X(01) VALUE 'N'.
PROCEDURE DIVISION.
OPEN INPUT INPUT-FILE
OUTPUT OUTPUT-FILE
MOVE SPACES TO WS-REC
READ INPUT-FILE
AT END MOVE 'Y' TO WS-EOF
END-READ
PERFORM UNTIL WS-EOF = 'Y'
PERFORM VARYING WS-IN
FROM 1 BY 1 UNTIL WS-IN > 80
EVALUATE TRUE
WHEN IN-CHAR (WS-IN) = '"'
CONTINUE
WHEN IN-CHAR (WS-IN) = X'25'
WRITE OUTPUT-REC FROM WS-REC
MOVE ZEROS TO WS-OUT
MOVE SPACES TO WS-REC
WHEN OTHER
ADD 1 TO WS-OUT
MOVE IN-CHAR (WS-IN) TO WS-CHAR (WS-OUT)
END-EVALUATE
END-PERFORM
READ INPUT-FILE
AT END MOVE 'Y' TO WS-EOF
END-READ
END-PERFORM
CLOSE INPUT-FILE
OUTPUT-FILE
GOBACK.
//*
//LKED EXEC PGM=IEWL,PARM='LIST,MAP',COND=(5,LT,COB)
//SYSLIN DD DSN=&&LOADSET,DISP=(OLD,DELETE)
// DD DDNAME=SYSIN
//SYSLMOD DD SPACE=(CYL,(5,5,5)),DISP=(,PASS),DSN=&&TEMP(GO),
// DSNTYPE=LIBRARY
//SYSLIB DD DISP=SHR,DSN=CEE.SCEELKED
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(1,1))
//SYSPRINT DD SYSOUT=*
//*
//GO EXEC PGM=*.LKED.SYSLMOD,COND=((5,LT,COB),(5,LT,LKED))
//SYSOUT DD SYSOUT=*
//INFILE DD DISP=SHR,DSN=PS file with uploaded text data
//OUTFILE DD DSN=output file
// LRECL=80,RECFM=FB,
// DISP=(,CATLG),SPACE=(CYL,(50,50),RLSE)
Friday, November 22, 2024
Finding non numeric data in the numeric fields using SORT
Suppose you think that some of the values in the Employees field might contain invalid numeric data, and you want to select the records with those values, if any. Each byte of the 4-byte Employees field should contain '0' through '9'; you would consider any other character, such as 'A' or '.' to be invalid. '1234' is a valid numeric value; it contains all numerics. '12.3' is an invalid numeric value; it contains a non-numeric. You can use one of the numeric test capabilities of the INCLUDE statement to collect the records you want as follows:
INCLUDE COND=(18,4,FS,NE,NUM)
If the value in the field (18,4,FS) is not equal (NE) to numerics (NUM), the record is included. The records in the output data set will be those in which the field has non-numerics (a character other than '0'-'9' appears somewhere in the field).
Use NUM to indicate a test for numerics or non-numerics.
Use EQ to test for numerics, or NE to test for non-numerics.
Use FS format for the field if you want to test for character numerics ('0'-'9' in every byte).
Use ZD format for the field if you want to test for zoned decimal numerics ('0'-'9' in all non-sign bytes; X'F0'-X'F9', X'D0'-X'D9' or X'C0'-X'C9' in the sign byte).
Use PD format for the field if you want to test for packed decimal numerics (0-9 for all digits; F, D or C for the sign).
Here's an INCLUDE statement that only includes records in which the Revenue field and Profit field have packed decimal numerics (that is, there are no invalid packed decimal values in these fields).
INCLUDE COND=(22,6,PD,EQ,NUM,AND,28,6,PD,EQ,NUM)
Sunday, October 27, 2024
Assembler program to process SMF 30 record types 4 and 5
A peek into SMF30 data
Many performance problems in
an application can be quickly solved once the bottlenecks are identified.
Performance monitoring tools help us identify bottlenecks, but what if a site
doesn’t have those expensive tools? What if a site is planning to get rid of
its performance tools to cut down costs? Sometimes it is difficult to justify
the investment in performance monitoring tools because many sites using them do
not use a lot of the information that they provide.
Here is a small utility
program that would interpret the SMF 30 records (address space-level accounting
record) and produce a report that could help identify candidates for
performance tuning. This program can be customized according to your
requirements – such as populating a database for performance analysis or
producing customized reports. We have utilized this in the past by populating
an Access database. The information in the reports is limited to analysing
batch workloads.
SOFTWARE DEPENDENCIES
This program works well with
the SMF30 records produced with Version 2 Release 10 of OS/390.
Compile this program after
concatenating the SYS.MACLIB provided with your release of OS/390. SMF type 30
layout will be expanded using the IFASMFR macro and the program is set to
produce the report using SMF records as input.
GETTING STARTED
Although SMF data given as is
to this program can contain any of the SMF record types, it will utilize only
the type 30 records with sub-types 4 and 5. It is therefore preferable to
filter out those records using IFASMFDP, and SORT these in order of JOBNAME/
STEP name so that the step level reports generated are more readable. JCL to
extract the SMF 30 (subtypes 4 and 5) and subsequently SORT the SMF 30 records
is given below:
//**** Place Job Card Here
//STEPØ1Ø EXEC PGM=IFASMFDP
//SYSPRINT DD SYSOUT=*
//SYSUDUMP DD SYSOUT=*
//DUMPIN DD
DISP=SHR,DSN=MY.SMF.DATASET
//DUMPOUT DD
DSN=&&OUTSMF,DISP=(NEW,PASS),
//
DCB=(LRECL=3276Ø,RECFM=VBS),SPACE=(CYL,(5Ø,2Ø),RLSE)
//SYSIN DD
*,DCB=BLKSIZE=8Ø
INDD(DUMPIN,OPTIONS(DUMP))
OUTDD(DUMPOUT,TYPE(3Ø(4,5)))
START(Ø6ØØ)
END(22ØØ)
/*
//STPEØ2Ø EXEC
PGM=SORT
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SORTIN DD DISP=(OLD,DELETE),DSN=&&OUTSMF
//SORTOUT DD DSN=MY.SORTED.SMF.DATASET,DISP=(NEW,CATLG),
//
DCB=(LRECL=3276Ø,RECFM=VBS),SPACE=(CYL,(5Ø,2Ø),RLSE)
//SYSIN DD *
SORT
FIELDS=(247,8,CH,A,215,8,CH,A,255,2,BI,A)
/*
As one may want to focus on a
particular set of jobs, this utility allows the user to limit the report output
by using masks at the job level. The include criterion is specified on the
SYSIN card and can contain the exact job name; alternatively, it can include
wildcard characters such as ‘*’ to indicate 0 or more character match, or ‘?’
to indicate exactly one character match. Multiple criteria can be given in the
SYSIN card. All jobs satisfying the criteria on the SYSIN cards will be
included in the generated reports.
The JCL to run this utility
program is shown below:
//RUN EXEC
PGM=SMF3ØPG
//STEPLIB DD DISP=SHR,DSN=<loadlib containing the
utility program>
//SYSIN DD *
JOBNAME=PRD*
//SMFIN DD DISP=SHR,DSN=MY.SORTED.SMF.DATASET
//STEPSU DD SYSOUT=*
//JOBSU DD SYSOUT=*
//STEPTIME DD SYSOUT=*
//JOBTIME DD SYSOUT=*
//STEPSTOR DD SYSOUT=*
The reports produced by the
sample JCL show only the jobs that start with PRD (by providing the
JOBNAME=PRD* in SYSIN DD card).
REPORTS
This utility produces five
reports that can be used to analyse the address space accounting information –
DD cards JOBSU, STEPSU, JOBTIME, STEPTIME, and STEPSTOR.
A report specified by the DD
card JOBTIME contains the following information at the job level:
•
Job name and job number.
•
Job start date (format YYYY-MM-DD) and start time
(format HH:MM:SS).
•
Job end date (format YYYY-MM-DD) and end time (format
HH:MM:SS).
•
Total CPU time taken by the job (format HH:MM:SS).
•
SRB time taken by the job (format HH:MM:SS).
•
Total EXCP count for the job.
•
WLM class and WLM service name.
A report specified by the DD
card JOBSU contains similar information to JOBTIME except that total CPU time
and SRB time is expressed in terms of service units. EXCP count is expressed in
terms of I/O service units.
A report specified by the DD
card STEPTIME contains the following information:
•
Job name and job number.
•
Step start date (format YYYY-MM-DD) and start time
(format HH:MM:SS).
•
Step end date (format YYYY-MM-DD) and end time
(format HH:MM:SS).
•
Step name.
•
Program name.
•
CPU time taken by the step (format HH:MM:SS).
•
SRB time taken by the step (format HH:MM:SS).
•
EXCP count for the step.
Report specified by the DD
card STEPSU contains similar information to STEPTIME except that CPU time and
SRB time are expressed in terms of service units. Additionally I/O service
units are also reported.
A report specified by
STEPSTOR contains information about memory usage at the step level. The
following information is contained in the report:
•
Job name and job number.
•
Step name.
•
Program name.
•
Step start date (format YYYY-MM-DD) and start time
(format HH:MM:SS).
•
Step end date (format YYYY-MM-DD) and end time
(format HH:MM:SS).
•
User storage below the 16MB line (in KB).
•
User storage above the 16MB line (in KB).
•
System storage below the 16MB line (in KB).
•
System storage above the 16MB line (in KB).
The output format generated
by this utility is easily portable to a spreadsheet or a database like
Microsoft Access. Once the data is imported to an office tool like Excel or
Access, various in-built functions (like ORDERING or SORTING, Data/Time functions)
can be used to quickly get to valuable information like identifying the top
consumers of CPU time, identifying long-running jobs, charting the trends over
a period of time, or capacity planning. With good job naming conventions, the
information can also be used for billing or charge-back purposes. Looking at
resource usage in terms of service units may also be useful when moving jobs
from one system to other. The STEPSTOR report can be used to see whether the
program is using too much storage below the line. If yes, it can be re-compiled
with DATA (31) option (if COBOL) to relieve storage below the line. In heavily
paging environments, one may want to look at long-running programs consuming
high storage to see whether there is potential to reduce their storage
requirements. On the other hand, if the paging activity is negligible (or UIC
stays at 255), one may want to look at exploiting the storage to reduce
elapsed/CPU time for the programs showing high EXCP counts. Depending on what
those programs do, it may be possible to use various buffering techniques like
batch LSR or System Managed Buffering (SMB).
SMF30PG TITLE 'A
SAMPLE SMF30 REPORT WRITER PROGRAM'
* THIS PROGRAM PROCESSES RECORD TYPE 4 AND 5
SMF30PG CSECT
SMF30PG AMODE 31
SMF30PG RMODE ANY
MACRO
$STRGACQ
&TYPE,&LEN=,&LOC=
AIF ('&TYPE' EQ 'R').L0001
L R0,&LEN
AGO .L0002
.L0001 ANOP
LR R0,&LEN
.L0002 ANOP
A R0,=F'4'
STORAGE
OBTAIN,LENGTH=(0),LOC=&LOC
ST R0,0(,R1)
LA R1,4(,R1)
MEND
MACRO
$STRGREL
&TYPE,&ADDR=
AIF ('&TYPE' EQ 'R').L0001
L R1,&ADDR
AGO .L0002
.L0001 ANOP
LR R1,&ADDR
.L0002 ANOP
S R1,=F'4'
L R0,0(,R1)
STORAGE
RELEASE,ADDR=(1),LENGTH=(0)
MEND
*
YREGS
USING
SMF30PG,R12
$CONS DS 0H
B $CONSL(R15)
DC C'SMF30PG &SYSDATE. &SYSTIME.'
DS 0H
$CONSL EQU *-$CONS
STM R14,R12,12(R13) Store caller information
LR R12,R15 R12 Base
LR R2,R1 Save R1 for later
$STRGACQ
A,LEN==A($DYNL),LOC=31 Acq Dyn Stor
ST R13,4(,R1) Save Back pointer
ST R1,8(,R13) Save forward pointer
LR R13,R1 My save area
USING
$DYN,R13 Let Assembler
know
BAS R14,OPEN#000 Open all the files.
LTR R15,R15 Mandatory files opened ?
BNZ RETURN4 N: bail out
LA R1,SYSIN point to SYSIN offset
M R0,=A(FILESIZ) Get the real offset
A R1,FILEDATA Add start
MVI INCL,INCLALL Default to include all
CLI FILEIND-FILEINFO(R1),X'00' Was the file
opened ?
BE SMFP#020 N:
L R2,FILEREC-FILEINFO(,R1) Get the record address
L R3,FILEDCB-FILEINFO(,R1) Get the SYSIN DCB Addr
SMFP#005 DS 0H
LR R0,R2 Move record ADDR to R0
GET (3) Get a record
CLC 0(08,R2),=C'JOBNAME=' Is it a mask ?
BNE SMFP#005 N:
CLI 08(R2),C' ' Is there a mask ?
BE SMFP#005 N:
XC INCL,INCL Indicate mask present
$STRGACQ
A,LEN==A(MASKL),LOC=31 Acq stor for mask
MVC MASKNEXT-MASKDSCT(4,R1),MASKLIST Store next
adr
ST R1,MASKLIST Store anchor
MVC MASKNAME-MASKDSCT(8,R1),08(R2) Store Mask
LA R4,08(,R2) Bump past literal
LA R5,08(,R2) Bump past literal
LA R6,8 length of jobname
SMFP#006 DS 0H
CLI 0(R4),C' ' is this char blank ?
BE SMFP#007 Y:
LA R4,1(,R4) bump past this char
BCT R6,SMFP#006 loop back
SMFP#007 DS 0H
SR R4,R5 subtract start address
LTR R4,R4 is it zero ?
BZ SMFP#005 y: back to read
ST R4,MASKNAML-MASKDSCT(R1) store length
B SMFP#005 read next record
SMFP#010 DS 0H
SMFP#015 DS 0H
SMFP#020 DS 0H
LA R1,SMFIN process smf file
M R0,=A(FILESIZ)
A R1,FILEDATA
CLI FILEIND-FILEINFO(R1),X'00' is the file open
?
BE RETURN4 n: go back
L R2,FILEREC-FILEINFO(,R1) get the record address
L R3,FILEDCB-FILEINFO(,R1) get the dcb address
SMFP#025 DS 0H
LR R0,R2 store record address in
R0
GET (3) get a record
MVI STEP,ISSTEP indicate this is a step rec
CLI SMF30RTY-SMFRCD30(R2),X'1E' is this rec type
30 ?
BNE SMFP#025
CLC SMF30STP-SMFRCD30(2,R2),=H'04' is this a
subtype 4 ?
BL SMFP#025
CLC SMF30STP-SMFRCD30(2,R2),=H'05' is this asubtype 5 ?
BH SMFP#025
CLC SMF30STP-SMFRCD30(2,R2),=H'04'
BE SMFP#251
MVI STEP,ISJOB
SMFP#251 DS 0H
LA R1,SMF30DTE-SMFRCD30(R2) get the end date
BAS R14,CNVD#000 convert date
MVC ENDDATE,WORKDATE+2 save date for later
ICM R1,15,SMF30TME-SMFRCD30(R2) get the end time
BAS R14,CNVT#000 convert time
MVC ENDTIME,WORKTIME+2 save time for later
CLC SMF30IOF-SMFRCD30(4,R2),=F'0' Iden section
present ?
BE SMFP#026
CLC SMF30ILN-SMFRCD30(2,R2),=H'0' Iden section
present ?
BE SMFP#026
CLC SMF30ION-SMFRCD30(2,R2),=H'0' Iden section
present ?
BE SMFP#026
L R4,SMF30IOF-SMFRCD30(R2) map the iden section
AR R4,R2
MVC JOBNAME,SMF30JBN-SMF30ID(R4) get jobname
CLI INCL,INCLALL is this include all ?
BE SMFP#254 n:
L R5,MASKLIST point to mask list
SMFP#253 DS 0H
LTR R5,R5 is one present ?
BZ SMFP#025 n: get another record
BAS R14,CHEK#000 check the mask
LTR R15,R15 check good ?
BZ SMFP#254 y: process record
L R5,MASKNEXT-MASKDSCT(,R5) get next mask
B SMFP#253 check again
SMFP#254 DS 0H
MVC JOBNUM,SMF30JNM-SMF30ID(R4) get the job
number
MVC STEPNAME,SMF30STM-SMF30ID(R4) get the step
name
MVC PROGRAM,SMF30PGM-SMF30ID(R4) get the program name
LA R1,SMF30STD-SMF30ID(R4) Get start date
BAS R14,CNVD#000 Convert date
MVC STRTDTE,WORKDATE+2 Save for later
ICM R1,15,SMF30SIT-SMF30ID(R4) Get start time
BAS R14,CNVT#000 Convert Time
MVC STRTTME,WORKTIME+2 Save time for later
SMFP#026 DS 0H
BAS R14,HEDR#000 Build healder info
BAS R14,SUDT#000 Build SU details
BAS R14,TMDT#000 Build Time details
BAS R14,STDT#000 Build Storage details
B SMFP#025 Get next record
SMFP#030 DS 0H
SMFP#035 DS 0H
SMFP#040 DS 0H
B RETURN0
RETURN0 DS 0H
LA R5,0 Process OK. RC=0
B RETURN
RETURN4 DS 0H
LA R5,4 Process not OK. RC=4
RETURN DS 0H
BAS R14,CLOS#000 Close all files.
LR R1,R13 Save current dyn area
L R13,4(,R13) Restore old dyn area
$STRGREL
R,ADDR=1 Release curr dyn
area
L R14,12(,R13) Restore R14
LR R15,R5 R15->RC
LM R0,R12,20(R13) Restore other regs
BSM 0,R14 goback
* Check if
the pattern mask matches the jobname
CHEK#000 BAKR
R14,0
LA R2,MASKNAME-MASKDSCT(R5) Get address of Mask
LA R3,MASKNAML-MASKDSCT(R5) Point to length of mask
LA R4,JOBNAME Point to current jobname
ASAXWC PATTERNSTR=(2), -
PATTERNSTRLEN=(3), -
STRING=(4), -
STRINGLEN==A(8), -
ZEROORMORE=Z, -
ONECHAR=O, -
RETCODE=RETCODE, -
WORKAREA=WORKAREA, -
MF=(E,MYLIST)
L R15,RETCODE RC=0, match, else nomatch
CHEK#999 PR Go back to caller
* Open all
files.
OPEN#000 BAKR
R14,0
SLR R0,R0 Initialize R0
LA R1,FILESIZ Get the size of 1 file rec
LA R3,DDINFOS Get no. of DDs
MR R0,R3 Get size required
LR R0,R1
$STRGACQ
R,LEN=0,LOC=31 Acq Dyn Stor
ST R1,FILEDATA Store returned addr
SLR R2,R2
LA R3,DDINFO Point to DDINFO
LR R4,R1
LA R5,DDINFOS Get no. of DDs
USING
FILEINFO,R4
OPEN#005 DS 0H
LA R0,MODOPENL Get length of OPEN MODEL
$STRGACQ
R,LEN=0,LOC=31 ACQ dyn area
ST R1,FILEOPEN Store returned addr
MVC 0(MODOPENL,R1),MODOPEN Move OPEN MODEL
LA R0,MODCLOSL Get Length of CLOSE MODEL
$STRGACQ
R,LEN=0,LOC=31 ACQ dyn area
ST R1,FILECLOS Store returned addr
MVC 0(MODCLOSL,R1),MODCLOS Move close model
LA R0,MODDCBEL Get length of DCBE model
$STRGACQ
R,LEN=0,LOC=31 ACQ dyn area
ST R1,FILEDCBE Store returned addr
MVC 0(MODDCBEL,R1),MODDCBE Move DCBE model
USING
DCBE,R1
MVC DCBEEODA,16(R3) Save EOD address
MVC DCBESYNA,20(R3) Save SYNAD address
DROP R1
CLI 8(R3),C'I' Is this open for Input
BNE OPEN#010 y:
LA R0,MODDCBIL Get input DCB length
$STRGACQ
R,LEN=0,LOC=24 ACQ dyn area
ST R1,FILEDCB Store returned addr
MVC 0(MODDCBIL,R1),MODDCBI Move input DCB model
B OPEN#015
OPEN#010 DS 0H
LA R0,MODDCBOL Get length of output DCB
$STRGACQ
R,LEN=0,LOC=24 ACQ dyn area
ST R1,FILEDCB Store returned addr
MVC 0(MODDCBOL,R1),MODDCBO Move output DCB model
OPEN#015 DS 0H
USING
IHADCB,R1
MVC DCBDDNAM,0(R3) Move DD name
MVC DCBDCBE,FILEDCBE Move DCBE address
DROP R1
L R0,12(,R3) Move length of record
$STRGACQ
R,LEN=0,LOC=31 ACQ dyn area
ST R1,FILEREC Store returned addr
MVC FILERECL,12(R3) save lrecl
XC FILEIND,FILEIND initialize indicator
MVC FILEHEDR,24(R3) move header address
L R6,FILEDCB point to file dcb
L R7,FILEOPEN point to open area
CLI 8(R3),C'I' is this open for input ?
BNE OPEN#020 n:
OPEN ((6),INPUT),MF=(E,(7)),MODE=31 open file
B OPEN#025
OPEN#020 DS 0H
OPEN ((6),OUTPUT),MF=(E,(7)),MODE=31 open file
OPEN#025 DS 0H
LTR R15,R15 Open success ?
BZ OPEN#035 Y:
CLI 9(R3),C'M' Was this a mandatory file ?
BNE OPEN#040 n:
LA R2,4 indicate RC=4
B OPEN#040
OPEN#035 DS 0H
MVI FILEIND,X'01' Indicate file open
CLI 8(R3),C'I' Was this input ?
BE OPEN#040 y:
LR R1,R4 point to offset
BAS R14,HDRW#000 Write header record
OPEN#040 DS 0H
LA R3,DDINFOL(,R3) Bump to next dd
LA R4,FILESIZ(,R4) Bump to next file
BCT R5,OPEN#005 open them
LR R15,R2 R15->RC
OPEN#999 PR
DROP R4
* Write header records to output file
HDRW#000 BAKR
R14,0
LR R4,R1 Point to offset
L R0,FILEREC-FILEINFO(R4) Get record addr
L R3,FILEDCB-FILEINFO(R4) Get DCB addr
L R1,FILERECL-FILEINFO(R4) Get record length
L R14,FILEHEDR-FILEINFO(R4) Get header rec
addr
LR R15,R1 length in R15
ICM R15,B'1000',BLANK Default to ' '
LTR R14,R14 Is header present ?
BZ HDRW#999 n: bail out
MVCL R0,R14 Move record to output
L R0,FILEREC-FILEINFO(R4) point to record addr
PUT (3) WRite output
HDRW#999 PR goback
* Close all files.
CLOS#000 BAKR
R14,0
L R2,FILEDATA Point to file information.
LA R3,DDINFOS Get number of DDs
USING
FILEINFO,R2
CLOS#005 DS 0H
L R6,FILEDCB Get DCB addr
L R7,FILECLOS Get close area
CLI FILEIND,X'00' Is this file open ?
BE CLOS#010 n:
CLOSE
((6)),MF=(E,(7)),MODE=31 Close file
CLOS#010 DS 0H
L R1,FILEOPEN Point to open area
$STRGREL
R,ADDR=1 Release storage
L R1,FILECLOS Point to close area
$STRGREL
R,ADDR=1 Release storage
L R1,FILEDCB Point to dcb area
$STRGREL
R,ADDR=1 Release storage
L R1,FILEDCBE Point to dcbe area
$STRGREL
R,ADDR=1 Release storage
L R1,FILEREC Point to rec area
$STRGREL
R,ADDR=1 Release storage
MVI FILEIND,X'00' Indicate file closed
LA R2,FILESIZ(,R2) Bump to next
BCT R3,CLOS#005 Close them
CLOS#999 PR go back
DROP R2
PRTF#000 BAKR
R14,0 Write
output to files
M
R0,=A(FILESIZ) R1 points to
offset
A R1,FILEDATA add start offset
CLI FILEIND-FILEINFO(R1),X'00' is this file open
?
BE PRTF#999 n: goback
L R2,FILEREC-FILEINFO(R1) Point to record addr
L R3,FILEDCB-FILEINFO(R1) Point to DCB
L R4,FILERECL-FILEINFO(R1) Get record length
LR R0,R2
LR R1,R4
LA R14,PRTLINE Point to PRTLINE
LA R15,L'PRTLINE Get PRTLINE address
ICM R15,B'1000',BLANK Default to ' '
MVCL R0,R14 Move record to output
LR R0,R2 R0-> record
PUT (3) Put to record to file/.
PRTF#999 PR goback
HEDR#000 BAKR
R14,0 write
header part of record
MVC PRTLINE(L'BLANK),BLANK initialize prtline
MVC PRTLINE+1(L'PRTLINE-1),PRTLINE
LA R1,PRTLINE point to prtline
USING
HEDR,R1 let assembler
know
MVC HEDRJNME,JOBNAME move jobname
MVC HEDRJNUM,JOBNUM move jobnumber
MVC HEDRSTDT,STRTDTE move start date
MVC HEDRSTTM,STRTTME move start time
MVC HEDRENDT,ENDDATE move end date
MVC HEDRENTM,ENDTIME move end time
CLI STEP,ISJOB is this step info ?
BE HEDR#999 n: goback
MVC HEDRSTNM,STEPNAME move stepname
MVC HEDRPGNM,PROGRAM move program name
HEDR#999 PR goback
SUDT#000 BAKR
R14,0 write
SU details
BAS R14,HEDR#000 write header part of rec
USING
SMFRCD30,R2 let assembler
know
CLC SMF30POF,=F'0' is there info ?
BE SUDT#999 n: goback
CLC SMF30PLN,=H'0' is there info ?
BE SUDT#999 n: goback
CLC SMF30PON,=H'0' is there info ?
BE SUDT#999 n: goback
A
R2,SMF30POF Add offset to
section.
USING
SMF30PRF,R2 Let assembler
know
LA R1,PRTLINE Point to prtline
CLI STEP,ISJOB is this jobinformation ?
BE SUDT#005 y:
LA R1,HEDRSTEP(,R1) Bump step header info
LA R3,STEPSU indicate stepsu
B SUDT#010
SUDT#005 DS 0H
LA R1,HEDRJOB(,R1) Bump past job header info
LA R3,JOBSU indicate jobsu
SUDT#010 DS 0H
USING
SUDSECT,R1 Let assembler
know
MVC SUTOT,EDMASKN Move mask to su totals
MVC SUCPU,EDMASKN Move mask to su cpu
MVC SUSRB,EDMASKN Move mask to su srb
MVC SUIO,EDMASKN Move mask to su io
ICM R14,15,SMF30SRV get total su
CVD R14,DWORD conver to decimal
ED SUTOT,DWORD+3 edit to su totals
ICM R14,15,SMF30CSU get cpu su
CVD R14,DWORD conver to decimal
ED SUCPU,DWORD+3 edit to su cpu
ICM R14,15,SMF30SRB get srb su
CVD R14,DWORD conver to decimal
ED SUSRB,DWORD+3 edit to su srb
ICM R14,15,SMF30IO get io su
CVD R14,DWORD conver to decimal
ED SUIO,DWORD+3 edit to su io
CLI STEP,ISSTEP is this step info ?
BE SUDT#015 y: goback
MVC SUWLM,SMF30WLM move wlm class
MVC SUSRVNM,SMF30SCN move wlm service name
MVC JOBWLMC,SMF30WLM move wlm class
MVC JOBWLMS,SMF30SCN move wlm service name
SUDT#015 DS 0H
LR R1,R3 point to dd offset
BAS R14,PRTF#000 write this record
SUDT#999 PR goback
DROP R1,R2
TMDT#000 BAKR
R14,0 write
TIME details
BAS R14,HEDR#000 write header part of rec
USING
SMFRCD30,R2 let assembler
know
CLC SMF30COF,=F'0' is there info ?
BE TMDT#999 n: goback
CLC SMF30CLN,=H'0' is there info ?
BE TMDT#999 n: goback
CLC SMF30CON,=H'0' is there info ?
BE TMDT#999 n: goback
ZAP DEXCP,=P'0' Initialize excp count
CLC SMF30UOF,=F'0' is there info ?
BE TMDT#003 n: goback
CLC SMF30ULN,=H'0' is there info ?
BE TMDT#003 n: goback
CLC SMF30UON,=H'0' is there info ?
BE TMDT#003 n: goback
LR R3,R2
A R3,SMF30UOF
L R1,SMF30TEP-SMF30URA(,R3) Get excp count
CVD R1,DEXCP Convert to decimal
TMDT#003 DS 0H
A
R2,SMF30COF Add offset
USING
SMF30CAS,R2 Let assembler
know
LA R4,PRTLINE Point to prtline
CLI STEP,ISJOB is this jobinformation ?
BE TMDT#005 y:
LA R4,HEDRSTEP(,R4) bump past step header
LA R3,STEPTIME indicate steptime dd
B TMDT#010
TMDT#005 DS 0H
LA R4,HEDRJOB(,R4) bump past job header
LA R3,JOBTIME indicate jobtime
TMDT#010 DS 0H
USING
TIMEDSCT,R4 let assembler
know
MVC TIMEEXCP,EDMASKN move edit mask to excp
ICM R1,15,SMF30CPT Get tcb cpu time
BAS R14,CNVT#000 convert time
MVC TIMECPU,WORKTIME+2 write cpu time to output
ICM R1,15,SMF30CPS Get tcb srb time
BAS R14,CNVT#000 convert time
MVC TIMESRB,WORKTIME+2 write srb time to output
ED TIMEEXCP,DEXCP+3 Edit excps
CLI STEP,ISSTEP Is this step info ?
BE TMDT#015
MVC TIMEWLM,JOBWLMC
MVC TIMESRVN,JOBWLMS
TMDT#015 DS 0H
LR R1,R3 point to dd offset
BAS R14,PRTF#000 write this record
TMDT#999 PR goback
DROP R4,R2
STDT#000 BAKR
R14,0 write
storage details
BAS R14,HEDR#000 write header part of output
USING
SMFRCD30,R2 let assembler
know
CLC SMF30ROF,=F'0' is there info ?
BE STDT#999 n: goback
CLC SMF30RLN,=H'0' is there info ?
BE STDT#999 n: goback
CLC SMF30RON,=H'0' is there info ?
BE STDT#999 n: goback
A R2,SMF30ROF Add offset
USING
SMF30SAP,R2 Let assembler
know
LA R4,PRTLINE point to prtline
CLI STEP,ISJOB is this job info ?
BE STDT#999 y:goback
LA R4,HEDRSTEP(,R4) bump step header info
LA R3,STEPSTOR indicate stepstor
USING
STORDSCT,R4 let assembler
know
MVC STORUB16,EDMASKN Move edit mask to UStor<16M
MVC STORUA16,EDMASKN Move edit mask to UStor>16M
MVC STORSB16,EDMASKN Move edit mask to SStor<16M
MVC STORSA16,EDMASKN Move edit mask to SStor>16M
ICM R14,B'1111',SMF30URB Get Ustor<16M
SRL R14,10 Convert to KB
CVD R14,DWORD Convert to decimal
ED STORUB16,DWORD+3 Edit to output area
ICM R14,B'1111',SMF30EUR Get Ustor>16M
SRL R14,10 Convert to KB
CVD R14,DWORD Convert to decimal
ED STORUA16,DWORD+3 Edit to output area
ICM R14,B'1111',SMF30ARB Get Sstor<16M
SRL R14,10 Convert to KB
CVD R14,DWORD Convert to decimal
ED STORSB16,DWORD+3 Edit to output area
ICM R14,B'1111',SMF30EAR Get Sstor>16M
SRL R14,10 Convert to KB
CVD R14,DWORD Convert to decimal
ED STORSA16,DWORD+3 Edit to output area
LR R1,R3 Point to dd offset
BAS R14,PRTF#000 write this output rec
STDT#999 PR goback
DROP R4,R2
CNVT#000 BAKR
R14,0 Convert
time to HH:MM:SS
SLR R0,R0 R1-> time in 100th of
sec
D R0,=F'360000' Get hours
CVD R1,DWORD Convert to decimal
SRP DWORD,4,0 000000000HH0000C
ZAP WTIME,DWORD Save it for later
LR R1,R0 Get reminder
SLR R0,R0
D R0,=F'6000' Get minutes
CVD R1,DWORD Convert to decimal
SRP DWORD,2,0 00000000000MM00C
AP WTIME,DWORD Add to saved time
LR R1,R0 Get reminder
SLR R0,R0
D R0,=F'100' Get seconds
CVD R1,DWORD Convert to decimal
AP WTIME,DWORD Add to saved time
MVC WORKTIME,EDMASKT Move edit mask for time
ED WORKTIME,WTIME+4 edit time
CNVT#999 PR goback
* Convert
date from 0nYYDDDF to CCYY-MM-DD format
CNVD#000 BAKR
R14,0
ZAP DWORD,0(4,R1) R1 points to input date
OI DWORD+L'DWORD-1,X'0F' Make pack!
AP DWORD,=P'1900000' Add 1900000
ZAP WDATE,DWORD Save for later
SRP DWORD,64-3,0 Remove days
CVB R1,DWORD Convert to binary
SLR R0,R0
D R0,=F'4' Divide by 4
C R0,=F'0' Any reminder ?
BE CNVD#005 y: is leap year
L R1,=A(NLEAPYR) not a leap year
B CNVD#010
CNVD#005 DS 0H
L R1,=A(LEAPYR) is a leap year
CNVD#010 DS 0H
ZAP DWORD,WDATE restore date
SRP WDATE,64-3,0 remove days
SRP WDATE,4,0 0000000CCYY0000F
SRP DWORD,12,0 DDD000000000000F
SRP DWORD,64-12,0 000000000000DDDF
AP WDATE,=P'100' Indicate 1st month
CNVD#015 DS 0H
CP DWORD,0(2,R1) is the days < table
BNH CNVD#020 n:
AP WDATE,=P'100' Add 1 month
SP DWORD,0(2,R1) Subtract date in month
LA R1,2(,R1) Bump to next table entry
B CNVD#015 loop back
CNVD#020 DS 0H
AP WDATE,DWORD Add date
MVC WORKDATE,EDMASKD Move mask for date
ED WORKDATE,WDATE+3 Edit date
CNVD#999 PR goback
* Literals
Z DC CL1'*' zero or more char
O DC CL1'?' exactly 1 char
LEAPYR DC
P'31,29,31,30,31,30,31,31,30,31,30,31,30,31' leap table
NLEAPYR DC
P'31,28,31,30,31,30,31,31,30,31,30,31,30,31'
EDMASKN DC X'40202020202020202120' Edit mask for number
EDMASKT DC X'402120207A20207A2020' Edit mask for time
EDMASKD DC X'402120202020602020602020' Edit mask for
date
BLANK DC C'
' Blanks
DS 0F DD table
DDINFO DC C'SYSIN
',C'I',C'O',A(80),A(SMFP#010),A(SMFP#015)
DC A(0)
SYSIN EQU 0
DDINFOL EQU *-DDINFO
DC C'SMFIN
',C'I',C'M',A(60000),A(SMFP#030),A(SMFP#035)
DC A(0)
SMFIN EQU 1
DC C'STEPSU
',C'O',C'O',A(133),A(0),A(0)
DC A(SUSHDR)
STEPSU EQU 2
DC C'JOBSU
',C'O',C'O',A(133),A(0),A(0)
DC A(SUJHDR)
JOBSU EQU 3
DC C'STEPTIME',C'O',C'O',A(133),A(0),A(0)
DC A(TMSHDR)
STEPTIME EQU 4
DC C'JOBTIME ',C'O',C'O',A(133),A(0),A(0)
DC A(TMJHDR)
JOBTIME EQU 5
DC C'STEPSTOR',C'O',C'O',A(133),A(0),A(0)
DC A(STSHDR)
STEPSTOR EQU 6
DDINFOS EQU (*-DDINFO)/DDINFOL
DC X'FFFFFFFF'
MODDCBO DCB DCBE=MODDCBE,MACRF=(PM),DSORG=PS,LRECL=133
output DCB
MODDCBOL EQU
*-MODDCBO
MODDCBI DCB
DCBE=MODDCBE,DDNAME=0,MACRF=(GM),DSORG=PS Input DCB
MODDCBIL EQU
*-MODDCBI
MODDCBE DCBE RMODE31=BUFF,EODAD=0,SYNAD=0 Model DCBE
MODDCBEL EQU
*-MODDCBE
MODOPEN OPEN (,),MF=L,MODE=31 Model OPEN
MODOPENL EQU
*-MODOPEN
MODCLOS CLOSE
(,),MF=L,MODE=31 Model
CLOSE
MODCLOSL EQU
*-MODCLOS
*
LTORG
SMF30PG CSECT
SUSHDR DS 0F Header information
DC C' JobName
JobNum Start Date St Time End D'
DC C'ate
End Time StepName Program Total
SU '
DC C'
CPU SU SRB SU IO SU '
SUJHDR DS 0F
DC C' JobName
JobNum Start Date St Time End D'
DC C'ate
End Time Total SU CPU SU
SRB'
DC C' SU
IO SU WLM Cls Serv Name '
TMSHDR DS 0F
DC C' JobName
JobNum Start Date St Time End D'
DC C'ate
End Time StepName Program TCB
CPU SR'
DC C'B CPU EXCP '
TMJHDR DS 0F
DC C' JobName
JobNum Start Date St Time End D'
DC C'ate
End Time TCB CPU SRB CPU EXCP '
DC C'WLM Cls
Serv Name
'
STSHDR DS 0F
DC C' JobName
JobNum Start Date St Time End D'
DC C'ate
End Time StepName Program
USR<16(K)'
DC C'
USR>16(K) SYS<16(K)
SYS>16(K) '
$DYN DSECT Dynamic area
SAVEAREA DS
18F Save area
FILEDATA DS
F Pointer to
file information
MASKLIST DS
F Pointer to
mask list
RETCODE DS F Return code
DWORD DS D work
DEXCP DS D work excp count
WDATE DS D work date
WTIME DS D work time
WORKTIME DS
CL(L'EDMASKT) work area
WORKDATE DS
CL(L'EDMASKD) work area
JOBWLMC DS CL08 wlm class
JOBWLMS DS CL08 wlm serice name
STRTDTE DS CL10 Start date
ENDDATE DS CL10 End date
STRTTME DS CL08 Start Time
ENDTIME DS CL08 End time
JOBNAME DS CL08 Jobname
JOBNUM DS CL08 Job Number
STEPNAME DS
CL08 Step Name
PROGRAM DS CL08 Program name
STEP DS X Step indicator
ISSTEP EQU X'00' ...Is step information
ISJOB EQU X'01' ...Is job information
INCL DS X Include indicator
INCLALL EQU X'01' ...Include all
PRTLINE DS CL133 Print line
ASAXWC MF=(L,MYLIST)
WORKAREA DS
CL256 WorkArea
$DYNL EQU *-$DYN Length of Dyn area
FILEINFO DSECT DSECT for file area
FILEOPEN DS
F Open area
addr
FILECLOS DS
F Close area
addr
FILEDCB DS F DCB addr
FILEDCBE DS
F DCBE addr
FILEREC DS F rec addr
FILERECL DS
F rec length
FILEHEDR DS
F header addr
FILEIND DS X indicator
DS CL3 filler
FILESIZ EQU *-FILEINFO length of file area
HEDR DSECT Heeader information for
rec
DS CL1
HEDRJNME DS
CL8 Jobname
DS CL1
HEDRJNUM DS
CL8 Jobnumber
DS CL1
HEDRSTDT DS
CL10 Start date
DS CL1
HEDRSTTM DS
CL08 Start Time
DS CL1
HEDRENDT DS
CL10 End date
DS CL1
HEDRENTM DS
CL08 End time
DS CL1
HEDRJOB EQU *-HEDR Length of job header
HEDRSTNM DS
CL08 Step Name
DS CL1
HEDRPGNM DS
CL08 Program
Name
DS CL1
HEDRSTEP EQU
*-HEDR Length of
Step Header
HEDRL EQU *-HEDR Total length of header
SUDSECT DSECT Dsect for SU details
SUTOT DS CL10 Total SU units
DS CL1
SUCPU DS CL10 CPU SU units
DS CL1
SUSRB DS CL10 SRB SU units
DS CL1
SUIO DS CL10 IO su units
DS CL1
SUWLM DS CL08 WLM class name
DS CL1
SUSRVNM DS CL08 WLM serv class
SUL EQU *-SUDSECT Length
TIMEDSCT DSECT Dsect for TIME details
TIMECPU DS CL08 TCB CPU time
DS CL1
TIMESRB DS CL08 TCP SRB time
DS CL1
TIMEEXCP DS
CL10 Total EXCP
DS CL1
TIMEWLM DS CL08 WLM class name
DS CL1
TIMESRVN DS
CL08 WLM serv
class
TIMEL EQU *-TIMEDSCT Length
STORDSCT DSECT Dsect for Storage
section
STORUB16 DS
CL10 User stor
< 16M
DS CL1
STORUA16 DS
CL10 User stor
> 16M
DS CL1
STORSB16 DS
CL10 Sys stor
< 16M
DS CL1
STORSA16 DS
CL10 Sys Stor
> 16M
STORL EQU *-STORDSCT Length
MASKDSCT DSECT Dsect for Mask details
MASKNEXT DS
F Ptr to Next
mask info elem
MASKNAML DS
F Length of
Mask
MASKNAME DS
CL8 Name of Mask
MASKL EQU *-MASKDSCT Length
DCBD
DSORG=PS,DEVD=DA
IHADCBE
IFASMFR 30
END SMF30PG
Subscribe to:
Posts (Atom)