//jobname JOB CLASS=x,MSGCLASS=x,NOTIFY=user-id <- CHECK //* ----------------------------------------------------------------- //* @LOC Install ... <- CHECK //* //* Step1: //* File Transfer to MVS . //* Step2: //* Enter Flow Line //* => X ALL;F '<- CHECK' ALL (Enter) //* Step3: <- CHECK //* Update Non-Exclusive Line . <- CHECK //* e.g. => C serial VOL001 ALL NX (Enter) <- CHECK //* Step4: <- CHECK //* Submit This JCL. <- CHECK //* Step5: <- CHECK //* Comcat Created Datasets in Your Logon Procedure . <- CHECK //* module.library : STEPLIB <- CHECK //* Step6: <- CHECK //* Enter Flow Line on ISPF Command Line . <- CHECK //* => TSO @LOC dataset_prefix (Enter) <- CHECK //* ----------------------------------------------------------------- //A EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //STEPCAT DD DSN=TSOCAT,DISP=SHR //SYSIN DD * START * ----------------------------------------------------------------- DC C'<< Super Locate ... Search Dataset and Information >>' DC C' Version ' @VERSION DC CL6'v3r0m1' DC C' ) _ Kimu // Compiled Date : &SYSDATE _ &SYSTIME ' PRINT NOGEN * ----------------------------------------------------------------- * v3r0m0 : Original Version * v3r0m1 : For MIGRAT or ARCIVE Bug Fix 97.09.24 * ----------------------------------------------------------------- * --- Start of Process -------------------------------------------- @LOC CSECT 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 ST R06,CPPL_PTR save CPPL Address USING CPPL,R06 CPPL Base Reg. R06 * BAL R14,@PPL parse command routine * BAL R14,@SUPER super locate routine * BAL R14,@PRINT super locate routine * @BYE EQU * L R01,@LOSWA# LH R00,0(,R01) N R00,=X'0000FFFF' FREEMAIN R,LV=(R00),A=(R01) 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 @DSN,X'40' clear @DSN MVC @DSN+1(L'@DSN-1),@DSN MVI @CAT,C' ' MVC @CAT+1(L'@CAT-1),@CAT L R12,ANS load PPL answer area USING PRDSECT,R12 L R01,PCLDSN R01 <- dsname address LH R02,PCLDSN+4 R02 <- dsname length BCTR R02,0 STC R02,*+5 MVC @DSN(0),0(R01) copy dsname ST R02,@DSNL * TM UCATN+6,X'80' BNO @PPL#X L R01,UCATN R01 <- dsname address LH R02,UCATN+4 R02 <- dsname length BCTR R02,0 STC R02,*+5 MVC @CAT(0),0(R01) copy dsname ST R02,@CATL LA R01,@CAT BAL R14,@PUTL#S @PPL#X EQU * * --- Partition Create -------------------------------------------- MVC MSG#P001+3(24),=CL24' Dataset Beginning With ' STC R02,*+5 MVC MSG#P001+27(0),@DSN LA R02,MSG#P001+28(R02) MVI 0(R02),C' ' 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. 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) 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. R07 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 * --- LOCATE ( super locate service ) ----------------------------- @SUPER EQU * STM R00,R15,SAVELOCS load reg. XC @LOSWA#,@LOSWA# work area clear XC @LOCATES,@LOCATES super locate area clear MVI @LOSOPT1,X'05' option 1 ( x'05' ) MVI @LOSOPT3,X'11' option 3 ( x'11' ) LA R01,@LOSROOT entry point address ST R01,@LOSENT# MVC @LOSROTN(44),@DSN L R01,@DSNL LA R01,1(R01) STC R01,@LOSROTL CLI @CAT,C' ' BE @S_CAT LA R01,@LOSCAT entry point address ST R01,@LOSCAT# * MVC @LOSCATN(44),@CAT * L R01,@CATL * LA R01,1(R01) * STC R01,@LOSCATL @S_CAT EQU * L R07,=F'32767' R07 <- getmain size LR R00,R07 GETMAIN R,LV=(R00) getmain LTR R15,R15 test BNZ @S_GMERR if error goto getmain err ST R01,@LOSWA# STH R07,0(R01) LA R01,@LOCATES * SVC 26 * C R15,=X'00000028' BE @S_28 C R15,=X'0000002C' BE @S_2C LTR R15,R15 BNZ @S_SVERR B @S_RET @S_28 EQU * L R07,@LOSWA# LH R07,2(,R07) N R07,=X'0000FFFF' B @S_RETRY @S_2C EQU * L R07,=X'0000FFFF' @S_RETRY EQU * L R08,@LOSWA# LH R00,0(,R08) N R00,=X'0000FFFF' LR R01,R08 FREEMAIN R,LV=(R00),A=(R01) LR R00,R07 GETMAIN R,LV=(R00) LTR R15,R15 BNZ @S_GMERR ST R01,@LOSWA# STH R07,0(,R01) LA R01,@LOCATES * SVC 26 * LTR R15,R15 BNZ @S_SVERR @S_RET EQU * LM R00,R15,SAVELOCS load reg. BR R14 * --- print out --------------------------------------------------- @PRINT EQU * STM R00,R15,SAVEPRTS save reg. * L R01,@LOSWA# LH R08,2(R01) used length get N R08,=X'0000FFFF' SL R08,=F'4' length - 4 SRDA R08,32 D R08,=F'45' length / 45 LR R07,R09 R07 <- number of dataset LA R08,4(R01) R08 <- dsname start point ******** L R01,@LOSWA# LH R09,2(R01) used length get N R09,=X'0000FFFF' LA R09,0(R08,R09) ******** MVI MSG#O102,C' ' MVC MSG#O102+1(78),MSG#O102 MVI MSG#O103,C' ' MVC MSG#O103+1(78),MSG#O103 LA R11,MSG#O102 USING DSLIST1,R11 LA R12,MSG#O103 USING DSLIST2,R12 @P_LOP01 EQU * MVC MSG#O101,MSG#P001 partition copy MVC D#TYPE(1),0(R08) dataset type ( from cat ) MVC D#DSN(44),1(R08) dataset name * BAL R14,@DSINFO dataset information get * LA R02,P#DSLST BAL R14,@PUTL#M * LA R08,45(R08) BCT R07,@P_LOP01 LM R00,R15,SAVEPRTS load reg. BR R14 * --- dataset information get ------------------------------------- @DSINFO EQU * STM R00,R15,SAVEINFO save reg. MVC V#DSN,D#DSN LOCATE L#CAMLST LTR R15,R15 BNZ @D_LOCER MVC D#VOL,L#VOL * --- get UCB ----------------------------------------------------- XC U#COPY,U#COPY XC U#WORK,U#WORK UCBSCAN COPY,WORKAREA=U#WORK,UCBAREA=U#COPY,VOLSER=L#VOL LTR R15,R15 BNZ @D_UCBER USING UCBOB,R10 LA R10,U#COPY MVC WK#DEVT(4),UCBTYP CALL @OS#6HC,(WK#DEVT,MSG#O102+65,4) CLI UCBTBYT4,X'0E' BE @DUCB#S8 CLI UCBTBYT4,X'0F' BE @DUCB#S9 B @D_UCBER @DUCB#S8 EQU * MVC D#UNITS(8),=CL8'3380' B @DUCB#X @DUCB#S9 EQU * MVC D#UNITS(8),=CL8'3390' @DUCB#X EQU * * --- get DSCB 4 -------------------------------------------------- XC V#DSCB4,V#DSCB4 MVI V#DSN4,X'04' MVC V#DSN4+1(43),V#DSN4 OBTAIN DSCBFMT4 LTR R15,R15 BNZ @D_DS4ER USING DSCBSEC4,R10 LA R10,V#DSCB4 MVC WK#CYLS(4),DS4DEVSZ copy trk no. and trk size . DROP R10 * --- get dscb1 --------------------------------------------------- XC V#DSCB,V#DSCB OBTAIN DSCBFMT1 LTR R15,R15 BNZ @D_DS1ER USING DSCBSEC1,R10 LA R10,V#JFCB * --- <<< dsorg >>> ----------------------------------------------- LA R01,D#ORG dsorg table address LA R08,D#ORGL dsorg table length SRDA R08,32 LA R02,L'D#ORG DR R08,R02 D#ORGL / L'D#ORG LR R02,R09 R02 <- number of table @DORG#L1 EQU * CLC DS1DSORG(2),0(R01) BE @DORG#LX if equal goto @DORG#LX LA R01,L'D#ORG(R01) BCT R02,@DORG#L1 next table ! MVC D#DSORG(3),=CL3'???' not found .. B @DORGX @DORG#LX EQU * MVC D#DSORG(3),2(R01) @DORGX EQU * * --- <<< recfm >>> ----------------------------------------------- LA R01,D#RFM dsorg table address LA R08,D#RFML dsorg table length SRDA R08,32 LA R02,L'D#RFM DR R08,R02 D#RFML / L'D#RFM LR R02,R09 R02 <- number of table @DRFM#L1 EQU * CLC DS1RECFM(1),0(R01) BE @DRFM#LX if equal goto @DRFM#LX LA R01,L'D#RFM(R01) BCT R02,@DRFM#L1 next table MVC D#RECFM(3),=CL3'???' not found .. B @DRFMX @DRFM#LX EQU * MVC D#RECFM(3),1(R01) @DRFMX EQU * * --- <<< lrecl >>> ----------------------------------------------- XR R01,R01 clear R01 LH R01,DS1LRECL R01 <- lrecl LTR R01,R01 if lrecl is zero BZ @DLRL#S1 goto @DLRLS1 CVD R01,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC D#LRECL(5),C#WK1+1 B @DLRLX @DLRL#S1 EQU * MVC D#LRECL(5),=CL5' 0' if zero @DLRLX EQU * * --- <<< blksz >>> ----------------------------------------------- XR R01,R01 clear R01 LH R01,DS1BLKL R01 <- blksz LTR R01,R01 if lrecl is zero BZ @DBLK#S1 goto @DLRLS1 CVD R01,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC D#BLKSZ(5),C#WK1+1 B @DBLKX @DBLK#S1 EQU * MVC D#BLKSZ(5),=CL5' 0' if zero @DBLKX EQU * * --- <<< allocation size >>> ------------------------------------- MVC WK#EXTS(30),DS1EXT1 extent 1,2,3 copy XR R01,R01 IC R01,DS1NOEPV R01 <- extent * Modified Start .. Kimu 03.25.98 LTR R01,R01 if No-Extents !! BZ @DALC#0 * Modified End .... Kimu 03.25.98 CL R01,=F'3' if extent < 3 then BNH @DALC#S1 goto @DALC#S1 * --- DSCB 3 ------------------------------------------------------ MVC V#CCHHR(5),DS1PTRDS XC V#DSCB3,V#DSCB3 OBTAIN DSCBFMT3 LTR R15,R15 BNZ @D_DS3ER USING DSCBSEC3,R07 LA R07,V#DSCB3 MVC WK#EXTS+30(40),DS3EXTNT extent 4 5 6 7 MVC WK#EXTS+70(90),DS3ADEXT extent 8 - 15 DROP R07 @DALC#S1 EQU * XR R07,R07 IC R07,DS1NOEPV R07 <- extent LA R01,WK#EXTS R01 <- work address XR R08,R08 R08 <- sum reg. @DALC#L1 EQU * CLC DS1DSORG(2),=XL2'0008' BE @DALC#X XR R02,R02 clear R02 LH R02,6(R01) R02 <- lower CC SH R02,2(R01) R02 <- upper CC - lower CC LA R08,1(R02,R08) R08 <- + num cyls LA R01,10(R01) BCT R07,@DALC#L1 CVD R08,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC WK#ALC#C(5),C#WK1+1 * XR R07,R07 IC R07,DS1NOEPV R07 <- extent LA R01,WK#EXTS R01 <- work address XR R08,R08 R08 <- sum reg. @DALC#L2 EQU * XR R02,R02 clear R02 LH R02,6(R01) R02 <- lower CC SH R02,2(R01) R02 <- upper CC - lower CC MH R02,WK#TRKS R02 <- CC * 15 AH R02,8(R01) SH R02,4(R01) LA R08,1(R02,R08) R08 <- + num cyls LA R01,10(R01) BCT R07,@DALC#L2 ST R08,WK#ALC#B store allocation track CVD R08,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC WK#ALC#T(5),C#WK1+1 * CLI DS1SCAL1,DS1CYL BE @DALC#C CLI DS1SCAL1,DS1TRK BE @DALC#T MVC D#ALLOC(5),=CL5' ???' B @DALC#X @DALC#C EQU * MVC D#ALLOC(5),WK#ALC#C B @DALC#X @DALC#T EQU * MVC D#ALLOC(5),WK#ALC#T * Modified Start .. Kimu 03.25.98 B @DALC#X @DALC#0 EQU * MVC D#ALLOC(5),=CL5' 0' * Modified End .... Kimu 03.25.98 @DALC#X EQU * * --- <<< used % >>> ---------------------------------------------- CLC DS1DSORG(2),=XL2'0008' BE @DUSE#X LH R08,DS1LSTAR L R01,DS1LSTAR N R01,=X'0000FF00' LTR R01,R01 BZ @DUSE#S1 LA R08,1(R08) @DUSE#S1 EQU * MH R08,=H'100' SRDA R08,32 L R01,WK#ALC#B LTR R01,R01 if Zero ? BZ @DUSE#S2 DR R08,R01 D#RFML / L'D#RFM * LTR R08,R08 LTR R09,R09 BZ @DUSE#S2 CVD R09,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC D#USED(5),C#WK1+1 B @DUSE#X @DUSE#S2 EQU * MVC D#USED(5),=CL5' 0' @DUSE#X EQU * * --- <<< primary space >>> --------------------------------------- LA R01,DS1EXT1 R01 <- extent address LTR R01,R01 BZ @DPRI#0 LH R02,6(R01) R02 <- lower CC SH R02,2(R01) R02 <- upper CC - lower CC LA R01,1(R02) R01 <- prim cylinder CVD R01,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC WK#PRI#C(5),C#WK1+1 * MH R02,WK#TRKS R02 <- prim cyl * 15 LA R01,DS1EXT1 R01 <- extent address AH R02,8(R01) R02 <- prim cyl + lower HH SH R02,4(R01) R02 <- prim cyl - lower HH LA R01,1(R02) R01 <- prim cylinder CVD R01,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC WK#PRI#T(5),C#WK1+1 * CLI DS1SCAL1,DS1CYL BE @DPRI#C CLI DS1SCAL1,DS1TRK BE @DPRI#T MVC D#PRIM(5),=CL5' ???' B @DPRI#X @DPRI#C EQU * MVC D#PRIM(5),WK#PRI#C B @DPRI#X @DPRI#T EQU * MVC D#PRIM(5),WK#PRI#T B @DPRI#X @DPRI#0 EQU * MVC D#PRIM(5),=CL5' 0' @DPRI#X EQU * * --- <<< second space >>> ---------------------------------------- L R01,DS1SCALO R01 <- secondary space N R01,=X'00FFFFFF' LTR R01,R01 BZ @DSEC#S1 CVD R01,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC D#SEC(5),C#WK1+1 B @DSECX @DSEC#S1 EQU * MVC D#SEC(5),=CL5' 0' if zero @DSECX EQU * * --- <<< trk/cyl >>> --------------------------------------------- LA R01,D#PAC dsorg table address LA R08,D#PACL dsorg table length SRDA R08,32 LA R02,L'D#PAC DR R08,R02 D#RFML / L'D#RFM LR R02,R09 R02 <- number of table @DPAC#L1 EQU * CLC DS1SCAL1(1),0(R01) BE @DPAC#LX if equal goto @DRFM#LX LA R01,L'D#PAC(R01) BCT R02,@DPAC#L1 next table MVC D#UNIT(3),=CL3'???' not found .. B @DPACX @DPAC#LX EQU * MVC D#UNIT(3),1(R01) @DPACX EQU * * --- <<< extent >>> ---------------------------------------------- XR R01,R01 clear R01 IC R01,DS1NOEPV R01 <- blksz CVD R01,D#WK1 MVC C#WK1(8),=XL8'4020202020202120' VERT LA R01,C#WK1+7 EDMK C#WK1(8),D#WK1+5 MVC D#EXT(2),C#WK1+4 CLC D#EXT(2),=CL2' ' BNE @DEXT#X MVC D#EXT(2),=CL2' 0' @DEXT#X EQU * * --- <<< create >>> ---------------------------------------------- L R01,DS1CREDT SRL R01,24 CVD R01,P#WK1 UNPK C#WK1(8),P#WK1 OI C#WK1+7,X'F0' MVC D#CREATE(2),C#WK1+6 MVI D#CREATE+2,C'/' L R01,DS1CREDT SRL R01,8 N R01,=X'0000FFFF' LTR R01,R01 BZ @DCRES1 CVD R01,P#WK1 UNPK C#WK1(8),P#WK1 OI C#WK1+7,X'F0' MVC D#CREATE+3(3),C#WK1+5 B @DCREX @DCRES1 EQU * MVC D#CREATE(6),=C'**/***' @DCREX EQU * * --- <<< reffer >>> ---------------------------------------------- L R01,DS1REFD SRL R01,24 CVD R01,P#WK1 UNPK C#WK1(8),P#WK1 OI C#WK1+7,X'F0' MVC D#REFFER(2),C#WK1+6 MVI D#REFFER+2,C'/' L R01,DS1REFD SRL R01,8 N R01,=X'0000FFFF' LTR R01,R01 BZ @DREFS1 CVD R01,P#WK1 UNPK C#WK1(8),P#WK1 OI C#WK1+7,X'F0' MVC D#REFFER+3(3),C#WK1+5 B @DREFX @DREFS1 EQU * MVC D#REFFER(6),=C'*none*' @DREFX EQU * * --- <<< expire >>> ---------------------------------------------- L R01,DS1EXPDT SRL R01,24 CVD R01,P#WK1 UNPK C#WK1(8),P#WK1 OI C#WK1+7,X'F0' MVC D#EXPIRE(2),C#WK1+6 MVI D#EXPIRE+2,C'/' L R01,DS1EXPDT SRL R01,8 N R01,=X'0000FFFF' LTR R01,R01 BZ @DEXPS1 CVD R01,P#WK1 UNPK C#WK1(8),P#WK1 OI C#WK1+7,X'F0' MVC D#EXPIRE+3(3),C#WK1+5 B @DEXPX @DEXPS1 EQU * MVC D#EXPIRE(6),=C'*none*' @DEXPX EQU * @D_EXIT EQU * LM R00,R15,SAVEINFO load reg. BR R14 @D_UCBER EQU * MVC D#UNITS(8),=CL8'*none*' @D_LOCER EQU * * ST R15,B#WK1 * CALL @OS#6HC,(B#WK1+3,WK#VOLS+3,1) * MVC D#VOL(6),WK#VOLS CLI L#VOL,C'M' MIGRAT BE @D_LOCE1 CLI L#VOL,C'A' ARCHIVE BNE @D_LOCE2 @D_LOCE1 EQU * MVC D#VOL(6),L#VOL B @D_LOCEX @D_LOCE2 EQU * MVC D#VOL(6),=CL6'??????' B @D_LOCEX @D_LOCEX EQU * @D_DS1ER EQU * MVC D#DSORG(3),=CL3'???' MVC D#RECFM(3),=CL3'???' MVC D#LRECL(5),=CL5'?????' MVC D#BLKSZ(5),=CL5'?????' MVC D#PRIM(5),=CL5'?????' MVC D#SEC(5),=CL5'?????' MVC D#UNIT(3),=CL3'???' MVC D#EXT(2),=CL2'??' MVC D#CREATE(6),=CL6'??/???' MVC D#REFFER(6),=CL6'??/???' MVC D#EXPIRE(6),=CL6'??/???' @D_DS4ER EQU * @D_DS3ER EQU * MVC D#ALLOC(5),=CL5'?????' MVC D#USED(5),=CL5'?????' B @D_EXIT * --- Sub Routine ( error routine ) ------------------------------- * --- 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,79 BAL R14,@PUTL#S B @TERM * --- Super Locate SVC 26 Error ----------------------------------- @S_SVERR EQU * ST R15,B#WK1 CALL @OS#6HC,(B#WK1,MSG#E002+34,4) LA R01,MSG#E002 LA R02,79 BAL R14,@PUTL#S * L R01,@LOSWA# LH R00,0(,R01) N R00,=X'0000FFFF' FREEMAIN R,LV=(R00),A=(R01) 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 * --- UCB --------------------------------------------------------- U#COPY DS XL48 U#WORK DS XL100 * --- locate ------------------------------------------------------ L#CAMLST CAMLST NAME,V#DSN,,L#AREA * --- obtain ( get dscb(1) ) -------------------------------------- DSCBFMT1 CAMLST SEARCH,V#DSN,L#VOL,V#DSCB * --- obtain ( get dscb(3) ) -------------------------------------- DSCBFMT3 CAMLST SEEK,V#CCHHR,L#VOL,V#DSCB3 * --- obtain ( get dscb(4) ) -------------------------------------- DSCBFMT4 CAMLST SEARCH,V#DSN4,L#VOL,V#DSCB4 * --- VTOC -------------------------------------------------------- DS 0D V#JFCB DS 0CL176 V#DSN DS CL44 V#DSCB DS CL140 V#JFCB3 DS 0CL176 V#DSN3 DS CL44 V#DSCB3 DS CL140 V#JFCB4 DS 0CL176 V#DSN4 DS CL44 V#DSCB4 DS CL140 V#CCHHR DS CL5 * --- LOCATE area ------------------------------------------------- L#AREA DS 0D DS XL3 L#TTR DS FL3 L#VOL DS CL6 DS 256C * --- dataset name ------------------------------------------------ @DSN DS CL44 @DSNL DS F @CAT DS CL44 @CATL DS F * --- IKJPARS ( tso parse service routine ) ----------------------- PCLADCON DC A(PCLDEFS) PCLAREA DS 0F PRINT GEN PCLDEFS IKJPARM DSECT=PRDSECT PCLDSN IKJIDENT ANY,PROMPT='DATA SET NAME', * FIRST=ALPHA,OTHER=ANY,MAXLNTH=44, * HELP=('ENTER DATASET SUFFIX') PCLCAT IKJKEYWD IKJNAME 'CAT',SUBFLD=UCATNAME UCATNAME IKJSUBF UCATN IKJPOSIT DSNAME,USID,PROMPT='USER CATALOG NAME', * HELP=('ENTER USER CATALOG NAME') PRINT NOGEN IKJENDP * --- 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 * --- LOCATE ( catalog search parameter list ) -------------------- PRINT GEN @LOC@@@@ CAMLST CAT,V#DSN,,L#AREA PRINT NOGEN * @LOCSSTA EQU * @LOCATES DS CL34 ORG @LOCATES @LOSOPT1 DS XL1'05' option 1 @LOSOPT2 DS XL1'00' option 2 @LOSOPT3 DS XL1'11' option 3 @LOSOPT4 DS XL1'00' option 4 @LOSENT# DS AL4(@LOSROOT) entry address @LOSCAT# DS AL4 catalog address @LOSWA# DS AL4 work area @LOSDSOR DS CL2 dataset organization @LOSOPTS DS CL1 @NM00001 DS CL1 @LOSTYPE DS CL1 @LOSNOFL DS CL1 @LOSDDNM DS CL4 @LOSJSCB DS CL4 @LOSFIEL DS CL4 ORG @LOCATES+34 @LOSROOT DS CL45 ORG @LOSROOT @LOSROTL DS FL1'12' dataset prefix length @LOSROTN DS CL44'DSMI.FSUPP17' dataset prefix @LOSCAT DS CL44 ORG @LOSCAT @LOSCATL DC FL1'6' dataset prefix length @LOSCATN DC CL44'TSOCAT' dataset prefix ORG @LOSCAT+45 @LOSEND EQU * @LLOC EQU *-@LOCSSTA * --- 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 WK#VOLS DC CL6'??@@??' device type work area * --- dataset organization ---------------------------------------- D#ORG DS 0XL6 DC XL2'8000',CL3'IS ',XL1'00' INDEXED SEQ DC XL2'4000',CL3'PS ',XL1'00' PHYSICAL SEQ DC XL2'2000',CL3'DA ',XL1'00' DIRECT ORG DC XL2'1000',CL3'CX ',XL1'00' BTAM OR QTAM LINE GROUP DC XL2'0800',CL3'CQ ',XL1'00' QTAM DIRECT ACCESS MES DC XL2'0400',CL3'MQ ',XL1'00' QTAM PROBLEM PROG MSG QUEUE DC XL2'0200',CL3'PO ',XL1'00' PARTITIONED ORGANIZATION DC XL2'0100',CL3'U ',XL1'00' UNMOVABLE LOCATION DC XL2'0080',CL3'GS ',XL1'00' GRAPHICS ORGANIZATION DC XL2'0040',CL3'TX ',XL1'00' TCAM LINE GROUP DC XL2'0020',CL3'TQ ',XL1'00' TCAM MESSAGE QUEUE DC XL2'0010',CL3'???',XL1'00' RESERVED DC XL2'0008',CL3'AM ',XL1'01' ACCESS METHOD CONTROL BLOCK DC XL2'0004',CL3'TR ',XL1'00' TCAM 3705 DC XL2'0002',CL3'???',XL1'00' RESERVED DC XL2'0001',CL3'???',XL1'00' RESERVED D#ORGT EQU * D#ORGL EQU *-D#ORG * --- record format ----------------------------------------------- D#RFM DS 0XL5 DC BL1'10000000',CL3'F ',XL1'00' fixed DC BL1'01000000',CL3'V ',XL1'00' variable DC BL1'11000000',CL3'U ',XL1'00' undefined DC BL1'10010000',CL3'FB ',XL1'00' fixed block DC BL1'01010000',CL3'VB ',XL1'00' variable block DC BL1'10001000',CL3'FS ',XL1'00' fixed span DC BL1'01001000',CL3'VS ',XL1'00' variable span DC BL1'10011000',CL3'FBS',XL1'00' fixed block span DC BL1'01011000',CL3'VBS',XL1'00' variable block span DC BL1'10000100',CL3'FA ',XL1'00' fixed ansi DC BL1'01000100',CL3'VA ',XL1'00' variable ansi DC BL1'10010100',CL3'FBA',XL1'00' fixed block ansi DC BL1'01010100',CL3'VBA',XL1'00' variable block ansi DC BL1'10000010',CL3'FM ',XL1'00' fixed machine DC BL1'01000010',CL3'VM ',XL1'00' variable machine DC BL1'10010010',CL3'FBM',XL1'00' fixed block machine DC BL1'01010010',CL3'VBM',XL1'00' variable block machine D#RFMT EQU * D#RFML EQU *-D#RFM * --- trk/cyl ----------------------------------------------------- D#PAC DS 0XL5 DC XL1'C0',CL3'CYL',XL1'00' track DC XL1'80',CL3'TRK',XL1'00' cylinder DC XL1'50',CL3'BLK',XL1'00' block DC XL1'40',CL3'BLK',XL1'00' block DC XL1'41',CL3'BLK',XL1'00' block DC XL1'20',CL3'MSG',XL1'00' DC XL1'08',CL3'CNT',XL1'00' DC XL1'04',CL3'MXG',XL1'00' DC XL1'02',CL3'ALX',XL1'00' DC XL1'01',CL3'ALX',XL1'00' DC XL1'00',CL3'ABS',XL1'00' abs D#PACT EQU * D#PACL EQU *-D#PAC * --- 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 ----------------------------------------------------- * --- Header 1 ---------------------------------------------------- *SG#H001 DC CL79'# Dataset name' * --- Partition --------------------------------------------------- MSG#P001 DC CL79'#--------------------------------------------------* --------------------------' * --- Error messgae ----------------------------------------------- MSG#E001 DC CL79'> Getmain Error Happend . ( Reg.15:@@@@@@@@ )' MSG#E002 DC CL79'> SVC 26 Error Happend . ( Reg.15:@@@@@@@@ )' * --- message ----------------------------------------------------- MSG#O001 DC CL79'> ' * --- test message ------------------------------------------------ MSG#T001 DC CL80'DSNAME:' LTORG * --- DSLIST output dsect ----------------------------------------- DSLIST1 DSECT MSG#O901 DS 0CL79 DC CL2'>' D#TYPE DS CL1 DC CL1' ' D#DSN DS CL44 DC CL1' ' D#VOL DS CL6 DC CL1' ' D#UNITS DS CL8 DSLIST2 DSECT MSG#O902 DS 0CL79 DC CL2'>' D#DSORG DS CL3 DC CL1' ' D#RECFM DS CL3 DC CL1' ' D#LRECL DS CL5 DC CL1' ' D#BLKSZ DS CL5 DC CL1' ' D#ALLOC DS CL5 DC CL1' ' D#USED DS CL5 DC CL1' ' D#PRIM DS CL5 DC CL1' ' D#SEC DS CL5 DC CL1' ' D#UNIT DS CL3 DC CL1' ' D#EXT DS CL2 DC CL1' ' D#CREATE DS CL6 DC CL1' ' D#REFFER DS CL6 DC CL1' ' D#EXPIRE DS CL6 * --- 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 * --- CVT ( communication vector table ) -------------------------- CVT DSECT=YES,LIST=YES * --- 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) * --- UCB --------------------------------------------------------- PRINT GEN IEFUCBOB LIST=YES 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 @LOC /* //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(@LOC#40C) <- CHECK //L EXEC PGM=IEWL,PARM='MAP,LET,LIST', // REGION=1M,COND=(8,LT,A) //STEPCAT DD DSN=TSOCAT,DISP=SHR //SYSLIN DD DDNAME=SYSIN //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 //SYSLIB DD DISP=SHR,UNIT=SYSDA, // DSN=SYS1.LPALIB //SYSLMOD DD DISP=SHR,UNIT=SYSDA, // DSN=module.library //SYSIN DD * INCLUDE OBJ(@LOC#40C) INCLUDE OBJ(@OS#6HC) ENTRY @LOC NAME @LOC(R) //