アセンブラーで区分データセットのディレクトリー部を読み込む – 「メインフレーム・コンピューター」で遊ぼう

区分データセットのディレクトリー部は、構造的には256バイト固定長の非ブロック化レコードの順次データセットと同じです。そのため、区分データセット内にどのようなメンバーが格納されているかを知るためにBSAMまたはQSAMによってディレクトリー・ブロックを読み取る方法が昔から使われてきました。この記事は、以前に掲載した「COBOLで区分データセットのディレクトリー部を直接読むサンプル」をアセンブラー言語用に作り直したものです。

QSAMのGETマクロでPDSディレクトリー部を読み込む

実際のディレクトリー・ブロックには8バイトのキーが付いており、キー部8バイト＋データ部256バイトでDASD上に書き込まれています。PDSのDIRブロックの8バイトのキーには、そのディレクトリー・ブロックに格納された最後のメンバーエントリーのメンバー名が入っています。このキーは、割当て済みのDIRブロックから使用済みの最後のブロック位置を判定する目的などで利用できます。OSのように直接チャネル・プログラムを使ってアクセスする場合、目的のメンバーが格納されているDIRブロックを1回のサーチ動作で探すこともできます。
アクセス方式によってキーにアクセスするにはBSAMを使用する必要がありますが、サンプルの処理ではキーを使用しないのでCOBOLのサンプル同様にQSAMでアクセスしています。非ブロック化レコードなのでBSAMでもQSAMでもアクセス単位はブロックですが、順次データセットのアクセスでは一般的に使われるQSAMを使用しています。

PDSディレクトリー読み込みプログラム・サンプル(QSAM)

//         JOB
//*********************************************************************
//ASMCG    PROC AOPT=,LOPT=
//ASM      EXEC PGM=ASMA90,PARM='TERM,ASA,&AOPT,US(WARN(11)),LC(32767)'
//SYSLIB   DD DISP=SHR,DSN=SYS1.MACLIB
//         DD DISP=SHR,DSN=SYS1.MODGEN
//SYSUT1   DD UNIT=SYSALLDA,SPACE=(TRK,(50,10))
//SYSLIN   DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(10,10),RLSE)
//SYSPRINT DD SYSOUT=*
//SYSTERM  DD SYSOUT=*
//GO       EXEC PGM=LOADER,COND=(5,LT,ASM),
//         PARM=('LIST,LET,MAP,XREF,&LOPT')
//SYSLOUT  DD SYSOUT=*
//SYSLIB   DD DISP=SHR,DSN=&SYSUID..LOAD
//SYSLIN   DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE)
//         DD DDNAME=SYSIN
//SYSUDUMP DD SYSOUT=*
//         PEND
//*********************************************************************
//PDSDIRQS EXEC ASMCG
//GO.SYSUT1 DD DISP=SHR,DSN=&SYSUID..JCL
//GO.SYSUT2 DD SYSOUT=*
//ASM.SYSIN  DD *
MAINENTR CSECT                          DEFINE CONTROL SECTION
         USING *,12                     DEFINE BASE REGISTER
         SAVE  (14,12),,                SAVE CALLER REGISTERS          +
               'MAINENTR &SYSDATE &SYSTIME'
         LR    12,15                    GR12 --> OUR 1ST BASE ADDRESS
         LR    15,13                    SAVE CALLER SAVEAREA
         CNOP  0,4                      INSURE FULL WORD BOUNDARY
         BAS   13,*+4+72                AROUND OUR SAVEAREA
         DC    18F'-1'                  OUR GPR SAVEAREA
         ST    15,4(,13)                SAVE CALLER SAVEAREA POINTER
         ST    13,8(,15)                FORWARD CHAIN FOR LINK TRACE
*                                  *----------------------------------*
*                                  *  LOAD EXEC PARAMETERS            *
*                                  *----------------------------------*
         L     R1,0(,R1)                LOAD EXEC PARM FIELD
         LH    R2,0(,R1)                GR2 ---> PARM STRING LENGTH
         LA    R3,2(,R1)                GR3 ---> BEGIN OF PARM STRING
         B     MAINPROC                 DO MAINLINE PROCESSING
*                                  *----------------------------------*
*                                  *  EXIT PROCESSING                 *
*                                  *----------------------------------*
EXIT8    DS    0H
         LA    15,8                     SET CC=8
         B     EXITPROC
