EXCPでDASDボリュームのトラックをまるごと読み込むサンプル

By 神居 - Posted: 2010/03/04 Last updated: 2010/03/27 - Leave a Comment

いただいた質問に答えるために書いたサンプルです。せっかくなので記事として残しておきます。実際には昔作ったプログラムを人様に見せられるように整理しただけのものです。

EXCPを使いCCWを直接投げる場合でも、本来ならばI/Oするデータセットに対応したDD文を定義してDCBをOPENします。OSはOPENによって作成されるDEBによって、例えEXCPと言えどもアクセスできる範囲を厳格にチェックします。通常はターゲット・データセットのエクステント内に限られます。VTOCをアクセスする場合は、RDJFCBとOPEN TYPE=Jを利用しDSNとして44文字のx04を使ってVTOCを1つのPSデータセットとしてOPENすることもできます。

元の質問の主旨は誤って削除してしまったデータセットがあるが、ボリュームのトラック上にはデータが残っているので、それをEXCPによって読み出すことはできないか、ということでした。この場合、削除してしまったデータセットであることがポイントになります。つまりDD文では定義できないデータセットになります。消してしまったデータセットではQSAMやBSAMなどを使うことはできませんから、EXCPを使うことになります。しかしDD文を定義できないのでボリューム上の任意のトラックをI/Oできるようにしなければなりません。OPENは出せませんから、自分でUCBを求めDEBを作ることになります。またDEBはOSが作った正規のものではないので、EXCPルーチンでのDEBの妥当性をスキップさせる必要があります。このサンプルではDCBはDEB領域をREDEFINEしていますが、DCB自体EXCPアクセスではアクセス法ほど意味を持たないので、必要最低限のフィールドの辻褄があえば大丈夫です。

正確なことを言えば、空きスペースに限っては適当な名前のデータセットをABSTRアロケーションして、そのDSNでDD文を定義する方法もあります。具体的なことは機会を改めて紹介します。

伝統的に伝えられてきた技法ですが、キー0(正確には7以下のキー)でEXCPを発行するなら、事前にOPENを出さなくてもI/Oできます。サンプルではUCBを簡単に求めるためにアクセスするDASDボリュームをDD文で定義していますが、UCBLOOKマクロ等で直接UCBアドレスを求めるなら、DD文やDYNALLOCによるアロケーションなしでデバイスに直接I/Oを行うこともできます。ただしONLINEデバイスでなければなりません。

//STEP1    EXEC PGM=READTRAK
//STEPLIB  DD DISP=SHR,DSN=your apf library
//SYSUT1   DD DISP=OLD,UNIT=SYSALLDA,VOL=SER=volser <== I/Oを行う
//                                                      ボリューム名
         LCLC  &MDLNM
&MDLNM   SETC  'READTRAK'               SET THIS MODULE NAME
*---------------------------------------------------------------------*
*        HOUSE KEEPING                                                *
*---------------------------------------------------------------------*
&MDLNM   CSECT
         B     4+68+10(,15)             AROUND PROGRAM HEADER
         DC    17F'-1'                  OUR REGISTER SAVEAREA
         DC    AL1(8)                   MODULE NAME LENGTH
         DC    CL8'&MDLNM'              MODULE NAME
         DS    0H
         USING &MDLNM,RD                DEFINE OUR BASE REGISTERS
         STM   RE,RC,12(RD)             SAVE CALLER REGISTERS
         ST    RD,4(,RF)                SAVE CALLER SAVEAREA POINTER
         LA    RE,0(,RD)                SAVE CALLER SAVEAREA ADDRESS
         LA    RD,0(,RF)                LOAD OUR 1ST BASE ADDRESS
         ST    RD,8(,RE)                SET BACK CHAIN FOR LINK TRACE
         B     MAINPROC                 DO MAIN PROCESSING
         SPACE ,
*---------------------------------------------------------------------*
*        EXIT PROCESSING                                              *
*---------------------------------------------------------------------*
EXITPROC DS    0H
         L     RD,4(,RD)                LOAD CALLER SAVEAREA
         ST    RF,16(,RD)               PASS RETURN CODE TO CALLER
         LM    RE,RC,12(RD)             RESTORE CALLER REGISTERS
         BSM   0,RE                     RETURN TO CALLER
         EJECT ,
