EXCPでDASDボリュームのトラックをまるごと読み込むサンプル
いただいた質問に答えるために書いたサンプルです。せっかくなので記事として残しておきます。実際には昔作ったプログラムを人様に見せられるように整理しただけのものです。
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

