Trying to OPEN a PDSE and write records to a new member using z/OS HL/ASM

81 Views Asked by At

I have the following code:

         START ,
         YREGS ,                   register equates, syslib SYS1.MACLIB
CRTMEM   CSECT ,
CRTMEM   AMODE 31
CRTMEM   RMODE ANY
        SYSSTATE AMODE64=NO,ARCHLVL=OSREL,OSREL=SYSSTATE
        IEABRCX  DEFINE    convert based branches to relative
*-------------------------------------------------------------------
* Linkage and storage obtain
*-------------------------------------------------------------------
         BAKR  R14,0                use linkage stack
         LARL  R12,DATCONST         setup base for CONSTANTS
         USING DATCONST,R12         "baseless" CSECT
        STORAGE OBTAIN,LENGTH=WALEN,EXECUTABLE=NO
         LR    R10,R1               R10 points to Working Storage
         USING WAREA,R10            BASE FOR DSECT
         MVC   SAVEA+4(4),=C'F1SA'  linkage stack convention
         LAE   R13,SAVEA            ADDRESS OF OUR SA IN R13
*-------------------------------------------------------------------
* application logic                                                -
*-------------------------------------------------------------------

        STORAGE OBTAIN,LENGTH=DCB_LEN,EXECUTABLE=NO,LOC=24
         LR R2,R1                   R2 points to Output DCB

LIB_OPEN  DS  0H
         MVC 0(DCB_LEN,R2),CONST_DCB
        OPEN ((R2),OUTPUT),MODE=24
         CIJE R15,0,OPEN_SUCCESS
OPEN_FAIL DS  0H
         LR  R9,R15                put err code in R9
         B   DONE
*
OPEN_SUCCESS DS 0H
         LA  R9,0                  CRTMEM successful put 0 in R9
*-------------------------------------------------------------------
* Linkage and storage release. set RC (reg 15)                     -
*-------------------------------------------------------------------
DONE     DS 0H
RLSE    STORAGE RELEASE,ADDR=(R10),LENGTH=WALEN,EXECUTABLE=NO
         LR    R15,R9               get saved rc into R15
         PR    ,                    return to caller

*-------------------------------------------------------------------
* constants and literal pool                                       -
*-------------------------------------------------------------------
DATCONST DS     0D                 Doubleword alignment for LARL
CONST_DCB  DCB   DSORG=PO,MACRF=(W),DDNAME=MYDD
DCB_LEN   EQU    *-CONST_DCB
WRITE_BUFFER DC CL80'Hello world'
         LTORG ,                   create literal pool

*-------------------------------------------------------------------
* DSECT                                                            -
*-------------------------------------------------------------------
WAREA    DSECT
SAVEA    DS    18F
WALEN  EQU   *-SAVEA

IHADCB   DCBD
DCBLEN   EQU   *-IHADCB
         END   CRTMEM

My goal is to write records to the PDSE then perform a STOW and then CLOSE, but I am stuck at the OPEN which is giving me a protection exception.

I have allocated the dataset FULTONM.ASMXMP.DATA as:

 Data Set Name  . . . : FULTONM.ASMXMP.DATA                                      .
                          .                                                                                  .
                          .  General Data                          Current Allocation                        .
                          .   Management class . . : STANDARD       Allocated tracks  . : 100                .
                          .   Storage class  . . . : OS390          Allocated extents . : 1                  .
                          .    Volume serial . . . : Z2B066         Maximum dir. blocks : NOLIMIT            .
                          .    Device type . . . . : 3390                                                    .
                          .   Data class . . . . . : DATAF                                                   .
                          .    Organization  . . . : PO            Current Utilization                       .
                          .    Record format . . . : FB             Used pages  . . . . : 5                  .
                          .    Record length . . . : 80             % Utilized  . . . . : 0                  .
                          .    Block size  . . . . : 80             Number of members . : 0                  .
                          .    1st extent tracks . : 100                                                     .
                          .    Secondary tracks  . : 100                                                     .
                          .    Data set name type  : LIBRARY       Dates                                     .
                          .    Data set encryption : NO             Creation date . . . : 2024/02/09         .
                          .    Data set version  . : 1              Referenced date . . : ***None***         .
                          .                                         Expiration date . . : ***None***

