********************************************************************** CLE00010 ** NOTICE TO USERS OF SOURCE CODE EXAMPLES ** CLE00020 ** ** CLE00030 ** THE SOURCE CODE EXAMPLES PROVIDED BY IBM ARE ONLY INTENDED TO ** CLE00040 ** ASSIST IN THE DEVELOPMENT OF A WORKING SOFTWARE PROGRAM. THE ** CLE00050 ** SOURCE CODE EXAMPLES MAY NOT FUNCTION AS WRITTEN; ADDITIONAL ** CLE00060 ** CODE MAY BE REQUIRED. IN ADDITION, THE SOURCE CODE EXAMPLES ** CLE00070 ** MAY NOT ASSEMBLE SUCCESSFULLY AS WRITTEN. ** CLE00080 ** CLE00090 ** INTERNATIONAL BUSINESS MACHINES CORPORATION PROVIDES THE SOURCE ** CLE00100 ** CODE EXAMPLES, BOTH INDIVIDUALLY AND AS ONE OR MORE GROUPS, ** CLE00110 ** "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR ** CLE00120 ** IMPLIED, INCLUDING, BUT NOT LIMITED TO THE IMPLIED WARRANTIES ** CLE00130 ** OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. ** CLE00140 ** THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOURCE ** CLE00150 ** CODE EXAMPLES, BOTH INDIVIDUALLY AND AS ONE OR MORE GROUPS, IS ** CLE00160 ** WITH YOU. SHOULD ANY PART OF THE SOURCE CODE EXAMPLES PROVE ** CLE00170 ** DEFECTIVE, YOU (AND NOT IBM) ASSUME THE ENTIRE COST OF ALL ** CLE00180 ** NECESSARY SERVICING, REPAIR OR CORRECTION. ** CLE00190 ** ** CLE00200 ** IBM does not warrant that the contents of the source code ** CLE00210 ** examples, whether individually or as one or more groups, will ** CLE00220 ** will meet your requirements or that the source code examples ** CLE00230 ** are error-free. ** CLE00240 ** ** CLE00250 ** IBM may make improvements and/or changes in the source code ** CLE00260 ** examples at any time. ** CLE00270 ** CLE00280 ** References in the source code examples to IBM products, ** CLE00290 ** programs, or services do not imply that IBM intends to make ** CLE00300 ** these available in all countries in which IBM operates. Any ** CLE00310 ** reference to an IBM licensed program in the source code ** CLE00320 ** examples is not intended to state or imply that only IBM's ** CLE00330 ** licensed program may be used. Any functionally equivalent ** CLE00340 ** program may be used. ** CLE00350 ********************************************************************** CLE00360 ** ** CLE00370 ** This is a sample program for requesting the mount of a cleaning ** CLE00380 ** cartridge on a silo-resident IBM Magstar 3590 Tape Drive. ** CLE00390 ** Please refer to "IBM Magstar 3590 Model C12 Silo Compatible ** CLE00400 ** Frame Introduction, Planning, and User's Guide," GA32-0366 ** CLE00410 ** for details and requirements for cleaning 3590 drives. ** CLE00420 ** ** CLE00430 ** This program takes the drive address as input from the EXEC ** CLE00440 ** card in the cleaning job. In the sample JCL shown below, each ** CLE00450 ** drive is allocated for its cleaning step. ** CLE00460 ** ** CLE00470 ** The program requests volume data on cartridges in a range that ** CLE00480 ** is based on a cleaning cartridge prefix defined as a constant ** CLE00490 ** (CLNPRFX) in the program and the low and high sequence numbers ** CLE00500 ** for the range (LOCART and HICART), also defined constants. The ** CLE00510 ** cleaning prefix "MGC" is specified in this program, and it ** CLE00520 ** matches that of the cleaning cartridge labels shipped with the ** CLE00530 ** C12 unit. These defined constants can be customized to meet ** CLE00540 ** local need. However, the cleaning prefix should not be the same ** CLE00550 ** as the HSC cleaning prefix when non-Magstar silo drives in the ** CLE00560 ** same ACS are being autocleaned. ** CLE00570 ** ** CLE00580 ** If the program encounters a volume that has reached the max ** CLE00590 ** recommended number of uses for a Magstar cleaning cartridge, ** CLE00600 ** an eject is requested for this volume, and the program looks ** CLE00610 ** for a another volume in the range. The suitable cartridge is ** CLE00620 ** mounted on the drive, and when control returns to this program, ** CLE00630 ** cleaning is complete and a dismount is requested to ensure the ** CLE00640 ** cartridge is available for use on the next job step. ** CLE00650 ** ** CLE00660 ** Job Control Statements to run this CLEANRRV program: ** CLE00670 ** ==================================================== ** CLE00680 ** ** CLE00690 ** //CLEANDRV JOB CLASS=A,MSGCLASS=H,MSGLEVEL=(1,1),REGION=4096K, ** CLE00700 ** // PRTY=15,PERFORM=5 ** CLE00710 ** /*JOBPARM LINES=9999 ** CLE00720 ** //CLNIT0 EXEC PGM=CLEANDRV,PARM='0E50' ** CLE00730 ** //DUMDD DD DSN=DUMDSN,DISP=(NEW,DELETE),(UNIT=E50,,DEFER) ** CLE00740 ** //STEPLIB DD DSN=COMMON.LINKLIB,DISP=SHR ** CLE00750 ** // DD DSN=SLS.SLSLINK,DISP=SHR ** CLE00760 ** //CLNIT1 EXEC PGM=CLEANDRV,PARM='0E51' ** CLE00770 ** //DUMDD DD DSN=DUMDSN,DISP=(NEW,DELETE),(UNIT=E51,,DEFER) ** CLE00780 ** //STEPLIB DD DSN=COMMON.LINKLIB,DISP=SHR ** CLE00790 ** // DD DSN=SLS.SLSLINK,DISP=SHR ** CLE00800 ** //CLNIT2 EXEC PGM=CLEANDRV,PARM='0E52' ** CLE00810 ** //DUMDD DD DSN=DUMDSN,DISP=(NEW,DELETE),(UNIT=E52,,DEFER) ** CLE00820 ** //STEPLIB DD DSN=COMMON.LINKLIB,DISP=SHR ** CLE00830 ** // DD DSN=SLS.SLSLINK,DISP=SHR ** CLE00840 ** //CLNIT3 EXEC PGM=CLEANDRV,PARM='0E53' ** CLE00850 ** //DUMDD DD DSN=DUMDSN,DISP=(NEW,DELETE),(UNIT=E53,,DEFER) ** CLE00860 ** //STEPLIB DD DSN=COMMON.LINKLIB,DISP=SHR ** CLE00870 ** // DD DSN=SLS.SLSLINK,DISP=SHR ** CLE00880 ** /* ** CLE00890 ** ** CLE00900 ** ** CLE00980 ** Input Parameter List Structure from EXEC Card ** CLE00990 ** ============================================= ** CLE01000 ** INPSIZE DS XL2 Count of input characters ** CLE01010 ** INPDRIV DS CL4 Drive to be cleaned ** CLE01020 ** ** CLE01030 ** Contents of R15 on exit from this Program ** CLE01040 ** ========================================= ** CLE01050 ** ** CLE01060 ** Invalid input -- 104 ** CLE01070 ** Cleaner vol not availble -- 108 ** CLE01080 ** HSC not active -- R15 after SLSXREQ call ** CLE01090 ** Mount of cleaner failed -- value of SLXCMDRC ** CLE01100 ** ** CLE01110 ********************************************************************** CLE01120 TITLE 'MOUNT CLEANING CARTIDGE' CLE01130 ENTRY CLEANDRV CLE01140 CLEANDRV CSECT CLE01150 STM R14,R12,12(R13) Save caller's regs CLE01160 LR R10,R15 Our base is R10 CLE01170 USING CLEANDRV,R10 Addressability CLE01180 B START Skip eyecatcher CLE01190 DC CL8'CLEANDRV' CLE01200 DC CL8'&SYSDATE' CLE01210 START DS 0H CLE01220 L R8,0(,R1) R8 -> plist from EXEC card CLE01230 USING MYLIST,R8 Plist addressability CLE01240 LR R3,R13 Save R13 as received CLE01250 LA R13,SAVEAREA R13 -> our save area CLE01260 ST R3,4(,R13) Backward pointer CLE01270 ST R13,8(,R3) Forward pointer CLE01280 * CLE01290 BAL R9,CNVTCCUU Call subr to convert char drive CLE01300 * address to hex CLE01310 LTR R15,R15 Did we convert without problems.. CLE01320 BZ CNVRTOK Yes, now find a cleaner cart CLE01330 LR R2,R15 Save RC from our subr in R2 CLE01340 B INPEXIT Exit if problem CLE01350 CNVRTOK LOAD EP=SLSXCAL Load the module that talks to HSC CLE01360 ST R0,MYCALADR Save address for macro call CLE01370 * CLE01380 * Input is converted, prgram is loaded, now we find a good cleaner CLE01390 * CLE01400 MVC THISCLN(3),CLNPRFX Setup the 3-char cleaner prefix CLE01410 MVC THISCLN+3(3),LOCART Add 3-char lo cleaner seq number CLE01420 QUERVOL SLSXREQ QVOLUME, XCLE01430 OPTION=SYNCH, XCLE01440 XCALADR=MYCALADR, XCLE01450 VOLSER=THISCLN, XCLE01460 MF=(E,WSLSXREQ) CLE01470 LTR R15,R15 Ensure HSC was up CLE01480 BZ CHKRESQ If OK, go check result CLE01490 B NOHSCERR Else process no-hsc error exit CLE01500 CHKRESQ DS 0H Look at query result CLE01510 LR R4,R1 Start of reply CLE01520 USING SLX,R4 Plist addressability CLE01530 SR R2,R2 Clear CLE01540 IC R2,SLXCMDRC Save RC in R2 CLE01550 CLI SLXCMDRC,SLXROK Look for Good Return code CLE01560 BH CHKNXTV If greater than 0, try another CLE01570 L R3,SLXXVOLN Number of vol elements CLE01580 LTR R3,R3 Ensure there is data there CLE01590 BZ CHKNXTV Forget it if there is no data CLE01600 L R3,SLXXVOLO This is offset to vol info CLE01610 LA R3,0(R4,R3) This is pointer to vol info CLE01620 USING SLXSVOL,R3 And a base for addressability CLE01630 L R5,SLXVSCNT Check the count CLE01680 C R5,MAXPLUS For greater than max uses + 1 CLE01690 BL MOUNTIT Great, we have found one CLE01700 * CLE01710 * Eject the cleaner if max usage reached CLE01720 * CLE01730 SLSXREQ EJECT, XCLE01740 OPTION=SYNCH, XCLE01750 XCALADR=MYCALADR, XCLE01760 VOLSER=THISCLN, XCLE01770 MF=(E,WSLSXREQ) CLE01780 LR R4,R1 Start of reply CLE01790 SR R2,R2 Clear CLE01800 IC R2,SLXCMDRC Save RC in R2 CLE01810 CLI SLXCMDRC,SLXROK Look for Good Return code CLE01820 BE EJECTMSG CLE01830 LR R0,R2 Copy of 1-byte RC CLE01840 STC R0,ERC+1 Convert first part CLE01850 OI ERC+1,X'F0' CLE01860 SRL R0,4 CLE01870 STC R0,ERC CLE01880 OI ERC,X'F0' CLE01890 MVC EJVF(6),THISCLN Fill in message variable CLE01900 WTO MF=(E,WTOEJCTM) CLE01910 AL3 DS 0H CLE01920 B CHKNXTV CLE01930 EJECTMSG DS 0H CLE01940 MVC EJVOL(6),THISCLN Fill in message variable CLE01950 WTO MF=(E,WTOEJECT) Tell operator about this CLE01960 CHKNXTV DS 0H CLE01970 DROP R4 CLE01980 DROP R3 CLE01990 CLC THISCLN+3(3),HICART Are we out of volsers CLE02000 BE NOCLNERR Error exit if no cleaners CLE02010 BAL R9,SETNEXTV Go find next volser to try CLE02020 B QUERVOL Run thru query loop again CLE02030 * CLE02040 * Issue mount of the cleaner cartridge CLE02050 * CLE02060 MOUNTIT DS 0H CLE02070 SLSXREQ MOUNT, XCLE02080 OPTION=SYNCH, XCLE02090 XCALADR=MYCALADR, XCLE02100 DRIVE=THISDRV, XCLE02110 VOLSER=THISCLN, XCLE02120 MF=(E,WSLSXREQ) CLE02130 LTR R15,R15 Ensure HSC was up CLE02140 BZ CHKRESM If OK, go check mount result CLE02150 * CLE02160 NOHSCERR LR R2,R15 Save return code in R2 CLE02170 WTO 'HSC NOT AVAILABLE - DRIVE NOT CLEANED' CLE02180 AB1 DS 0H CLE02190 B ALLDONE Leave CLE02200 * CLE02210 NOCLNERR LA R2,NOCLEANR Set RC CLE02220 WTO 'NO USABLE CLEANER VOL FOUND - DRIVE NOT CLEANED' CLE02230 AB2 DS 0H CLE02240 B ALLDONE Exit this program CLE02250 * CLE02260 CHKRESM DS 0H Look at mount result CLE02270 LR R4,R1 Start of reply CLE02280 USING SLX,R4 Plist addressability CLE02290 SR R2,R2 Clear CLE02300 IC R2,SLXCMDRC Save RC in R2 CLE02310 CLI SLXCMDRC,SLXROK Look for Good Return code CLE02320 BNE HANDLERR CLE02330 * CLE02340 * Issue dismount of the cleaner cartridge CLE02350 * CLE02360 SLSXREQ DISMOUNT, XCLE02370 OPTION=SYNCH, XCLE02380 XCALADR=MYCALADR, XCLE02390 DRIVE=THISDRV, XCLE02400 VOLSER=THISCLN, XCLE02410 MF=(E,WSLSXREQ) CLE02420 B ALLDONE CLE02430 * CLE02440 * Make bad RC readable for operator message CLE02450 * CLE02460 HANDLERR DS 0H CLE02470 LR R0,R2 Copy of 1-byte RC CLE02480 STC R0,FRC+1 Convert first part CLE02490 OI FRC+1,X'F0' CLE02500 SRL R0,4 CLE02510 STC R0,FRC CLE02520 OI FRC,X'F0' CLE02530 WTO MF=(E,WTOFAILM) CLE02540 ALLDONE DS 0H CLE02550 DELETE EP=SLSXCAL CLE02560 INPEXIT LR R15,R2 Return code CLE02570 L R13,4(,R13) Restore R13 CLE02580 L R14,12(,R13) Restore R14 CLE02590 LM R0,R12,20(R13) Restore R0-R12 CLE02600 BR R14 Return to caller CLE02610 * CLE02620 * Subroutine to convert character drive address of input to hex CLE02630 * CLE02640 CNVTCCUU DS 0H CLE02650 LH R3,INPSIZE Look at length of input CLE02660 CH R3,=H'4' Check for no more than 4 chars CLE02670 BH BADINPUT Error exit if 5 or more CLE02680 CH R3,=H'3' Check for fewer than 3 CLE02690 BL BADINPUT Error exit is not at least 3 CLE02700 MVI WRKCCUU,X'00' In case 3 char input, init 1st byte CLE02710 * CLE02720 * Now, do the conversion from char to hex CLE02730 * CLE02740 LA R4,INPDRIV+3 The address of input CCUU CLE02750 LA R2,WRKCCUU+3 Point to conversion work area CLE02760 CNVTONE SR R6,R6 Reg 6 = 0 CLE02770 IC R6,0(R4) Pick up an input character CLE02780 SRDL R6,4 Isolate the nibbles CLE02790 SRL R7,28 into the rightmost byte CLE02800 STC R6,HINIB Save the hi-order nibble (4 bits) CLE02810 STC R7,LONIB Save the lo-order nibble (4 bits) CLE02820 CLI HINIB,X'0C' Hi-order nibble can be x'0C' CLE02830 BL BADINPUT Invalid character CLE02840 BE HEXCHAR Go handle C1-C6 CLE02850 CLI HINIB,X'0F' Hi order nibble can be x'0F' CLE02860 BNE BADINPUT Otherwise bad input CLE02870 CLI LONIB,X'09' When hi-order nibble is x'F' CLE02880 BH BADINPUT then lo-order must be x'0'-x'9' CLE02890 B CHAROK CLE02900 HEXCHAR CLI LONIB,X'00' When hi-order nibble is x'C' then CLE02910 BE BADINPUT lo-order nibble must be x'1' min CLE02920 CLI LONIB,X'06' or x'6' max CLE02930 BH BADINPUT Invalid character CLE02940 LA R7,9(R7) Add 9 to lo nibble to get hex value CLE02950 CHAROK STC R7,0(R2) Save hex value CLE02960 BCTR R2,0 Next output workarea byte CLE02970 BCTR R4,0 Next input byte CLE02980 BCT R3,CNVTONE Do for each input character CLE02990 ICM R6,15,WRKCCUU Get the 4 converted bytes in a reg CLE03000 LA R5,4 Get ready to loop 4 times CLE03010 CLNLOOP SRDL R6,4 Shift 4 bits into R7 CLE03020 SRL R6,4 Drop unwanted bits CLE03030 BCT R5,CLNLOOP Do once for each char CLE03040 STCM R7,B'1100',THISDRV Now we have the drive address in hex CLE03050 SR R15,R15 Tell main routine we did good CLE03060 BR R9 Return CLE03070 BADINPUT DS 0H CLE03080 WTO 'INVALID INPUT DRIVE ADDRESS WAS SPECIFIED' CLE03090 DS 0H CLE03100 LA R15,INPUTERR Tell main routine of failure CLE03110 BR R9 Return CLE03120 * CLE03130 * This is the subroutine to set up the next volser in our range CLE03140 * CLE03150 SETNEXTV DS 0H CLE03160 CLI THISCLN+5,X'F9' If 1's digit a 9 CLE03170 BE INCRTENS Done with 1's, change 10's CLE03180 IC R6,THISCLN+5 Get the byte in a register CLE03190 LA R6,1(R6) Add one CLE03200 STC R6,THISCLN+5 Update the volser CLE03210 BR R9 We are done CLE03220 INCRTENS MVI THISCLN+5,X'F0' Set 1's place to zero CLE03230 CLI THISCLN+4,X'F9' If 10s digit a 9 CLE03240 BE INCR100S Move to 100s and increment there CLE03250 IC R6,THISCLN+4 Get the byte in a register CLE03260 LA R6,1(R6) Add one CLE03270 STC R6,THISCLN+4 Update the volser CLE03280 BR R9 We are done CLE03290 INCR100S MVI THISCLN+4,X'F0' Set 1's place to zero CLE03300 IC R6,THISCLN+3 Get the byte in a register CLE03310 LA R6,1(R6) Add one CLE03320 STC R6,THISCLN+3 Update the volser CLE03330 BR R9 We are done CLE03340 * CLE03350 LTORG CLE03360 SAVEAREA DS 9D Save area CLE03370 MYCALADR DS F Addr of loaded SLSCAL program CLE03380 WRKCCUU DS CL4 Work area for ccuu conversion CLE03390 HINIB DS X Work area for ccuu conversion CLE03400 LONIB DS X Work area for ccuu conversion CLE03410 THISDRV DS XL2 Hardcoded drive address CLE03420 THISCLN DS CL6 CLE03430 CLNPRFX DC CL3'MGC' Our cleaner prefix is MGC CLE03440 LOCART DC CL3'000' Low cleaner cart sequence num CLE03450 HICART DC CL3'020' High cleaner cart sequence num CLE03460 MAXPLUS DC F'101' Maximum recommended number of CLE03470 * cleaning cart usages PLUS 1 CLE03480 * CLE03490 WTOFAILM WTO 'CLEANER MOUNT FAILED WITH SLXCMDRC = XX',MF=L CLE03500 FRC EQU WTOFAILM+41 CLE03510 * CLE03520 WTOEJECT WTO 'MAX USAGE REACHED, CLEANER XXXXXX EJECTED',MF=L CLE03530 EJVOL EQU WTOEJECT+31 CLE03540 * CLE03550 WTOEJCTM WTO 'MAX USAGE REACHED, CLEANER XXXXXX NOT EJECTED, RCxx', XCLE03560 MF=L CLE03570 EJVF EQU WTOEJCTM+31 CLE03580 ERC EQU WTOEJCTM+53 CLE03590 * CLE03600 WSLSXREQ SLSXREQ MF=L List form of macro CLE03610 * CLE03620 MYLIST DSECT , CLE03630 INPSIZE DS XL2 Plist length CLE03640 INPDRIV DS CL4 3 or 4 char addr of drive CLE03650 ENDLIST EQU *-MYLIST CLE03660 * CLE03670 INPUTERR EQU 104 CLE03680 NOCLEANR EQU 108 CLE03690 * CLE03700 R0 EQU 0 CLE03710 R1 EQU 1 CLE03720 R2 EQU 2 CLE03730 R3 EQU 3 CLE03740 R4 EQU 4 CLE03750 R5 EQU 5 CLE03760 R6 EQU 6 CLE03770 R7 EQU 7 CLE03780 R8 EQU 8 CLE03790 R9 EQU 9 CLE03800 R10 EQU 10 CLE03810 R11 EQU 11 CLE03820 R12 EQU 12 CLE03830 R13 EQU 13 CLE03840 R14 EQU 14 CLE03850 R15 EQU 15 CLE03860 * CLE03870 SLSXREQM , CLE03880 END CLEANDRV CLE03890