***********************************************************************
*        MAIN PROCESSING                                              *
*        =====================================================        *
*        GR0 -- N/A                                                   *
*        GR1 -- EXEC PARAMETER PLIST                                  *
*        GR13 - BASE REGISTER AND OUR REGISTER SAVEAREA               *
***********************************************************************
MAINPROC DS    0H
*                                  *----------------------------------*
*                                  *  SETUP EXCP I/O PROCESSING       *
*                                  *  ==============================  *
*                                  *----------------------------------*
         EXTRACT DOUBLE,'S',FIELDS=TIOT EXTRACT OUR TIOT ADDRESS
         L     RA,DOUBLE                LOAD TIOT ADDRESS
         LA    RA,TIOENTRY-TIOT1(,RA)   LOCATE TO 1ST DD ENTRY
         USING TIOENTRY,RA              ADDRESS IT
         SLR   RF,RF                    CLEAR WORKREG
         CLC   TIOEDDNM,=CL8'SYSUT1'    IS HERE SYSUT1 DD ENTRY ?
         BE    *+4+4+4+4                YES, FOUND IT
         IC    RF,TIOELNGH              ADD CURRENT ENTRY LENGTH
         LA    RA,0(RF,RA)              LOCATE TO NEXT ENTRY
         B     *-4-4-4-6                FIND OUR DD STATEMENT
         MVC   DEBUCBAD,TIOEFSRT        SET UCB(CAPTURED) ADDR TO DEB
         DROP  RA                       FORGET TIOT
         SPACE ,
         L     R0,LIOBUF                LOAD I/O BUFFER LENGTH
         GETMAIN RU,LV=(0),BNDRY=PAGE   GETMAIN EXCP I/O BUFFER
         ST    R1,AIOBUF                SAVE IT
         STCM  R1,B'0111',CCWRTRK+1     AND SET IT IN CCW
         LR    R0,R1                    INIT I/O BUFFER(NULL CLEAR)
         L     R1,LIOBUF                 I
         L     RF,=A(X'00000000')        I
         MVCL  R0,RE                     V
         SPACE ,
         L     RF,PSATOLD-PSA(0,0)      LOAD OUR TCB
         STCM  RF,B'0111',DEBTCBAD      SET INTO DEB
         MVC   DEBDEBID,TCBPKF-TCB(RF)  SET TCBPKF
         OI    DEBDEBID,X'0F'           CORRECT TO DEBID
         SPACE ,
         MODESET MODE=SUP               CHANGE US TO SUP STATE
         SPACE ,
*                                  *----------------------------------*
*                                  *  ISSUE EXCP TO READ TRACK DATA   *
*                                  *  ==============================  *
*                                  *----------------------------------*
*                                  ここで読み込むトラックのアドレスを指定する。
         MVC   IOBCC,=XL2'0000'         SET SEEK ADDR(CYLINDER NUMBER)
         MVC   IOBHH,=XL2'0001'         SET SEEK ADDR(TRACK NUMBER)
         SPACE ,
DOEXCP   DS    0H
         SPKA  0                        CHANGE TO PSWKEY=0
         EXCP  IOB                      ISSUE EXCP I/O
         SPKA  X'80'                    BACK TO SAFE KEY
         WAIT  ECB=ECB                  WAIT FOR I/O COMPLETION
         CLI   ECB,X'7F'                NORMAL COMPLETION ?
         BE    *+4+2+4+4                YES, CONTINUE PROCESSING
         SLR   RF,RF                    NO, ABORT PROCESSING WITH ERRCD
         IC    RF,ECB                   LOAD COMPLETION CODE INTO GR15
         B     EXITPROC                 PROCESSING DONE
         SPACE ,
         SLR   RE,RE                    CLEAR READ LENGTH
         ICM   RE,B'0011',IOBRDUAL      LOAD RESIDUAL COUNT
         L     R0,=F'65535'
         SR    R0,RE                    GR0 --> READ LENGTH            +
                                        (ACTUAL DATA LENGTH ON TRACK)
         L     R1,AIOBUF                GR1 --> ALL CKD DATA ON TRACK
         SPACE ,