EXIT0    DS    0H
         SLR   15,15                    SET CC=0
EXITPROC DS    0H
         L     13,4(,13)                RESTORE CALLER SAVEAREA
         ST    15,16(,13)               PASS RETURN CODE TO CALLER
         RETURN (14,12),T               RESTORE CALLER REGISTERS       +
                                                   AND RETURN TO CALLER
         EJECT ,
***********************************************************************
*        SAMPLE CODE FOR PRINTING PDS DIRECTORY BLOCK DATA            *
*        =====================================================        *
*        READ PDS DIRECTORY BLOCK BY QSAM.                            *
***********************************************************************
MAINPROC DS    0H
         WTO   'THIS IS SAMPLE ASSEMBLER PROGRAM(READ PDS DIRECTORY BLO+
               CK)'
*                                  *----------------------------------*
*                                  *  OPEN THE DATASET                *
*                                  *----------------------------------*
         OPEN  (DIRDCB,INPUT)           OPEN THE PDS DIRECTORY
         LTR   R15,R15                  SUCCESSFUL ?
         BNZ   EXIT8                    NO, MAY BE DD STMT NOT DEFINED
         OPEN  (PRTDCB,OUTPUT)          OPEN THE PRINT DATASET
         LTR   R15,R15                  SUCCESSFUL ?
         BNZ   EXIT8                    NO, MAY BE DD STMT NOT DEFINED

*                                  *----------------------------------*
*                                  *  READ PDS DIRECTORY BY QSAM      *
*                                  *----------------------------------*
READDIR  DS    0H
         GET   DIRDCB,INDATA            READ NEXT DIR BLOCK RECORD
         PUT   PRTDCB,OUTDATA
         B     READDIR                  LOOP FOR NEXT DIR BLOCK

*                                  *----------------------------------*
*                                  *  CLOSE THE DATASET               *
*                                  *----------------------------------*
CLOSDIR  DS    0H
         CLOSE (DIRDCB,,                CLOSE THE PDS DIRECTORY        +
               PRTDCB)                  CLOSE USED DATASET
         B     EXIT0                    ALL PROCESSING DONE
         EJECT ,
***********************************************************************
         EJECT ,
***********************************************************************
*        INTERNAL SUB ROUTINES                                        *
***********************************************************************
***********************************************************************
*        DATA AREA                                                    *
***********************************************************************
DIRDCB   DCB   DDNAME=SYSUT1,           QSAM DCB FOR PDS DIRECTORY     +
               DSORG=PS,MACRF=GM,EODAD=CLOSDIR,                        +
               RECFM=F,LRECL=256,BLKSIZE=256
PRTDCB   DCB   DDNAME=SYSUT2,           QSAM DCB FOR PRINT OUT         +
               DSORG=PS,MACRF=PM,                                      +
               RECFM=FB,LRECL=OUTDATA#

OUTDATA  EQU   *
MARK1    DC    C'>>>'
INDATA   DS    XL256                     PDS DIR BLOCK READ AREA
MARK2    DC    C'<<<'
OUTDATA# EQU   *-OUTDATA
*=====================================================================*
         LTORG ,
         EJECT ,
***********************************************************************
*        DSECT                                                        *
***********************************************************************
         YREGS ,                        S/370 REGISTER EQUATES
         END
//
//

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

// JOB

//*********************************************************************

//ASMCG PROC AOPT=,LOPT=

//ASM EXEC PGM=ASMA90,PARM='TERM,ASA,&AOPT,US(WARN(11)),LC(32767)'

//SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB

// DD DISP=SHR,DSN=SYS1.MODGEN

//SYSUT1 DD UNIT=SYSALLDA,SPACE=(TRK,(50,10))

//SYSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(10,10),RLSE)

//SYSPRINT DD SYSOUT=*

//SYSTERM DD SYSOUT=*

//GO EXEC PGM=LOADER,COND=(5,LT,ASM),

// PARM=('LIST,LET,MAP,XREF,&LOPT')

//SYSLOUT DD SYSOUT=*

//SYSLIB DD DISP=SHR,DSN=&SYSUID..LOAD

//SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE)

// DD DDNAME=SYSIN

//SYSUDUMP DD SYSOUT=*

// PEND

//*********************************************************************

//PDSDIRQS EXEC ASMCG

//GO.SYSUT1 DD DISP=SHR,DSN=&SYSUID..JCL

//GO.SYSUT2 DD SYSOUT=*

