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

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

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

//         JOB
//*********************************************************************
//ASMCG    PROC AOPT=,LOPT=
//ASM      EXEC PGM=ASMA90,PARM='TERM,ASA,&AOPT,US(WARN(11)),LC(32767)'
//SYSLIB   DD DISP=SHR,DSN=&SYSUID..WEB.ASM
//         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..WEB.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=USR1.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'
*                                  *----------------------------------*
*                                  *  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モードでの表示に切り替えて下さい。

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
*                                  *----------------------------------*
*                                  *  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 name offset
 r1,smde(r1) locate to section
 r1,smde_name_val-smde_name(,r1) gr1 name
 r14,smde_usrd_off user data r14,smde(r14) gr14 <-- data
 r15,smde_usrd_len gr15 length

 mvc memname,0(r1) set xc userdata,userdata clear field
 bctr r15,0 data(variable length)
 ex r15,*+4+4 i
 b *+4+6 userdata(0),0(r14) v
 put prtdcb,outdata print mem name+user data

 al r6,smde_len next smde entry
 bct r7,memloop loop for member

* *----------------------------------*
* * close the dataset *
* *----------------------------------*
closdir freemain ru,sp   =100 deserv buffer
 (dirdcb,, pds directory +
 prtdcb) used dataset
 exit0 all processing done
 eject ,
***********************************************************************
 ,
***********************************************************************
* internal sub routines *
***********************************************************************
***********************************************************************
* area *
***********************************************************************
dirdcb dcb ddname                                  =SYSUT1, qsam dsorg    =PO,MACRF=RPRTDCB>>>'
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マクロでないとアクセスできません。