//jobname JOB CLASS=x,MSGCLASS=x,NOTIFY=user-id <- CHECK //* ----------------------------------------------------------------- //* @VOL ! Install ... <- X ALL;F '<- CHECK' ALL (Enter) <- CHECK //* Step3: <- CHECK //* Update Non-Exclusive Line . <- CHECK //* e.g. => C 'object.library' 'USER.OBJECT' ALL NX (Enter) <- CHECK //* Step4: <- CHECK //* Submit This JCL and Lock WTO Message . <- CHECK //* Step5: <- CHECK //* Comcat Created Datasets in Your Logon Procedure . <- CHECK //* module.library : ISPLLIB or STEPLIB <- CHECK //* Step6: <- CHECK //* Create This Procedure in Your System Procedure Library . <- CHECK //* +-----------------------------------------------------+ <- CHECK //* |//VOLLST PROC V='HELP' | <- CHECK //* |//VOLLST EXEC PGM=@VOL,PARM='&V' | <- CHECK //* |//STEPLIB DD DSN=module.library,DISP=SHR | <- CHECK //* +-----------------------------------------------------+ <- CHECK //* Step6: <- CHECK //* Enter Below TSO Command . <- CHECK //* @VOL serial (Enter) <- CHECK //* ----------------------------------------------------------------- //JOBCAT DD DSN=user.catalog,DISP=SHR <- CHECK //A1 EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START * ----------------------------------------------------------------- DC C'<< Volume Scan ... Scanning Online DASD >>' DC C' Version ' @VERSION DC CL6'v3r1m0' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' PRINT NOGEN * --- Start of Process -------------------------------------------- @VOL CSECT *VOL AMODE 31 *VOL RMODE ANY SAVE (14,12),T,* BALR R03,0 USING *,R03,R04,R05 Base Reg. R03,R04,R05 LA R04,2048(R03) 2'ND Base Reg LA R04,2048(R04) LA R05,2048(R04) 3'ND Base Reg LA R05,2048(R05) ST R13,SAVEAREA+4 Save A(OLD SaveArea) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) Save A(NEW SaveArea) * set CPPL Base Reg. LR R06,R01 Load CPPL Address * LA R08,EXT#TSO EXTRACT (R08),FIELDS=TJID CHECK TSO CLC EXT#TSO,=F'0' BNE TSO#PROC * LA R08,EXT#TSO * EXTRACT (R08),FIELDS=TSO CHECK TSO * TM EXT#TSO,X'80' if TSO then * BNO TSO#PROC goto --- * STC or BATCH Environment * * if STC address space --- STC#P EQU * MVC @OPTION,@OPTCHP MVC @OPTION2,@OPTON Display Option-2 * MVI @SERIAL,X'40' Clear Volume Serial MVC @SERIAL+1(L'@SERIAL-1),@SERIAL MVC MSG#P001+03(04),=CL04'@VOL' L R01,@VER_A MVC MSG#P001+08(06),0(R01) MVC MSG#P001+15(16),=CL16' Scan Volume is ' L R06,0(R06) Copy Volume Serial LH R02,0(R06) Parameter Length LA R12,2(R06) Start Pointer LR R11,R12 Current Pointer XR R01,R01 Loop Clounter STC#PL0 EQU * CLI 0(R11),C',' If Parm Next BE STC#PL0X CLI 0(R11),C' ' If Parm Next BE STC#PL0X CLR R01,R02 If Parm End BNL STC#PL0X LA R01,1(R01) Loop Counter + 1 LA R11,1(R11) Next Byte B STC#PL0 Loop STC#PL0X EQU * STC R01,*+5 Copy Volume Serial MVC @SERIAL(6),0(R12) ST R01,@SERL STC R01,*+5 Copy Title Line MVC MSG#P001+31(6),@SERIAL LA R12,MSG#P001+31(R01) MVI 0(R12),C' ' CLR R01,R02 If Parm End BNL STC#PLX SR R02,R01 LA R11,1(R11) Option 1 Search BCTR R02,0 LR R12,R11 XR R01,R01 STC#PL1 EQU * CLI 0(R11),C',' BE STC#PL1X CLI 0(R11),C' ' BE STC#PL1X LA R01,1(R01) CLR R01,R02 BNL STC#PL1X LA R11,1(R11) B STC#PL1 STC#PL1X EQU * LA R06,@OP1_S LA R07,@OP1_E BCTR R01,0 STC R01,*+5 STC#PC1 EQU * CLC 0(0,R06),0(R12) BE STC#PC1F LA R06,10(R06) CLR R06,R07 BNH STC#PC1 MVC @OPTION,@OPTCHP B STC#PC1X STC#PC1F EQU * MVC @OPTION,8(R06) B STC#PC1X STC#PC1X EQU * MVC MSG#P001+52(8),0(R06) STC#PLX EQU * MVC @FILE(8),=CL8'NOFILE ' * LA R01,MSG#P001 * LA R02,L'MSG#P001 LA R02,80 BAL R14,@PUTL#S * BAL R14,@SCANUCB super locate routine * B @BYE * * if TSO address space --- TSO#PROC EQU * ST R06,CPPL_PTR save CPPL Address USING CPPL,R06 CPPL Base Reg. R06 * BAL R14,@PPL parse command routine * BAL R14,@SCANUCB super locate routine * @BYE EQU * CLC @FILE(8),=CL8'NOFILE ' BE @BYEX CLOSE (OUTDCB) @BYEX EQU * L R13,SAVEAREA+4 RETURN (14,12),RC=0 * --- Sub Routine ------------------------------------------------- * --- PPL ( parse service routine ) ------------------------------- @PPL EQU * STM R00,R15,SAVEPPL save reg. GETMAIN RU,LV=L_PPL getmain PPL comm area STM R00,R01,PPL_LEN save getmain length and address L R12,PPL_ADR USING PPL,R12 PPL Base Reg. R12 MVC PPLUPT,CPPLUPT UPT address from CPPL MVC PPLECT,CPPLECT ECT address from CPPL MVC PPLCBUF,CPPLCBUF command buffer from CPPL LA R01,ANS load answer area address and ST R01,PPLANS store it in the PPL XC #ECB,#ECB clear ECB ( event control block ) LA R01,#ECB load ECB address and ST R01,PPLECB store it in the PPL L R01,PCLADCON load PCL address and ST R01,PPLPCL store it in the PPL CALLTSSR EP=IKJPARS,MF=(E,PPL) DROP R12 LTR R15,R15 test IKJPARS BNZ @PPL_ERR if error goto @PPL_ERR MVI @SERIAL,X'40' clear @SERIAL MVC @SERIAL+1(L'@SERIAL-1),@SERIAL MVI @FILE,X'40' clear @FILE MVC @FILE+1(L'@FILE-1),@FILE L R12,ANS load PPL answer area USING PRDSECT,R12 L R01,PCLVOL R01 <- volume address LH R02,PCLVOL+4 R02 <- volume length BCTR R02,0 STC R02,*+5 MVC @SERIAL(0),0(R01) copy dsname ST R02,@SERL L R01,FNAME R01 <- file address LH R02,FNAME+4 R02 <- file length LTR R02,R02 BZ @PPLFIL1 BCTR R02,0 STC R02,*+5 MVC @FILE(0),0(R01) copy dd-name ST R02,@FILEL MVC OUTDCB+X'28'(8),@FILE copy dd-name OPEN (OUTDCB,(OUTPUT)) B @PPLFILX @PPLFIL1 EQU * MVC @FILE(6),=C'NOFILE' copy dd-name @PPLFILX EQU * * TPUT @FILE,L'@FILE * --- Partition Create -------------------------------------------- MVC MSG#P001+3(16),=CL16' Scan Volume is ' L R02,@SERL STC R02,*+5 MVC MSG#P001+19(0),@SERIAL LA R02,MSG#P001+20(R02) MVI 0(R02),C' ' * MVC @OPTION(2),PCLSPC MVC @OPTION2(2),PCLON MVC @OPTION3(2),PCLWAIT CLC PCLSPC(2),@OPTSPC BE @PPL#SP1 CLC PCLSPC(2),@OPTCHP BE @PPL#SP2 CLC PCLSPC(2),@OPTCACH BE @PPL#SP3 CLC PCLSPC(2),@OPTNON BE @PPL#SP4 MVC MSG#P001+52(7),=CL7' Other ' B @PPL#X @PPL#SP1 EQU * MVC MSG#P001+52(7),=CL7' Space ' B @PPL#X @PPL#SP2 EQU * MVC MSG#P001+52(7),=CL7' CHP ' B @PPL#X @PPL#SP3 EQU * MVC MSG#P001+52(7),=CL7' Cache ' B @PPL#X @PPL#SP4 EQU * MVC MSG#P001+52(7),=CL7' None ' B @PPL#X @PPL#X EQU * CLC PCLON(2),@OPTON BE @PPL#ON1 CLC PCLON(2),@OPTOFF BE @PPL#ON2 CLC PCLON(2),@OPTALL BE @PPL#ON3 CLC PCLON(2),@OPTPRV BE @PPL#ON4 CLC PCLON(2),@OPTSTG BE @PPL#ON5 MVC MSG#P001+60(8),=CL8' Public ' B @PPL#X2 @PPL#ON1 EQU * MVC MSG#P001+60(8),=CL8' Online ' B @PPL#X2 @PPL#ON2 EQU * MVC MSG#P001+60(9),=CL9' Offline ' B @PPL#X2 @PPL#ON3 EQU * MVC MSG#P001+60(5),=CL5' ALL ' B @PPL#X2 @PPL#ON4 EQU * MVC MSG#P001+60(9),=CL9' Private ' B @PPL#X2 @PPL#ON5 EQU * MVC MSG#P001+60(9),=CL9' Storage ' B @PPL#X2 @PPL#X2 EQU * CLC PCLWAIT(2),@OPTWAIT BE @PPL#WT1 MVC MSG#P001+70(8),=CL8' NoWait ' B @PPL#X3 @PPL#WT1 EQU * MVC MSG#P001+70(6),=CL6' Wait ' B @PPL#X3 @PPL#X3 EQU * LA R01,MSG#P001 LA R02,L'MSG#P001 BAL R14,@PUTL#S DROP R12 * L R01,PPL_ADR free main PPL comm area FREEMAIN RU,LV=L_PPL,A=(R01) LM R00,R15,SAVEPPL load reg. BR R14 return * @PPL_ERR EQU * L R01,PPL_ADR free main PPL comm area FREEMAIN RU,LV=L_PPL,A=(R01) LM R00,R15,SAVEPPL load reg. L R13,SAVEAREA+4 RETURN (14,12),RC=8 * --- PUTLINE servise routine ( single line ) --------------------- @PUTL#S EQU * STM R00,R15,SAVEIOPL save reg. CLC @FILE(8),=CL8'NOFILE' BNE @PUTL#S3 CLC EXT#TSO,=F'0' BE @PUTL#S2 * TSO Environment STC R02,*+5 MVC PUTL#S_(0),0(R01) copy message area LA R02,4(R02) length + 4 STH R02,PUTL#SL store length XC #ECB,#ECB clear ECB area XC #IOPL(16),#IOPL clear IOPL area L R10,CPPLUPT L R11,CPPLECT PUTLINE PARM=PUTBLOK,UPT=(10),ECT=(11),ECB=#ECB, * OUTPUT=(PUTL#S,TERM,SINGLE,DATA),MF=(E,#IOPL) B @PUTL#SX * STC or JOB Environment @PUTL#S2 EQU * BCTR R02,0 STC R02,*+5 MVC MESSAGE(0),0(R01) copy message area LA R02,WTOHDR(R02) length + 4 STH R02,WTOAREA store length LA R01,WTOAREA SVC 35 * WTO MESSAGE B @PUTL#SX * FILE Write @PUTL#S3 EQU * MVI OUTAREA,X'40' clear @FILE MVC OUTAREA+1(L'OUTAREA-1),OUTAREA BCTR R02,0 STC R02,*+5 MVC OUTAREA(0),0(R01) copy message area PUT OUTDCB,OUTAREA B @PUTL#SX @PUTL#SX EQU * LM R00,R15,SAVEIOPL load reg. BR R14 return * --- PUTLINE servise routine ( multi line ) ---------------------- @PUTL#M EQU * STM R00,R15,SAVEIOPL save reg. XC #IOPL(16),#IOPL clear IOPL area LA R12,#IOPL Load IOPL Address USING IOPL,R12 IOPL Base Reg. R12 L R01,CPPLUPT ST R01,IOPLUPT L R01,CPPLECT ST R01,IOPLECT XC #ECB,#ECB clear ECB area LA R01,#ECB ST R01,IOPLECB PUTLINE PARM=PUTBLOK,OUTPUT=((2),MULTLIN,DATA), * MF=(E,#IOPL) DROP R12 LM R00,R15,SAVEIOPL load reg. BR R14 return * --- SCANUCB ----------------------------------------------------- @SCANUCB EQU * STM R00,R15,SAVEUCB load reg. XC U#COPY,U#COPY XC U#WORK,U#WORK CLC @SERIAL(4),=CL4'HELP ' BE @HELP * * L R12,CVTPTR CVT ADDR. ( PSA + X'10' ) * USING CVTMAP,R12 * XC WORKAREA,WORKAREA * MVI DEVCLASS,UCB3DACC * OI PARMUCB,X'80' @U_NEXT EQU * UCBSCAN COPY,WORKAREA=U#WORK,UCBAREA=U#COPY, * DEVCLASS=DASD,RANGE=ALL * * LA R01,PARMLIST * L R15,CVTUCBSC * BALR R14,R15 LTR R15,R15 BNZ @U_QUIT USING UCBOB,R10 LA R10,U#COPY * L R10,U#PTR * L R10,ADDRUCB * CLC @OPTION2(2),@OPTON BNE @U_OPT#1 TM UCBSTAT,UCBONLI ( X'80' ) if offline then BNO @U_X goto --- B @U_OPT#X @U_OPT#1 EQU * CLC @OPTION2(2),@OPTOFF BNE @U_OPT#2 TM UCBSTAT,UCBONLI ( X'80' ) if offline then BO @U_X goto --- B @U_OPT#X @U_OPT#2 EQU * CLC @OPTION2(2),@OPTPRV BNE @U_OPT#3 TM UCBSTAB,UCBBPRV ( X'10' ) BNO @U_X goto --- B @U_OPT#X @U_OPT#3 EQU * CLC @OPTION2(2),@OPTSTG BNE @U_OPT#4 TM UCBSTAB,UCBBSTR ( X'10' ) BNO @U_X goto --- B @U_OPT#X @U_OPT#4 EQU * CLC @OPTION2(2),@OPTPUB BNE @U_OPT#5 TM UCBSTAB,UCBBPUB ( X'10' ) BNO @U_X goto --- B @U_OPT#X @U_OPT#5 EQU * B @U_OPT#X @U_OPT#X EQU * * LA R01,@SERIAL LA R02,UCBVOLI LA R14,6 @U_SER#C EQU * CLI 0(R01),C'*' BE @U_SER#X CLI 0(R01),C'%' BE @U_SER#N CLI 0(R01),C'+' BE @U_SER#N CLC 0(R01,1),0(R02) BNE @U_X @U_SER#N EQU * LA R01,1(R01) LA R02,1(R02) BCT R14,@U_SER#C @U_SER#X EQU * MVI MSG#O001,C'>' MVI MSG#O001+1,C' ' MVC MSG#O001+2(L'MSG#O001-2),MSG#O001+1 * copy to address MVC PATHDEVN(2),UCBCHAN CALL @OS#6HC,(PATHDEVN,MSG#O001+2,2) * MVC MSG#O001+2(3),UCBNAME copy address * copy to volume serial MVC MSG#O001+7(6),UCBVOLI copy volume serial * check to device type CLI UCBTBYT4,X'0E' 3380 BE @U_3380 CLI UCBTBYT4,X'0F' 3390 BE @U_3390 MVC MSG#O001+14(5),=C'OTHER' B @U_TYPEX @U_3380 EQU * MVC MSG#O001+14(5),=C'3380 ' B @U_TYPEX @U_3390 EQU * MVC MSG#O001+14(5),=C'3390 ' B @U_TYPEX @U_TYPEX EQU * * check to status TM UCBSTAT,UCBRESV ( X'20' ) BNO @U_STAT1 MVI MSG#O001+20,C'R' B @U_STATX @U_STAT1 EQU * TM UCBSTAT,UCBALOC ( X'08' ) BNO @U_STAT2 MVI MSG#O001+20,C'A' B @U_STATX @U_STAT2 EQU * TM UCBSTAT,UCBSYSR ( X'02' ) BNO @U_STAT3 MVI MSG#O001+20,C'S' B @U_STATX @U_STAT3 EQU * TM UCBSTAT,UCBONLI ( X'80' ) BNO @U_STAT4 MVI MSG#O001+20,C'O' B @U_STATX @U_STAT4 EQU * @U_STATX EQU * TM UCBSTAB,UCBBPRV ( X'10' ) BNO @U_STAB1 MVC MSG#O001+22(3),=C'PRV' B @U_STABX @U_STAB1 EQU * TM UCBSTAB,UCBBPUB ( X'08' ) BNO @U_STAB2 MVC MSG#O001+22(3),=C'PUB' B @U_STABX @U_STAB2 EQU * TM UCBSTAB,UCBBSTR ( X'04' ) BNO @U_STAB3 MVC MSG#O001+22(3),=C'STR' B @U_STABX @U_STAB3 EQU * @U_STABX EQU * TM UCBSTAB,UCBPGFL ( X'40' ) BNO @U_STAB4 TM UCBSTAB,UCBBNUL ( X'01' ) BNO @U_STAB4 MVC MSG#O001+25(7),=CL7'/PG-CAT' B @U_STABQ @U_STAB4 EQU * TM UCBSTAB,UCBPGFL ( X'40' ) BNO @U_STAB5 MVC MSG#O001+25(7),=CL7'/PG ' B @U_STABQ @U_STAB5 EQU * TM UCBSTAB,UCBBNUL ( X'01' ) BNO @U_STAB6 MVC MSG#O001+25(7),=CL7'/CAT ' B @U_STABQ @U_STAB6 EQU * @U_STABQ EQU * * --- Space --- TM UCBSTAT,UCBONLI ( X'80' ) if offline then BNO @U_SPC#X goto --- CLC @OPTION(2),@OPTSPC BNE @U_SPC#X * --- wait check --- CLC @OPTION3(2),@OPTWAIT BE @U_WT CLI UCBSQC,X'00' BNE @U_SPC#N @U_WT EQU * LA R11,MSG#O001+33 LSPACE UCB=(R10),MSG=(R11),MF=I B @U_SPC#X @U_SPC#N EQU * MVC MSG#O001+33(30),MSG#BUSY @U_SPC#X EQU * * --- Path Map --- CLC @OPTION(2),@OPTCHP BNE @U_CHP#X XC PATHMAP,PATHMAP UCBINFO PATHMAP,MAPAREA=PATHMAP,DEVN=PATHDEVN, * RETCODE=B#WK1,RSNCODE=B#WK2 LTR R15,R15 BNZ @U_MAP#E USING IOSDMAP,R11 LA R11,PATHMAP USING MAPDATA,R12 LA R12,MAPCHPDT LA R09,MSG#O001+33 XR R02,R02 IC R02,MAPCHPNO @U_MAP#L EQU * MVC B#WK1(3),MAPCHPID CALL @OS#6HC,(B#WK1,(R09),1) MVI 2(R09),C':' CLI B#WK1+2,X'06' BE @U_MAP#6 CLI B#WK1+2,X'02' BE @U_MAP#2 MVI 3(R09),C'-' B @U_MAP#O @U_MAP#6 EQU * MVI 3(R09),C'+' B @U_MAP#O @U_MAP#2 EQU * MVI 3(R09),C'*' B @U_MAP#O @U_MAP#O EQU * LA R09,5(R09) LA R12,3(R12) BCT R02,@U_MAP#L B @U_MAP#X DROP R11,R12 @U_MAP#E EQU * CALL @OS#6HC,(B#WK1,MSG#PATH+12,4) CALL @OS#6HC,(B#WK2,MSG#PATH+21,4) MVC MSG#O001+33(30),MSG#BUSY @U_MAP#X EQU * @U_CHP#X EQU * * --- Cache --- CLC @OPTION(2),@OPTCACH BNE @U_CHE#X * * --- APF Test --- TESTAUTH FCTN=1 Call Parameter Edit LTR R15,R15 if Auth BZ @U_CAC#G MVC MSG#O001+33(30),MSG#CACH B @U_CHE#X goto @TERM#E1 * @U_CAC#G EQU * MVI LD#BUFF,X'00' Clear LISTDATA Buffer LA R00,LD#BUFF LA R01,LLD#BUFF-1 LA R14,LD#BUFF+1 MVCL R00,R14 XC SSGARGL(SSGARGLL),SSGARGL XC SSGADDN,SSGADDN LA R01,UCBVOLI ST R01,SSGAVOL MVC SSGUNIT,UCBTYP LA R01,LLD#BUFF ST R01,SSGOLN LA R01,LD#BUFF ST R01,SSGOADR XR R01,R01 * IC R01,=BL1'11110010' IC R01,=BL1'01000000' STC R01,SSGOPT1 XC SSGOPT2,SSGOPT2 XC SSGMDLID,SSGMDLID XC SSGRCIOS,SSGRCIOS * WTO 'LISTDATA ( EXECUTE )' LA R01,LDPARM LINK EP=IDCSS01 ST R15,B#WK1 LA R11,LD#BUFF R11 <- SSGDA Base Reg. USING SSGDA,R11 LA R12,SSGDADA USING SSGDASS,R12 R12 <- SSGDASS Base Reg. * LTR R15,R15 if IDCSS01 is Error BZ @LD_CHK goto @LD_ERR1 * CALL @OS#6HC,(B#WK1,MSG#E003+22,4) CALL @OS#6HC,(SSGRCIOS,MSG#CAC2+17,1) CALL @OS#6HC,(LD#RC,MSG#CAC2+29,2) MVC MSG#O001+33(40),MSG#CAC2 B @U_CHE#X goto @TERM#E1 @LD_CHK EQU * *** SUBSYSTEM STATUS *** TM SSGDACST,X'E0' BO @01 DESTAGE ERROR TM SSGDACST,X'C0' BO @02 OFFLINE PROCESSING TM SSGDACST,X'80' BO @03 CACHE OFF TM SSGDACST,X'40' BO @04 HARD ERROR TM SSGDACST,X'20' BO @05 ONLINE PROCESSING * MVC MSG#CAC3+04(03),=CL03'ON' B @0X @01 EQU * MVC MSG#CAC3+04(03),=CL03'DES' B @0X @02 EQU * MVC MSG#CAC3+04(03),=CL03'OFP' B @0X @03 EQU * MVC MSG#CAC3+04(03),=CL03'OFF' B @0X @04 EQU * MVC MSG#CAC3+04(03),=CL03'HRD' B @0X @05 EQU * MVC MSG#CAC3+04(03),=CL03'ONP' B @0X @0X EQU * *** NVS STATUS *** TM SSGDANST,X'C0' BO @21 DESTAGE ERROR TM SSGDANST,X'80' BO @22 OFF TM SSGDANST,X'40' BO @23 HARD ERROR * MVC MSG#CAC3+12(03),=CL03'ON' B @2X @21 EQU * MVC MSG#CAC3+12(03),=CL03'DES' B @2X @22 EQU * MVC MSG#CAC3+12(03),=CL03'OFF' B @2X @23 EQU * MVC MSG#CAC3+12(03),=CL03'HRD' B @2X @2X EQU * *** DEVICE STATUS *** TM SSGDAUST,X'C0' BO @31 DEVICE OFF TM SSGDAUST,X'80' BO @32 DEVICE ERROR * MVC MSG#CAC3+20(03),=CL03'ON ' B @3X @31 EQU * MVC MSG#CAC3+20(03),=CL03'OFF' B @3X @32 EQU * MVC MSG#CAC3+20(03),=CL03'DEV' B @3X @3X EQU * *** DFW STATUS *** TM SSGDAUST,X'30' BO @41 DFW OFF TM SSGDAUST,X'20' BO @42 DFW ERROR * MVC MSG#CAC3+28(03),=CL03'ON ' B @4X @41 EQU * MVC MSG#CAC3+28(03),=CL03'OFF' B @4X @42 EQU * MVC MSG#CAC3+28(03),=CL03'ERR' B @4X @4X EQU * *** CFW STATUS *** TM SSGDACST,X'01' BO @11 CFW OFF * MVC MSG#CAC3+36(03),=CL03'ON ' B @1X @11 EQU * MVC MSG#CAC3+36(03),=CL03'OFF' B @1X @1X EQU * MVC MSG#O001+33(40),MSG#CAC3 * WTO 'LISTDATA ( RETURN )' @U_CHE#X EQU * * ------------- * IOSINFO FUNCTN=SUBCHNO,UCB=(R10),OUTPUT=SUBCH, * RTNCODE=SUBCHRC * CALL @OS#6HC,(SUBCH,MSG#O001+21,4) * @U_PRT EQU * LA R01,MSG#O001 LA R02,L'MSG#O001 BAL R14,@PUTL#S @U_X EQU * B @U_NEXT @U_QUIT EQU * * DROP R10,R12 DROP R10 LM R00,R15,SAVEUCB load reg. BR R14 return * --- Sub Routine ( error routine ) ------------------------------- * --- Help Message ------------------------------------------------ @HELP EQU * LA R07,MSG#HELP LA R08,L'MSG#HELP LA R09,MSG#HPL XR R10,R10 @HELP#L EQU * CLR R10,R09 BNL @HELP#X LR R01,R07 LR R02,R08 BAL R14,@PUTL#S LA R07,0(R07,R08) LA R10,0(R10,R08) B @HELP#L @HELP#X EQU * B @U_QUIT * --- Super Locate Getmain Error ---------------------------------- @S_GMERR EQU * ST R15,B#WK1 CALL @OS#6HC,(B#WK1,MSG#E001+35,4) LA R01,MSG#E001 LA R02,L'MSG#E001 BAL R14,@PUTL#S B @TERM @TERM EQU * L R13,SAVEAREA+4 RETURN (14,12),RC=8 * --- Define Storage ---------------------------------------------- * --- Reg. Save Area ---------------------------------------------- DS 0F SAVEAREA DS 18F SAVEPPL DS 18F SAVEIOPL DS 18F SAVELOCS DS 18F SAVEPRTS DS 18F SAVEINFO DS 18F SAVEUCB DS 18F * --- SUB CHANNEL NUMBER ------------------------------------------ SUBCH DS F SUBCHRC DS F PARMLIST DS 3F ORG PARMLIST PARMWA DC A(WORKAREA) PARMDEVT DC A(DEVCLASS) PARMUCB DC A(ADDRUCB) * DS 0D WORKAREA DS CL100 DEVCLASS DS CL1 ADDRUCB DS F * PATHDEVN DS H PATHMAP DS XL40 PATHINFO DS XL256 * --- UCB --------------------------------------------------------- U#COPY DS XL48 U#PTR DS F U#WORK DS XL100 * --- SSGARAL ----------------------------------------------------- SSGARGLA DC A(SSGARGL) SSGARGL DS 0F SSGHEAD DS CL8 c'SSGARGL' SSGADDN DS A dd name address SSGAVOL DS A volser address SSGUNIT DS XL4 unit type ( ucbtyp ) SSGOLN DS F buffer length SSGOADR DS A buffer address SSGOPT DS 0XL4 option SSGOPT1 DS XL1 option 1 * x'80' : subsystem count * x'40' : subsystem status * x'20' : * x'10' : * x'08' : all same subsystem cnt * x'04' : a subsystem count * x'02' : a device count * x'01' : 3880 pointer SSGOPT2 DS XL3 SSGMDLID DS XL1 ssid SSGRCIOS DS XL1 ios return code SSGARGLL EQU *-SSGARGL * --- listdata parameter list ------------------------------------- LDPARM DS 0D DC A(0) DC A(SSGARGLA) DC A(LD#RC) * --- listdata work area ------------------------------------------ LD#RC DS H *DCSS01 DC V(IDCSS01) * --- Extracter --------------------------------------------------- EXT#TSO DS F * --- volume serial ----------------------------------------------- @SERIAL DS CL6 @SERL DS F @OPTION DS H @OPTION2 DS H @OPTION3 DS H @OP1_S EQU * DC CL8'SPACE' @OPTSPC DC H'0001' DC CL8'CHP' @OPTCHP DC H'0002' DC CL8'CACHE' @OPTCACH DC H'0003' DC CL8'NONE' @OPTNON DC H'0004' @OP1_E EQU * @OP1_L EQU *-@OP1_S @OP2_S EQU * DC CL8'ON' @OPTON DC H'0001' DC CL8'OFF' @OPTOFF DC H'0002' DC CL8'ALL' @OPTALL DC H'0003' DC CL8'PRIVATE' @OPTPRV DC H'0004' DC CL8'STORAGE' @OPTSTG DC H'0005' DC CL8'PUBLIC' @OPTPUB DC H'0006' @OP2_E EQU * @OP2_L EQU *-@OP2_S @OP3_S EQU * DC CL8'WAIT' @OPTWAIT DC H'0001' DC CL8'NOWAIT' @OPTNOWT DC H'0002' @OP3_E EQU * @OP3_L EQU *-@OP3_S @FILE DS CL8 @FILEL DS F * --- IKJPARS ( tso parse service routine ) ----------------------- * PRINT GEN PCLADCON DC A(PCLDEFS) PCLAREA DS 0F PCLDEFS IKJPARM DSECT=PRDSECT PCLVOL IKJIDENT ALPHANUM, * PROMPT='VOLUME SERIAL', * FIRST=ANY,OTHER=ANY,MAXLNTH=6, * HELP=('Search Volume Serial or *') PCLSPC IKJKEYWD DEFAULT='SPACE' IKJNAME 'SPACE' IKJNAME 'CHP' IKJNAME 'CACHE' IKJNAME 'NONE' PCLON IKJKEYWD DEFAULT='ONLINE' IKJNAME 'ONLINE' IKJNAME 'OFFLINE' IKJNAME 'ALL' IKJNAME 'PRIVATE' IKJNAME 'STORAGE' IKJNAME 'PUBLIC' PCLWAIT IKJKEYWD DEFAULT='NOWAIT' IKJNAME 'WAIT' IKJNAME 'NOWAIT' PCLFILE IKJKEYWD IKJNAME 'PCLFILE',SUBFLD=FILESUB,ALIAS='F' FILESUB IKJSUBF FNAME IKJIDENT 'FILENAME', * FIRST=ALPHA,OTHER=ALPHANUM,MAXLNTH=8, * PROMPT='DD-NAME' IKJENDP * PRINT NOGEN * --- CPPL pointer save area -------------------------------------- CPPL_PTR DS F * --- PPL Getmain Area -------------------------------------------- PPL_LEN DS F PPL length PPL_ADR DS F PPL address * --- PPL answer area --------------------------------------------- ANS DS F * --- ECB --------------------------------------------------------- #ECB DS F * --- IOPL -------------------------------------------------------- #IOPL DS 4F * --- PUTLINE ( mapping macro ) ----------------------------------- PUTBLOK PUTLINE MF=L * --- PUTLINE ( single line put ) --------------------------------- PUTL#S DS 0D PUTL#SL DS H DC H'0' PUTL#S_ DS CL80 DS CL100 * --- File Area --------------------------------------------------- OUTDCB DCB DSORG=PS,MACRF=(PM),DDNAME=OUTDD, * RECFM=FB,LRECL=80,BLKSIZE=3120 OUTAREA DS CL80 @VER_A DC A(@VERSION) * --- WTO Area ---------------------------------------------------- WTOAREA DS 0F DC AL2(WTOLEN) DC B'0000000000000000' MESSAGE DS CL80 WTOLEN EQU *-WTOAREA WTOHDR EQU MESSAGE-WTOAREA DS CL100 * --- dump work area ---------------------------------------------- B#WK1 DS F dump work area B#WK2 DS F dump work area D#WK1 DS D dump work area D#WK2 DS D dump work area C#WK1 DS CL12 dump work area C#WK2 DS CL12 dump work area P#WK1 DS PL8 dump work area P#WK2 DS PL8 dump work area WK#PRI#C DS CL5 work primary space ( cyl ) WK#PRI#T DS CL5 work primary space ( trk ) WK#ALC#C DS CL5 work allocation space ( cyl ) WK#ALC#T DS CL5 work allocation space ( trk ) WK#ALC#B DS F work allocation space ( bin ) WK#CYLS DS XL2 quantity of cylinder per volume WK#TRKS DS XL2 quantity of tracks per cylinder WK#EXTS DS 16XL10 extent data copy area WK#DEVT DS XL4 device type work area * --- PUTLINE ( multi line put ) ---------------------------------- P#DSLST DC A(P#DSLST2) DC H'83' DC H'0' MSG#O101 DS CL79 P#DSLST2 DC A(P#DSLST3) DC H'83' DC H'0' MSG#O102 DS CL79 P#DSLST3 DC A(0) DC H'83' DC H'0' MSG#O103 DS CL79 * --- messgae ----------------------------------------------------- * --- Partition --------------------------------------------------- MSG#P001 DC CL79'#--------------------------------------------------* ---------------------' MSG#P002 DC CL79'#--------------------------------------------------* --------------------------' * --- Error messgae ----------------------------------------------- MSG#E001 DC CL79'> Getmain Error Happend . ( Reg.15:@@@@@@@@ )' MSG#E002 DC CL79'> SVC 26 Error Happend . ( Reg.15:@@@@@@@@ )' MSG#E003 DC CL79'> Listdata Error ( Rc:@@@@@@@@ R15:@@@@@@@@ )' MSG#E004 DC CL79'> Not TSO Address Space .( ENV:@@@@@@@@ )' * --- message ----------------------------------------------------- MSG001 DC CL79'*** CAHCE START ***' MSG002 DC CL79'*** CACHE END ***' MSG003 DC CL79'*** CACHE SET ***' MSG004 DC CL79'*** MODESET ***' * --- message ----------------------------------------------------- MSG#O001 DC CL79'> ' * 0....+....1....+....2....+....3....+ MSG#PATH DC CL30'Path Err Rc:@@@@@@@@:@@@@@@@@' MSG#CACH DC CL30'APF Authorization Check Fail ' * 0....+....1....+....2....+....3....+ MSG#CAC2 DC CL40'Listd Err IOS-RC:@@ LISTD-RC:@@@@' MSG#CAC3 DC CL40'SUB:@@@ NVS:@@@ DEV:@@@ DFW:@@@ CFW:@@@' MSG#BUSY DC CL30' Be Busy with One''s Work ' MSG#HELP DS 0CL79 DC CL79'# Volume Search and Check Program .. ' DC CL79'# ' DC CL79'# - USING ( TSO Environment ) - ' DC CL79'# @VOL serial ' DC CL79'# ' DC CL79'# * seleal ( Volume Serial Number ) ' DC CL79'# * opt1 ( Display Option ) ' DC CL79'# < SPACE , CHP , CACHE , NONE > ' DC CL79'# * opt2 ( Search Option ) ' DC CL79'# < ONLINE , OFFLINE , PRIVATE , STORAGE , ' DC CL79'# PUBLIC , ALL > ' DC CL79'# * opt3 ( Wait Option - SPACE request only ) ' DC CL79'# < NOWAIT , WAIT > ' DC CL79'# ' DC CL79'# - USING ( Batch Environment ) - ' DC CL79'# //stepname EXEC PGM=@VOL,PARM=serial,opt1 ' DC CL79'# ' DC CL79'# - USING ( STC Environment ) - ' DC CL79'# > S @VOL,V=serial,opt1 ' DC CL79'# ' DC CL79'# Thanks for Your use .. Bye ! ' MSG#HPL EQU *-MSG#HELP LTORG LD#BUFF DS 4000XL1 LLD#BUFF EQU *-LD#BUFF * --- SSGARAL BUFFER AREA ----------------------------------------- SSGDA DSECT SSGDAVOL DS CL6 Volume Serial DS XL2 Reserved SSGDAUA1 DS CL3 Unit Address SSGDAUA2 DS CL3 Second Address SSGDALN DS H Data Length SSGDADA DS 0X Data Area * --- SSGARAL DATA AREA ( 3880-11,13 3990-3 MODEL SUBSYSTEM STATUS ) DS 0D SSGDASS DSECT DS XL1 0 Reserved SSGDACCA DS XL1 1 Unit Address ( for Channel Prog ) SSGDANUM DS XL1 2 Number of Unit SSGDASNO DS XL1 3 Statistics Set Number SSGDACST DS BL1 4 Cache Status * ooo o oo o o * - Cache Fast Write ( 1:OFF ) * - IML non used . * -- Reserved * - Customize ( Do'nt Use Cache ) * --- Cache Status * 000 : Cache On * 001 : Online Processing * 010 : Hard Error ( Cache Off ) * 100 : Cache Off * 110 : Offine Processing (Destageing) * 111 : Destage Error SSGDANST DS XL1 5 NVS Status * oo o o o ooo * --- Reserved * - Hard Error * - Costomize ( Do'nt Use ) * - Reserved * -- NVS Status * 00 : NVS On * 01 : Hard Error * 10 : NVS Off or Hard Error * 11 : Destageing or Error * DS XL4 6-9 Reserved SSGDACSZ DS FL4 10-13 Cache Size SSGDAUSZ DS FL4 14-17 Useable Size SSGDAPSZ DS FL4 18-21 PIN Data Size SSGDAFSZ DS FL4 22-25 Offline Size SSGDAUST DS XL2 26,27 Unit Status * oo oo o o oo * -- Dual Copy Status * 00 : Dual Copy Ready * 01 : Dual Copy ( Processing ) * 10 : Dual Stop ( NO-Swicth ) * 11 : Dual Stop ( Switched ) * - Dual Copy ( Second Units ) * - Dual Copy ( First Units ) * -- DFW Status * 00 : DFW On * 01 : Reserved * 10 : DFW Error * 11 : DFW Off * -- Device Status * 00 : Device On * 01 : Reserved * 10 : Device Error * 11 : Deivce Off * oo oooooo * ------ Dual Copy Either Address * -- PIN Data Status * 00 : PIN Not Found * 01 : PIN Found ( DFW On ) * 10 : Reserved * 11 : PIN Found ( DFW Off ) SSGDANSZ DS FL4 28-31 NVS Size SSGDANPS DS FL4 32-35 PINNED Size ( NVS ) DS XL1 36 Unit Status ( Group 2 ) DS XL1 37 Reserved SSGDASSI DS XL2 38-39 Subsystem-ID * --- CPPL ( command processor parameter list ) ------------------- IKJCPPL L_CPPL EQU *-CPPL * --- PPL ( parse parameter list ) -------------------------------- IKJPPL L_PPL EQU *-PPL * --- IKJIOPL ( input / output parameter list ) ------------------- IKJIOPL L_IOPL EQU *-IOPL * --- DSCB ( dataset control block ) type 1 ----------------------- DSCBSEC1 DSECT IECSDSL1 (1) * --- DSCB ( dataset control block ) type 3 ----------------------- DSCBSEC3 DSECT IECSDSL1 (3) * --- DSCB ( dataset control block ) type 4 ----------------------- DSCBSEC4 DSECT IECSDSL1 (4) * --- CVT ( communication vector table ) -------------------------- PRINT GEN CVT DSECT=YES,LIST=YES * --- UCB --------------------------------------------------------- * PRINT GEN IEFUCBOB LIST=YES * --- IOCOM ------------------------------------------------------- * PRINT GEN IECDIOCM * --- PATHINFO ---------------------------------------------------- * PRINT GEN IOSDPATH * --- PATHMAP ----------------------------------------------------- * PRINT GEN IOSDMAP * --- SSGARAL ----------------------------------------------------- R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @VOL /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR // DD DSN=SYS1.MODGEN,DISP=SHR //SYSUT1 DD UNIT=(SYSDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //SYSLIN DD DISP=SHR,UNIT=SYSDA, // DSN=object.library(@VOL#03C) <- CHECK //A2 EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START DC C'<< HexToChar Conv >> Version 6 ( ' OSV DC CL6'v6r1m1' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' PRINT NOGEN @OS#6HC CSECT SAVE (14,12),T,* BALR R03,0 USING *,R03 Base Reg. R03 ST R13,SAVEAREA+4 Save A(OLD SaveArea) LR R12,R13 LA R13,SAVEAREA ST R13,8(R12) Save A(NEW SaveArea) * --- from characher --- L R07,0(R01) * --- to character --- L R08,4(R01) * --- convert length --- L R09,8(R01) * LA R07,ALLOCER * LA R08,ERRMSG02+30 * LA R09,4 * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR @CO_HEX EQU * CONVERT HEX-CHARACTER LA R15,5 @CO_HC EQU * LTR R09,R09 BZ @CO_EXIT BCT R15,@CO_SKIP * MVI 0(R08),X'40' LA R08,1(R08) LA R15,4 @CO_SKIP EQU * SR R01,R01 IC R01,0(R07) SRL R01,4 A R01,A_TR ICM R02,B'0010',0(R01) IC R01,0(R07) N R01,=F'15' A R01,A_TR ICM R02,B'0001',0(R01) STCM R02,B'0011',0(R08) LA R07,1(R07) LA R08,2(R08) BCTR R09,0 B @CO_HC @CO_EXIT EQU * L R13,SAVEAREA+4 RETURN (14,12),RC=0 * SAVEAREA DS 18F WORK SAVEAREA TR DC C'0123456789ABCDEF' CHAR TRUNC TABLE A_TR DC A(TR) LTORG R00 EQU 00 R01 EQU 01 R02 EQU 02 R03 EQU 03 R04 EQU 04 R05 EQU 05 R06 EQU 06 R07 EQU 07 R08 EQU 08 R09 EQU 09 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END @OS#6HC /* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR //SYSUT1 DD UNIT=(SYSDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1 //SYSPUNCH DD DUMMY //*YSPUNCH DD SYSOUT=*,DCB=(BLKSIZE=800),SPACE=(CYL,(5,5,0)) //SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3509), // UNIT=(,SEP=(SYSUT1,SYSPUNCH)) //*YSLIN DD DISP=(,PASS),UNIT=SYSDA,SPACE=(CYL,(5,5,0)), //* DCB=(BLKSIZE=400),DSN=&&LOADSET //SYSLIN DD DSN=object.library(@OS#6HC),DISP=SHR <- CHECK //L EXEC PGM=IEWL,PARM='MAP,LET,LIST,AC=1', // REGION=1M,COND=(8,LT,A) //SYSLIN DD DDNAME=SYSIN //SYSLMOD DD DSN=module.library,DISP=SHR <- CHECK //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(3,2)),DSN=&SYSUT1 //SYSPRINT DD SYSOUT=*,DCB=(RECFM=FB,BLKSIZE=3509) //OBJ DD DISP=SHR,UNIT=SYSDA, // DSN=object.library <- CHECK //SYSLIB DD DISP=SHR,UNIT=SYSDA, // DSN=SYS1.LPALIB <- CHECK // DD DISP=SHR,UNIT=SYSDA, // DSN=SYS1.LINKLIB <- CHECK //SYSIN DD * INCLUDE OBJ(@VOL#03C) INCLUDE OBJ(@OS#6HC) ENTRY @VOL NAME @VOL(R) //G EXEC PGM=@VOL,COND=((8,LT,A),(4,LT,L)), //* PARM='FC*,CACHE,PRIVATE,NOWAIT' // PARM='serial,CACHE' <- CHECK //STEPLIB DD DSN=module.library,DISP=SHR <- CHECK