//ASM.SYSIN DD *

MAINENTR CSECT DEFINE CONTROL SECTION

USING *,12 DEFINE BASE REGISTER

SAVE (14,12),, SAVE CALLER REGISTERS +

'MAINENTR &SYSDATE &SYSTIME'

LR 12,15 GR12 --> OUR 1ST BASE ADDRESS

LR 15,13 SAVE CALLER SAVEAREA

CNOP 0,4 INSURE FULL WORD BOUNDARY

BAS 13,*+4+72 AROUND OUR SAVEAREA

DC 18F'-1' OUR GPR SAVEAREA

ST 15,4(,13) SAVE CALLER SAVEAREA POINTER

ST 13,8(,15) FORWARD CHAIN FOR LINK TRACE

* *----------------------------------*

* * LOAD EXEC PARAMETERS *

* *----------------------------------*

L R1,0(,R1) LOAD EXEC PARM FIELD

LH R2,0(,R1) GR2 ---> PARM STRING LENGTH

LA R3,2(,R1) GR3 ---> BEGIN OF PARM STRING

B MAINPROC DO MAINLINE PROCESSING

* *----------------------------------*

* * EXIT PROCESSING *

* *----------------------------------*

EXIT8 DS 0H

LA 15,8 SET CC=8

B EXITPROC

EXIT0 DS 0H

SLR 15,15 SET CC=0

EXITPROC DS 0H

L 13,4(,13) RESTORE CALLER SAVEAREA

ST 15,16(,13) PASS RETURN CODE TO CALLER

RETURN (14,12),T RESTORE CALLER REGISTERS +

AND RETURN TO CALLER

EJECT ,

***********************************************************************

* SAMPLE CODE FOR PRINTING PDS DIRECTORY BLOCK DATA *

* ===================================================== *

* READ PDS DIRECTORY BLOCK BY QSAM. *

***********************************************************************

MAINPROC DS 0H

WTO 'THIS IS SAMPLE ASSEMBLER PROGRAM(READ PDS DIRECTORY BLO+

CK)'

* *----------------------------------*

* * OPEN THE DATASET *

* *----------------------------------*

OPEN (DIRDCB,INPUT) OPEN THE PDS DIRECTORY

LTR R15,R15 SUCCESSFUL ?

BNZ EXIT8 NO, MAY BE DD STMT NOT DEFINED

OPEN (PRTDCB,OUTPUT) OPEN THE PRINT DATASET

LTR R15,R15 SUCCESSFUL ?

BNZ EXIT8 NO, MAY BE DD STMT NOT DEFINED

* *----------------------------------*

* * READ PDS DIRECTORY BY QSAM *

* *----------------------------------*

READDIR DS 0H

GET DIRDCB,INDATA READ NEXT DIR BLOCK RECORD

PUT PRTDCB,OUTDATA

B READDIR LOOP FOR NEXT DIR BLOCK

* *----------------------------------*

* * CLOSE THE DATASET *

* *----------------------------------*

CLOSDIR DS 0H

CLOSE (DIRDCB,, CLOSE THE PDS DIRECTORY +

PRTDCB) CLOSE USED DATASET

B EXIT0 ALL PROCESSING DONE

EJECT ,

***********************************************************************

EJECT ,

***********************************************************************

* INTERNAL SUB ROUTINES *

***********************************************************************

* DATA AREA *

***********************************************************************

DIRDCB DCB DDNAME=SYSUT1, QSAM DCB FOR PDS DIRECTORY +

DSORG=PS,MACRF=GM,EODAD=CLOSDIR, +

RECFM=F,LRECL=256,BLKSIZE=256

PRTDCB DCB DDNAME=SYSUT2, QSAM DCB FOR PRINT OUT +

DSORG=PS,MACRF=PM, +

RECFM=FB,LRECL=OUTDATA#

OUTDATA EQU *

MARK1 DC C'>>>'

INDATA DS XL256 PDS DIR BLOCK READ AREA

MARK2 DC C'<<<'

OUTDATA# EQU *-OUTDATA

*=====================================================================*

LTORG ,

EJECT ,

***********************************************************************

* DSECT *

***********************************************************************

YREGS , S/370 REGISTER EQUATES

END