*                 読み込んだトラックデータはGR1が示す領域に格納されている。
*                 長さはGR0に入っている。IOBRDUALはREADコマンドで指定した
*                 読み込み長に対して、読み残した長さが入っている。
*                 実際に書かれているデータが短い場合などである。
*                 メモリー内のデータはトラックに書かれているR1以降のすべての
*                 ブロックがCKDの形式で並ぶ。トラックからGAPを抜いたような感じ。
*
*        ADD YOUR OWN CODE
*
*
         SPACE ,
*        他のトラックも読むなら、そのアドレスをIOBにセットしてDOEXCPから再実行する。
*
*        SET NEXT TRACK ADDRESS IF NEED...
*
*        B     DOEXCP                   READ NEXT TRACK AGAIN
*
         SPACE ,
         SLR   RF,RF                    CLEAR COMPLETION CODE
         B     EXITPROC                 PROCESSING DONE
         EJECT ,
***********************************************************************
*        I N T E R N A L  S U B  R O U T I N E S                      *
***********************************************************************
         EJECT ,
***********************************************************************
*        DATA AREA (CONSTANTS)                                        *
***********************************************************************
*                                  *----------------------------------*
*                                  *  MISCELLANEOUS                   *
*                                  *----------------------------------*
         SPACE ,
***********************************************************************
*        DATA AREA                                                    *
***********************************************************************
*                                  *----------------------------------*
*                                  *  MISCELLANEOUS                   *
*                                  *----------------------------------*
DOUBLE   DC    D'0'                     DOUBLE WORD WORKAREA
*                                  *----------------------------------*
*                                  *  PROCESSING WORKS                *
*                                  *  ==============================  *
*                                  *----------------------------------*
LIOBUF   DC    A(64*1024)               I/O BUFFER LENGTH
AIOBUF   DC    A(0)                     64KB I/O BUFFER
         SPACE ,
*---------------------------------------------------------------------*
*        C C W                                                        *
*---------------------------------------------------------------------*
         DC    0D'0',CL8'CCW CCW '      FOR DIAGNOSE
CCWRMCKD DS    0D                       (FOR TRACK READ)
         CCW   X'39',IOBCCHHR,X'40',4   SERACH HA EQ
         CCW   X'08',CCWRMCKD,X'00',0   TIC BACK
CCWRTRK  CCW   X'5E',0,X'20',65535      READ MULTIPLE CKD
LNRMCKD  EQU   *-CCWRMCKD               LENGTH OF CCW
*
*        ECKDデバイスであれば、LOCATE RECORDとREAD TRACKコマンドを
*        使う方がいいが、特定の目的のために一時的に使うようなプログラムなら
*        従来からあるREAD MCKDコマンドの方がわかりやすい。
*
         SPACE ,
*---------------------------------------------------------------------*
*        E C B + I O B                                                *
*---------------------------------------------------------------------*
         DC    0D'0',CL8'ECB ECB '      FOR DIAGNOSE
ECB      DC    F'0'                     ECB
         DC    0D'0',CL8'IOB IOB '      FOR DIAGNOSE
IOB      DS    0D        IOB STANDARD SECTION(40BYTES)
IOBSTDRD DS    0D
IOBFLAG1 DC    AL1(IOBCMDCH+IOBUNREL)  FLAG BYTE 1
IOBDATCH EQU   X'80' -   DATA CHAINING USED IN CHANNEL PROGRAM
IOBCMDCH EQU   X'40' -   COMMAND CHAINING USED IN CHANNEL PROGRAM
IOBUNREL EQU   X'02' -   IOB UNRELATED FLAG (I.E., NONSEQUENTIAL)
IOBFLAG2 DC    AL1(0)    FLAG BYTE 2
IOBSENS0 DC    AL1(0)    FIRST SENSE BYTE
IOBSENS1 DC    AL1(0)    SECOND SENSE BYTE
IOBECBPT DS    0A    -   ADDRESS OF ECB
IOBECBCC DC    AL1(0)    I/O COMPLETION CODE
IOBECBPB DC    AL3(ECB)
IOBFLAG3 DC    AL1(0)    FLAG BYTE 3
IOBCSW   DS    0XL7      COPIED CHANNEL STATUS WORD
IOBCMDA  DC    AL3(0)    FINAL CCW ADDRESS
IOBUSTAT DC    AL1(0)    DEVICE STATUS CODE
IOBCSTAT DC    AL1(0)    CHANNEL STATUS CODE
IOBRDUAL DC    AL2(0)    REMAIN BYTE COUNT(RESIDUAL COUNT)
IOBSTART DS    0A    -   ADDRESS OF CHANNEL PROGRAM TO BE EXECUTED
         DC    AL1(0)