I use the following JCL:

//CRTMEM EXEC PGM=CRTMEM
//STEPLIB DD DSN=FULTONM.ASMXMP.LOAD,DISP=SHR
//MYDD DD DSN=FULTONM.ASMXMP.DATA,DISP=SHR

I get the following abend:

IEF236I ALLOC. FOR FULTONMA CRTMEM
IGD103I SMS ALLOCATED TO DDNAME STEPLIB
IGD103I SMS ALLOCATED TO DDNAME MYDD
IEA995I SYMPTOM DUMP OUTPUT
SYSTEM COMPLETION CODE=0C4  REASON CODE=00000011
 TIME=23.01.41  SEQ=43178  CPU=0000  ASID=0096
 PSW AT TIME OF ERROR  078C1000   80CCD038  ILC 4  INTC 11
   NO ACTIVE MODULE FOUND
   NAME=UNKNOWN
   DATA AT PSW  00CCD032 - 1B22A516  00FFBF27  1001A774
   AR/GR 0: 00000000/00000058   1: 00000000/00900EF4
         2: 00000000/00000000   3: 00000000/00CCD228
         4: 00000000/008B7E88   5: 00000000/008FFCD8
         6: 00000000/A6900EF4   7: 00000000/00F6B700
         8: 00000000/00000000   9: 00000000/01963E78
         A: 00000000/008FFD98   B: 00000000/008B7E88
         C: 00000000/010AE210   D: 00000000/26901FB8
         E: 00000000/80CCC706   F: 20000000/008B7E88

I put a ST 0,0 before the OPEN to check the registers as suggested:

I put a ST 0,0 just before the open and I see:

2: 00000000/00016FA8   3: 00000000/02CDAA00
4: 00000000/7F629D70   5: 00000000/008BEE88
6: 00000000/271FAFD8   7: 00000000/7F629006
8: 00000000/008BE288   9: 00000000/7F62A1FF
A: 00000000/271F9FB8   B: 00000000/7F629006
C: 00000000/271F8F38   D: 00000000/271F9FB8
E: 00000000/0000030B   F: 20000000/00000000

So I think R2 looks ok.

Here is the expansion of the STORAGE OBTAIN and the OPEN:

0                                    368         STORAGE OBTAIN,LENGTH=DCB_LEN,EXECUTABLE=NO,LOC=24
 000032 9AFF C0A8            00148   370+         LAM   15,15,=AL1(B'00100000',(0),(0),B'00000000')             X01-STORA
                                        +                                               .SET AR 15          @P9C
 000036 5800 C0B8            00158   371+         L      0,=A(DCB_LEN)                .STORAGE LENGTH       @P9C 01-STORA
1                                                                                                               Page    4
   Active Usings: WAREA,R10  DATCONST,R12
0  Loc  Object Code    Addr1 Addr2  Stmt   Source Statement                                  HLASM R6.0  2024/02/10 14.05
000003A 58F0 C0BC            0015C   372+         L      15,=AL1(B'00100000',(0*16),(0),B'00010010')            X01-STORA
                                        +                                             .CONTROL INFORMATION  @P9C
 00003E 58E0 0010            00010   373+         L      14,16(0,0)                   .CVT ADDRESS               01-STORA
 000042 58EE 0304            00304   374+         L      14,772(14,0)                 .ADDR SYST LINKAGE TABLE   01-STORA
 000046 58EE 00A0            000A0   375+         L      14,160(14,0)                 .OBTAIN LX/EX FOR OBTAIN   01-STORA
 00004A B218 E000      00000         376+         PC     0(14)                        .PC TO STORAGE RTN         01-STORA
 00004E 1821                         377          LR R2,R1                   R2 points to Output DCB