読み込んだPDSディレクトリー・ブロックは、文字’>>>’と’<<<'で囲んでSYSUT2データセットへ書き出しています。>>>と<<<に囲まれた部分が読み込んだディレクトリー・ブロック内容です。ISPFブラウザーなどのHEXモードで表示すれば、区分データセットのディレクトリー・ブロックの構造が目視できます。※区分データセットのディレクトリー内容は「区分データセットのディレクトリー構造」に解説があります。

なお、PDSEであってもPDS同様に従来から知られているBSAMやQSAMによってディレクトリー・ブロックを読み込むことができます。PDSEの内部構造にはPDSと同じディレクトリー・ブロック・データはありませんが、アクセス方式によってアクセスする場合はプログラムに対しては従来の区分データセットのメンバー部がエミュレートされるようになっています。

DESERVマクロでPDSディレクトリー部を読み込む

こちらは、QSAMやBSAMでディレクトリー・ブロックを直接読み込むのではなくDESERVマクロを利用する方法です。DESERVは、DFSMS/MVS V1R3からサポートされた比較的新しいサービスです。ディレクトリー・ブロックがそのままのイメージで入ってくるのではなく、DESERV内部の形式に展開された内容でメンバー・ディレクトリー情報が渡されます。そのため、サンプル・プログラムの出力もメンバー名＋ディレクトリー部のユーザー・データで書き出しています。ユーザー・データ部分（>>>と<<<に囲まれた部分）はバイナリーのまま出力していますので、必要に応じてISPFブラウザーなどのHEXモードでの表示に切り替えて下さい。

PDSディレクトリー読み込みプログラム・サンプル(BPAM:DESERV)

//         JOB
//*********************************************************************
//ASMCG    PROC AOPT=,LOPT=
//ASM      EXEC PGM=ASMA90,PARM='TERM,ASA,&AOPT,US(WARN(11)),LC(32767)'
//SYSLIB   DD DISP=SHR,DSN=SYS1.MACLIB
//         DD DISP=SHR,DSN=SYS1.MODGEN
//SYSUT1   DD UNIT=SYSALLDA,SPACE=(TRK,(50,10))
//SYSLIN   DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(10,10),RLSE)
//SYSPRINT DD SYSOUT=*
//SYSTERM  DD SYSOUT=*
//GO       EXEC PGM=LOADER,COND=(5,LT,ASM),
//         PARM=('LIST,LET,MAP,XREF,&LOPT')
//SYSLOUT  DD SYSOUT=*
//SYSLIB   DD DISP=SHR,DSN=&SYSUID..LOAD
//SYSLIN   DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE)
//         DD DDNAME=SYSIN
//SYSUDUMP DD SYSOUT=*
//         PEND
//*********************************************************************
//PDSDIRDS EXEC ASMCG
//GO.SYSUT1 DD DISP=SHR,DSN=&SYSUID..JCL
//GO.SYSUT2 DD SYSOUT=*
//ASM.SYSIN  DD *
MAINENTR CSECT                          DEFINE CONTROL SECTION
         USING *,12                     DEFINE BASE REGISTER
         SAVE  (14,12),,                SAVE CALLER REGISTERS          +
               'MAINENTR &SYSDATE &SYSTIME'
         LR    12,15                    GR12 --> OUR 1ST BASE ADDRESS
         LR    15,13                    SAVE CALLER SAVEAREA
         CNOP  0,4                      INSURE FULL WORD BOUNDARY
         BAS   13,*+4+72                AROUND OUR SAVEAREA
         DC    18F'-1'                  OUR GPR SAVEAREA
         ST    15,4(,13)                SAVE CALLER SAVEAREA POINTER
         ST    13,8(,15)                FORWARD CHAIN FOR LINK TRACE
*                                  *----------------------------------*
*                                  *  LOAD EXEC PARAMETERS            *
*                                  *----------------------------------*
         L     R1,0(,R1)                LOAD EXEC PARM FIELD
         LH    R2,0(,R1)                GR2 ---> PARM STRING LENGTH
         LA    R3,2(,R1)                GR3 ---> BEGIN OF PARM STRING
         B     MAINPROC                 DO MAINLINE PROCESSING
*                                  *----------------------------------*
*                                  *  EXIT PROCESSING                 *
*                                  *----------------------------------*
EXIT8    DS    0H
         LA    15,8                     SET CC=8
         B     EXITPROC
EXIT0    DS    0H
         SLR   15,15                    SET CC=0