IOBSTRTB DC    AL3(CCWRMCKD)
IOBDCBPT DS    0A    -   ADDRESS OF DCB ASSOCIATED WITH THIS IOB
         DC    AL1(0)
IOBDCBPB DC    AL3(DCB)
         DC    AL4(0)
         DC    AL4(0)
IOBEXTEN DS    0D
IOBSEEK  DS    0XL8  -   A SEEK ADDRESS(IN THE FORMAT MBBCCHHR)
IOBM     DC    X'00'     THE NUMBER OF THE DEB EXTENT
IOBBB    DS    0XL2  -   BIN NUMBER(DATA CELL)
IOBBB1   DC    X'00'
IOBBB2   DC    X'00'
IOBCCHHR DS    0XL5  -   FORMAT CCHHR
IOBCC    DS    0XL2  -   CYLINDER NUMBER
IOBCC1   DC    X'00'
IOBCC2   DC    X'00'
IOBHH    DS    0XL2  -   TRACK NUMBER
IOBHH1   DC    X'00'
IOBHH2   DC    X'00'
IOBR     DC    X'00' -   RECORD NUMBER
LIOB     EQU   *-IOB
         SPACE ,
*---------------------------------------------------------------------*
*        I/O APPENDAGE ROUTINE (DUMMY ROUTINE FOR OUR EXCP I/O)       *
*---------------------------------------------------------------------*
         DC    0D'0',CL8'APENDAGE'      FOR DIAGNOSE
IOAPENDR BR    14                       DUMMY APPENDAGE ROUTINE
         SPACE ,
*---------------------------------------------------------------------*
*        D E B (SIMULATE DEB FOR EXCP I/O)  AND  D C B (DUMMY)        *
*---------------------------------------------------------------------*
         DC    0D'0',CL8'DEBAVT-8'      FOR DIAGNOSE