0000050                              379 LIB_OPEN  DS  0H
 000050 D257 2000 C000 00000 000A0   380          MVC 0(DCB_LEN,R2),CONST_DCB
 000056 5000 0000            00000   381          ST  0,0
                                     382         OPEN ((R2),OUTPUT),MODE=24
 00005A 0700                         384+         CNOP  0,4                      Align list to word              01-OPEN
 00005C A715 0004            00064   386+         BRAS  1,*+8  (BAS)                                             02-00318
 000060 00000000                     387+         DC    A(0)                     Opt byte & DCB or ACB addr      01-OPEN
 000064 BE27 1001            00001   388+         STCM  R2,B'0111',0+1(1)         Store DCB or ACB addr     @L3C 01-OPEN
 000068 928F 1000      00000         389+         MVI   0(1),143                 Set option byte                 01-OPEN
 00006C 0A13                         390+         SVC   19                       Issue OPEN SVC                  01-OPEN
 00006E ECF8 0006 007E       0007A   391          CIJE R15,0,OPEN_SUCCESS

Looking at the macro expansion, I realized this isn't what I want because I want the code to be re-entrant, so I changed the OPEN macro to:

                                     381         OPEN ((R2),OUTPUT),MF=(E,OPEN_PARMS),MODE=24
 000056 4110 A048            00048   385+         LA    1,OPEN_PARMS                      LOAD PARAMETER REG 1   02-IHBIN
 00005A 94F0 1000      00000         386+         NI    0(1),X'F0'               CLEAR OPTION 1 BITS        @L3M 01-OPEN
 00005E 960F 1000      00000         387+         OI    0(1),15                  INSERT OPTION BITS         @L3M 01-OPEN
 000062 BE27 1001            00001   388+         STCM  R2,B'0111',0+1(1)         Store DCB or ACB address  @L3C 01-OPEN
 000066 0A13                         389+         SVC   19                       Issue OPEN SVC                  01-OPEN

but still got a protection exception. I set up OPEN_PARMS in my writable area as:

 000000                00000 0004C   486 WAREA    DSECT
 000000                              487 SAVEA    DS    18F
 000048                              488 OPEN_PARMS DS 1A

I would appreciate guidance on where I'm going wrong and also perhaps some hints and tips on how to debug code that fails in an SVC with a protection exception

1

There are 1 best solutions below

4
mike On

I got a lot of help from @pjfarley3 and Marc van der Meer and have sorted things out.

Here is 'working code' that opens and then turns around and closes the dataset (not super useful, but at least it shows OPEN and CLOSE).

The key difference was in how I set up the OPEN and CLOSE parmlist - I changed things to do a proper copy of the parm list into a writable area for both the OPEN and CLOSE parms and then things started to go better. I also cleared the storage to 0's that I obtained - I am not convinced that is required, so I will experiment out of curiosity, but it might be necessary for the OPEN and CLOSE parms (I don't think it's necessary for the DCB since I'm copying over the storage with an MVC anyway).

         START , 
         YREGS ,                   register equates, syslib SYS1.MACLIB 
CRTMEM   CSECT , 
CRTMEM   AMODE 31 
CRTMEM   RMODE ANY
        SYSSTATE AMODE64=NO,ARCHLVL=OSREL,OSREL=SYSSTATE 
        IEABRCX  DEFINE    convert based branches to relative
*------------------------------------------------------------------- 
* Linkage and storage obtain
*------------------------------------------------------------------- 
         BAKR  R14,0                use linkage stack 
         LARL  R12,DATCONST         setup base for CONSTANTS
         USING DATCONST,R12         "baseless" CSECT 
        STORAGE OBTAIN,LENGTH=WALEN,EXECUTABLE=NO,LOC=ANY,CHECKZERO=YES
         LR    R10,R1               R10 points to Working Storage 
         USING WAREA,R10            BASE FOR DSECT 
*
* Clear storage
*
         CHI   R15,X'0014'           X'14': storage zeroed
         BE    STG_WA_CLEAR
         LR    R2,R1                 system did not clear, do ourselves
         LA    R3,WALEN
         XR    R5,R5
         MVCL  R2,R4                 clear storage (pad byte zero)