EXITPROC DS    0H
         L     13,4(,13)                RESTORE CALLER SAVEAREA
         ST    15,16(,13)               PASS RETURN CODE TO CALLER
         RETURN (14,12),T               RESTORE CALLER REGISTERS       +
                                                   AND RETURN TO CALLER
         EJECT ,
***********************************************************************
*        SAMPLE CODE FOR PRINTING PDS DIRECTORY BLOCK DATA            *
*        =====================================================        *
*        READ PDS DIRECTORY BLOCK BY DESERV.                          *
***********************************************************************
MAINPROC DS    0H
         WTO   'THIS IS SAMPLE ASSEMBLER PROGRAM(READ PDS DIRECTORY BLO+
               CK BY DESERV)'
*                                  *----------------------------------*
*                                  *  OPEN THE DATASET                *
*                                  *----------------------------------*
         OPEN  (DIRDCB,INPUT)           OPEN THE PDS DIRECTORY
         LTR   R15,R15                  SUCCESSFUL ?
         BNZ   EXIT8                    NO, MAY BE DD STMT NOT DEFINED
         OPEN  (PRTDCB,OUTPUT)          OPEN THE PRINT DATASET
         LTR   R15,R15                  SUCCESSFUL ?
         BNZ   EXIT8                    NO, MAY BE DD STMT NOT DEFINED

*                                  *----------------------------------*
*                                  *  READ PDS DIRECTORY BY DESERV    *
*                                  *----------------------------------*
READDIR  DS    0H
         DESERV FUNC=GET_ALL,           READ ALL MEMBER DIRECTORY ENTRY+
               DCB=DIRDCB,AREAPTR=ADESB,                               +
               SUBPOOL=100
         LTR   R15,R15                  SUCCESSFUL ?
         BNZ   EXIT8                    NO, MAY BE DD STMT NOT DEFINED

         L     R6,ADESB                 LOAD DESERV BUFFER HEADER
         L     R7,DESB_COUNT-DESB(,R6)  GR7 <--- NUM OF MEMBERS
         LA    R6,DESB_DATA-DESB(,R6)   GR6 <--- 1ST MEMBER SMDE
         USING SMDE,R6                  ADDRESS IT
MEMLOOP  DS    0H
         LH    R1,SMDE_NAME_OFF         LOAD MEMBER NAME OFFSET
         LA    R1,SMDE(R1)              LOCATE TO MEMBER NAME SECTION
         LA    R1,SMDE_NAME_VAL-SMDE_NAME(,R1)  GR1 <--- MEMBER NAME
         LH    R14,SMDE_USRD_OFF        LOAD USER DATA OFFSET
         LA    R14,SMDE(R14)            GR14 <-- USER DATA
         LH    R15,SMDE_USRD_LEN        GR15 <-- USER DATA LENGTH

         MVC   MEMNAME,0(R1)            SET MEMBER NAME
         XC    USERDATA,USERDATA        CLEAR USER DATA FIELD
         LTR   R15,R15                  NO USER DATA ?
         BZ    *+4+2+4                  YES, SKIP USER DATA MOVING
         BCTR  R15,0                    SET USER DATA(VARIABLE LENGTH)
         EX    R15,*+4+4                  I
         B     *+4+6                      I
         MVC   USERDATA(0),0(R14)         V
         PUT   PRTDCB,OUTDATA           PRINT MEM NAME+USER DATA

         AL    R6,SMDE_LEN              LOCATE TO NEXT SMDE ENTRY
         BCT   R7,MEMLOOP               LOOP FOR NEXT MEMBER

*                                  *----------------------------------*
*                                  *  CLOSE THE DATASET               *
*                                  *----------------------------------*
CLOSDIR  DS    0H
         FREEMAIN RU,SP=100             FREEMAIN DESERV BUFFER
         CLOSE (DIRDCB,,                CLOSE THE PDS DIRECTORY        +
               PRTDCB)                  CLOSE USED DATASET
         B     EXIT0                    ALL PROCESSING DONE
         EJECT ,
***********************************************************************
         EJECT ,
***********************************************************************
*        INTERNAL SUB ROUTINES                                        *
***********************************************************************
***********************************************************************
*        DATA AREA                                                    *
***********************************************************************
DIRDCB   DCB   DDNAME=SYSUT1,           QSAM DCB FOR PDS DIRECTORY     +
               DSORG=PO,MACRF=R
PRTDCB   DCB   DDNAME=SYSUT2,           QSAM DCB FOR PRINT OUT         +
               DSORG=PS,MACRF=PM,                                      +
               RECFM=FB,LRECL=OUTDATA#
