IBM Mainframe Forum

by **belkin99** » Fri Mar 04, 2011 11:21 am

Hi,
I would like to verify the format of the READ and WRITE macros
where I have a BPAM DCB, but I am not sure how I can use the READ correctly.
for example:

Select all

OPEN (DCB,(INPUT))
LA DCBR,DCB
USING IHADCB,DCBR
...
READ DECB1,SF,DCB,AREA1,'S'

Where I would like to know what is the difference between the
Q1> dcbname and dcbaddress
Q2> How should area1 be located in storage.
Q3> If I dont know the length of my block, what I should put, assuming this is my first read, and I did not calculate the Blksize, LRECL, Residual factor yet.

Any advise is appreciated

by **steve-myers** » Fri Mar 04, 2011 12:24 pm

Before you can read a member you have to provide member information.

Specify the member name in the DSNAME= parameter in JCL.
Use RDJFCB, insert a member name in JFCBELNM and use OPEN TYPE=J to open the dataset. This method is slow, but you can use GET to read the member.
Use the FIND macro to supply a member name.
Provide the TTRN of the first record in the member using the FIND macro. You can get the TTR by reading the directory yourself (generally speaking, the N will be 0 if you use thus method), or the TTRN by using the BLDL macro. This is the fastest way to read multiple members in a single job step.

As for your questions.

A DCB name is just the label you place on the Assembler statement that defines the DCB. A DD name is specified by the DDNAME=xxx parameter in your DCB macro, and it must match a DD name on a DD statement in the JCL used to run your program.

The area address you use can be defined in your program, or it can be allocated using a GETMAIN macro, or it can be a buffer in the buffer pool the OPEN macro assigns in OPEN processing. Most of my recent programs use the buffer pool method. Specify BUFNO=1 in your DCB macro to persuade OPEN to build a buffer pool, and GETBUF to extract a buffer from the buffer pool.

Your block length (when reading) is defined by the BLKSIZE parameter. Specify 'S' in the READ macro to use BLKSIZE.