STG_WA_CLEAR DS 0H
*
         MVC   SAVEA+4(4),=C'F1SA'  linkage stack convention 
         LAE   R13,SAVEA            ADDRESS OF OUR SA IN R13 

*------------------------------------------------------------------- 
* application logic                                                - 
*------------------------------------------------------------------- 

*
* DCB has to be below the line
*
        STORAGE OBTAIN,LENGTH=DCBLEN,EXECUTABLE=NO,LOC=24,CHECKZERO=YES
         LR R8,R1                   R8 points to Output DCB
         USING DCBAREA,R8

*
* Clear storage
*
         CHI   R15,X'0014'           X'14': storage zeroed
         BE    STG_DCB_CLEAR
         LR    R2,R1                 system did not clear, do ourselves
         LA    R3,DCBLEN
         XR    R5,R5
         MVCL  R2,R4                 clear storage (pad byte zero)

STG_DCB_CLEAR DS 0H
*
*
* Copy the DCB template into 24-bit storage
* The OPEN_PARMS and DCBE is 31-bit to minimize below-line stg
*
LIB_OPEN  DS  0H
         MVC LIB_DCB(DCBLEN),CONST_DCB
         MVC OPEN_PARMS(OPENLEN),CONST_OPEN
        OPEN (LIB_DCB,OUTPUT),MF=(E,OPEN_PARMS),MODE=31
         CIJE R15,0,OPEN_SUCCESS
*
OPEN_FAIL DS  0H
         LR  R9,R15                put err code in R9
         B   DONE
*
OPEN_SUCCESS DS 0H
*

*
LIB_CLOSE  DS 0H
         MVC CLOSE_PARMS(CLOSELEN),CONST_CLOSE
        CLOSE (LIB_DCB),MF=(E,CLOSE_PARMS),MODE=31
         CIJE R15,0,CLOSE_SUCCESS
*
CLOSE_FAIL DS  0H
         LR  R9,R15                put err code in R9
         B   DONE
*
CLOSE_SUCCESS DS 0H
         LA  R9,0                  CRTMEM successful put 0 in R9
*
* Free DCB storage
*
RLSE_DCB   DS 0H
        STORAGE RELEASE,ADDR=(R8),LENGTH=DCBLEN,EXECUTABLE=NO 

*------------------------------------------------------------------- 
* Linkage and storage release. set RC (reg 15)                     -
*------------------------------------------------------------------- 
DONE     DS 0H
RLSE_WA  DS 0H
        STORAGE RELEASE,ADDR=(R10),LENGTH=WALEN,EXECUTABLE=NO 
         LR    R15,R9               get saved rc into R15
         PR    ,                    return to caller 

*------------------------------------------------------------------- 
* constants and literal pool                                       - 
*------------------------------------------------------------------- 
DATCONST   DS    0D                 Doubleword alignment for LARL
CONST_DCB  DCB   DSORG=PO,MACRF=(W),DDNAME=MYDD,DCBE=CONST_DCBE
CONST_DCBE DCBE  RMODE31=BUFF
DCBLEN    EQU   *-CONST_DCB
CONST_OPEN OPEN (*-*,(OUTPUT)),MODE=31,MF=L
OPENLEN   EQU   *-CONST_OPEN
CONST_CLOSE CLOSE (*-*),MODE=31,MF=L
CLOSELEN  EQU   *-CONST_CLOSE
*
WRITE_BUFFER DC CL80'Hello world'
         LTORG ,

*------------------------------------------------------------------- 
* DSECT                                                            - 
*------------------------------------------------------------------- 
WAREA       DSECT 
SAVEA       DS    18F 
OPEN_PARMS  DS CL(OPENLEN)
CLOSE_PARMS DS CL(CLOSELEN)
WALEN       EQU  *-SAVEA

DCBAREA     DSECT
LIB_DCB     DS   CL(DCBLEN)
         END   CRTMEM