ADESB    DC    A(0)                     DESERV DESB POINTER

OUTDATA  EQU   *
MEMNAME  DC    CL8' '
         DC    CL3'>>>'
USERDATA DS    XL62                      PDS DIR BLOCK READ AREA
         DC    CL3'<<<'
OUTDATA# EQU   *-OUTDATA
*=====================================================================*
         LTORG ,
         EJECT ,
***********************************************************************
*        DSECT                                                        *
***********************************************************************
         IGWSMDE ,                      DE SERVICE SMDE DSECT
         YREGS ,                        S/370 REGISTER EQUATES
         END
//
//

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

// JOB

//*********************************************************************

//ASMCG PROC AOPT=,LOPT=

//ASM EXEC PGM=ASMA90,PARM='TERM,ASA,&AOPT,US(WARN(11)),LC(32767)'

//SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB

// DD DISP=SHR,DSN=SYS1.MODGEN

//SYSUT1 DD UNIT=SYSALLDA,SPACE=(TRK,(50,10))

//SYSLIN DD DISP=(,PASS),UNIT=SYSALLDA,SPACE=(TRK,(10,10),RLSE)

//SYSPRINT DD SYSOUT=*

//SYSTERM DD SYSOUT=*

//GO EXEC PGM=LOADER,COND=(5,LT,ASM),

// PARM=('LIST,LET,MAP,XREF,&LOPT')

//SYSLOUT DD SYSOUT=*

//SYSLIB DD DISP=SHR,DSN=&SYSUID..LOAD

//SYSLIN DD DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE)

// DD DDNAME=SYSIN

//SYSUDUMP DD SYSOUT=*

// PEND

//*********************************************************************

//PDSDIRDS EXEC ASMCG

//GO.SYSUT1 DD DISP=SHR,DSN=&SYSUID..JCL

//GO.SYSUT2 DD SYSOUT=*

//ASM.SYSIN DD *

MAINENTR CSECT DEFINE CONTROL SECTION

USING *,12 DEFINE BASE REGISTER

SAVE (14,12),, SAVE CALLER REGISTERS +

'MAINENTR &SYSDATE &SYSTIME'

LR 12,15 GR12 --> OUR 1ST BASE ADDRESS

LR 15,13 SAVE CALLER SAVEAREA

CNOP 0,4 INSURE FULL WORD BOUNDARY

BAS 13,*+4+72 AROUND OUR SAVEAREA

DC 18F'-1' OUR GPR SAVEAREA

ST 15,4(,13) SAVE CALLER SAVEAREA POINTER

ST 13,8(,15) FORWARD CHAIN FOR LINK TRACE

* *----------------------------------*

* * LOAD EXEC PARAMETERS *

* *----------------------------------*

L R1,0(,R1) LOAD EXEC PARM FIELD

LH R2,0(,R1) GR2 ---> PARM STRING LENGTH

LA R3,2(,R1) GR3 ---> BEGIN OF PARM STRING

B MAINPROC DO MAINLINE PROCESSING

* *----------------------------------*

* * EXIT PROCESSING *

* *----------------------------------*

EXIT8 DS 0H

LA 15,8 SET CC=8

B EXITPROC

EXIT0 DS 0H

SLR 15,15 SET CC=0

EXITPROC DS 0H

L 13,4(,13) RESTORE CALLER SAVEAREA

ST 15,16(,13) PASS RETURN CODE TO CALLER

RETURN (14,12),T RESTORE CALLER REGISTERS +

AND RETURN TO CALLER

EJECT ,

***********************************************************************

* SAMPLE CODE FOR PRINTING PDS DIRECTORY BLOCK DATA *

* ===================================================== *

* READ PDS DIRECTORY BLOCK BY DESERV. *

***********************************************************************

MAINPROC DS 0H

WTO 'THIS IS SAMPLE ASSEMBLER PROGRAM(READ PDS DIRECTORY BLO+

CK BY DESERV)'

* *----------------------------------*

* * OPEN THE DATASET *

* *----------------------------------*

OPEN (DIRDCB,INPUT) OPEN THE PDS DIRECTORY

LTR R15,R15 SUCCESSFUL ?

BNZ EXIT8 NO, MAY BE DD STMT NOT DEFINED

OPEN (PRTDCB,OUTPUT) OPEN THE PRINT DATASET