You must determine the actual block length of a block you just read after the CHECK macro. You do this by obtaining the residual byte count (that's a fancy way of saying bytes that were not read in a READ operation).

Select all

GETBLOCK READ DECB,SF,UT1,*-*,'S' READ A BLOCK
CHECK DECB WAIT FOR THE BLOCK TO COME IN
L 3,DECB+12 LOAD ADDR OF THE I/O BUFFER
LH 4,DCBLRECL-IHADCB+UT1 LOAD THE LOGICAL RECORD LENGTH
LH 5,DCBBLKSI-IHADCB+UT1 LOAD THE BUFFER SIZE
L 15,DECB+16 LOAD ADDR OF THE PSEUDO IOB
LH 0,14(,15) LOAD THE RESIDUAL BYTE COUNT FROM ->
THE PSEUDO CAW IN THE PSEUDO IOB
SR 5,0 COMPUTE THE ACTUAL NUMBER OF BYTES ->
IN THE BLOCK WE JUST READ
SR 5,4 COMPUTE THE OFFSET IN THE BLOCK ->
OF THE LAST LOGICAL RECORD IN THE ->
BLOCK
AR 5,3 COMPUTE THE ADDR OF THE LAST ->
LOGICAL RECORD IN THE BLOCK
PUTLRECL PUT UT2,(3) WRITE THE LOGICAL RECORD
BXLE 3,4,PUTLRECL COMPUTE THE ADDR OF THE NEXT ->
LOGICAL RECORD IN THE INPUT ->
BLOCK, BR IF THE RECORD IS IN ->
BLOCK
B GETBLOCK GO READ THE NEXT BLOCK
...
UT1 DCB DSORG=PO,MACRF=R,DDNAME=SYSUT1,EODAD=MEMBEOF,RECFM=FB, ->
BUFNO=1

This example is in a program that copies a member to a sequential data set and will work for datasets with RECFM=F or RECFM=FB. The area address was stored in the appropriate place in the DECB before this code was entered. The comments refer to "pseudo" this and that because the control blocks (the IOB) or data area (CAW) no longer exist or are no longer used, but analogs of the data are kept for so that 40 year old programs written for OS/360, as well as new programs will work correctly. Datasets with RECFM=VB are processed similarly, but you do not need to calculate the block length because your program can use the block length stored in the Block Descriptor Word in the data block itself.

Writing BPAM is more difficult. I would suggest becoming proficient reading BPAM before trying to write using BPAM.

by **belkin99** » Tue Mar 08, 2011 10:44 am

Really appreciating your help.

Can you clarify what is IHADCB in

Select all

LH 4,DCBLRECL-IHADCB+UT1 LOAD THE LOGICAL RECORD LENGTH
LH 5,DCBBLKSI-IHADCB+UT1 LOAD THE BUFFER SIZE

where I am using the following

Select all

LA R11,BPAMIN GET ADDRESS OF THE DCB
L R8,INDECB+16 LOAD ADDRESS OF I/O BUFFER
LH R7,14(R8) GET THE RESIDUAL LENGTH
LH R9,62(R11) GET BLOCK SIZE IN R9
LH R10,82(R11) LRECL SIZE
SR R10,R7 FIND BLOCK SIZE
M R8,=F'1' PUTTING CORRECT SIGN
DR R8,R10 GET NO. OF RECORD IN R9

The only problem here, is when I read short block, it is sound to me is not correct when I dump the registers.

by **steve-myers** » Tue Mar 08, 2011 11:52 am

IHADCB is the name of the DCB DSECT built by the DCBD macro. DCBLRECL-IHADCB is the offset of the DCBLRECL data area in the DCB. DCBLRECL-IHADCB+UT1 is the address of DCBLRECL data area in the DCB with DCB name UT1.

The comment on your L R8,INDECB+16 statement is incorrect. You are loading the address of what used to be a control block called an IOB. An IOB is not an I/O buffer. The I/O buffer address is at offset 12 in the DECB. An IOB is still used with the EXCP macro, but that's a whole 'nother can of worms that has nothing to do with this topic.

There are other problems with your code. I'd try -

Select all

L R1,INDECB+16 L0AD ADDRESS OF THE IOB
LH R9,DCBBLKSI-IHADCB+BPAMIN LOAD THE BLOCK LENGTH
SH R9,14(,R1) SUBTRACT THE RESIDUAL BYTE COUNT
* FROM THE BLOCK LENGTH
LH R10,DCBLRECL-IHADCB+BPAMIN LOAD THE LOGICAL REC LEN
SR R8,R8 SET REG 8 = 0
DR R8,R10 DIVIDE THE ACTUAL BLOCK LENGTH
* BY THE LOGICAL RECORD LENGTH
* TO GET THE LOGICAL RECORDS IN
* THE DATA BLOCK

If the result of the SH instruction is negative you've got other problems, so the SR R8,R8 should be safe. You will sometimes see the the math done in the even register(R8, in other words), with a SLDA R8,32 before the divide to copy register 8 to register 9 and preserve the sign just in case it's negative. Register 8 should be 0 after the divide, though it's not worth testing it. The CHECK macro verifies the block length is a multiple of the logical record length, and it will fail with an S001 or S002 ABEND if there is something wrong with the block length.

by **belkin99** » Fri Mar 25, 2011 5:04 am

YES,
You are correct the calculating of short block is should be as follow

Select all

MR R6,R8 CALCULATE THE SHORT SIZE
R7 #LOGICAL REC X BLOCKSIZE
LH R10,PDSOUT+62 CALCULATE BLOCK SIZE
ST R10,SAVEBLK STORE BLOCK SIZE FOR RESET
STH R7,PDSOUT+62 STORE SHORT BLOCK
WRITE DECBY,SF,PDSOUT,WBUFFER WRITE THE BLOCK
CHECK DECBY

and calculating of the block factor itself as follow

Select all

LH R7,PDSOUT+62 HOLDS BLOCKING FACTOR/BLKSIZE
LH R8,PDSOUT+82 HOLDS THE LRECL
M R6,=F'1' PUTTING THE CORRECT SIGN
DR R6,R8 GET BLOCK FACTOR @ R7
ST R7,BLKFACTR SAVE THE BLOCK FACTOR

where PDSOUT my DCB
I tested both and are working fine, and I thing we covered this topic
Thanks,

by **steve-myers** » Fri Mar 25, 2011 8:29 am

You should avoid structures like PDSOUT+62. I certainly don't memorize DCB offsets, and it's unlikely you will, too, much less the next person to work on the program. Better something like DCBBLKSI-IHADCB+PDSOUT. You get the Assembler to do the arithmetic, and, better yet, the next person (or you) to work on the program will have a better idea what's going on.

For what it's worth, I always form my structure like DCBBLKSI-IHADCB+dcb. This way, if you are doing something like MVC DCBBLKSI-IHADCB+dcb,value, the Assembler will generally fill in the length of DCBBLKSI, if its correct in its definition, which is not always the case. This is one less thing to do by yourself.

Back when I started, I usually did something like -

Select all

BLKSI EQU DCBBLKSI-IHADCB
LRECL EQU DCBLRECL-IHADCB
RECFM EQU DCBRECFM-IHADCB

LH Rx,dcb+BLKSI

In other words, what you're doing, but symbolically. This simplified matters when I dealt with multiple DCBs, but I stopped doing this something like 20 years ago, and even now when my typing speed has been radically reduced I won't resume this practice.

Another thing I've stopped doing is defining and using Rx symbols. The register XREF provided in the recent HLASM releases does a better job, like identify hidden registers in instructions, than having Rx show up in your symbol table. There is no longer value to this, so why continue defining and using Rx symbols?

By hidden registers, consider

TRT AREA,TRTTAB

TRT will alter register 1, and may alter register 2. This will show up in the HLASM register XREF, and nowhere else. Same thing with something like

MVCL 2,4

Registers 2, 3, 4 and 5 may be altered, and this will be reflected in the register XREF.

by **enrico-sorichetti** » Fri Mar 25, 2011 2:49 pm

here is the main for a rexx function to read/write/delete/rename PDS members

Select all

TITLE '* * * * * R X P D S * * * * *'
GBLA &BLDLLEN
&BLDLLEN SETA 44
&VARPREF SETC 'RXPDS_'
&MSGPREF SETC 'RXPDS - '
RXPDS $ENTR BASE=(R12,R11),SAVE=RENT,RENT=RENTL
RXPDS AMODE 24
RXPDS RMODE 24
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* SAVE EFPL POINTER
LR R10,R1
USING EFPL,R10
L R9,EFPLARG
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* INITIALIZE WORKING STORAGE
LA R4,WORK
LA R5,WORKL
LA R6,DATA
LA R7,DATAL
MVCL R4,R6
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* FUNCTION
P1 $GETPARM 1,FUNCPAR,STRIP=STRIP
CLC FUNCPAR,=CL8'STATS'
BE ENDP1
CLC FUNCPAR,=CL8'READ'
BE ENDP1
CLC FUNCPAR,=CL8'WRITE'
BE ENDP1
CLC FUNCPAR,=CL8'REPLACE'
BE ENDP1
CLC FUNCPAR,=CL8'DELETE'
BNE ERRP1
ENDP1 DS 0H
SPACE
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* DDNAME
P2 $GETPARM 2,DDNMPAR,STRIP=STRIP
MVC DDNAME,DDNMPAR
SPACE
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* MEMBER
P3 $GETPARM 3,MEMBPAR,STRIP=STRIP
MVC MEMBER,MEMBPAR
MVC BLDLMBR,MEMBPAR
MVC STOWMBR,MEMBPAR
CLC FUNCPAR,=CL8'STATS'
BE ENDPARMS
CLC FUNCPAR,=CL8'DELETE'
BE ENDPARMS
SPACE
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* STEM
P4 $GETPARM 4,STEMPAR,STRIP=STRIP
ENDPARMS DS 0H
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* PHASE 0 FIND OUT THE RELEVANT INFORMATION
*
PDS0JFCB DS 0H
CALL $RDJFCB,(FCBAREA),MF=(E,PLIS),VL
LTR R15,R15
BZ PDS0JFCE
MVC MAXCC,=AL4(4)
$VARTOKN MSGV$,'&MSGPREF.DDname Not Found'
C R15,=AL4(4)
BE RETURN
MVC MAXCC,RCODE
$VARTOKN MSGV$,'&MSGPREF.$RDJFCB System Error'
B RETURN
PDS0JFCE DS 0H
MVC QNAME,SYSIEWLP
CLI RECFM,RECFM_U
BE PDS0DEVT
MVC QNAME,SPFEDIT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* GET THE DEVICE DATA
PDS0DEVT DS 0H
DEVTYPE DDNMPAR,DEVAREA,DEVTAB
LTR R15,R15
BZ PDS0BUFF
A R15,=AL4(3000)
ST R15,MAXCC
$VARTOKN MSGV$,'&MSGPREF.DEVTYPE System Error'
B RETURN
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* GET THE I/O BUFFER
PDS0BUFF DS 0H
CLC FUNCPAR,=CL8'DELETE'
BE PDS0OPEN
L R0,DEVAREA+4 GET MAX RECORD SIZE ON DEVICE
ST R0,BUFFLEN ... AND SAVE IT
GETMAIN R,LV=(0) GET STORAGE FOR RECORD AREA
ST R1,BUFFPTR SAVE ADDRESS OF AREA
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* OPEN FOR INPUT
PDS0OPEN DS 0H
LA R9,PDSDCB
USING IHADCB,R9
MVC DCBDDNAM,DDNMPAR
LA R15,PDS1EOD
ST R15,DCBEODAD
OPEN ((R9),(INPUT)),MF=(E,OPENLST)
TM DCBOFLGS,DCBOFOPN
BO PDS0BLDL
MVC MAXCC,=AL4(12)
$VARTOKN MSGV$,'&MSGPREF.Input Open Error'
B RETURN
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* GET MEMBER INFORMATION
PDS0BLDL DS 0H
BLDL ((R9)),BLDLAREA
LTR R15,R15
BZ PDS0BLD1
CLC FUNCPAR,=CL8'WRITE'
BE PDS2WRTE
CLC FUNCPAR,=CL8'REPLACE'
BE PDS2WRTE
MVC MAXCC,=AL4(8)
$VARTOKN MSGV$,'&MSGPREF.Member Not Found'
CLOSE ((R9)),MF=(E,CLOSLST)
CLC FUNCPAR,=CL8'READ'
BNE RETURN
XC INDEX,INDEX
XC PLIS,PLIS
CALL $441PUT,(STEM$,ZERO,TYPEBIN,INDEX),MF=(E,PLIS),VL
B RETURN
PDS0BLD1 DS 0H
CLC FUNCPAR,=CL8'REPLACE'
BE PDS2WRTE
CLC FUNCPAR,=CL8'DELETE'
BE PDS2WRTE
sr r15,r15
ICM R15,B'0001',BLDLK
ST R15,FWORD
XC PLIS,PLIS
CALL $441PUT,(LEVEL$,,TYPEBIN,FWORD),MF=(E,PLIS),VL
sr r15,r15
ICM R15,B'0001',BLDLC
SLL R15,1
STCM R15,B'0011',TEMP$
XC TEMP,TEMP
LTR R15,R15
BZ PDS0SPF1
BCTR R15,0
EX R15,MVCSTATS
* MVC TEMP(0),BLDLU
PDS0SPF1 DS 0H
XC PLIS,PLIS
CALL $441PUT,(STATS$,,TYPECHR,temp$),MF=(E,PLIS),VL
CLC FUNCPAR,=CL8'STATS'
BE PDS1CLOS
CLC FUNCPAR,=CL8'READ'
BE PDS0FIND
MVC MAXCC,=AL4(8)
$VARTOKN MSGV$,'&MSGPREF.Duplicate Member'
CLOSE ((R9)),MF=(E,CLOSLST)
B RETURN
SPACE
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDS0FIND DS 0H
FIND (R9),BLDLTTR,C
LTR R15,R15
BZ PDS1READ
A R15,=AL4(3000)
ST R15,MAXCC
$VARTOKN MSGV$,'&MSGPREF.FIND System Error'
CLOSE ((R9)),MF=(E,CLOSLST)
B RETURN
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDS1READ DS 0H
SR R8,R8
NEXT1BLK DS 0H
L R4,BUFFPTR ADDR OF DCB
L R7,BUFFLEN MAXIMUM TRACK SIZE
READ DECBR,SF,(R9),(R4),(R7),MF=E
CHECK DECBR
XR R7,R7
LH R7,DECBR+6 REQUESTED LENGTH (BUFFLEN)
L R15,DECBR+16 IOB ADDR
SR R6,R6
SH R7,14(,R15) SUBTRACT RESIDUAL COUNT
sr r15,r15
ICM R15,B'0011',LRECL
DR R6,R15
MR R6,R15
L R5,BUFFPTR
sr r6,r6
ICM R6,B'0011',LRECL
LA R7,0(R5,R7)
BCTR R7,0
NEXT1REC DS 0H
MVC CARD$(2),LRECL
LA R14,CARD
SR R15,R15
ICM R15,B'0011',LRECL
LR R0,R5
LR R1,R15
MVCL R14,R0
LA R8,1(,R8)
ST R8,INDEX
XC PLIS,PLIS
CALL $441PUT,(STEM$,INDEX,TYPECHR,CARD$),MF=(E,PLIS),VL
BXLE R5,R6,NEXT1REC
B NEXT1BLK
PDS1EOD DS 0H
XC PLIS,PLIS
CALL $441PUT,(STEM$,ZERO,TYPEBIN,INDEX),MF=(E,PLIS),VL
PDS1CLOS DS 0H
CLOSE ((R9)),MF=(E,CLOSLST)
B RETURN0
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDS2WRTE DS 0H
CLOSE ((R9)),MF=(E,CLOSLST)
*
CLC FUNCPAR,=CL8'DELETE'
BE PDS2ENQ
CLI RECFM,RECFM_U
BNE PDS2ENQ
MVC MAXCC,=AL4(4)
$VARTOKN MSGV$,'&MSGPREF.Invalid record format'
B RETURN
*
PDS2ENQ DS 0H
ENQ (SPFEDIT,DSNAME,E,52,SYSTEMS),RET=USE,MF=(E,ENQ)
LTR R15,R15
BZ PDS2ENQ2
MVC MAXCC,=AL4(4)
$VARTOKN MSGV$,'&MSGPREF.Dataset/Member In Use'
B RETURN
PDS2ENQ2 DS 0H
L R1,UCBADDR
TM UCBTBYT2-UCBOB(R1),UCBRR
BO PDS2ENQ3
ENQ (QNAME,DSNAME,E,44,SYSTEMS),MF=(E,ENQ2)
B PDS2ENQ4
PDS2ENQ3 DS 0H
RESERVE (QNAME,DSNAME,E,44,SYSTEMS),UCB=UCBADDR, X
MF=(E,ENQRSV),LOC=ANY
PDS2ENQ4 DS 0H
LTR R15,R15
BZ PDS2ENQ5
A R15,=AL4(3000)
ST R15,MAXCC
$VARTOKN MSGV$,'&MSGPREF.RESERVE/ENQ System Error'
B PDSTERM3
PDS2ENQ5 DS 0H
CLC FUNCPAR,=CL8'DELETE'
BE PDS3DLET
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDS2VAR0 DS 0H
MVC TEMP$(2),=AL2(16)
XC PLIS,PLIS
CALL $441GET,(STEM$,ZERO,,TEMP$),MF=(E,PLIS),VL
LTR R15,R15
BNZ EVAR1
sr r15,r15
ICM R15,B'0011',TEMP$
BZ EVAR1
BCTR R15,0
EX R15,PACK
CVB R8,DWORD
LTR R8,R8
BZ EVAR1
ST R8,COUNT
EJECT
PDS2OPEN DS 0H
LA R9,PD2DCB
* USING IHADCB,R9
MVC DCBDDNAM,DDNMPAR
OPEN ((R9),(OUTPUT)),MF=(E,OPENLST)
TM DCBOFLGS,DCBOFOPN
BO PDS2WINI
MVC MAXCC,=AL4(12)
$VARTOKN MSGV$,'&MSGPREF.Output Open Error'
B PDSTERM2
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDS2WINI DS 0H
L R8,COUNT
LA R4,0
L R5,BUFFPTR
LH R6,LRECL
SR R7,R7
LH R7,BLKSZ
A R7,BUFFPTR
BCTR R7,0
NEXT2REC DS 0H
LA R4,1(,R4)
ST R4,INDEX
MVC CARD$(2),LRECL
XC PLIS,PLIS
CALL $441GET,(STEM$,INDEX,,CARD$),MF=(E,PLIS),VL
LTR R15,R15
BNZ EVAR1
LR R2,R5
sr r3,r3
ICM R3,B'0011',LRECL
LA R14,CARD$+2
sr r15,r15
ICM R15,B'0011',CARD$
icm R15,b'1000',=X'40'
MVCL R2,R14
BXH R5,R6,PDS2WBLK
BCT R8,NEXT2REC
PDS2WBLK DS 0H
SL R5,BUFFPTR
LTR R5,R5
BZ PDS2WSKP
STH R5,DCBBLKSI
L R5,BUFFPTR
WRITE DECBW,SF,(R9),(R5),'S',MF=E
CHECK DECBW
OC STOWTTR,STOWTTR
BNZ PDS2WSKP
NOTE (R9)
ST R1,STOWTTR
PDS2WSKP DS 0H
LTR R8,R8
BZ PDS2ST01
L R5,BUFFPTR
LH R6,LRECL
SR R7,R7
LH R7,BLKSZ
A R7,BUFFPTR
BCTR R7,0
BCT R8,NEXT2REC
PDS2ST01 DS 0H
*
XC SPFSTATS,SPFSTATS
MVI STOWFLG,15
MVI SPFVV,1
MVI SPFMM,1
L R1,COUNT
STCM R1,B'0011',SPFCURR
STCM R1,B'0011',SPFINIT
TIME DEC
ST R1,SPFDCRE
ST R1,SPFDCHG
STCM R0,B'1100',SPFHHMM
MVC SPFUSER,=CL10'RXPDS'
*
STOW (R9),STOWAREA,R
LTR R15,R15
BZ PDSTERM
C R15,=AL4(8)
BE PDSTERM
A R15,=AL4(3000)
ST R15,MAXCC
$VARTOKN MSGV$,'&MSGPREF.STOW Replace/Add Error'
B PDSTERM
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDS3DLET DS 0H
LA R9,PD3DCB
* USING IHADCB,R9
MVC DCBDDNAM,DDNMPAR
OPEN ((R9),(UPDAT)),MF=(E,OPENLST)
TM DCBOFLGS,DCBOFOPN
BO PDS3STOW
MVC MAXCC,=AL4(12)
$VARTOKN MSGV$,'&MSGPREF.Update Open Error'
B PDSTERM2
* USING IHADCB,R9
PDS3STOW DS 0H
STOW (R9),STOWAREA,D
LTR R15,R15
BZ PDSTERM
A R15,=AL4(3000)
ST R15,MAXCC
$VARTOKN MSGV$,'&MSGPREF.STOW Delete Error'
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
PDSTERM DS 0H
CLOSE ((R9)),MF=(E,CLOSLST)
PDSTERM2 DS 0H
DEQ (QNAME,DSNAME,44,SYSTEMS),MF=(E,DEQ2)
PDSTERM3 DS 0H
DEQ (SPFEDIT,DSNAME,52,SYSTEMS),MF=(E,DEQ)
L R15,MAXCC
LTR R15,R15
BNZ RETURN
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
RETURN0 DS 0H
$VARTOKN MSGV$,'OK'
XC MAXCC,MAXCC
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
RETURN DS 0H
L R15,MAXCC
$MKNUMB RETV$,R15
*
LM R0,R1,BUFFLEN
LTR R1,R1
BZ NOBUFFER
FREEMAIN R,LV=(0),A=(1)
NOBUFFER DS 0H
*
XC PLIS,PLIS
CALL $441PUT,(RETN$,,TYPECHR,RETV$),MF=(E,PLIS),VL
XC PLIS,PLIS
CALL $441PUT,(MSGN$,,TYPECHR,MSGV$),MF=(E,PLIS),VL
L R9,EFPLEVAL
L R9,0(R9)
USING EVALBLOCK,R9
LA R6,RETV$+2
XR R7,R7
LH R7,RETV$
ST R7,EVALBLOCK_EVLEN SET LENGTH
LA R4,EVALBLOCK_EVDATA
LR R5,R7
MVCL R4,R6
SR R15,R15
$RTRN RC=(R15),RENT=RENTL
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
STRIP $STRIP
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
ERRP1 DS 0H
$VARTOKN MSGV$,'&MSGPREF.Missing Or Invalid Function'
MVC MAXCC,=AL4(4)
B RETURN
ERRP2 DS 0H
$VARTOKN MSGV$,'&MSGPREF.Missing Or Invalid DD Name'
MVC MAXCC,=AL4(4)
B RETURN
ERRP3 DS 0H
$VARTOKN MSGV$,'&MSGPREF.Missing Or Invalid MEMBER Name'
MVC MAXCC,=AL4(4)
B RETURN
ERRP4 DS 0H
$VARTOKN MSGV$,'&MSGPREF.Missing Or Invalid STEM Name'
MVC MAXCC,=AL4(4)
B RETURN
EJECT
EVAR1 DS 0H
$VARTOKN MSGV$,'&MSGPREF.Stem Variable Not Found'
MVC MAXCC,=AL4(8)
B PDSTERM
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
DS 0D
PACK PACK DWORD,TEMP$+2(0)
MVCSTATS MVC TEMP(0),BLDLU
DS 0D
BLANKS DC CL8' '
NUMBRS DC CL8'00000000'
X4FF DC X'FFFFFFFF'
*
SPFEDIT DC CL8'SPFEDIT'
SYSIEWLP DC CL8'SYSIEWLP'
*
ZERO DC AL4(0)
NEGZ DC X'80',AL4(0)
TYPEHEX DC AL4(0)
TYPEBIN DC AL4(1)
TYPEDEC DC AL4(2)
TYPECHR DC AL4(3)
*
RETN$ $VARCHAR 'RC'
MSGN$ $VARCHAR '_ERRMSG'
LEVEL$ $VARCHAR '&VARPREF.LEVEL'
STATS$ $VARCHAR '&VARPREF.STATS'
MEMBS$ $VARCHAR '&VARPREF.MEMBERS'
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
DATA DS 0D
ENQ (*-*,*-*,E,52,SYSTEMS),RET=USE,MF=L
ENQ (*-*,*-*,E,44,SYSTEMS),MF=L
RESERVE (*-*,*-*,E,44,SYSTEMS),UCB=*-*,LOC=ANY,MF=L
DEQ (*-*,*-*,44,SYSTEMS),MF=L
DEQ (*-*,*-*,44,SYSTEMS),MF=L
DEQ (*-*,*-*,52,SYSTEMS),MF=L
DCB DSORG=PO,MACRF=(R),DDNAME=*-*,RECFM=U,EXLST=*-*
DCB DSORG=PO,MACRF=(W),DDNAME=*-*
DCB DSORG=PO,MACRF=(R),DDNAME=*-*
OPEN (*-*,(INPUT)),MF=L
OPEN (*-*,(OUTPUT)),MF=L
CLOSE (*-*),MF=L
READ ZZZZ1,SF,*-*,*-*,*-*,MF=L
WRITE ZZZZ2,SF,*-*,*-*,*-*,MF=L
DS 0D
DC H'1'
DC H'&BLDLLEN'
BLDL$EN DS 0H
DC CL8' '
DC XL3'000000'
DC XL1'00'
DC XL1'00'
DC XL1'00'
DC (&BLDLLEN-(*-BLDL$EN))X'00'
DS 0D
DC XL1'00'
DS 0D
DC CL8' '
DC XL3'000000'
DC XL1'0F'
DC XL30'00'
DS 0D
DATAL EQU *-DATA
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
LTORG
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*
TRTABLES CSECT
TBFIND $TRTB SCAN,FIND=C' '
TBSKIP $TRTB SCAN,SKIP=C' '
TBUPPR $TRTB UPPER
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* DYNAMIC WORK AREA
RENT DSECT
SAVE DS 9D SAVE AREA - MUST BE FIRST
DWORD DS D
FWORD DS F
DS 0D
MAXCC DS F
INDEX DS F
COUNT DS F
DS 0D
PLIS DS CL256
*
FUNC$ DS H,CL8
FUNCPAR EQU FUNC$+2,8
DDNM$ DS H,CL8
DDNMPAR EQU DDNM$+2,8
MEMB$ DS H,CL8
MEMBPAR EQU MEMB$+2,8
STEM$ DS H,CL64
STEMPAR EQU STEM$+2,64
*
RETV$ DS H,CL16
MSGV$ DS H,CL80
*
CARD$ DS H,CL512
CARD EQU CARD$+2,512
*
TEMP$ DS H,CL256
TEMP EQU TEMP$+2,256
*
DS 0D
DEVAREA DS 5F
BUFFLEN DS F
BUFFPTR DS F
*
FCBAREA DS 0D
DDNAME DS CL8
RCODE DS AL4
UCBADDR DS AL4
DSNAME DS CL44
MEMBER DS CL8
NVOL DS CL2
VOLS DS CL30
DSORG DS CL2
BLKSZ DS CL2
LRECL DS CL2
RECFM DS CL1
RECFM_U EQU B'11000000'
RECFM_F EQU B'10000000'
RECFM_V EQU B'01000000'
*
QNAME DS CL8
*
WORK DS 0D
ENQ ENQ (*-*,*-*,E,52,SYSTEMS),RET=USE,MF=L
ENQ2 ENQ (*-*,*-*,E,44,SYSTEMS),MF=L
ENQRSV RESERVE (*-*,*-*,E,44,SYSTEMS),UCB=*-*,MF=L
DEQRSV DEQ (*-*,*-*,44,SYSTEMS),MF=L
DEQ2 DEQ (*-*,*-*,44,SYSTEMS),MF=L
DEQ DEQ (*-*,*-*,52,SYSTEMS),MF=L
PDSDCB DCB DSORG=PO,MACRF=(R),DDNAME=*-*,RECFM=U,EXLST=*-*
PD2DCB DCB DSORG=PO,MACRF=(W),DDNAME=*-*
PD3DCB DCB DSORG=PO,MACRF=(R),DDNAME=*-*
OPENLST OPEN (*-*,(INPUT)),MF=L
OPENLS2 OPEN (*-*,(OUTPUT)),MF=L
CLOSLST CLOSE (*-*),MF=L
DECBR READ DECB1,SF,*-*,*-*,*-*,MF=L
DECBW WRITE DECB2,SF,*-*,*-*,*-*,MF=L
BLDLAREA DS 0D
BLDLCOUN DC H'1'
BLDLLEN DC H'&BLDLLEN'
BLDLENT DS 0H
BLDLMBR DC CL8' '
BLDLTTR DC XL3'000000'
BLDLK DC XL1'00'
BLDLZ DC XL1'00'
BLDLC DC XL1'00'
BLDLU DC (&BLDLLEN-(*-BLDLENT))X'00'
DS 0D
STOWIND DC XL1'00'
STOWAREA DS 0D
STOWMBR DC CL8' '
STOWTTR DC XL3'000000'
STOWFLG DC XL1'0F'
SPFSTATS DS 0CL30
SPFVV DC XL1'01'
SPFMM DC XL1'01'
DC XL2'0000'
SPFDCRE DC PL4'0'
SPFDCHG DC PL4'0'
SPFHHMM DC XL2'0000'
SPFCURR DC H'0'
SPFINIT DC H'0'
SPFMODS DC H'0'
SPFUSER DC CL10'RXPDS'
DS 0D
WORKL EQU *-WORK
RENTL EQU *-RENT
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* DSECTS FOR MVS / DATA MANAGEMENT
DCBD DSORG=PS,DEVD=DA
*
IEFUCBOB
*
EJECT
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* DSECTS FOR MVS / REXX INTERFACE
IRXEFPL , EXTERNAL FUNCTION PARAMETER LIST
EJECT
IRXEVALB , EVALUATION BLOCK
EJECT
END RXPDS

not 100% general ( max lrecl 512, no checking for concatenated datasets )
have had it working for ages
if anybody needs them I might post also the macros and the subroutines

by **Sxandy** » Mon Oct 27, 2014 3:18 pm

error is just a label in Your program,
You are free to do anything You like/feel useful to provide to the user.
You might probably want to display the return code and the reason code and exit nicely with a 16 RC

by **steve-myers** » Sat Mar 19, 2016 12:24 am

Your query is misworded. There are four potential sources for DCB attributes.
- The DCB attributes specified on the DCB macro call. When the Assembler process the DCB macro it has no knowledge pf the data the DCB will be used to read or write.
- DCB attributes specified in the DD statement.
- The data set label.
- The "DCB exit" exit routine, which can alter DCB attributes during OPEN. These modified attributes are equivalent to being specified in the DCB macro.
These attributes are inserted into the DCB in reverse order. Parameters specified in the DCB macro are fixed and override anything specified in JCL or the data set label. Parameters specified in JCL override the equivalent parameter in the data set label. Finally note the use of the "DCB exit" exit routine.
Look at the examples in your previous queries. I do hope you understood them. Obviously you didn't.
Look at the examples in your previous queries. I do hope you understood them. Obviously you didn't.

IBM Mainframe Forum

READ & WRITE with BPAM

READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM

Re: READ & WRITE with BPAM