DEBAVT   DS    0D                       DEB -36 (DEB APPENDAGE VECTOR)
DEBEOEA  DC    A(IOAPENDR)              EOE APPENDAGE ROUTINE
DEBSIOA  DC    A(IOAPENDR)              SIO APPENDAGE ROUTINE
DEBPCIA  DC    A(IOAPENDR)              PCI APPENDAGE ROUTINE
DEBCEA   DC    A(IOAPENDR)              CHANNEL-END APPENDAGE ROUTINE
DEBXCEA  DC    A(IOAPENDR)              ABNORMAL-END APPENDAGE ROUTINE
DEBPREFX DS    0A                       DEB -16 (DEB PREFIX)
DEBWKARA DC    XL1'00'                  IOS WORKAREA
DEBDSCBA DC    XL7'00'                  IOS USE DSCB ADDRESS
DEBXTNP  DC    A(0)                     POINTER TO DEB EXTENSION
DEBLNGTH DC    AL1(12)                  LENGTH OF DEB IN DOUBLE WORDS
DEBAMTYP DC    XL1'00'                  ACCESS METHOD TYPE
DEBTBLOF DC    H'0'                     OFFSET IN DEB TABLE OF THIS DEB
DEB      EQU   *
DEBBASIC DS    0A                       DEB +0 (DEB BASIC SECTION)
DEBNMSUB DC    AL1(0)                   NUMBER OF SUB ROUTINES
DEBTCBAD DC    AL3(0)                   TCB ADDRESS
DEBAMLNG DC    AL1(16)                  ACCESS METHOD LENGTH
DEBDEBAD DC    AL3(0)                   NEXT DEB ADDRESS
DEBOFLGS DC    XL1'60'                  DATASET STATUS FLAG
DEBIRBAD DC    AL3(0)                   IRB ADDRESS
DEBOPATB DC    XL1'0F'                  TYPE OF I/O
DEBQSCNT DC    AL1(0)                   PURGE QUIESCE COUNT
DEBFLGS1 DC    XL1'00'                  FLAGS 1
DEBFLGS2 DC    XL1'00'                  FLAGS 2
DEBNMEXT DC    AL1(1)                   NUMBER OF EXTENTS
DEBUSRPB DC    AL3(0)                   USER PURGE CHAIN
DEBPRIOR DC    AL1(250)                 PRIORITY
DEBECBAD DC    AL3(0)                   PLIST TO FIND PURGE ECB
DEBDEBID DC    XL1'0F'                  DEBID
DEBDCBAD DC    AL3(DCB)                 DCB ADDRESS
DEBEXSCL DC    AL1(4)                   EXTENT SCALE
DEBAPPAD DC    AL3(DEBAVT)              I/O APPENDAGE VECTOR TABLE
DEBDASD  DS    0A                       DEB +32 (DEB DASD SECTION)
DEBDVMOD DC    XL1'10'                  DEVICE MODIFIER - FILE MASK
DEBUCBAD DC    AL3(0)                   UCB ADDRESS
DEBBINUM DC    XL2'00'                  BIN NUMBER
DEBSTRCC DC    XL2'00'                  STARTING CYLINDER
DEBSTRHH DC    XL2'00'                  STARTING TRACK
DEBENDCC DC    XL2'FFFF'                ENDING CYLINDER
DEBENDHH DC    XL2'FFFF'                ENDING TRACK
DEBNMTRK DC    XL2'FFFF'                NUMBER OF TRACKS IN EXTENT
DEBVOLSQ DC    H'1'                     VOLUME SEQUENCE NUMBER
DEBVOLNM DC    H'1'                     NUMBER OF VOLUMES
         DC    2F'0'                    RESERVE
DCB      EQU   *-44                     DEFINE DUMMY DCB
DCBDEBAD DC    A(DEB)                   DEB ADDRESS
*---------------------------------------------------------------------*
         LTORG ,                        USER LITERAL PLACE AT HERE
         DROP  ,                        FORGET ALL BASE REGISTER
***********************************************************************
*        DATA AREA (OUTSIDE OUR BASE)                                 *
***********************************************************************
*---------------------------------------------------------------------*
*        LOCAL WORKAREA                                               *
*---------------------------------------------------------------------*
*---------------------------------------------------------------------*
*        LOCAL DSECTS                                                 *
*---------------------------------------------------------------------*
*---------------------------------------------------------------------*
*        GLOBAL DSECTS                                                *
*---------------------------------------------------------------------*
*---------------------------------------------------------------------*
*        S/370, ESA/390 REGISTER EQUATES                              *
*---------------------------------------------------------------------*
*------- YREGS ,                        OS: REGISTER EQUATES
R0       EQU   0                        GENERAL REGISTER 0
R1       EQU   1                        GENERAL REGISTER 1
R2       EQU   2                        GENERAL REGISTER 2
R3       EQU   3                        GENERAL REGISTER 3
R4       EQU   4                        GENERAL REGISTER 4
R5       EQU   5                        GENERAL REGISTER 5
R6       EQU   6                        GENERAL REGISTER 6
R7       EQU   7                        GENERAL REGISTER 7
R8       EQU   8                        GENERAL REGISTER 8
R9       EQU   9                        GENERAL REGISTER 9
RA       EQU   10                       GENERAL REGISTER 10
RB       EQU   11                       GENERAL REGISTER 11
RC       EQU   12                       GENERAL REGISTER 12
RD       EQU   13                       GENERAL REGISTER 13
RE       EQU   14                       GENERAL REGISTER 14
RF       EQU   15                       GENERAL REGISTER 15
*---------------------------------------------------------------------*
*        OS CONTROL BLOCKS                                            *
*---------------------------------------------------------------------*
******** PRINT NOGEN
         IHAPSA ,                       PSA
         IKJTCB ,                       TCB
DTIOT    DSECT ,
         IEFTIOT1 ,                     TIOT
         END
Posted in 未分類 • • Top Of Page