READ & WRITE with BPAM



High Level Assembler(HLASM) for MVS & VM & VSE

READ & WRITE with BPAM

Postby 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:
 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
belkin99
 
Posts: 25
Joined: Mon Aug 30, 2010 6:59 pm
Has thanked: 0 time
Been thanked: 0 time

Re: READ & WRITE with BPAM

Postby 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).
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.
steve-myers
Global moderator
 
Posts: 2105
Joined: Thu Jun 03, 2010 6:21 pm
Has thanked: 4 times
Been thanked: 243 times

Re: READ & WRITE with BPAM

Postby belkin99 » Tue Mar 08, 2011 10:44 am

Really appreciating your help.

Can you clarify what is IHADCB in
 
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
                                             
 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.
belkin99
 
Posts: 25
Joined: Mon Aug 30, 2010 6:59 pm
Has thanked: 0 time
Been thanked: 0 time

Re: READ & WRITE with BPAM

Postby 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 -
         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.
steve-myers
Global moderator
 
Posts: 2105
Joined: Thu Jun 03, 2010 6:21 pm
Has thanked: 4 times
Been thanked: 243 times

Re: READ & WRITE with BPAM

Postby belkin99 » Fri Mar 25, 2011 5:04 am

YES,
You are correct the calculating of short block is should be as follow
 
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
  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,
belkin99
 
Posts: 25
Joined: Mon Aug 30, 2010 6:59 pm
Has thanked: 0 time
Been thanked: 0 time

Re: READ & WRITE with BPAM

Postby 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 -
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.
steve-myers
Global moderator
 
Posts: 2105
Joined: Thu Jun 03, 2010 6:21 pm
Has thanked: 4 times
Been thanked: 243 times

Re: READ & WRITE with BPAM

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

here is the main for a rexx function to read/write/delete/rename PDS members
         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
cheers
enrico
When I tell somebody to RTFM or STFW I usually have the page open in another tab/window of my browser,
so that I am sure that the information requested can be reached with a very small effort
enrico-sorichetti
Global moderator
 
Posts: 3002
Joined: Fri Apr 18, 2008 11:25 pm
Has thanked: 0 time
Been thanked: 164 times

Re: READ & WRITE with BPAM

Postby 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
We are the pioneers in providing 350-050 dumps and SAP exams with 100% exam pass guarantee. Download our latest Baldwin Wallace University gmat .
Sxandy
 
Posts: 1
Joined: Mon Oct 27, 2014 3:10 pm
Has thanked: 0 time
Been thanked: 0 time

Re: READ & WRITE with BPAM

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

  1. 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.
  2. Look at the examples in your previous queries. I do hope you understood them. Obviously you didn't.
  3. Look at the examples in your previous queries. I do hope you understood them. Obviously you didn't.
steve-myers
Global moderator
 
Posts: 2105
Joined: Thu Jun 03, 2010 6:21 pm
Has thanked: 4 times
Been thanked: 243 times


Return to Assembler

 


  • Related topics
    Replies
    Views
    Last post