LTR R15,R15 SUCCESSFUL ?

BNZ EXIT8 NO, MAY BE DD STMT NOT DEFINED

* *----------------------------------*

* * READ PDS DIRECTORY BY DESERV *

* *----------------------------------*

READDIR DS 0H

DESERV FUNC=GET_ALL, READ ALL MEMBER DIRECTORY ENTRY+

DCB=DIRDCB,AREAPTR=ADESB, +

SUBPOOL=100

LTR R15,R15 SUCCESSFUL ?

BNZ EXIT8 NO, MAY BE DD STMT NOT DEFINED

L R6,ADESB LOAD DESERV BUFFER HEADER

L R7,DESB_COUNT-DESB(,R6) GR7 <--- NUM OF MEMBERS

LA R6,DESB_DATA-DESB(,R6) GR6 <--- 1ST MEMBER SMDE

USING SMDE,R6 ADDRESS IT

MEMLOOP DS 0H

LH R1,SMDE_NAME_OFF LOAD MEMBER NAME OFFSET

LA R1,SMDE(R1) LOCATE TO MEMBER NAME SECTION

LA R1,SMDE_NAME_VAL-SMDE_NAME(,R1) GR1 <--- MEMBER NAME

LH R14,SMDE_USRD_OFF LOAD USER DATA OFFSET

LA R14,SMDE(R14) GR14 <-- USER DATA

LH R15,SMDE_USRD_LEN GR15 <-- USER DATA LENGTH

MVC MEMNAME,0(R1) SET MEMBER NAME

XC USERDATA,USERDATA CLEAR USER DATA FIELD

LTR R15,R15 NO USER DATA ?

BZ *+4+2+4 YES, SKIP USER DATA MOVING

BCTR R15,0 SET USER DATA(VARIABLE LENGTH)

EX R15,*+4+4 I

B *+4+6 I

MVC USERDATA(0),0(R14) V

PUT PRTDCB,OUTDATA PRINT MEM NAME+USER DATA

AL R6,SMDE_LEN LOCATE TO NEXT SMDE ENTRY

BCT R7,MEMLOOP LOOP FOR NEXT MEMBER

* *----------------------------------*

* * CLOSE THE DATASET *

* *----------------------------------*

CLOSDIR DS 0H

FREEMAIN RU,SP=100 FREEMAIN DESERV BUFFER

CLOSE (DIRDCB,, CLOSE THE PDS DIRECTORY +

PRTDCB) CLOSE USED DATASET

B EXIT0 ALL PROCESSING DONE

EJECT ,

***********************************************************************

EJECT ,

***********************************************************************

* INTERNAL SUB ROUTINES *

***********************************************************************

* DATA AREA *

***********************************************************************

DIRDCB DCB DDNAME=SYSUT1, QSAM DCB FOR PDS DIRECTORY +

DSORG=PO,MACRF=R

PRTDCB DCB DDNAME=SYSUT2, QSAM DCB FOR PRINT OUT +

DSORG=PS,MACRF=PM, +

RECFM=FB,LRECL=OUTDATA#

ADESB DC A(0) DESERV DESB POINTER

OUTDATA EQU *

MEMNAME DC CL8' '

DC CL3'>>>'

USERDATA DS XL62 PDS DIR BLOCK READ AREA

DC CL3'<<<'

OUTDATA# EQU *-OUTDATA

*=====================================================================*

LTORG ,

EJECT ,

***********************************************************************

* DSECT *

***********************************************************************

IGWSMDE , DE SERVICE SMDE DSECT

YREGS , S/370 REGISTER EQUATES

END

DESERVマクロは少々複雑です。特に、返答領域であるSMDE（システム管理ディレクトリー項目）は、従来のPDSデータセットのメンバー・エントリーよりも構造が複雑です。マッピングされるDSECTも多く、BSAM/QSAMによるディレクトリー部アクセスに比べると煩雑になります。ISPF等で編集するJCLやソース・プログラムなどのライブラリー・データセットであれば、PDSでもPDSEでもBSAM/QSAMによる方法が手軽でしょう。
ただし、ロード・モジュールを格納しているPDSEデータセットの場合は、ロード・モジュールの形式がプログラム・オブジェクトと呼ばれる新しい形式に変わっています。プログラム・オブジェクトは別名であれば1024バイトという長い名前を付けることもできます。その場合はDESERVマクロでないとアクセスできません。