//MARKSAVE JOB (0),'SAVE TAPEMAN V3',CLASS=A,MSGCLASS=T //* ************************************************************** //* //* INSTALLATION JOB FOR TAPEMAN3 //* //* //* R E A D T H E I N S T R U C T I O N S H E R E //* //* B E F O R E R U N N I N G T H I S J O B //* //* //* THE FOLLOWING CHANGES ARE REQUIRED TO GET THIS JCL TO RUN //* ON YOUR SYSTEM. THE JOB OBLY CREATES THE INSTALLATION //* LIBRARIES AND ASSEMBLES THE MODULES FROM SOURCE INTO AN //* INSTALL LINKLIB. IT DOES NOT TOUCH YOU SYSTEM DATASETS. //* //* THE MAIN REASON FOR THAT IS THAT YOU WILL HAVE TO CUSTOMISE //* THE DATASET PREFIXES USED IN THE JOBS THAT CREATE/USE THE //* VSAM DATABASE FILE AND ALSO THE JOBS THAT WILL COPY FROM //* THE INSTALL DATASETS TO YOUR SYSTEM LIBRARIES. //* //* REFER TO THE XXXX.TAPEMAN3.INSTALL DATASET THAT //* IS CREATED AS PART OF THIS JOB ON HOW TO MIGRATE FROM //* THE INSTALL LIBRARIES INTO AN ACTIVE ENVIRONMENT. //* //* Y O U M U S T C U S T O M I S E A S B E L O W //* //* //* ----- ALL USERS Globally change ----- //* //* (1) //* UNIT=3350,VOL=SER=SRCMD1 to a 3350 pack you can use //* it does need to be a 3350 or larger as some of the programs //* need to be copied to your system libraries after they are //* assembled and you cannot copy from a 2314 to a 3350 load //* library. //* //* (2) //* INSTALL.TAPEMAN3 to XXXX.TAPEMAN3 //* where XXXX is a prefix you use for 3rd party software. //* Datasets with this prefix are where everything will be //* installed and programs assembled into. //* //* --- after that is done you can run this job --- //* //* After this job is run all the install libraries will have //* been created and loaded, plus all the programs assembled //* into the install load library ready for you to copy to //* your system load libraries. //* IMPORTANT: If you are using RAKF and denied access to all //* for the default PROD batch group (as you should) //* all the assemblies kicked off will fail with //* security denies. Edit the .SRC dataset to add a //* user=/password= fields in each member and //* manulally submit to populate the install linklib //* //* ************************************************************** //* //CREATDDS EXEC PGM=IEFBR14 //DD2 DD DSN=INSTALL.TAPEMAN3.CONTROL, // DISP=(NEW,CATLG,DELETE), // UNIT=3350,VOL=SER=SRCMD1, // DCB=(LRECL=80,DSORG=PO,BLKSIZE=3120,RECFM=FB), // SPACE=(TRK,(1,1,5)) //DD3 DD DSN=INSTALL.TAPEMAN3.DOC, // DISP=(NEW,CATLG,DELETE), // UNIT=3350,VOL=SER=SRCMD1, // DCB=(LRECL=80,DSORG=PO,BLKSIZE=3120,RECFM=FB), // SPACE=(TRK,(6,1,5)) //DD4 DD DSN=INSTALL.TAPEMAN3.INSTALL, // DISP=(NEW,CATLG,DELETE), // UNIT=3350,VOL=SER=SRCMD1, // DCB=(LRECL=80,DSORG=PO,BLKSIZE=3120,RECFM=FB), // SPACE=(TRK,(2,1,5)) //DD5 DD DSN=INSTALL.TAPEMAN3.SRC, // DISP=(NEW,CATLG,DELETE), // UNIT=3350,VOL=SER=SRCMD1, // DCB=(LRECL=80,DSORG=PO,BLKSIZE=3120,RECFM=FB), // SPACE=(TRK,(50,5,5)) //DD6 DD DSN=INSTALL.TAPEMAN3.LINKLIB, // DISP=(NEW,CATLG,DELETE), // UNIT=3350,VOL=SER=SRCMD1, // DCB=SYS1.LINKLIB, // SPACE=(TRK,(30,1,5)) //ASMLIB EXEC PGM=IEBUPDTE,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC //SYSUT2 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC //SYSIN DD DATA,DLM=QQ ./ ADD NAME=MMPFCYCL *********************************************************************** * BSPPILOT SCRIPT : MUST BE PLACED IN SYS1.PARMLIB FOR TK3 AND TK4- * * * * USED TO RECYCLE (STOP/WAIT/START) MMPF * * TRIGGERED BY MY CUSTOMISED IEECVXIT WHEN THERE IS A DATASET ENQUEUE * * ON THE VSAM DATABASE USED BY MMPF. MY IEECVXIT WILL ISSUE A * * "F BSPPILOT,SCRIPT=MMPFCYCL" * *********************************************************************** PARM NOECHO PARM NOREPLYU IF MMPF COM P MMPF ENDIF WAIT 5 IF MMPF MSG MMPF COULD NOT BE STOPPED ELSE WAIT 10 COM S MMPF ENDIF ./ ADD NAME=DBREC MACRO &NAME DBREC .* ------------------------------------------------------------------ .* This is the VSAM database record definition I use in all the .* programs. Keeping it as a seperate macro just makes database .* changes easier. .* ------------------------------------------------------------------ DS 0F RECTMPL DC CL6' ' VOLSER (6) DC CL1' ' (7) DC CL8'--------' JOBNAME (15) DC CL1' ' (16) DC CL5'00000' EXP-DATE YYDDD (21) DC CL1' ' (22) DC CL44' ' DESC-BKPFILENAM(66) DC CL66' ' RESERVED (132) DBSLEN EQU *-RECTMPL MEND ./ ADD NAME=TAPEMAN3 //MARKASM1 JOB (0),'TAPEMAN',CLASS=A,MSGCLASS=T,MSGLEVEL=(1,1) //ASM EXEC PGM=IFOX00, // PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // REGION=4096K,COND=(0,NE) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC // DD DISP=SHR,DSN=SYS1.AMODGEN FOR IHAECB //SYSUT1 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT2 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT3 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSTERM DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSIN DD DATA,DLM=ZZ ********************************************************************** * * * TAPEMAN : Mark Dickinson, December 2008 * * * * T A P E M A N T O O L K I T * * Tapeman - Version 3.06 - December 2015 * * T A P E M A N T O O L K I T * * * * * * Version 3 is not compatible with version 2. Specifically the entire* * message can no longer be passed to TAPEMAN so unless you want to * * put one hell of a lot of message parsing into your IEECVXIT just * * don't use it. * * Version 3 is designed to be * * triggered from my MMPF message processing tool which can do all * * the message parsing required; so all message parsing has been * * removed from version 3 itself. * * * * Credits: With code blocks copied from Jay Moseleys cobol/vsam * * interface code to get the vsam file access, as I don't * * fully understand vsam yet. Updates to follow when I do. * * * * Desc: automate Tape mounts on a MVS3.8J Hercules system * * * * Requires : My MMPF message automation tool * * DIAG8CMD ENABLE set in the hercules config file * * My TAPEMAN programs * * See installation documentation. * * * * Automatically mount .AWS tapes for both mount requests for a * * specific volser, and also for scratch tapes (volser=PRIVAT). * * * * This is invoked from my MMPF console message processing tool, which* * will parse the mount messages and pass to TAPEMAN the parm field * * -- normally 'MSGNUMID CUU VOLSER JOBNAME' * * -- for IEC701D 'MSGNUMID CUU VOLSER RR' where RR is the IEHINIT * * reply number we must reply to, the only message that needs a * * reply and it has no jobname value in the message. * * It then builds and executes the DIAG8 command to mount the tape * * and updates the scratch status of any tape used. * * * * One DD CARD is needed to be added to the MMPF proc, * * TAPEVOLS - indexes VSAM cluster, records 132 bytes, key bytes 0-5 * * The database of tape VOLSERS to be used for automation. * * Currently contains fields VOLSER, Jobname that used it, and the * * expiry date as YYDDD. Scratch tapes available for use have an * * expiry field of 00000. Record layout is member DBREC. * * * * Sample procedure is provided in the * * INSTALL.TAPEMAN3.CONTROL file * * (no trailing * above is deliberate, global filename changes * * done in the install steps cause a compile fail if the * gets * * pushed due to a longer name, I must remember that) * * * ********************************************************************** EJECT ********************************************************************** * * * HOW DOES IT WORK (WHAT DOES IT DO) ? * * * * OPERATION WHEN TRIGGERED FOR A TAPE MOUNT MESSAGE * * For a scratch tape or a named volser ? * * 1. Scratch mount... * * Scan through TAPEVOLS for a scratch tape * * ? Scratch tape found * * No - (recoverable) * * WTO that there are no scratch tapes left in DBS * * WTOR operator to enter a volser to be used * * ? operator replied cancel * * No - Use the volser entered by operator even if * * not one we have catalogued (may have been * * created manually by op for this onetime fix)* * --- GOTO 3. --- * * Yes - cancel job requesting the mount * * --- END --- * * Neither - if operator does not reply in 10mins * * the job is cancelled so automation resumes * * --- END --- * * Yes - Use that scratch volser found * * --- GOTO 3. --- * * * * 2. Named volser mount... * * Is it in our catalogue ? * * No - WTO we will not automount it (could be anywhere)* * Yes - use volser in mount message, --- GOTO 3. --- * * * * ...Now we have a volser... * * 3. Use the MDDIAG8 program to issue via DIAG8 to the CP * * 'devinit CUU tapes/VOLSER.aws' * * CUU is the unit from the IEF233A mount message * * VOLSER is the tape volser we worked out * * Update the volser entry in TAPEVOLS with an expiry of +14 * * Exit * * * ********************************************************************** EJECT ********************************************************************** * * * KNOWN BUGS * * 1. With the OS. If this is triggered * * by a job trying to backup any tapeman files even if the * * backup job and this job open them disp=shr there is still * * a waiting for dataset contention against both jobs so the * * backup has to be cancelled. This occurs for backups not * * automated by this also (ie: backing up SYS1 files with a * * disp=shr tends to wait on datasets until tso and vtam are * * shutdown, dunno why as all have them share) so not much I * * can do about it. For ordinary user backups and restores this* * works just fine. * * See change history 2006/03 for a workaround. * * 2. Recovery if the VSAM file wasn't closed properly. * * If there is an error on the VSAM file open it is retried. * * This gets around the problem where the file may not have * * been closed properly and TAPEMAN works correctly but will * * end with an ABEND SC03. It won't happen next time as the * * file will have been closed correctly and no action is * * required. * * 3. Not a bug but... with RAKF denying TAPEVOL resources to * * unauthorised jobs the OS will just keep asking for another * * tape to be mounted; which will eventually exhaust the * * available scratch tapes. I have included in the SRC file * * an IEECVXIT example that includes the code I use to cancel * * jobs that try to use tapes they should not. * * Search on RAKF000A and CTAPVOLM for the changes needed. * * * * Other references * * - See TAPEMUTL to list/add/delete tapes in the TAPEVOLS file * * - See TAPEMSCR which is the program you should run daily to seek * * out tapes that have expired and return them to the scratch state* * * ********************************************************************** EJECT ********************************************************************** * * * AUTHOR * * Mark Dickinson - 2006, with changes thru to 2015 * * * * Desc: created to automate my 'managed' Tape mounts on my * * MVS3.8J hercules system. * * * * TODO * * Maybe add a field in the TAPEVOLS record to allow people to * * specify a HET|AWS volser type as some people may want it. Or * * maybe not as I only use AWS at the moment. Later, when I need * * it pherhaps. * * * * CHANGE HISTORY * * 2005/12 - created and started using it, yippee my backups don't * * abend with timeouts when I'm not there. * * 2006/01 - updated to allow variable length volser and jobnames * * by implementing parsing of the message to extract the * * fields, and then the newly necessary volser length * * scan to determine at what point to actually add .aws * * onto the link to herccmd. * * 2006/01 - broke it. after abends the vsam file is not closed * * properly so the next open fails. To allow for that * * I now retry the vsam open once if the first open * * fails as we do NEED this to run or tape mounts will * * be left hanging. I don't check if the vsam return * * code is one that should be retried, I'm too close to * * the 4K program limit for additional code. * * 2006/02 - changed to only automate for tapes that are in the * * vsam catalogue. removed the tapedevs dd and functions * * changed the exit to pass 45 bytes of the message as * * needed to correctly handle a IEC501A message. * * 2006/03 - added a test for a parm of MOUNTSCRATCH as a workaround * for Bug1. This allows a batch job that knows it will * * need a scratch tape while automation is turned off to * * manually load a scratch tape from within the job. THIS* * THIS SHOULD NOT BE USED WHILE AUTOMATION IS ACTIVE * * or the automation will also mount/allocate another tape * ISSUE: preloading the tape in step1 of a job does not * * work as when step2 starts the OS unloads the preloaded* * tape and issues a new mount request. * * RESOLUTION: do not invoke TAPEMAN with the mountscratch * parm, instead use TAPEMCUU (see TAPEMCUU) which will * * invoke TAPEMAN with the correct parms in the background * so the main job can continue (the background task(this) * will sleep 30 seconds while the main job triggers the * * mount request, then we wake to satisfy it. * * 2007/02 - Added IEC701D (iehinitt mount request) * * 2007/11 - Making changes blew addressing/ltorg space, lots of * * cleanup, *+nn branching added instead of using labels,* * truncates lots of WTOs to smaller strings, moved as * * many =CL'xx' as practical to data fields. * * Still not enough so added a second addressing register* * for the program, now uses R12 (standard) PLUS R11 for * * addressing. * * 2007/11 - And the change needed was, add additional IEC701D * * processing to handle when it is called from MMPF * * instead of IEECVXIT as when invoked from MMPF we MUST * * reply to the associated WTOR within the 15sec MMPF * * window or MMPF will try the mount again, and again... * * so if triggered from MMPF (if it has the message Rnn * * number prefixed to the message is MMPF) then TAPEMAN * * will sleep for 5 seconds, then reply M to the WTOR * * and we pray the tape has been mounted in time. * * ------- Version 3.00 ------- * * 2008/12 - Removed all message parsing code from the program. * * Consolidated message processing functions, in V2 each * * message has to be parsed uniquely which is no longer * * now MMPF has done the parsing. * * Updated comments with the requirement to add the DD * * TAPEVOLS to the MMPF stc proc (needed for LNK use * * from MMPF, not needed if CMD S TAPEMAN stil used). * * Changed handling of getting parms passed, V2 linked * * back through callers to find the master jobs parm area* * which would give us the MMPF parm area, wheras we * * want know the parm area provided in the LINK command * * ------- Version 3.01 ------- * * 2009/03 - Minor tweak * * Changed TAP005W message to a TAP005A message desc=2, * * it is now a NRD to stop it scrolling off the screen * * as MMPF will DOM the origional mount message as I * * have implemented the MMPF rules. * * Changed that message to include the unit now also as * * the origional mount message that had it will have * * scrolled off. * * ------- Version 3.02 ------- * * 2009/09 - Minor tweak * * If there are no spare scratch tapes for a mount and * * the operator replies cancel instead of selecting a * * tape volser we now try to cancel the job requesting * * the mount from tapeman instead of making the operator * * do it manually. As I do this with a 'C JOBNAME' it * * will not work if there are multiple jobs of the same * * name on the input queue, but will be fine normally. * * Needed because... (a) we have already DOMed the mount * * message so ops won't know it is still outstanding * * unless they check, (b) they replied cancel, so lets * * cancel the job. * * ------- Version 3.03 ------- * * 2012/06 - Minor tweak needed for my public system * * Minor change, change the not automated message to * * include the jobname in the message, so my automation * * can cancel a job asking for a non-automated volser. * * OLD MSG : TAP005A NOT AUTOMATED, MANUALLY MOUNT vvvvvv ON cuu * * NEW MSG : TAP005A MANUALLY MOUNT vvvvvv ON cuu, JOB JJJJJJJJ * * ------- Version 3.04 ------- * * 2014/04 - Minor tweak, for lights out the operator prompt to * * provide a volser when there is no scratch tapes * * available not has a timer to go to the cancel job * * step rather than waiting forever for a operator reply * * Required to stop my MMPF waiting forever on this pgm. * * ------- Version 3.05 ------- * * 2014/12 - Minor tweak, discovered scratch tapes can be requested* * with a volser of SCRTCH so added that test for a * * scratch mount along with the existing PRIVAT test. * * ------- Version 3.06 ------- * * 2015/12 - Minor tweak, replaced the requirement for HERCCMD. * * Now using MDDIAG8 so no 3rd party software is needed. * * * ********************************************************************** EJECT TAPEMAN3 CSECT STM R14,R12,12(R13) SAVE REGISTERS LR R12,R15 R12 = ADDR OF ENTRY POINT USING TAPEMAN3,R12,R11 ADDRESABILITY TO CSECT LA R11,SAVEAREA R11 = ADDR OF OUR SAVE AREA ST R13,SAVEAREA+4 SAVE POINTER TO CALLERS SAVE AREA ST R11,8(R13) SAVE PTR TO OUR SAVE AREA IN CALLER'S LR R13,R11 R13 = ADDR OF OUR SAVE AREA LA R11,4095(R12) R11 WILL BE LA R11,1(R11) SECOND BASE REGISTER SPACE 5 * --- GET THE PARM FIELD PASSED --- * WE ONLY EXPECT ONE PARM SO NO NEED TO CHECK FOR MORE LTR R1,R1 BZ NOPARM LR R2,R1 ADDRESS OF ADDR LIST TO R2 L R5,0(,R2) R5 TO ADDRESS DATA FIELD * OK, SAVE THE PARM TO RECDATA SR R3,R3 LEN OF PARM TO R3 LH R3,0(R5) LA R4,L'RECDATA MAX FIELD LEN ALLOWED IN R4 CR R3,R4 WILL PARM FIT ? BNH PARMOK YES, OK LA R3,L'RECDATA NO, TRUNCATE TO MAX LEN PARMOK EX R3,EXPRMSAV MOVE FOR LEN DETERMINED B STRTOPEN EXPRMSAV MVC RECDATA(0),2(R5) SAVE PARM1 DATA FROM +2 SPACE 1 * --- NO PARM OR BAD PARM PROVIDED, FATAL ERROR NOPARM WTO 'TAP001E NO PARM DATA PROVIDED' B EXIT1 --- SO EXIT OUT EJECT * OPEN THE VSAM TAPE VOLSER DATABASE STRTOPEN BAL R4,OPENKSDS LTR R15,R15 BZ OPENEDOK * VSAM DATASET OPEN FAILED, MAYBE A PREVIOUS JOB ABENDED * SO WE RETRY THE OPEN. CNOP 0,4 BAL R4,OPENKSDS LTR R15,R15 BZ OPENEDOK * RETRY FAILED, NOW WE HAVE NO CHOICE BUT TO EXIT WTO 'OPEN ERROR DD TAPEVOLS, NO RETRY' B EXIT1 SPACE 2 OPENEDOK DS 0F * NOW FIND OUT WHAT WE NEED TO DO CLC RECDATA(8),MIEF233A Tape mount request message BNE *+8 B IEF233A CLC RECDATA(8),MIEC501A Tape mount request message BNE *+8 B IEC501A CLC RECDATA(12),=CL12'MOUNTSCRATCH' 2006/03 change BNE *+8 B BATCHMNT CLC RECDATA(8),MIEC701D 2007/02 change BNE *+8 B IEC701D SPACE 1 * IF WE FALL THROUGH IT IS NOT A MESSAGE WE HANDLE MVC ERRNOAUT+16(8),RECDATA ERRNOAUT WTO 'TAP002W ........ IS NOT AN AUTOMATED MESSAGE' * B EXIT DONE NOW SPACE 1 * ----------------------------------------------------------- * All good things must come to an end. * ----------------------------------------------------------- EXIT CNOP 0,4 LA R7,EXIT1 SET VSAM AFTER RECOVER PTR ST R7,RECOVRPL TO THE EXIT1 SO IF ERRORS ON * CLOSE WE DON'T START LOOPING LA R2,IFGACB CLOSE THE VSAM DATASET CLOSE ((R2)) * B EXIT1 * EXIT1 CNOP 0,4 ALIGN, COULD BE CALLED FROM VSAM L R13,4(R13) ERROR HANDLER LM R14,R12,12(R13) SLR R15,R15 BR R14 EJECT * ----------------------------------------------------------- * A mount tape on device XXX message * * IEF233A M 310,VVVVVV,,JJJJJJJJ,RESTORE <-- to read * IEF233A M 311,PRIVAT,SL,JJJJJJJJ,REPORT1 <-- to write scratch * IEF233A M 311,SCRTCH,SL,JJJJJJJJ,REPORT1 <-- to write scratch * IEC501A M 311,VVVVVV,SL,6250 BPI,JJJJJJJJ,STEP1 <-- to write * * Get the jobname and volser required. If the volser is PRIVAT * or SCRTCH then find a free scratch tape to use as the volser. * When we have the jobname and volser populated call MDDIAG8 * * RECDATA WILL CONTAIN - MSGNUMID CUU VOLSER JOBNAME * ----------------------------------------------------------- DS 0F IEF233A EQU * IEC501A EQU * MVC DEVICE(3),RECDATA+8 MVC VOLSER(6),RECDATA+12 MVC JOBNAME(8),RECDATA+19 CLC VOLSER(L'VOLSER),PRIVAT <-- SCRATCH TAPE RQST BE FNDSPARE CLC VOLSER(L'VOLSER),SCRTCH <-- SCRATCH TAPE RQST BE FNDSPARE B MDDIAG8 EXACT TAPE NEEDED, CARRY ON * -- FIND ANY SCRATCH TAPE TO USE FNDSPARE MVI VSOPCODE,C'S' WE ARE SEARCHING FOR A SPARE CNOP 0,4 IF THIS IS NOT HERE WE SOC1 BAL R4,GETSPARE B MDDIAG8 ISSUE THE DEVINIT COMMAND EJECT * ----------------------------------------------------------- * IEHINITT message * * IEC701D M 312,VOLUME TO BE LABELED VVVVVV * * Get the unit and volser required, then mount it via herccmd * We then need to reply to the WTOR (RR number passed in the * jobname position by MMPF * ----------------------------------------------------------- DS 0F IEC701D MVC DEVICE(3),RECDATA+8 MVC VOLSER(6),RECDATA+12 MVC JOBNAME(8),=CL8'IEHINITT' HARD CODE FOR THIS BAL R4,UPDATVOL CNOP 0,4 AVOID SOC1 BAL R4,GETVOLSZ GET VOLSER SIZE MVC CMDDVINI+10(3),DEVICE MVC CMDDVINI+20(6),VOLSER LA R4,CMDDVINI+20 A R4,VOLSERL MVC 0(4,R4),=CL4'.aws' LINK EP=MDDIAG8,PARAM=CMDDVINI,ERRET=LINKERR SPACE 1 * WAIT A FEW SECONDS AND REPLY TO THE WTOR FOR IEC701D STIMER WAIT,,DINTVL=SECS6 6 secs MVC CMD701D+6(2),RECDATA+19 THE NN REPLY NUMBER STM R0,R1,SAVESVCR * LOG WHAT WE ARE ISSUING, THE USE OF DOTS IS A DEBUGGING AID, * IF THEY ARE NOT OVERWRITTEM WITH THE EXPECTED REPLY, OOPSIE MVC WTO701D+19(6),CMD701D+4 WTO701D WTO '>>TAPEMAN3 ...... ',DESC=(5) WTO TO LOG ONLY * GO ISSUE THE COMMAND VIA SVC 34 NOW MODESET KEY=ZERO,MODE=SUP SR R1,R1 LA R1,CMD701D SR R0,R0 SVC 34 ISSUE COMMAND SPECIFIED MODESET KEY=NZERO,MODE=PROB LM R0,R1,SAVESVCR B EXIT EJECT * ----------------------------------------------------------- * This is called if the parm was MOUNTSCRATCH. This should * should only ever be called from a batch job when automation * has been shut down. The CUU to mount the tape on must be * provided, it is not sanity checked so use with caution. * It MUST be called from a batch job, we don't check for this * being invoked from a TSO session (as we are out of space * in this code block now). * * MOUNTSCRATCH cuu jobnamef * * Get the CUU device to be used from the parm field, we * do not sanity check it. * Get the jobname from the parm field, do not sanitycheck it * Call MDDIAG8 to mount the tape. * ----------------------------------------------------------- SECS30 DC CL8'00003000' * THIRTY SECONDS BATCHMNT MVC DEVICE(3),RECDATA+13 MVC JOBNAME(8),RECDATA+17 * -- SLEEP, GIVE TIME FOR A MOUNT TO BE ISSUED STIMER WAIT,,DINTVL=SECS30 * -- FIND ANY SCRATCH TAPE TO USE MVI VSOPCODE,C'S' WE ARE SEARCHING FOR A SPARE CNOP 0,4 IF THIS IS NOT HERE WE SOC1 BAL R4,GETSPARE B MDDIAG8 ISSUE THE DEVINIT COMMAND EJECT * ----------------------------------------------------------- * MDDIAG8 * 1 - update the volume entry, expiry to be +14 days from now * if the update fails, then not a volume we manage so * just exit out (or a vsam error, still exit out). * 2 - issue the DIAG8 to mount (devinit) the tape file. * * NOTES: * I used to have the update last with the view to always * mounting a named tape if requested even if there were * vsam errors, to allow automatic mounting of tapes by * name even if they are not in the catalogue. But then * I thought, what happens if the tape doesn't physically * exist. * *IEF233A M 310,FRED99,,MARKREST,RESTORE * - TAP006I ALLOCATED FRED99 TO 310. * - HERCCMD - CMD : DEVINIT 310 tapes/FRED99.aws * IEA000I 310,EQC,07,0E00,,,FRED99,MARKREST,07.11.00 * IEA000I 310,,,,5022000000C003600000000000800100010000FFFF000000 * IGF500I SWAP 310 TO 311 - I/O ERROR * *02 IGF500D REPLY 'YES', DEVICE, OR 'NO' * So now we only automate mounts of tape volumes we manage * explicitly from out tape catalogue, so do the update of * the catalogue entry first; any vsam errors (ie: tape volser * not found) will then exit us out before the automatic * mount is issued. For an external tape the devinit must * be manually performed as per the non-automated life. * EXCEPTION: * The one exception is in the case of no scratch tapes * available, where the operator has entered a volser * in response to the WTOR. This volser will be used * even if it is not found in the database on the assumption * that one has been created specially. * ----------------------------------------------------------- DS 0F MDDIAG8 CNOP 0,4 AVOID SOC1 BAL R4,UPDATVOL CNOP 0,4 AVOID SOC1 * IF WE ARE STILL HERE THE TAPE IS IN THE VSAM CATALOG MVC HERCWTO+26(6),VOLSER WTO WHAT WE ARE USING MVC HERCWTO+36(3),DEVICE HERCWTO WTO 'TAP006I ALLOCATED vvvvvv TO ddd. ' SPACE 1 * ISSUE THE DIAG 8 COMMAND, THE ACTUAL VOLSER LENGTH * MAY NOW BE LESS THAN 6 SO WE HAVE TO DETERMINE IT * SO WE KNOW WHERE TO PUT THE .aws PART OF THE COMMAND BAL R4,GETVOLSZ SO GET VOLSER SIZE MVC CMDDVINI+10(3),DEVICE MVC CMDDVINI+20(6),VOLSER LA R4,CMDDVINI+20 A R4,VOLSERL MVC 0(4,R4),=CL4'.aws' LINK EP=MDDIAG8,PARAM=CMDDVINI,ERRET=LINKERR SPACE 1 B EXIT WE ARE FINISHED SPACE 2 * ----------------------------------------------------------- * LINKERR: triggered when the LINK command fails * ----------------------------------------------------------- LINKERR CNOP 0,4 WTO 'TAP004E PROGRAM MDDIAG8 NOT FOUND' B EXIT EJECT * ----------------------------------------------------------- * GET THE DATESTAMP NOW AS YYDDD FOR A LAST USED REFERENCE * DATE IN THE TAPEVOLS FILE, AND THE DATESTAMP IN 14 DAYS * TIME AS YYDDD AS AN EXPIRY DATE IN CASE WE ARE ALLOCATING * A NEW SCRATCH TAPE FOR THIS EXECUTION. * ----------------------------------------------------------- DATESTMP DS 0F STM R0,R4,DATESAVA * R0 has the time, we ignore but it is used so we save the register * R1 has the date, save the register * R2-R4 used in calculations, save those registers TIME DEC GET SYSTEM TIME AND DATE ST R1,PDAT STORE PACKED DATE ST R1,PDAT STORE PACKED DATE STCM R1,4,YEAREND+1 SAVE 'YY' PART OF DATE ED CURDMSK(7),PDAT+1 UNPACK DATE SLR R2,R2 R2 = 0 CVB R3,PDATDBL R3 = YYDDD IN BINARY D R2,FULL1000 R3 = YY, R2 = DDD LR R4,R3 KEEP YEARS FOR LATER SRL R4,2 R4 = R4 / 4 SLL R4,2 R4 = R4 * 4 CR R3,R4 ARE YEARS EQUAL ? BNE DATNLEAP NO -> L R4,LEAPDAYS LEAP YEARS HAVE 366 DAYS ST R4,YEAREND DATNLEAP EQU * UNPK TXTDAT,PDAT X'00YYDDDF' TO C'YYDDD' MVC DATENOW(5),TXTDAT A R2,EXPAMNT CL R2,YEAREND BL DATNROLL S R2,YEAREND ROLL BACK DAYS BY 36X A R3,FULLONE ADD 1 TO YEAR DATNROLL CVD R3,DECIMWRK CONVERT BINARY YY TO C'0YY' UNPK DECIMWRK(3),DECIMWRK+6(2) OI DECIMWRK+2,C'0' MVC DATEEXP(2),DECIMWRK+1 SAVE THE YY BIT CVD R2,DECIMWRK CONVERT BINARY DDD TO C'DDD' UNPK DECIMWRK(3),DECIMWRK+6(2) OI DECIMWRK+2,C'0' MVC DATEEXP+2(3),DECIMWRK AND THE DDD BIT LM R0,R4,DATESAVA BR R4 DATESAVA DS 5F EJECT * ----------------------------------------------------------- * UPDATVOL: Update the VOLSER entry in the database to * indicate it has been allocated. * ----------------------------------------------------------- UPDATVOL DS 0F STM R4,R7,UPVSAV SR R7,R7 CLEAR RECOVERY FLAG BY DEFAULT ST R7,RECOVRPL CLI VSOPCODE,C'M' IF VOLSER WAS ENTERED MANUALLY BY BNE UPDATVO1 OPERATOR WE WILL CONTINUE MOUNT EVEN LA R7,UPDATXIT IF A VSAM ERROR AS THE TAPE MAY NOT ST R7,RECOVRPL BE IN OUT DATABASE BUT BE ONE JUST * MANUALLY CREATED FOR THIS INSTANCE. * SO RECOVRPL TO NORMAL UPDATVOL EXIT SPACE 1 * SEEK TO AND READ EXACT RECORD UPDATVO1 CNOP 0,4 * KEYPOSITION BAL R14,MODIFY MVC $IOAREA(L'VOLSER),VOLSER THE KEY MODCB RPL=(R2),OPTCD=(KEQ) POINT RPL=(R2) MODCB RPL=(R2),OPTCD=(KEQ) * READ CNOP 0,4 BAL R14,MODIFY GET RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=FEEDBACK,LENGTH=4 L R7,FEEDBACK STH R7,$RECLEN LENGTH ACTUALLY READ * NOW UPDATE THE FIELDS IN THE RECORD CNOP 0,4 BAL R4,DATESTMP GET DATESTAMPS MVC $IOAREA+16(5),DATEEXP EXPIRY DATE MVC $IOAREA+7(8),JOBNAME JOBNAME * THEN REWRITE THE RECORD CNOP 0,4 BAL R14,MODIFY LA R2,IFGRPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) PUT RPL=(R2) * DONE UPDATXIT CNOP 0,4 SR R7,R7 CLEAR RECOVERY FLAG IS SET ST R7,RECOVRPL LM R4,R7,UPVSAV BR R4 UPVSAV DS 4F SPACE 2 * ----------------------------------------------------------- * GETSPARE: Find the next available scratch volser to use. * note: also modifies R7 and R14 but we don't need to * save those. * Will try to find a spare tape in the TAPVOLS file, if it * can we will update the record in the VSAM file and return * the volser found. If we cannot the VSAM EOF exit will take * the program to VSEOF which will WTOR for a volser to use. * ----------------------------------------------------------- GETSPARE ST R4,GSSAVER4 * SEEK TO THE START OF THE FILE MVC $IOAREA(6),SPACES6 NULL VOLSER BAL R14,MODIFY MODCB RPL=(R2),OPTCD=(KGE) LA R7,WTORONER GO TO MANUAL PROMPT IF I-O ERR ST R7,RECOVRPL POINT RPL=(R2) * START READING MODCB RPL=(R2),OPTCD=(KEQ) BAL R14,MODIFY GET RPL=(R2) CLC $IOAREA+16(5),SPAREFLG # EXP-DATE FIELD BE GETSPAR2 GETSPAR1 BAL R14,MODIFY LOOP FOR THE REST GET RPL=(R2) CLC $IOAREA+16(5),SPAREFLG BNE GETSPAR1 * WE FOUND A SCRATCH VOLSER, PASS IT BACK GETSPAR2 EQU * MVC VOLSER(L'VOLSER),$IOAREA L R4,GSSAVER4 BR R4 GSSAVER4 DS 1F EJECT *-----------------------------------------------------------* * OPENKSDS * * OPEN THE VSAM FILE FOR KSDS, INPUT/OUTPUT * *-----------------------------------------------------------* OPENKSDS DS 0F ST R4,SAVER4 * RESET FIELDS USED FOR STATUS INFORMATION XC $RC,$RC CLEAR RETURN CODE XC $VSRC,$VSRC CLEAR VSAM RETURN CODE XC $VSFUNC,$VSFUNC CLEAR VSAM FUNCTION CODE XC $VSREAS,$VSREAS CLEAR VSAM REASON CODE L R10,=A($IOAREA) THE IO BUFFER AREA SR R7,R7 CLEAR ADDR FOR STORE ST R7,RECOVRPL NO RPL FIXUPS NEEDED YET LA R7,DBSLEN SET RECLEN VALUE STH R7,$RECLEN LA R7,VOLSRLEN SET KEYLEN VALUE (VOLSER) STH R7,$KEYLEN SR R7,R7 CLEAR AGAIN * BUILD ACCESS CONTROL BLOCK USING MODEL MVC IFGACB($ACBLEN),ACBMODEL LA R2,IFGACB MODCB ACB=(R2),DDNAME=(*,$DDNAME) * BUILD REQUEST PARAMETER LIST USING MODEL MVC IFGRPL($RPLLEN),RPLMODEL LA R2,IFGRPL MODCB RPL=(R2),ACB=(S,IFGACB) * ACCESS MODE TO BE USED, KSDS, IN R7 SR R7,R7 LA R7,18 LA R2,IFGACB MODCB ACB=(R2),MACRF=(KEY) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(KEY) * USE DYNAMIC ACCESS FOR THE VSAM FILE LA R7,6(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(SEQ,DIR) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(SEQ) * FILE TO BE OPENED FOR INPUT/OUTPUT LA R7,2(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(OUT) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(UPD) * DO THE REST OF THE REQUIRED RPL MODS AND OPEN THE DS BAL R14,MODIFY LA R2,IFGACB OPEN ((R2)) * R15 IS CHECKED BY THE CALLER FOR SUCCESS * OK, DONE HERE OPENKSDX L R4,SAVER4 BR R4 EJECT *-----------------------------------------------------------* * CALLED TO SET ALL THE DEFAULT ACB/RPL VALUES. SHOULD BE * * CALLED PRIOR TO EACH VSAM REQUEST. * *-----------------------------------------------------------* MODIFY DS 0F ST R14,SAVER14 SAVE RETURN ADDRESS LA R2,IFGRPL ADDRESS GENERATED BY RPL SR R3,R3 CLEAR R3 TO LOAD * LA R3,DBSLEN MAY BE CHANGED BY THE READ, USE BELOW * SO WE UPDATE ONLY WHAT WE READ SR R3,R3 LH R3,$RECLEN LENGTH OF RECORD SR R4,R4 CLEAR R4 FOR KEY ADDRESS SR R5,R5 CLEAR R5 FOR KEY LENGTH LA R4,$RRN ADDRESS RELATIVE RECORD NUM LH R4,$RKP LOAD KEY OFFSET AR R4,R10 ADD RECORD ADDRESS LH R5,$KEYLEN LOAD KEY LENGTH MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10), X ARG=(R4),KEYLEN=(R5) L R14,SAVER14 RELOAD RETURN ADDRESS BR R14 SAVER14 DS 1F SAVE LOCAL RETURN ADDRESS SPACE 2 EJECT *-----------------------------------------------------------* * ERROR DURING VSAM PROCESSING. THE EXLST BROUGHT US HERE. * *-----------------------------------------------------------* VSERROR DS 0F CLI VSOPCODE,C'M' IF A MANUAL VOLSER ENTERED THEN THE * MOST LIKELY CAUSE OF COMING HERE IS * THAT THE VOLSER IS NOT IN THE FILE * OF TAPES WE MANAGE, SO IF OPCODE=M * JUST LEAVE HERE AS AN OPERATOR * OVERRIDE IS NOT AN ERROR. BE VSERRORX SPACE 1 LA R2,IFGRPL SHOWCB RPL=(R2),FIELDS=FDBK,AREA=FEEDBACK,LENGTH=4 ICM R5,B'1111',FEEDBACK RETRIEVE FEEDBACK CODES STCM R5,B'0100',$VSRC+1 AND VSAM RETURN CODE STCM R5,B'0010',$VSFUNC+1 AND VSAM FUNCTION CODE STCM R5,B'0001',$VSREAS+1 AND VSAM REASON CODE SPACE 1 * WTO OUT THE ERROR WE GOT, ONLY THE REASON CODE STM R5,R6,VSERSAV2 XR R5,R5 LH R5,$VSREAS Reason= bit C R5,=F'16' RECORD NOT FOUND ACCEPTABLE, BNE VSERRWT1 ANYTHING ELSE SKIP TO ERROR WTO * IF NOT FOUND THEN A TAPE WE DON'T MANAGE MVC VSERRNF+31(6),VOLSER MVC VSERRNF+41(3),DEVICE MVC VSERRNF+50(8),JOBNAME VSERRNF WTO 'TAP005A MANUALLY MOUNT vvvvvv ON cuu, JOB JJJJJJJJ', X DESC=(2) B EXIT JUST EXIT FROM HERE VSERRWT1 CVD R5,DECIMWRK UNPK DECIMWRK(3),DECIMWRK+6(2) OI DECIMWRK+2,C'0' MVC VSERRWTO+34(3),DECIMWRK VSERRWTO WTO 'VSAM I-O ERR, REASON CODE=nnn.' VSERRWSK LM R5,R6,VSERSAV2 SPACE 1 * YES WE NEED THE CHECKS BELOW, OR WE COULD AT A MINIMUM * GO INTO AN ENDLESS LOOP TRYING TO CLOSE THE FILE IS WE * GET ERRORS ON THAT (RECOVRPL WILL JUMP TO EXIT1 IN THAT CASE) VSERRORX L R7,RECOVRPL ANY ERROR HANDLER ADDR TO GO TO ? LTR R7,R7 BZ EXIT NO, JUST EXIT SR R4,R4 YES, CLEAR ADDR TO AVOID LOOPS AND JUMP ST R4,RECOVRPL BR R7 SPACE 1 VSERSAV2 DS 2F SPACE 2 *-----------------------------------------------------------* * EOF ON VSAM FILE, NO SCRATCH TAPES WERE FOUND ? * *-----------------------------------------------------------* VSEOF DS 0F CLI VSOPCODE,C'S' SEARCHING FOR SCRATCH ? BE WTORPROC YES, NO SCRATCH TAPES * FOUND SO WTOR FOR ONE B EXIT ELSE JUST EXIT EJECT * ----------------------------------------------------------- * GETVOLSZ * Added now we can have a variable volser size. Called to * determine the exact length so we know where to append * any file extension to. * ----------------------------------------------------------- GETVOLSZ DS 0F STM R4,R5,GETVOLSA LA R4,VOLSER SR R5,R5 GETVOLZ1 CLI 0(R4),C' ' BE GETVOLZ2 A R5,FULLONE C R5,=F'6' CAN ONLY BE 6 BYTES MAX BNL GETVOLZ2 A R4,FULLONE B GETVOLZ1 GETVOLZ2 ST R5,VOLSERL LM R4,R5,GETVOLSA BR R4 GETVOLSA DS 2F EJECT LTORG * ----------------------------------------------------------- * DATA AREAS * ----------------------------------------------------------- SAVEAREA DS 18F SAVER4 DS 1F SAVESVCR DS 2F SAVE AREA WHEN I NEED SVC34 FULL128 DC F'128' VSOPCODE DC C'-' ANYTHING BUT S TO START WITH PRIVAT DC CL6'PRIVAT' VOLSER OS USES FOR SCRATCH RQST SCRTCH DC CL6'SCRTCH' ANOTHER USED FOR SCRATCH RQST RECDATA DC CL27' ' PARM FIELD SAVED, EXPECT 27 BYTES DEVREC DS CL80' ' SPACE 1 VOLSER DC CL6' ' DC - START AS SPACES, WE MAY UPDATE LESS SPACES6 DC CL6' ' USED FOR NULL VOLSER CHECKS DEVICE DS CL3 DS - WE UPDATE THE FULL FIELD JOBNAME DC CL8' ' DC - START AS SPACES, WE MAY UPDATE LESS DEVFOUND DS CL1 ZERO DC CL1'0' ONE DC CL1'1' SPAREFLG DC CL5'00000' ZEROS INDICATES A SPARE TAPE FULLZERO DC F'0' VOLSERL DC F'6' DEFAULT, REPLACE WITH PARSED LEN CANCEL DC CL6'CANCEL' USED IN WTOR REPLY TEST SECS6 DC CL8'00000600' SIX SECONDS, FOR STIMER * SPACE 2 * MESSAGE NUMBERS HERE AS LTORG POOL IS BLOWING OUT * RR IEC701D M CUU,VOLUME TO BE LABELED VVVVVV (from MMPF) MIEC701D DC CL8'IEC701D ' * IEC501A M CUU,VVVVVV,SL,6250 BPI,JJJJJJJJ,STEPNAME MIEC501A DC CL8'IEC501A ' * IEF233A M CUU,VVVVVV,,JJJJJJJJ,STEPNAME <-- to read * IEF233A M CUU,PRIVAT,SL,JJJJJJJJ,STEPNAME <-- to write MIEF233A DC CL8'IEF233A ' * SPACE 2 * USED IN THE SVC34 COMMAND TO REPLY TO A TAPE LABEL WTOR CMD701D DC 0D'0',XL2'0C',XL2'00',C'R nn,M ' SPACE 2 * USED IN THE SVC34 COMMAND TO CANCEl A JOB IF NO SCRATCH CARTS ARE * AVAILABLE FOR IT AND THE OPERATOR REPLIED CANCLEL TO THE SELECT * TAPE VOLUME PROMPT CMDCANCL DC 0D'0',XL2'0F',XL2'00',C'C jjjjjjjj ' SPACE 2 * ----------------------------------------------------------- * USED BY THE DATE OBTAIN AND ADD CODE * ----------------------------------------------------------- DECIMWRK DC D'0' TXTDAT DS CL5 - - - added FULL1000 DC F'1000' CONSTANT FULL14 DC F'14' FULLONE DC F'1' DS 0D ALIGNMENT PDATDBL DC XL4'0' PDAT DC PL4'0' PACKED DATE FORMAT 00YYDDDF CURDMSK DC CL1'0' FILL CHAR CURDAT DC XL6'21204B202020' CURRENT DATE (YY.DDD) YEAREND DC F'365' END OF YEAR LEAPDAYS DC F'366' NO OF DAYS IN A LEAP YEAR DATENOW DS CL5 YYDDD DATEEXP DS CL5 YYDDD, as above +14 days EXPAMNT DC F'14' AMOUNT (DAYS) TO + TO EXPIRE SPACE 2 * * DIAG8 BLOCKS * LTORG CMDDVINI DS 0F DC AL2(33) 33 BYTES IN COMMAND DC CL34'DEVINIT xxx tapes/ ' pad to even num * xxxxxx.aws inserted after / SPACE 2 PRINT NOGEN * * FILE DCB'S AND ACB'S * *-----------------------------------------------------------* * VSAM DATA AREAS USED * *-----------------------------------------------------------* LTORG ACBMODEL ACB DDNAME=VSAMDD,EXLST=EXL001 RPLMODEL RPL ACB=ACBMODEL EXL001 EXLST LERAD=VSERROR,SYNAD=VSERROR,EODAD=VSEOF SPACE 2 LTORG VOLSRLEN EQU 6 FEEDBACK DS 0F RECOVRPL DS 0F $RC DS H $VSRC DS H $VSFUNC DS H $VSREAS DS H $DDNAME DC CL8'TAPEVOLS' DDNAME USED $RECLEN DS H $RKP DS H $KEYLEN DS H $RRN EQU $RKP PRINT GEN DBREC PRINT NOGEN SPACE 2 * THE ACTUAL ACB AND RPL USED IFGACB DSECT=NO $ACBLEN EQU (*-IFGACB) IFGRPL DSECT=NO $RPLLEN EQU (*-IFGRPL) SPACE 1 * THE IO RECORD/DATA AREA, ADDRESS USING R10 $IOAREA DS CL200' ' OUR VSAM FILE ONLY HAS 132 BYTE RECORDS * BUT WE NEED A LARGER BUFFER AREA SPACE 2 * ----------------------------------------------------------- * START OF WTOR SPECIFIC STUFF * If no scratch tapes were found in the VSAM file then we * must prompt the operators for one to use. * If the operator replies with a volser we continue on and * use it. * If the operator replies cancel, we attampt to cancel the * job that wanted the tape before we exit, that will probably * fail if there are multiple jobs with the same name on the * input queue but should work fine normally. * if no response to the WTOR within 10 mins we cancel the job * ----------------------------------------------------------- SAVEWTOR DS 1F WTORECB DS 1F TIMERECB DS 1F TIMEXPRM DS 1F EVENT TO POST WTORECBL DS 2F ECB LIST, 2 ENTRIES WTORMSID DS 1F DS 0D BELOW MUST BE DOUBLEWORD ALLIGNED WTORMAX DC CL8'00100000' hhmmss-10ths of secs WTORREPL DC CL6' ' WTORONER WTO 'VSAM I-O ERROR' WTORPROC WTO 'TAP096W *** NO SCRATCH TAPES ARE AVAILABLE ***' STIMER REAL,WTORTIMO,DINTVL=WTORMAX LA R1,TIMERECB ST R1,TIMEXPRM MVC WTORTEXT+57(8),JOBNAME XC WTORECB,WTORECB XC TIMERECB,TIMERECB WTORTEXT WTOR 'TAP097A ENTER TAPE VOLSER TO USE FOR JOB xxxxxxxx, OR CX ANCEL, YOU HAVE 10 MINS TO RESPOND BEFORE JOB IS CANCELEX D', X WTORREPL,L'WTORREPL,WTORECB ST R1,WTORMSID SAVE WTOR MESSAGE ID LA R1,WTORECB STORE WTOR ECB IN ECB LIST ST R1,WTORECBL LA R1,TIMERECB STORE TIMER ECB IN ECB LIST ST R1,WTORECBL+4 OI WTORECBL+4,X'80' MARK END OF ECBLIST WAIT 1,ECBLIST=WTORECBL WAIT FOR SOMETHING IN LIST TTIMER CANCEL ALWAYS CANCEL TIMERS LA R1,TIMERECB SEE IF THE TIMER POPPED USING ECB,R1 TM ECBCC,ECBPOST WAS IT ? BO WTORKILL YES, JUMP DIRECTLY TO CANCEL DROP R1 * ELSE IT WAS A WTOR RESPONSE CLC WTORREPL(6),CANCEL IF NOT CANCEL THEN CONTINUE BNE WTORCONT B WTORJOBC OP CANCEL NO WTOR OUTSTANDING WTORKILL L R1,WTORMSID OR FOR TIMER TRIGGER WE MUST DOM MSG=(R1),REPLY=YES CANCEL THE WTOR WTORJOBC MVC CMDCANCL+6(8),JOBNAME THE JOBNAME TO CANCEL STM R0,R1,SAVESVCR SAVE REGS AND ISSUE CANCEL MODESET KEY=ZERO,MODE=SUP SR R1,R1 LA R1,CMDCANCL SR R0,R0 SVC 34 ISSUE COMMAND SPECIFIED MODESET KEY=NZERO,MODE=PROB MVC WTOCAN+30(8),JOBNAME WTOCAN WTO 'TAP007I CANCELLED JOB jjjjjjjj' LM R0,R1,SAVESVCR B EXIT CANCELLED, WE ARE DONE WTORCONT MVC VOLSER(6),SPACES6 SPACE OVER THE PRIVAT MVC VOLSER(L'VOLSER),WTORREPL SAVE THE VOLSER FOR MAINLINE MVC WTORTAPE+27(6),VOLSER DEBUGGING, BUT LEAVE IN WTORTAPE WTO 'TAP008I USING TAPE vvvvvv' MVI VSOPCODE,C'M' MANUAL FLAG, DONT ERROR IF LATER * VSAM FILE UPDATE FAILS AS THIS TAPE * MAY NOT BE IN OUR DBS. B MDDIAG8 USE THIS VOLSER FOR MOUNT AND UPDATE * BELOW TRIGGERED ON TIMER TIMEOUT, POSTS TO THE ENTRY WATCHED * BY THE ECBLIST. WTORTIMO SAVE (14,12) L R2,TIMEXPRM IT IS THE TIMER EVENT WE ARE POSTING POST (2) POST THE TIMER EVENT, DO NO MORE !!! RETURN (14,12) STIMER EXIT END, RETURN CONTROL SPACE 2 IHAECB NEEDED FOR ECBLIST STUFF EJECT * ----------------------------------------------------------- * END OF WTOR SPECIFIC STUFF * ----------------------------------------------------------- EJECT R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * END ZZ //SYSPUNCH DD SYSOUT=* //SYSGO DD DISP=(MOD,PASS,DELETE),UNIT=SYSDA, // DSN=&&OBJLIB,SPACE=(TRK,(10,2)) //LKED1 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=1', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(TAPEMAN3),DISP=SHR //SYSLIN DD DSN=&&OBJLIB,DISP=(OLD,DELETE,DELETE) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //LKED2 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=1', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //SYSLIN DD * SETCODE AC(1) INCLUDE SYSLMOD(TAPEMAN3) ENTRY TAPEMAN3 NAME TAPEMAN3(R) /* // ./ ADD NAME=TAPEMCUU //MARKASM2 JOB (0),'TAPEMCUU',CLASS=A,MSGCLASS=T,MSGLEVEL=(1,1) //ASM EXEC PGM=IFOX00, // PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // REGION=4096K,COND=(0,NE) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB //SYSUT1 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT2 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT3 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSTERM DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSIN DD DATA,DLM=ZZ * ------------------------------------------------------------------- * * TAPEMCUU: * * A simple interface to allow a batch job to request a scratch tape * mount on a specific device. Origionally issued a 'S TAPEMAN' with * the mountscratch data but that proc was obsoleted in TAPEMAN3 so * this needs to be run outside the batch job so the step to request * the tape starts running and asks for the tape mount before TAPEMCUU * performs the tape mount... see the example below. * * The program (via tapeman3) aloocates a scratch tape, waits 30 * seconds, and then mounts the tape on the drive selected. * * ONLY TO BE USED WHEN AUTOMATION HAS BEEN SHUTDOWN. Intended use * is only to backup system libraries when the system is in a fairly * quiesced state (ie: no automation running to do the mount so the * batch job needs to do it itself this way). * WARNING: IF RUN WITH AUTOMATION RUNNING THEN AUTOMATION WILL * DO A MOUNT WHILE THE DRIVE IS IN USE, CAUSING ALL SORTS * OF PROBLEMS...try it, master console goes into a * hardware recovery screen instead of being a console. * * You are expected to customise the section that checks for valid * tape unit CUU entries. The sloppy check provided allows CUU of 48x. * * Example: using unit 487, note the use of unit=CUU rather than * unit=tape in step2. * you must change the tapevols dd dataset name to the * name of your tape database of course. * * //DEMOJOB JOB (0),'DEMO TAPEMCUU',CLASS=A,MSGCLASS=T * //* * //* OOPS, SEE * //* WE MUST RUN TAPEMCUU OUTSIDE THE CURENT BATCH JOB * //* NOW THAE WE HAVE OBSOLETED THE TAPEMAN PROC AND * //* LINK TO TAPEMAN3 DIRECTLY * //* * //STEP1 EXEC PGM=IEBGENER * //SYSIN DD DUMMY * //SYSPRINT DD SYSOUT=* * //SYSUT2 DD SYSOUT=(A,INTRDR) * //SYSUT1 DD DATA,DLM=ZZ * //TAPEMCUU JOB (0),'SPAWN TAPEMCUU',CLASS=A,MSGCLASS=T * //STEPMCUU EXEC PGM=TAPEMCUU,PARM='487' * //TAPEVOLS DD DISP=OLD, * // DSN=VSAM.INSTALL.TAPEMAN33.VVDS.VOLSERS * // * ZZ * //* * //* RUN THE NEXT STEP IMMEDIATELY TO REQUEST THE * //* TAPE MOUNT, THEN WHEN THE TAPEMCUU 30SEC TIMER * //* EXPIRES AND MOUNTS THE TAPE WE WILL USE IT * //* * //STEP2 EXEC PGM=IEBCOPY * //SYSPRINT DD SYSOUT=* * //SYSUT1 DD DISP=SHR,DSN=SYSPROG.LIB.USERCAT.JCL * //SYSUT2 DD DISP=(NEW,KEEP),UNIT=487,LABEL=(1,SL), * // DSN=SYSPROG.LIB.USERCAT.JCL, * // DCB=*.SYSUT1 * //SYSIN DD * * COPY INDD=SYSUT1,OUTDD=SYSUT2 * /* * * Known Bugs. * (1) The WTO messages from herccmd (which is invoked by tapeman3) * generated to the console contain rubbish in the tape name * field... however a correct scratch tape has been selected * and mounted as shown in the herccmd command issued WTO and * verified by a fuser against the tape file (as mvs38j will * not show the volser as mounted simply because a tape is put * into the drive can't check what mvs thinks. * But functionally it works as intended so not an important * bug. Documented simply as all bugs should be. * (2) See 2012/05/06 changes/comments in change history below. * * Changes. * MID: 2013/03/24 - Replaced code that used to SVC34 a 's tapeman' * request with code to link directly to TAPEMAN3 * as the tapeman task hasn't been available since * version3 was released. * 2012/05/06 OOPS... ALSO IS BAD. Because now we link * directly to TAPEMAN3 it is not a seperate task * sleeping for 30secs, it is us... so the tape * gets mounted before the next step starts, so the * next step unloads the premounted tape and we get * another mount request. * So you can still use this but it has to be sent * to intrdr to run as a seperate job so step2 can * start before step1 (tapemcuu) expires its timer. * The example above has been updated to show that. * * ------------------------------------------------------------------- TAPEMCUU CSECT STM R14,R12,12(13) BALR R12,R0 USING *,R12 LA R15,SAVEAREA ST R15,8(R13) ST R13,4(R15) LR R13,R15 * * ---- ENSURE WE HAVE A PARM, SAVE FIRST THREE BYTES AS THE CUU L R1,0(,R1) POINT TO PARM LH R0,0(,R1) GET LENGTH OF PARM LTR R0,R0 IF ZERO THEN NO PARM BZ NOPARM CH R0,=H'3' IS PARM LONG ENOUGH FOR CUU? BL BADPARM NO, NOT A VALID PARM LA R1,2(,R1) POINT TO PARM DATA * * ------------- >>>>>> CUSTOMISE <<<<<< ------------------------- CLC 0(2,R1),=CL2'48' ALL TK3 TAPE DRIVES ARE CUU=48u * ------------- >>>>>> END CUSTOM <<<<<< ------------------------- BNE BADCUU NOT A TAPE VALID DRIVE CUU MVC SYSCMDTX+13(3),0(R1) PUT CUU FROM THE PARM IN PARMFLD * ---- GET THE BATCH JOB NAME FROM THE TASK CONTROL BLOCK LA R5,16 ADDR OF CVT POINTER L R6,0(R5) ADDR OF CVT L R5,0(R6) ADDR OF TCBS L R6,4(R5) ADDR OF 2ND TCB L R5,180(R6) ADDR OF JSCB L R6,260(R5) ADDR OF JCT PREFIX LA R6,24(R6) ADDR OF JOBNAME IN JCT MVC SYSCMDTX+17(8),0(R6) STORE THE JOBNAME IN PARMFLD MVC LNKPRME2+16(8),0(R6) AND IN ERROR MSG IF NEEDED L R6,=F'25' SET LENGTH OR PARMFLD STH R6,SYSCMDLN * --- fidling to setup registers for a safe link, and do the link L R6,SAVEAREA+4 -- save pointer to caller savearea ST R6,R13CALLR -- ... ST R13,SAVEAREA+4 STORE OUR R13 IN SAVE AREA LA R13,SAVEAREA AND LINKED MODULE IS TO USE OURS LINK EPLOC=LNKPROG,ERRET=LNKPRME1,PARAM=(SYSCMD),VL=1 L R13,SAVEAREA+4 GET OURS BACK * --- get our R13 back or we will abend L R6,R13CALLR -- restore origional pointer ST R6,SAVEAREA+4 -- ... B ENDMOUNT -- DONE, EXIT NOW -- LNKPRME1 MVC LNKPRME2+37(8),LNKPROG LNKPRME2 WTO 'MID006E ........:LINK ERROR, ........ NOT FOUND' B ENDMOUNT -- DONE, EXIT NOW -- R13CALLR DS F TO SAVE R13 FROM SAVE AREA WHEN I * NEED TO ALTER IT DURING LINK LNKPROG DC CL8'TAPEMAN3' SYSCMD EQU * SYSCMDLN DC CL2' ' PARMLEN, 2 BYTES SYSCMDTX DC CL25'MOUNTSCRATCH xxx jjjjjjjj' PARM TEXT ENDMOUNT CNOP 0,4 * ************************************************************** * END OF CHANGED FOR TAPEMAN3 * ************************************************************** * EXIT NOW L R13,4(R13) LM R14,R12,12(R13) SLR R15,R15 BR R14 EJECT * ---- BAD PARAMETER ABENDS ALL HERE NOPARM WTO 'NO PARM FIELD PROVIDED TO TAPEMCUU' B ABEND100 BADPARM WTO 'TAPEMCUU:PARM PROVIDED TO TAPEMCUU TO SHORT FOR A CUU' B ABEND100 BADCUU MVC BADCUU1+17(3),0(R1) BADCUU1 WTO 'TAPEMCUU:cuu IS NOT AN AUTHORISED TAPE UNIT' ABEND100 ABEND 100 EJECT LTORG SAVEAREA DS 18F SAVEAREA FOR MAIN PROGRAM JOBNAME DC CL8' ' DEVICE DC CL3'CUU' * * REGISTER EQUATES R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END ZZ //SYSPUNCH DD SYSOUT=* //SYSGO DD DISP=(MOD,PASS,DELETE),UNIT=SYSDA, // DSN=&&OBJLIB,SPACE=(TRK,(10,2)) //LKED1 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=1', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(TAPEMCUU), // DISP=SHR //SYSLIN DD DSN=&&OBJLIB,DISP=(OLD,PASS,DELETE) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //LKED2 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=1', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //SYSLIN DD * SETCODE AC(1) INCLUDE SYSLMOD(TAPEMCUU) ENTRY TAPEMCUU NAME TAPEMCUU(R) /* // ./ ADD NAME=TAPEMDES //MARKASM3 JOB (0),'TAPEMDES',CLASS=A,MSGCLASS=T, // MSGLEVEL=(1,1) //ASM EXEC PGM=IFOX00, // PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // REGION=4096K,COND=(0,NE) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC //SYSUT1 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT2 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT3 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSTERM DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSIN DD * PRINT NOGEN * ******************************************************************** * * * TAPEMDES - TAPEMAN UTILITY * * * * USED TO SLAP A DESCRIPTION INTO THE VSAM RECORD ENTRY * * FOR A TAPE VOLSER. * * * * THIS IS DESIGNED TO BE CALLED FROM THE BATCH JOB DOING * * THE TAPE BACKUP AND EXPECTS TO GET ITS TAPE VOLUME VOLSER FROM * * READING THE FCB OF THE DD 'INPUT', THIS WOULD NORMALLY BE A * * REFERBACK TO THE STEP THAT ACTUALLY ALLOCATED THE TAPE AND DID * * THE BACKUP. * * THE DESCRIPTION IS FREE-FORM 44 BYTES (FILENAME SIZE), PROVIDED * * IN THE SYSIN FILE. I USE IT IN MY BACKUP JOBS TO SET THE * * DESCRIPTION TO THE NAME OF THE FILE (GDG) THAT HAS THE BACKUP * * LISTING FOR THE TAPE (SEE THE SAMPLE BACKUP JOB PROVIDED FOR * * HOW I DO THAT). * * * * IT MAY BE RUN WITHOUT A PHYSICAL TAPE IF NEEDED BY OMITTING * * THE INPUT DD AND PROVIDING A VOLSER IN THE PARM FIELD INSTEAD. * * THIS CAN BE USED TO CUSTOMISE DESCRIPTIONS AS NEEDED. * * * * JCL REQUIRED... * * //STEPX EXEC PGM=TAPEMDES * * //TAPEVOLS DD DISP=SHR,DSN=...what you called it... * * //INPUT DD UNIT=TAPE,VOL=REF=earlierstep,DISP=OLD * * //SYSIN DD * * * NEW DESCRIPTION * * /* * * OR to avoid mounting the tape if you know what the volser is * * //STEPX EXEC PGM=TAPEMDES,PARM='vvvvvv' * * //TAPEVOLS DD DISP=SHR,DSN=...what you called it... * * //SYSIN DD * * * NEW DESCRIPTION * * /* * * * * CHANGE HISTORY * * 2006/07/27 - Created to be used to populate the new description * * field just added to the database. I will use this * * to record the disk based dataset name that holds * * the backup listing for the tape. * * Why?, so I have an easy way of finding the backup * * listing for a specific tape (and I will be using * * this info in an automated restore clist, yes this * * change is to make my life easier. * * * * ******************************************************************** TAPEMDES CSECT STM R14,R12,12(13) , standard program entry BALR R12,R0 USING *,R12 LA R15,SAVEAREA ST R15,8(R13) ST R13,4(R15) LR R13,R15 * * SEE IF THERE IS A PARM FIRST, BEFORE WE START TRASHING ANY * OF THE REGISTERS IN ANY SYSTEM CALLS * LOTS OF MUCKING ABOUT, I MAY BE CALLING THIS AS AN EMBEDDED * MODULE AT SOME POINT. * L 15,4(13) GET ADDRESS OF THE PREVIOUS SAVE AREA PARMPREV L 14,4(15) GET ADDRESS OF THE NEXTPREVIOUS SAVE AREA LTR 14,14 ARE WE IN THE O/S SAVEAREA? BZ PARMTEST YES GO TEST PARM LR 15,14 NO, MAKE 15 = 14 AND BE READY FOR NEXT TEST B PARMPREV BRANCH BACK TO THE LOOP PARMTEST L 14,24(15) WE ARE NOW IN O/S. GOODY GOODY L 14,0(14) LOAD IN THE ADDRESS OF THE ADDRESS SR 1,1 SR 15,15 LH 15,0(14) PUT COUNT OF PARM INTO R15 LTR 15,15 IS COUNT OF PARM= 0? BZ CHKTAPE NO PARM, CARRY ON MVI PRMAVAIL,C'Y' YES, AVAILABLE IF NEEDED LA 1,2(14) MVC PRMVALU(6),0(R1) VALUE SAVED HERE EJECT * * SEE IF A TAPE VOLUME IS MOUNTED, AND OBTAIN THE VOLSER OFF * THE TAPE IF IT IS MOUNTED. * CHKTAPE RDJFCB (INPUT) READ INPUT TAPE'S JFCB LTR R15,R15 SEE IF DD STATEMENT THERE BNE USEPARM NOT THERE, CHECK PARM MVC TVOLSER,JFCBIN+JFCBVOLS ELSE USE VOLSER ON TAPE MVC JFCLTSV,JFCBIN+JFCBLTYP SAVE INPUT TAPE'S LABEL TYPE TM JFCLTSV,X'01' SEE IF NL OR LTM SPECIFIED BO NLERROR YES, WHATS GOING ON CLI JFCLTSV,X'10' SEE IF BLP SPECIFIED BO NLERROR YES, WHATS GOING ON B FROMFCB NLERROR WTO 'TAPM001E TAPE ALLOCATED TO INPUT IS NL/BLP' WTO 'TAPM002E NO DESCRIPTION UPDATE PERFORMED' B EXIT00 NOT FATAL, JUST NO UPDATE * * IF NO TAPE VOLUME WAS MOUNTED, HAVE TO CHECK THE PARM * FIELD TO SEE IF ANYTHING IS PRESENT THERE. * USEPARM CLI PRMAVAIL,C'Y' BNE NOPARM MVC TVOLSER,PRMVALU B PROCEED NOPARM WTO 'TAPM004E FATAL, NO TAPE MOUNTED AND NO PARM' WTO 'TAPM005E NO VOLSER SELECTED TO UPDATE' B EXIT00 NOT FATAL, JUST NO UPDATE FROMFCB CLI PRMAVAIL,C'Y' BNE PROCEED WTO 'TAPM003W PARM IGNORED, USING VOLSER FROM FCB' * * WE HAVE A TAPE VOLSER NOW, WHETHER FROM THE RDJFCB OR IF NO * TAPE ALLOCATED TO THE DD THEN FROM THE PARM FIELD. THE NEXT * STEP IS TO GRAB THE DESCRIPTION FROM THE SYSIN FILE. * PROCEED EQU * OPEN (SYSIN,(INPUT)) GET SYSIN MVC SYSINCRD,0(R1) WE ONLY EXPECT ONE CARD EOFSYSIN CLOSE (SYSIN) EJECT * * OK, WE HAVE A TAPE VOLSER AND A NEW DESCRIPTION, SO * WE NOW NEED TO UPDATE THE VSAM FILE ENTRY. * *-----------------------------------------------------------* * OPEN OUR VSAM FILE, WE WANT TO UPDATE IT * *-----------------------------------------------------------* LA R7,EXIT00 SET VSAM ERROR HANDLING TO EXIT ST R7,RECOVRPL THIS PROGRAM ON AN ERROR * RESET FIELDS USED FOR STATUS INFORMATION XC $RC,$RC CLEAR RETURN CODE XC $VSRC,$VSRC CLEAR VSAM RETURN CODE XC $VSFUNC,$VSFUNC CLEAR VSAM FUNCTION CODE XC $VSREAS,$VSREAS CLEAR VSAM REASON CODE L R10,=A($IOAREA) THE IO BUFFER AREA LA R7,DBSLEN SET RECLEN VALUE, ITS AN EQU VALUE * SO LA IS OK, L GIVES ALIGNMENT ERR * STH R7,$RECLEN LA R7,VOLSRLEN SET KEYLEN VALUE (VOLSER) STH R7,$KEYLEN SR R7,R7 CLEAR AGAIN * BUILD ACCESS CONTROL BLOCK USING MODEL MVC IFGACB($ACBLEN),ACBMODEL LA R2,IFGACB MODCB ACB=(R2),DDNAME=(*,$DDNAME) * BUILD REQUEST PARAMETER LIST USING MODEL MVC IFGRPL($RPLLEN),RPLMODEL LA R2,IFGRPL MODCB RPL=(R2),ACB=(S,IFGACB) * ACCESS MODE TO BE USED, KSDS, IN R7 SR R7,R7 LA R7,18 LA R2,IFGACB MODCB ACB=(R2),MACRF=(KEY) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(KEY) * USE DYNAMIC ACCESS FOR THE VSAM FILE LA R7,6(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(SEQ,DIR) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(SEQ) * FILE TO BE OPENED FOR INPUT/OUTPUT LA R7,2(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(OUT) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(UPD) * DO THE REST OF THE REQUIRED RPL MODS AND OPEN THE DS BAL R14,MODIFY LA R2,IFGACB OPEN ((R2)) * R15 HAS WHETHER WE MANAGED TO OPEN IT OR NOT LTR R15,R15 BZ OPENEDOK WTO 'TAPM009E *ERROR* CANNOT OPEN CATALOG' B EXIT00 *-----------------------------------------------------------* * WAS OPENED OK, READ THE RECORD USING THE EXACT KEY *-----------------------------------------------------------* OPENEDOK LA R7,EXITV SET VSAM ERROR HANDLING TO ST R7,RECOVRPL JUMP TO CLOSING THE FILE MVC $IOAREA(VOLSRLEN),TVOLSER BAL R14,MODIFY * KEYPOSITION MODCB RPL=(R2),OPTCD=(KEQ) POINT RPL=(R2) MODCB RPL=(R2),OPTCD=(KEQ) * READ, ANY ERRORS ARE HANDLED BY THE ERROR HANDLER BAL R14,MODIFY GET RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=FEEDBACK,LENGTH=4 L R7,FEEDBACK STH R7,$RECLEN LENGTH ACTUALLY READ *-----------------------------------------------------------* * IF WE GET HERE THE RECORD WAS READ, SO LETS UPDATE IT * *-----------------------------------------------------------* MVC $IOAREA+22(44),SYSINCRD MVC $IOAREA(VOLSRLEN),TVOLSER OK, I'M PARANOID, SET KEY BAL R14,MODIFY LA R2,IFGRPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) PUT RPL=(R2) B EXITV DONE, CLOSE FILE AND EXIT EXITVE DS 0F MVC EXITVEW+29(6),TVOLSER EXITVEW WTO 'TAPM001E TAPE VOLUME vvvvvv NOT FOUND, NOT UPDATED' EXITV LA R7,EXIT00 SET VSAM ERROR HANDLING TO JUST ST R7,RECOVRPL EXIT ON ERROR SO IF ERRORS ON * CLOSE WE DON'T START LOOPING LA R2,IFGACB TRYING TO CLOSE THE VSAM DATASET CLOSE ((R2)) B EXIT00 EJECT *-----------------------------------------------------------* * CALLED TO SET ALL THE DEFAULT ACB/RPL VALUES. SHOULD BE * * CALLED PRIOR TO EACH VSAM REQUEST. * *-----------------------------------------------------------* MODIFY DS 0F ST R14,SAVER14 SAVE RETURN ADDRESS LA R2,IFGRPL ADDRESS GENERATED BY RPL SR R3,R3 CLEAR R3 TO LOAD * LA R3,DBSLEN MAY BE CHANGED BY IO, USE BELOW LH R3,$RECLEN LENGTH OF RECORD SR R4,R4 CLEAR R4 FOR KEY ADDRESS SR R5,R5 CLEAR R5 FOR KEY LENGTH LA R4,$RRN ADDRESS RELATIVE RECORD NUM LH R4,$RKP LOAD KEY OFFSET AR R4,R10 ADD RECORD ADDRESS LH R5,$KEYLEN LOAD KEY LENGTH MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10), X ARG=(R4),KEYLEN=(R5) L R14,SAVER14 RELOAD RETURN ADDRESS BR R14 SAVER14 DS 1F SAVE LOCAL RETURN ADDRESS EJECT *-----------------------------------------------------------* * ERROR DURING VSAM PROCESSING. THE EXLST BROUGHT US HERE. * *-----------------------------------------------------------* VSERROR DS 0F LA R2,IFGRPL SHOWCB RPL=(R2),FIELDS=FDBK,AREA=FEEDBACK,LENGTH=4 ICM R5,B'1111',FEEDBACK RETRIEVE FEEDBACK CODES STCM R5,B'0100',$VSRC+1 AND VSAM RETURN CODE STCM R5,B'0010',$VSFUNC+1 AND VSAM FUNCTION CODE STCM R5,B'0001',$VSREAS+1 AND VSAM REASON CODE MVI SYSINCRD,C' ' MVC SYSINCRD+1(L'SYSINCRD-1),SYSINCRD XR R5,R5 LH R5,$VSREAS Reason= bit CL R5,=F'16' RECORD NOT FOUND BE EXITVE YES, SO THIS EXIT POINT * ELSE WTO THE ERROR MVC SYSINCRD(36),=CL36'VSAM RC=nnn, FC=nnn, REASON CODE=nnn' STM R5,R6,VSERSAV2 LH R5,$VSRC RC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSINCRD+8(3),NUMBUF LH R5,$VSFUNC FC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSINCRD+16(3),NUMBUF LH R5,$VSREAS Reason= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSINCRD+33(3),NUMBUF MVC VSERRWTO+8(36),SYSINCRD LM R5,R6,VSERSAV2 VSERRWTO WTO '....+....1....+....2....+....3....+. ' L R7,RECOVRPL DO WE HAVE A SPECIFIC EXIT POINT C R7,=F'0' IF NOT JUST BE EXITV EXIT OUT AND CLOSE THE FILE BR R7 IF SO, JUMP TO IT VSERSAV2 DS 2F EJECT EXIT00 L R13,4(R13) LM R14,R12,12(R13) SLR R15,R15 BR R14 EJECT VOLSRLEN EQU 6 LENGTH OF A TAPE VOLUME NAME SAVEAREA DS 15F JFCBLTYP EQU 66 LABEL TYPE (AL, LTM, ETC.) JFCBFLSQ EQU 68 FILE SEQUENCE NUMBER, 0 OR 1 =1ST JFCBVOLS EQU 118 1ST BYTE OF JFCB VOLUME LIST JFCLTSV DS CL1 CHECKING TAPE TYPE HERE PRMAVAIL DS CL1 FLAG TO INDICATE IF PARM PASSED PRMVALU DS CL6 PARM VALUE IF IT WAS PASSED TVOLSER DS CL6 TAPE VOLSER FROM READJFCB (OR PARM) SYSINCRD DC CL80' ' SYSIN CARD INPUT LINE, DEFAULT SPACES NUMBUF DC D'0' * INPUT DCB DDNAME=INPUT,MACRF=RC,DSORG=PS,RECFM=U,DEVD=TA, + BLKSIZE=32760,EXLST=EXITLIST,EODAD=USEPARM EXITLIST DS 0F INPUT DCB EXIT LIST FOR RDJFCB DC X'87' LAST ENTRY AND RDJFCB DC AL3(JFCBIN) BUFFER FOR INPUT TAPE'S JFCB JFCBIN DS 22D 176 BYTES SYSIN DCB DDNAME=SYSIN,MACRF=(GL),DSORG=PS,EODAD=EOFSYSIN SPACE 2 *-----------------------------------------------------------* * THIS ACCESS CONTROL BLOCK IS USED AS A MODEL TO BUILD * * VSAM ACB'S DYNAMICALLY. * *-----------------------------------------------------------* ACBMODEL ACB DDNAME=VSAMDD,EXLST=EXL001 SPACE 1 *-----------------------------------------------------------* * THE REQUEST PARAMETER BLOCK HERE IS USED AS A MODEL TO * * BUILD REQUESTS DYNAMICALLY AS NEEDED. * *-----------------------------------------------------------* RPLMODEL RPL ACB=ACBMODEL SPACE 1 *-----------------------------------------------------------* *-----------------------------------------------------------* EXL001 EXLST LERAD=VSERROR,SYNAD=VSERROR,EODAD=EXITVE SPACE 2 *-----------------------------------------------------------* * DATA AREAS USED * *-----------------------------------------------------------* FEEDBACK DS 0F RECOVRPL DS 0F $RC DS H $VSRC DS H $VSFUNC DS H $VSREAS DS H $DDNAME DC CL8'TAPEVOLS' DDNAME USED $RECLEN DS H $RKP DS H $KEYLEN DS H $RRN EQU $RKP SPACE 2 *-----------------------------------------------------------* * THE ACTUAL ACB AND RPL USED * *-----------------------------------------------------------* IFGACB DSECT=NO $ACBLEN EQU (*-IFGACB) IFGRPL DSECT=NO $RPLLEN EQU (*-IFGRPL) SPACE 2 *-----------------------------------------------------------* * THE IO RECORD/DATA AREA, ADDRESS USING R10 * *-----------------------------------------------------------* $IOAREA DS CL200' ' RECORD IS 132 BYTES, NEED MORE * THE VSAM FIELD RECORD LAYOUT PRINT GEN DBREC PRINT NOGEN EJECT * REGISTER EQUATES R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END /* //SYSPUNCH DD SYSOUT=* //SYSGO DD DISP=(MOD,PASS,DELETE),UNIT=SYSDA, // DSN=&&OBJLIB,SPACE=(TRK,(10,2)) //LKED1 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(TAPEMDES),DISP=SHR //SYSLIN DD DSN=&&OBJLIB,DISP=(OLD,PASS,DELETE) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //LKED2 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //SYSLIN DD * INCLUDE SYSLMOD(TAPEMDES) ENTRY TAPEMDES NAME TAPEMDES(R) /* // ./ ADD NAME=TAPEMEXP //MARKASM4 JOB (0),'TAPEMEXP',CLASS=A,MSGCLASS=T, // MSGLEVEL=(1,1) //ASM EXEC PGM=IFOX00, // PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // REGION=4096K,COND=(0,NE) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=SYS1.AMODGEN // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC //SYSUT1 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT2 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT3 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSTERM DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSIN DD * PRINT NOGEN * ******************************************************************** * * * TAPEMEXP - TAPEMAN UTILITY * * * * PURPOSE: PROVIDE A BATCH INTERFACE TO MANUALLY ALTER THE EXPIRY * * DATE OF VOLSERS. THIS IS USED ONLY FOR TESTING THE * * AUTOMATED EXPIRY HANDLING. * * * * JCL REQUIRED... * * //STEPX EXEC PGM=TAPEMEXP * * //TAPEVOLS DD DISP=SHR,DSN=...what you called it... * * //SYSPRINT DD SYSOUT=* * * //SYSIN DD * * * control cards, see below * * /* * * * * SYSIN DATA CARDS ALLOWED...all start in column 1 * * vvvvvv nnnnn - volser new-expiry * * * * CREDITS * * All the VSAM code here has been extracted/butchered from the * * cobol vsam interface library provided to the hercules community * * by Jay Moseley. I just needed to get native use rather than * * calling it from cobol. * * * * ******************************************************************** MACRO &NAME SPACEOUT &A,&B * ******************************************************************** * SPACE FILL THE DATA AREA 'A' FOR THE LENGTH OF THE DATA FIELD. * * OR THE OPTIONAL LENGTH PROVIDED IN PARM B * * SPACEOUT FIELDNAME OR SPACEOUT FIELDNAME,LEN * * ******************************************************************** AIF ('&A' EQ '').NOPARM AIF ('&B' NE '').HAVLEN MVI &A,C' ' MVC &A+1(L'&A-1),&A MEXIT .HAVLEN MVI &A,C' ' MVC &A+1(&B-1),&A MEXIT .NOPARM MNOTE 12,'*** DATA AREA NAME MUST BE PROVIDED ***' MEND * TAPEMEXP CSECT STM R14,R12,12(13) BALR R12,R0 USING *,R12 LA R15,SAVEAREA ST R15,8(R13) ST R13,4(R15) LR R13,R15 SPACE 2 OPEN (SYSPRINT,(OUTPUT)) LTR R15,R15 BZ OPEN2 WTO 'CANNOT OPEN SYSPRINT' B EXIT99 OPEN2 OPEN (SYSIN,(INPUT)) LTR R15,R15 BZ OPEN3 MVC SYSPRLIN(L'ERSYSIN),ERSYSIN PUT SYSPRINT,SYSPRLIN B EXIT 51 OPEN3 BAL R4,OPENKSDS LTR R15,R15 BZ OPENEDOK MVC SYSPRLIN(L'ERTAPVOL),ERTAPVOL PUT SYSPRINT,SYSPRLIN B EXIT50 OPENEDOK DS 0F SPACE 2 READCARD DS 0F SPACEOUT SYSPRLIN SPACE SEPERATE RPT OUTPUT PUT SYSPRINT,SYSPRLIN GET SYSIN READ A LINE FROM FILE MVC CARDLINE(L'CARDLINE),0(R1) SAVE THE LINE MVC SYSPRLIN(L'CARDLINE),CARDLINE AND SYSPRINT IT PUT SYSPRINT,SYSPRLIN MVI SYSPRLIN,C' ' MVC SYSPRLIN+1(L'SYSPRLIN-1),SYSPRLIN MVC $IOAREA(VOLSRLEN),CARDLINE BAL R4,CHKVOLSR CHECK VOLSER ON INSERTS BAL R4,READEXCT IF OK, READ EXACT MVC $IOAREA+16(5),CARDLINE+7 EXPDATE FROM CARD BAL R4,UPDATE BAL R4,SUCCESSM B READCARD ONTO THE NEXT CARD SPACE 2 EXIT LA R7,EXIT50 SET VSAM AFTER RECOVER PTR ST R7,RECOVRPL TO THE EXIT50 SO IF ERRORS ON * CLOSE WE DON'T START LOOPING LA R2,IFGACB CLOSE THE VSAM DATASET CLOSE ((R2)) EXIT50 CLOSE (SYSIN) CLOSE SYSIN EXIT51 CLOSE (SYSPRINT) CLOSE SYSPRINT SPACE 1 EXIT99 L R13,4(R13) STANDARD EXIT CODE LM R14,R12,12(R13) SLR R15,R15 BR R14 LTORG EJECT *===========================================================* * START OF VSAM IO CODE BLOCK * *===========================================================* SPACE 1 *-----------------------------------------------------------* * OPENKSDS * * OPEN THE VSAM FILE FOR KSDS, INPUT/OUTPUT * *-----------------------------------------------------------* OPENKSDS DS 0F ST R4,SAVER4 * RESET FIELDS USED FOR STATUS INFORMATION XC $RC,$RC CLEAR RETURN CODE XC $VSRC,$VSRC CLEAR VSAM RETURN CODE XC $VSFUNC,$VSFUNC CLEAR VSAM FUNCTION CODE XC $VSREAS,$VSREAS CLEAR VSAM REASON CODE L R10,=A($IOAREA) THE IO BUFFER AREA SR R7,R7 CLEAR ADDR FOR STORE ST R7,RECOVRPL NO RPL FIXUPS NEEDED YET LA R7,DBSLEN SET RECLEN VALUE, ITS AN EQU VALUE * SO LA IS OK, L GIVES ALIGNMENT ERR * STH R7,$RECLEN LA R7,VOLSRLEN SET KEYLEN VALUE (VOLSER) STH R7,$KEYLEN SR R7,R7 CLEAR AGAIN * BUILD ACCESS CONTROL BLOCK USING MODEL MVC IFGACB($ACBLEN),ACBMODEL LA R2,IFGACB MODCB ACB=(R2),DDNAME=(*,$DDNAME) * BUILD REQUEST PARAMETER LIST USING MODEL MVC IFGRPL($RPLLEN),RPLMODEL LA R2,IFGRPL MODCB RPL=(R2),ACB=(S,IFGACB) * ACCESS MODE TO BE USED, KSDS, IN R7 SR R7,R7 LA R7,18 LA R2,IFGACB MODCB ACB=(R2),MACRF=(KEY) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(KEY) * USE DYNAMIC ACCESS FOR THE VSAM FILE LA R7,6(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(SEQ,DIR) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(SEQ) * FILE TO BE OPENED FOR INPUT/OUTPUT LA R7,2(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(OUT) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(UPD) * DO THE REST OF THE REQUIRED RPL MODS AND OPEN THE DS BAL R14,MODIFY LA R2,IFGACB OPEN ((R2)) * R15 IS CHECKED BY THE CALLER FOR SUCCESS * OK, DONE HERE OPENKSDX L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * READ EXACT * *-----------------------------------------------------------* READEXCT DS 0F READ EXACT ST R4,SAVER4 BAL R14,MODIFY SR R7,R7 NO NEED TO RESTORE DEFAULT ST R7,RECOVRPL * KEYPOSITION MODCB RPL=(R2),OPTCD=(KEQ) POINT RPL=(R2) MODCB RPL=(R2),OPTCD=(KEQ) * READ BAL R14,MODIFY GET RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=FEEDBACK,LENGTH=4 L R7,FEEDBACK STH R7,$RECLEN LENGTH ACTUALLY READ * DONE L R4,SAVER4 BR R4 SPACE 2 @STARTRS SR R7,R7 TO AVOID LOOPING IF ERROR ON MODCB ST R7,RECOVRPL MODCB RPL=(R2),OPTCD=(KEQ) B READCARD <-- startrs is if an error ocurred * but we just get next sysin * card and process it SPACE 2 @WRITERS DS 0H SR R7,R7 TO AVOID LOOPING ON MODCB ERROR ST R7,RECOVRPL MODCB RPL=(R2),OPTCD=(UPD) B READCARD <--- writors run on modcb error * but we just get next sysin * card and process it SPACE 2 *-----------------------------------------------------------* * UPDATE AN EXISTING RECORD * * A READ EXACT SHOULD HAVE BEEN DONE PRIOR. * * WILL UPDATE THE LAST RECORD READ !. * *-----------------------------------------------------------* UPDATE DS 0F ST R4,SAVER4 BAL R14,MODIFY LA R7,@WRITERS ADDRESS TO RESTORE DEFAULT ST R7,RECOVRPL LA R2,IFGRPL * SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ * LA R3,DBSLEN USE KNOWN RECORD LENGTH, FIX? NO WORK * MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) PUT RPL=(R2) L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * CALLED TO SET ALL THE DEFAULT ACB/RPL VALUES. SHOULD BE * * CALLED PRIOR TO EACH VSAM REQUEST. * *-----------------------------------------------------------* MODIFY DS 0F ST R14,SAVER14 SAVE RETURN ADDRESS LA R2,IFGRPL ADDRESS GENERATED BY RPL SR R3,R3 CLEAR R3 TO LOAD * LA R3,DBSLEN MAY BE CHANGED BY IO, USE BELOW LH R3,$RECLEN LENGTH OF RECORD SR R4,R4 CLEAR R4 FOR KEY ADDRESS SR R5,R5 CLEAR R5 FOR KEY LENGTH LA R4,$RRN ADDRESS RELATIVE RECORD NUM LH R4,$RKP LOAD KEY OFFSET AR R4,R10 ADD RECORD ADDRESS LH R5,$KEYLEN LOAD KEY LENGTH MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10), X ARG=(R4),KEYLEN=(R5) L R14,SAVER14 RELOAD RETURN ADDRESS BR R14 SAVER14 DS 1F SAVE LOCAL RETURN ADDRESS SPACE 2 *-----------------------------------------------------------* * ERROR DURING VSAM PROCESSING. THE EXLST BROUGHT US HERE. * *-----------------------------------------------------------* VSERROR DS 0F LA R2,IFGRPL SHOWCB RPL=(R2),FIELDS=FDBK,AREA=FEEDBACK,LENGTH=4 ICM R5,B'1111',FEEDBACK RETRIEVE FEEDBACK CODES STCM R5,B'0100',$VSRC+1 AND VSAM RETURN CODE STCM R5,B'0010',$VSFUNC+1 AND VSAM FUNCTION CODE STCM R5,B'0001',$VSREAS+1 AND VSAM REASON CODE SPACEOUT SYSPRLIN XR R5,R5 LH R5,$VSREAS Reason= bit * CL R5,=F'08' DUPLICATE KEY * BE VSERRTX1 * CL R5,=F'12' SEQUENCE CHECK * BE VSERRTX2 CL R5,=F'16' RECORD NOT FOUND BE VSERRTX3 MVC SYSPRLIN(36),ERRDUMP VSAM RC=nnn, FC=nnn, REASON CODE=nnn STM R5,R6,VSERSAV2 LH R5,$VSRC RC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+8(3),NUMBUF LH R5,$VSFUNC FC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+16(3),NUMBUF LH R5,$VSREAS Reason= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+33(3),NUMBUF PUT SYSPRINT,SYSPRLIN SPACEOUT SYSPRLIN B VSERROR0 *VSERRTX1 MVC SYSPRLIN(L'ERDUPKEY),ERDUPKEY * PUT SYSPRINT,SYSPRLIN * B VSERROR0 VSERRTX3 MVC SYSPRLIN(L'ERNOKEY),ERNOKEY PUT SYSPRINT,SYSPRLIN * B VSERROR0 VSERROR0 LM R5,R6,VSERSAV2 * **** IF WE WERE DOING A STARTGE OR WRITE THEN THE * RPL WAS MODIFIED AND WE NEED TO SET IT BACK L R7,RECOVRPL RECOVERY ACTION ADDRESS LTR R7,R7 BZ VSERROR1 NO ACTION NEEDED XR R4,R4 CLEAR RECOVERY ADDR TO OREVENT ANY ST R4,RECOVRPL CHANCE OF RECURSION BR R7 ELSE DO IT VSERROR1 B READCARD ERROR HANDLED, GET NEXT SYSIN CARD VSERSAV2 DS 2F SPACE 2 *-----------------------------------------------------------* * EOF ON VSAM FILE, REQUESTED RECORD NOT FOUND ?, BUT NO * * ERROR MESSAGE AS THIS MAY JUST BE EOF FROM A LIST/ALL * *-----------------------------------------------------------* VSEOF DS 0F B READCARD AND GET NEXT SYSIN CARD EJECT *-----------------------------------------------------------* * CHECK THE VOLSER THAT IS BEING USED TO ENSURE IT IS SIX * * BYTES WITH NO SPACES. * *-----------------------------------------------------------* CHKVOLSR DS 0F STM R4,R5,CHKSAVE2 LA R4,$IOAREA L R5,ZERO COUNTER ZERO CHKVOLS0 CLI 0(R4),C' ' IS BYTE N A SPACE ? BE CHKVOLS1 YES, BAD VOLSER A R5,ONE ADD 1 TO COUNTER CL R5,FIVE NO, HAVE WE CHECKED 6 BYTES ? BE CHKVOLS2 YES, DONE A R4,ONE ADD 1 TO ADDR BEING CHECKED B CHKVOLS0 AND CHECK THE NEXT ADDR CHKVOLS1 DS 0F SPACEOUT SYSPRLIN MVC SYSPRLIN(L'ERVOLLEN),ERVOLLEN MVC SYSPRLIN(VOLSRLEN),$IOAREA PUT SYSPRINT,SYSPRLIN LM R4,R5,CHKSAVE2 B READCARD JUST GO GET NEXT CARD CHKVOLS2 LM R4,R5,CHKSAVE2 BR R4 RETURN TO CALLER, WE CONTINUE CHKSAVE2 DS 2F EJECT SUCCESSM DS 0F ST R4,SAVER4 SPACEOUT SYSPRLIN MVC SYSPRLIN(L'SUCCESS),SUCCESS PUT SYSPRINT,SYSPRLIN L R4,SAVER4 BR R4 LTORG *-----------------------------------------------------------* * THIS ACCESS CONTROL BLOCK IS USED AS A MODEL TO BUILD * * VSAM ACB'S DYNAMICALLY. * *-----------------------------------------------------------* ACBMODEL ACB DDNAME=VSAMDD,EXLST=EXL001 SPACE 1 *-----------------------------------------------------------* * THE REQUEST PARAMETER BLOCK HERE IS USED AS A MODEL TO * * BUILD REQUESTS DYNAMICALLY AS NEEDED. * *-----------------------------------------------------------* RPLMODEL RPL ACB=ACBMODEL SPACE 1 *-----------------------------------------------------------* *-----------------------------------------------------------* EXL001 EXLST LERAD=VSERROR,SYNAD=VSERROR,EODAD=VSEOF SPACE 2 LTORG *-----------------------------------------------------------* * DATA AREAS USED * *-----------------------------------------------------------* FEEDBACK DS 0F RECOVRPL DS 0F $RC DS H $VSRC DS H $VSFUNC DS H $VSREAS DS H $DDNAME DC CL8'TAPEVOLS' DDNAME USED $RECLEN DS H $RKP DS H $KEYLEN DS H $RRN EQU $RKP SPACE 2 LTORG *-----------------------------------------------------------* * THE ACTUAL ACB AND RPL USED * *-----------------------------------------------------------* IFGACB DSECT=NO $ACBLEN EQU (*-IFGACB) IFGRPL DSECT=NO $RPLLEN EQU (*-IFGRPL) SPACE 2 *-----------------------------------------------------------* * THE IO RECORD/DATA AREA, ADDRESS USING R10 * *-----------------------------------------------------------* $IOAREA DS CL150' ' RECORD IS 132 BYTES, ALLOW MORE * AT LEAST 50 MORE IF POSSIBLE SPACE 1 *===========================================================* * END OF VSAM IO CODE BLOCK * *===========================================================* SPACE 2 LTORG SAVEAREA DS 18F SAVER4 DS 1F SPACE 2 LTORG SYSPRINT DCB DDNAME=SYSPRINT,MACRF=(PM),DSORG=PS,RECFM=F, X LRECL=132,BLKSIZE=132 SYSIN DCB DDNAME=SYSIN,MACRF=(GL),DSORG=PS,EODAD=EXIT SPACE 2 LTORG CARDLINE DC CL80' ' SYSPRLIN DC CL132' ' ERVOLLEN DC CL27'vvvvvv IS AN INVALID VOLSER' ERNOKEY DC CL18'NO MATCHING RECORD' ERSYSIN DC CL21'I-O ERROR ON DD SYSIN' ERTAPVOL DC CL24'I-O ERROR ON DD TAPEVOLS' ERRDUMP DC CL36'VSAM RC=nnn, FC=nnn, REASON CODE=nnn' SUCCESS DC CL7'SUCCESS' LTORG ZERO DC F'0' ONE DC F'1' FIVE DC F'5' NUMBUF DC D'0' SPACE 2 LTORG * THE VSAM FIELD RECORD LAYOUT VOLSRLEN EQU 6 FOR LA STATEMENTS TO CLEAR THE KEY * AND FOR MOVING INTO MESSAGES PRINT GEN DBREC PRINT NOGEN EJECT * REGISTER EQUATES R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END /* //SYSPUNCH DD SYSOUT=* //SYSGO DD DISP=(MOD,PASS,DELETE),UNIT=SYSDA, // DSN=&&OBJLIB,SPACE=(TRK,(10,2)) //LKED1 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(TAPEMEXP),DISP=SHR //SYSLIN DD DSN=&&OBJLIB,DISP=(OLD,PASS,DELETE) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //LKED2 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //SYSLIN DD * INCLUDE SYSLMOD(TAPEMEXP) ENTRY TAPEMEXP NAME TAPEMEXP(R) /* // ./ ADD NAME=TAPEMSCR //MARKASM5 JOB (0),'TAPEMSCR',CLASS=A,MSGCLASS=T, // MSGLEVEL=(1,1) //ASM EXEC PGM=IFOX00, // PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // REGION=4096K,COND=(0,NE) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC //SYSUT1 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT2 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT3 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSTERM DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSIN DD * PRINT NOGEN * ******************************************************************** * * * TAPEMSCR - TAPEMAN DAILY SCRATCH PROGRAM * * * * PURPOSE: RUN DAILY TO RETURN ANY EXPIRED TAPES TO SCRATCH STATUS * * WITHIN THE VSAM DATABASE. * * * * JCL REQUIRED... * * //STEPX EXEC PGM=TAPEMSCR * * //TAPEVOLS DD DISP=SHR,DSN=...what you called it... * * //SYSPRINT DD SYSOUT=* * * * * ******************************************************************** MACRO &NAME SPACEOUT &A * ******************************************************************** * SPACE FILL THE DATA AREA 'A' FOR THE LENGTH OF THE DATA FIELD. * * ******************************************************************** AIF ('&A' EQ '').NOPARM MVI &A,C' ' MVC &A+1(L'&A-1),&A MEXIT .NOPARM MNOTE 12,'*** DATA AREA NAME MUST BE PROVIDED ***' MEND * TAPEMSCR CSECT STM R14,R12,12(13) BALR R12,R0 USING *,R12 LA R15,SAVEAREA ST R15,8(R13) ST R13,4(R15) LR R13,R15 SPACE 2 LA R1,0 SET COUNTER TO ZERO ST R1,COUNTER OPEN (SYSPRINT,(OUTPUT)) LTR R15,R15 BZ OPEN2 WTO 'CANNOT OPEN SYSPRINT' B EXIT99 OPEN2 BAL R4,OPENKSDS LTR R15,R15 BZ OPENEDOK MVC SYSPRLIN(L'ERTAPVOL),ERTAPVOL PUT SYSPRINT,SYSPRLIN B EXIT50 EXIT, NO CLOSE ON VSAM FILE THOUGH OPENEDOK DS 0F SPACE 1 * GET DATESTAMP OF TODAY BAL R4,DATESTMP DO NOW, JUST DO IT ONCE SPACEOUT SYSPRLIN MVC SYSPRLIN(L'LOGINIT),LOGINIT MVC SYSPRLIN+17(5),DATENOW PUT SYSPRINT,SYSPRLIN SPACE 1 * SEEK TO THE START OF THE VSAM FILE * KEYPOSITION BAL R14,MODIFY MVC $IOAREA(6),SPACES6 # NULL VOLSER MODCB RPL=(R2),OPTCD=(KGE) POINT RPL=(R2) MODCB RPL=(R2),OPTCD=(KEQ) * READ SEQUENTIALLY THROUGH THE FILE AND EXPIRE ANY * RECORDS THAT HAVE AN EXPDATE LESS THAN THE * CURRENT DATE. READNEXT LA R7,DBSLEN ALWAYS TRY FOR MAX LEN STH R7,$RECLEN BAL R14,MODIFY GET RPL=(R2) CLC $IOAREA+16(5),=CL5'00000' IS IT ALREADY SCRATCH ? BE BUMPCNT YES DO NOTHING CLC $IOAREA+16(5),DATENOW IS EXP-DATE < TODAY ? BNL READNEXT NO DO NOTHING * * WAS LOW, SO NEEDS TO BE EXPIRED SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=FEEDBACK,LENGTH=4 L R7,FEEDBACK STH R7,$RECLEN LENGTH ACTUALLY READ MVC $IOAREA+7(8),=CL8' ' ERASE JOBNAME FIELD MVC $IOAREA+16(5),=CL5'00000' ZERO OUT EXPDATE FIELD MVC $IOAREA+22(44),SPACES44 SPACE OUT DESCRIPTION BAL R14,MODIFY LA R2,IFGRPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) PUT RPL=(R2) SPACEOUT SYSPRLIN MVC SYSPRLIN(L'LOGSCR),LOGSCR MVC SYSPRLIN+7(6),$IOAREA VOLSER SCRATCHED INTO MSG PUT SYSPRINT,SYSPRLIN RECORD IT BUMPCNT L R3,COUNTER A R3,=F'1' ST R3,COUNTER B READNEXT AND CONTINUE READING SPACE 2 * WE GET HERE FROM THE VSAM ERROR HANDLER OR THE VSAM FILE EOF * HANDLER. EXIT LA R2,IFGACB CLOSE THE VSAM DATASET CLOSE ((R2)) L R2,COUNTER WTO SCRATCH TAPES AVAILABLE CVD R2,COUNTERD UNPK COUNTERD(3),COUNTERD+6(2) OI COUNTERD+2,C'0' EXITDAT1 SPACEOUT SYSPRLIN MVC SYSPRLIN(27),=CL27'nnn SCRATCH TAPES AVAILABLE' MVC SYSPRLIN(3),COUNTERD MVC EXITDAT2+16(3),COUNTERD EXITDAT2 WTO 'TAP009I nnn SCRATCH TAPES AVAILABLE' EXIT50 CLOSE (SYSPRINT) CLOSE SYSPRINT SPACE 1 EXIT99 L R13,4(R13) STANDARD EXIT CODE LM R14,R12,12(R13) SLR R15,R15 BR R14 EJECT * ----------------------------------------------------------- * GET THE DATESTAMP NOW AS YYDDD FOR A LAST USED REFERENCE * DATE IN THE TAPEVOLS FILE, AND THE DATESTAMP IN 14 DAYS * TIME AS YYDDD AS AN EXPIRY DATE IN CASE WE ARE ALLOCATING * A NEW SCRATCH TAPE FOR THIS EXECUTION. * ----------------------------------------------------------- DATESTMP DS 0F STM R0,R1,DATESAVA * R0 has the time, we ignore but it is used so we save the register * R1 has the date, save the register * R2-R4 used in calculations, save those registers TIME DEC GET SYSTEM TIME AND DATE ST R1,PDAT STORE PACKED DATE UNPK TXTDAT,PDAT X'00YYDDDF' TO C'YYDDD' MVC DATENOW(5),TXTDAT LM R0,R1,DATESAVA BR R4 DATESAVA DS 2F EJECT *===========================================================* * START OF VSAM IO CODE BLOCK * *===========================================================* SPACE 1 *-----------------------------------------------------------* * OPENKSDS * * OPEN THE VSAM FILE FOR KSDS, INPUT/OUTPUT * *-----------------------------------------------------------* OPENKSDS DS 0F ST R4,SAVER4 * RESET FIELDS USED FOR STATUS INFORMATION XC $RC,$RC CLEAR RETURN CODE XC $VSRC,$VSRC CLEAR VSAM RETURN CODE XC $VSFUNC,$VSFUNC CLEAR VSAM FUNCTION CODE XC $VSREAS,$VSREAS CLEAR VSAM REASON CODE L R10,=A($IOAREA) THE IO BUFFER AREA LA R7,DBSLEN SET RECLEN VALUE, ITS AN EQU VALUE * SO LA IS OK, L GIVES ALIGNMENT ERR * STH R7,$RECLEN LA R7,VOLSRLEN SET KEYLEN VALUE (VOLSER) STH R7,$KEYLEN SR R7,R7 CLEAR AGAIN * BUILD ACCESS CONTROL BLOCK USING MODEL MVC IFGACB($ACBLEN),ACBMODEL LA R2,IFGACB MODCB ACB=(R2),DDNAME=(*,$DDNAME) * BUILD REQUEST PARAMETER LIST USING MODEL MVC IFGRPL($RPLLEN),RPLMODEL LA R2,IFGRPL MODCB RPL=(R2),ACB=(S,IFGACB) * ACCESS MODE TO BE USED, KSDS, IN R7 SR R7,R7 LA R7,18 LA R2,IFGACB MODCB ACB=(R2),MACRF=(KEY) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(KEY) * USE DYNAMIC ACCESS FOR THE VSAM FILE LA R7,6(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(SEQ,DIR) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(SEQ) * FILE TO BE OPENED FOR INPUT/OUTPUT LA R7,2(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(OUT) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(UPD) * DO THE REST OF THE REQUIRED RPL MODS AND OPEN THE DS BAL R14,MODIFY LA R2,IFGACB OPEN ((R2)) * R15 IS CHECKED BY THE CALLER FOR SUCCESS * OK, DONE HERE OPENKSDX L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * CALLED TO SET ALL THE DEFAULT ACB/RPL VALUES. SHOULD BE * * CALLED PRIOR TO EACH VSAM REQUEST. * *-----------------------------------------------------------* MODIFY DS 0F ST R14,SAVER14 SAVE RETURN ADDRESS LA R2,IFGRPL ADDRESS GENERATED BY RPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN ACTUAL LENGTH OF RECORD READ SR R4,R4 CLEAR R4 FOR KEY ADDRESS SR R5,R5 CLEAR R5 FOR KEY LENGTH LA R4,$RRN ADDRESS RELATIVE RECORD NUM LH R4,$RKP LOAD KEY OFFSET AR R4,R10 ADD RECORD ADDRESS LH R5,$KEYLEN LOAD KEY LENGTH MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10), X ARG=(R4),KEYLEN=(R5) L R14,SAVER14 RELOAD RETURN ADDRESS BR R14 SAVER14 DS 1F SAVE LOCAL RETURN ADDRESS SPACE 2 *-----------------------------------------------------------* * ERROR DURING VSAM PROCESSING. THE EXLST BROUGHT US HERE. * *-----------------------------------------------------------* VSERROR DS 0F LA R2,IFGRPL SHOWCB RPL=(R2),FIELDS=FDBK,AREA=FEEDBACK,LENGTH=4 ICM R5,B'1111',FEEDBACK RETRIEVE FEEDBACK CODES STCM R5,B'0100',$VSRC+1 AND VSAM RETURN CODE STCM R5,B'0010',$VSFUNC+1 AND VSAM FUNCTION CODE STCM R5,B'0001',$VSREAS+1 AND VSAM REASON CODE SPACEOUT SYSPRLIN MVC SYSPRLIN(36),=CL36'VSAM RC=nnn, FC=nnn, REASON CODE=nnn' STM R5,R6,VSERSAV2 LH R5,$VSRC RC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+8(3),NUMBUF LH R5,$VSFUNC FC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+16(3),NUMBUF LH R5,$VSREAS Reason= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+33(3),NUMBUF PUT SYSPRINT,SYSPRLIN B EXIT NO RECOVERY, WE JUST EXIT VSERSAV2 DS 2F SAVE WORK REGS IF ERROR TRIGGERED SPACE 2 *-----------------------------------------------------------* * EOF ON VSAM FILE, AS WE ARE DOING SEQUENTIAL READS WE ARE * * FINISHED, AND CAN JUST EXIT NOW. * *-----------------------------------------------------------* VSEOF DS 0F B EXIT END OF FILE, WE EXIT NOW EJECT LTORG *-----------------------------------------------------------* * THIS ACCESS CONTROL BLOCK IS USED AS A MODEL TO BUILD * * VSAM ACB'S DYNAMICALLY. * *-----------------------------------------------------------* ACBMODEL ACB DDNAME=VSAMDD,EXLST=EXL001 SPACE 1 *-----------------------------------------------------------* * THE REQUEST PARAMETER BLOCK HERE IS USED AS A MODEL TO * * BUILD REQUESTS DYNAMICALLY AS NEEDED. * *-----------------------------------------------------------* RPLMODEL RPL ACB=ACBMODEL SPACE 1 *-----------------------------------------------------------* *-----------------------------------------------------------* EXL001 EXLST LERAD=VSERROR,SYNAD=VSERROR,EODAD=VSEOF SPACE 2 LTORG *-----------------------------------------------------------* * DATA AREAS USED * *-----------------------------------------------------------* COUNTERD DS D WORK AREA FOR CVD/UNPK OF COUNTER COUNTER DS 1F COUNT SCRATCH TAPES LEFT FEEDBACK DS 0F $RC DS H $VSRC DS H $VSFUNC DS H $VSREAS DS H $DDNAME DC CL8'TAPEVOLS' DDNAME USED $RECLEN DS H $RKP DS H $KEYLEN DS H $RRN EQU $RKP SPACE 2 LTORG *-----------------------------------------------------------* * THE ACTUAL ACB AND RPL USED * *-----------------------------------------------------------* IFGACB DSECT=NO $ACBLEN EQU (*-IFGACB) IFGRPL DSECT=NO $RPLLEN EQU (*-IFGRPL) SPACE 2 *-----------------------------------------------------------* * THE IO RECORD/DATA AREA, ADDRESS USING R10 * *-----------------------------------------------------------* $IOAREA DS CL200' ' RECORD IS 132 BYTES, ALLOW MORE SPACE 1 *===========================================================* * END OF VSAM IO CODE BLOCK * *===========================================================* SPACE 2 LTORG SAVEAREA DS 18F SAVER4 DS 1F SPACE 2 LTORG SYSPRINT DCB DDNAME=SYSPRINT,MACRF=(PM),DSORG=PS,RECFM=F, X LRECL=132,BLKSIZE=132 SPACE 2 LTORG SYSPRLIN DS CL132 LOGINIT DC CL22'PROCESSING DATE: xxxxx' LOGSCR DC CL33'VOLSER vvvvvv RETURNED TO SCRATCH' ERTAPVOL DC CL24'I-O ERROR ON DD TAPEVOLS' SPACES6 DC CL6' ' SPACES44 DC CL44' ' NUMBUF DC D'0' SPACE 2 LTORG * THE VSAM FIELD RECORD LAYOUT VOLSRLEN EQU 6 FOR LA STATEMENTS TO CLEAR THE KEY * AND FOR MOVING INTO MESSAGES * NOTE: WHILE THE RECORD LAYOUT IS NOT ACTUALLY * REFERENCED ANYWHERE IN THE CODE THE DBSLEN * IS NEEDED SO I HAVE LEFT IT IN. PRINT GEN DBREC PRINT NOGEN SPACE 2 * ----------------------------------------------------------- * USED BY THE DATE OBTAIN CODE * ----------------------------------------------------------- TXTDAT DS CL5 - - - added DS 0D ALIGNMENT PDAT DC PL4'0' PACKED DATE FORMAT 00YYDDDF DATENOW DS CL5 YYDDD EJECT * REGISTER EQUATES R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END /* //SYSPUNCH DD SYSOUT=* //SYSGO DD DISP=(MOD,PASS,DELETE),UNIT=SYSDA, // DSN=&&OBJLIB,SPACE=(TRK,(10,2)) //LKED1 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(TAPEMSCR),DISP=SHR //SYSLIN DD DSN=&&OBJLIB,DISP=(OLD,PASS,DELETE) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //LKED2 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //SYSLIN DD * INCLUDE SYSLMOD(TAPEMSCR) ENTRY TAPEMSCR NAME TAPEMSCR(R) /* // ./ ADD NAME=TAPEMUTL //MARKASM6 JOB (0),'TAPEMUTL',CLASS=A,MSGCLASS=T, // MSGLEVEL=(1,1) //ASM EXEC PGM=IFOX00, // PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)', // REGION=4096K,COND=(0,NE) //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=SYS1.AMODGEN // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC //SYSUT1 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT2 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSUT3 DD SPACE=(CYL,(25,5)),UNIT=3350 //SYSTERM DD SYSOUT=* //SYSPRINT DD SYSOUT=* //SYSIN DD * PRINT NOGEN * ******************************************************************** * * * TAPEMUTL - TAPEMAN UTILITY * * * * PURPOSE: PROVIDE A BATCH INTERFACE TO MANAGE ENTRIES IN THE VSAM * * TAPE CATALOGUE FILE USED BY THE TAPEMAN PROGRAM. * * RECORD LAYOUT IS FIXED AS PER THE TAPEMAN PROGRAM. REFER * * TO THE TAPEMAN PROGRAM FOR DETAILS. * * * * JCL REQUIRED... * * //STEPX EXEC PGM=TAPEMUTL * * //TAPEVOLS DD DISP=SHR,DSN=...what you called it... * * //SYSPRINT DD SYSOUT=* * * //SYSIN DD * * * control cards, see below * * /* * * * * SYSIN DATA CARDS ALLOWED...all start in column 1 * * DELETE vvvvvv - delete an existing volser * * INSERT vvvvvv - add a new volser * * LIST ALL - list all database entries * * LIST vvvvvv - list status of one volser * * LIST SCRATCH - list all available scratch tapes * * SCRATCH vvvvvv - mark entry as available for use * * * * CREDITS * * All the VSAM code here has been extracted/butchered from the * * cobol vsam interface library provided to the hercules community * * by Jay Moseley. I just needed to get native use rather than * * calling it from cobol. * * * * CHANGE HISTORY * * 2006/07/13 - Changed so SYSIN cards do NOT have a leading space, * * as the CLIST code can't use a leading space. * * 2008/05/27 - Increased database record size to include a 44 byte * * field I can use as a description field, added a 66 * * byte reserved field, recsize now 132 bytes. * * 2008/06/06 - Fixed bug where sequential and random IO could not * * be mixed; list/insert/scratch/delete etc can be * * mixed in one sysin card stream now. * * ---WARNING--- DBSLEN is now 132 bytes (the SYSPRINT DD size). * * If the record needs to be enlarges again the LIST * * processing sections will need to be changed. * * * * ******************************************************************** MACRO &NAME SPACEOUT &A,&B * ******************************************************************** * SPACE FILL THE DATA AREA 'A' FOR THE LENGTH OF THE DATA FIELD. * * OR THE OPTIONAL LENGTH PROVIDED IN PARM B * * SPACEOUT FIELDNAME OR SPACEOUT FIELDNAME,LEN * * ******************************************************************** AIF ('&A' EQ '').NOPARM AIF ('&B' NE '').HAVLEN MVI &A,C' ' MVC &A+1(L'&A-1),&A MEXIT .HAVLEN MVI &A,C' ' MVC &A+1(&B-1),&A MEXIT .NOPARM MNOTE 12,'*** DATA AREA NAME MUST BE PROVIDED ***' MEND * TAPEMUTL CSECT STM R14,R12,12(13) BALR R12,R0 * USING TAPEMUTL,R12,R8 NEED TWO ADDR REGISTERS USING *,R12 LA R15,SAVEAREA ST R15,8(R13) ST R13,4(R15) LR R13,R15 SPACE 2 OPEN (SYSPRINT,(OUTPUT)) LTR R15,R15 BZ OPEN2 WTO 'CANNOT OPEN SYSPRINT' B EXIT99 OPEN2 OPEN (SYSIN,(INPUT)) LTR R15,R15 BZ OPEN3 MVC SYSPRLIN(L'ERSYSIN),ERSYSIN PUT SYSPRINT,SYSPRLIN B EXIT 51 OPEN3 BAL R4,OPENKSDS LTR R15,R15 BZ OPENEDOK MVC SYSPRLIN(L'ERTAPVOL),ERTAPVOL PUT SYSPRINT,SYSPRLIN B EXIT50 OPENEDOK DS 0F SPACE 2 READCARD DS 0F SPACEOUT SYSPRLIN SPACE SEPERATE RPT OUTPUT PUT SYSPRINT,SYSPRLIN GET SYSIN READ A LINE FROM FILE MVC CARDLINE(CARDLEN),0(R1) SAVE THE LINE MVC SYSPRLIN(CARDLEN),CARDLINE AND SYSPRINT IT PUT SYSPRINT,SYSPRLIN MVI SYSPRLIN,C' ' MVC SYSPRLIN+1(L'SYSPRLIN-1),SYSPRLIN * WHAT WERE WE ASKED TO DO CLC CARDLINE(5),ISLIST 'LIST xxx' BE EXECLIST CLC CARDLINE(7),ISINSERT 'INSERT xxx' BE EXECINS CLC CARDLINE(7),ISDELETE 'DELETE xxx' BE EXECDELT CLC CARDLINE(8),ISSCRTCH 'SCRATCH xxx' BE EXECSCRT SPACEOUT SYSPRLIN MVC SYSPRLIN(L'BADCARD),BADCARD PUT SYSPRINT,SYSPRLIN B READCARD ONTO THE NEXT CARD SPACE 2 EXIT LA R7,EXIT50 SET VSAM AFTER RECOVER PTR ST R7,RECOVRPL TO THE EXIT50 SO IF ERRORS ON * CLOSE WE DON'T START LOOPING LA R2,IFGACB CLOSE THE VSAM DATASET CLOSE ((R2)) EXIT50 CLOSE (SYSIN) CLOSE SYSIN EXIT51 CLOSE (SYSPRINT) CLOSE SYSPRINT SPACE 1 EXIT99 L R13,4(R13) STANDARD EXIT CODE LM R14,R12,12(R13) SLR R15,R15 BR R14 LTORG EJECT * LIST FROM THE DATABASE EXECLIST DS 0F CLC CARDLINE(8),ISLIST 'LIST ALL' BE EXECL100 CLC CARDLINE(12),ISLISTS 'LIST SCRATCH' BE EXECL200 SPACE 1 * 'LIST volser' MVC $IOAREA(VOLSRLEN),CARDLINE+5 KEY TO USE IS VOLSER * read exact for the volser BAL R4,READEXCT * show results MVC SYSPRLIN(DBSLEN),$IOAREA PUT SYSPRINT,SYSPRLIN B READCARD SPACE 1 EXECL100 DS 0F LIST ALL BAL R4,SEEKSTRT MVC SYSPRLIN(DBSLEN),$IOAREA PUT SYSPRINT,SYSPRLIN EXECL101 BAL R14,MODIFY LOOP FOR THE REST GET RPL=(R2) MVC SYSPRLIN(DBSLEN),$IOAREA PUT SYSPRINT,SYSPRLIN B EXECL101 KEEP GOING UNTIL EOF * THE VSAM EOF HANDLER JUMPS US BACK TO READING SYSIN CARDS SPACE 1 EXECL200 DS 0F LIST SCRATCH BAL R4,SEEKSTRT CLC $IOAREA+16(5),ZEROS5 # EXP-DATE FIELD BNE EXECL201 MVC SYSPRLIN(DBSLEN),$IOAREA PUT SYSPRINT,SYSPRLIN EXECL201 BAL R14,MODIFY LOOP FOR THE REST GET RPL=(R2) CLC $IOAREA+16(5),ZEROS5 BNE EXECL201 MVC SYSPRLIN(DBSLEN),$IOAREA PUT SYSPRINT,SYSPRLIN B EXECL201 KEEP GOING UNTIL EOF * THE VSAM EOF HANDLER JUMPS US BACK TO READING SYSIN CARDS SPACE 1 B READCARD SHOULD NEVER GET HERE SPACE 2 * INSERT A VOLSER EXECINS DS 0F MVC $IOAREA(DBSLEN),RECTMPL MVC $IOAREA(VOLSRLEN),CARDLINE+7 PUT VOLSER INTO IT BAL R4,CHKVOLSR CHECK VOLSER ON INSERTS BAL R4,INSERT BAL R4,SUCCESSM B READCARD SPACE 2 * DELETE A VOLSER EXECDELT DS 0F DELETE RECORD MVC $IOAREA(VOLSRLEN),CARDLINE+7 KEY TO USE IS VOLSER BAL R4,READEXCT BAL R4,DELETE BAL R4,SUCCESSM B READCARD SPACE 2 * CHANGE A VOLSER ENTRY TO A SCRATCH VOLSER EXECSCRT DS 0F VOLSER TO BE SCRATCH MVC $IOAREA(VOLSRLEN),CARDLINE+8 KEY TO USE IS VOLSER BAL R4,READEXCT MVC $IOAREA(DBSLEN),RECTMPL MVC $IOAREA(VOLSRLEN),CARDLINE+8 KEY TO USE IS VOLSER BAL R4,UPDATE BAL R4,SUCCESSM B READCARD SPACE 2 * SEEK TO THE START OF THE FILE SEEKSTRT DS 0F ST R4,SEEKRSAV MVC $IOAREA(6),SPACES6 # NULL VOLSER BAL R4,READAPRX L R4,SEEKRSAV BR R4 SEEKRSAV DS 1F LTORG EJECT *===========================================================* * START OF VSAM IO CODE BLOCK * *===========================================================* SPACE 1 *-----------------------------------------------------------* * OPENKSDS * * OPEN THE VSAM FILE FOR KSDS, INPUT/OUTPUT * *-----------------------------------------------------------* OPENKSDS DS 0F ST R4,SAVER4 * RESET FIELDS USED FOR STATUS INFORMATION XC $RC,$RC CLEAR RETURN CODE XC $VSRC,$VSRC CLEAR VSAM RETURN CODE XC $VSFUNC,$VSFUNC CLEAR VSAM FUNCTION CODE XC $VSREAS,$VSREAS CLEAR VSAM REASON CODE L R10,=A($IOAREA) THE IO BUFFER AREA SR R7,R7 CLEAR ADDR FOR STORE ST R7,RECOVRPL NO RPL FIXUPS NEEDED YET LA R7,DBSLEN SET RECLEN VALUE, ITS AN EQU VALUE * SO LA IS OK, L GIVES ALIGNMENT ERR * STH R7,$RECLEN LA R7,VOLSRLEN SET KEYLEN VALUE (VOLSER) STH R7,$KEYLEN SR R7,R7 CLEAR AGAIN * BUILD ACCESS CONTROL BLOCK USING MODEL MVC IFGACB($ACBLEN),ACBMODEL LA R2,IFGACB MODCB ACB=(R2),DDNAME=(*,$DDNAME) * BUILD REQUEST PARAMETER LIST USING MODEL MVC IFGRPL($RPLLEN),RPLMODEL LA R2,IFGRPL MODCB RPL=(R2),ACB=(S,IFGACB) * ACCESS MODE TO BE USED, KSDS, IN R7 SR R7,R7 LA R7,18 LA R2,IFGACB MODCB ACB=(R2),MACRF=(KEY) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(KEY) * USE DYNAMIC ACCESS FOR THE VSAM FILE LA R7,6(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(SEQ,DIR) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(SEQ) * FILE TO BE OPENED FOR INPUT/OUTPUT LA R7,2(,R7) LA R2,IFGACB MODCB ACB=(R2),MACRF=(OUT) LA R2,IFGRPL MODCB RPL=(R2),OPTCD=(UPD) * DO THE REST OF THE REQUIRED RPL MODS AND OPEN THE DS BAL R14,MODIFY LA R2,IFGACB OPEN ((R2)) * R15 IS CHECKED BY THE CALLER FOR SUCCESS * OK, DONE HERE OPENKSDX L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * READ EXACT * *-----------------------------------------------------------* READEXCT DS 0F READ EXACT ST R4,SAVER4 BAL R14,MODIFY SR R7,R7 NO NEED TO RESTORE DEFAULT ST R7,RECOVRPL * KEYPOSITION MODCB RPL=(R2),OPTCD=(KEQ) POINT RPL=(R2) MODCB RPL=(R2),OPTCD=(KEQ) * READ BAL R14,MODIFY GET RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=FEEDBACK,LENGTH=4 L R7,FEEDBACK STH R7,$RECLEN LENGTH ACTUALLY READ * DONE L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * READ APROXIMATE * *-----------------------------------------------------------* READAPRX DS 0F READ APROX (GTE) ST R4,SAVER4 BAL R14,MODIFY * KEYPOSITION MODCB RPL=(R2),OPTCD=(KGE) LA R7,@STARTRS ADDRESS TO RESTORE DEFAULT ST R7,RECOVRPL POINT RPL=(R2) SR R7,R7 TO AVOID LOOPING IF ERROR ON MODCB ST R7,RECOVRPL MODCB RPL=(R2),OPTCD=(KEQ) * READ BAL R14,MODIFY GET RPL=(R2) SHOWCB RPL=(R2),FIELDS=RECLEN,AREA=FEEDBACK,LENGTH=4 L R7,FEEDBACK STH R7,$RECLEN LENGTH ACTUALL READ * DONE L R4,SAVER4 BR R4 SPACE 1 @STARTRS SR R7,R7 TO AVOID LOOPING IF ERROR ON MODCB ST R7,RECOVRPL MODCB RPL=(R2),OPTCD=(KEQ) B READCARD <-- startrs is if an error ocurred * but we just get next sysin * card and process it SPACE 2 *-----------------------------------------------------------* * INSERT A NEW RECORD * *-----------------------------------------------------------* INSERT DS 0F ST R4,SAVER4 BAL R14,MODIFY SR R7,R7 NO RESET ON ERROR NEEDED MODCB RPL=(R2),OPTCD=(NUP) LA R7,@WRITERS ADDRESS TO RESTORE DEFAULT ST R7,RECOVRPL PUT RPL=(R2) SR R7,R7 TO AVOID LOOPING ON MODCB ERROR ST R7,RECOVRPL MODCB RPL=(R2),OPTCD=(UPD) L R4,SAVER4 BR R4 SPACE 1 @WRITERS DS 0H SR R7,R7 TO AVOID LOOPING ON MODCB ERROR ST R7,RECOVRPL MODCB RPL=(R2),OPTCD=(UPD) B READCARD <--- writors run on modcb error * but we just get next sysin * card and process it SPACE 2 *-----------------------------------------------------------* * UPDATE AN EXISTING RECORD * * A READ EXACT SHOULD HAVE BEEN DONE PRIOR. * * WILL UPDATE THE LAST RECORD READ !. * *-----------------------------------------------------------* UPDATE DS 0F ST R4,SAVER4 BAL R14,MODIFY LA R7,@WRITERS ADDRESS TO RESTORE DEFAULT ST R7,RECOVRPL LA R2,IFGRPL * SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ * LA R3,DBSLEN USE KNOWN RECORD LENGTH, FIX? NO WORK * MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) PUT RPL=(R2) L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * DELETE AN EXISTING RECORD * * A READ EXACT SHOULD HAVE BEEN DONE PRIOR. * * WILL DELETE THE LAST RECORD READ !. * *-----------------------------------------------------------* DELETE DS 0F ST R4,SAVER4 BAL R14,MODIFY LA R2,IFGRPL SR R3,R3 CLEAR R3 TO LOAD LH R3,$RECLEN LENGTH THAT WAS READ MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10) ERASE RPL=(R2) L R4,SAVER4 BR R4 SPACE 2 *-----------------------------------------------------------* * CALLED TO SET ALL THE DEFAULT ACB/RPL VALUES. SHOULD BE * * CALLED PRIOR TO EACH VSAM REQUEST. * *-----------------------------------------------------------* MODIFY DS 0F ST R14,SAVER14 SAVE RETURN ADDRESS LA R2,IFGRPL ADDRESS GENERATED BY RPL SR R3,R3 CLEAR R3 TO LOAD * LA R3,DBSLEN MAY BE CHANGED BY IO, USE BELOW LH R3,$RECLEN LENGTH OF RECORD SR R4,R4 CLEAR R4 FOR KEY ADDRESS SR R5,R5 CLEAR R5 FOR KEY LENGTH LA R4,$RRN ADDRESS RELATIVE RECORD NUM LH R4,$RKP LOAD KEY OFFSET AR R4,R10 ADD RECORD ADDRESS LH R5,$KEYLEN LOAD KEY LENGTH MODCB RPL=(R2),RECLEN=(R3),AREALEN=(R3),AREA=(R10), X ARG=(R4),KEYLEN=(R5) L R14,SAVER14 RELOAD RETURN ADDRESS BR R14 SAVER14 DS 1F SAVE LOCAL RETURN ADDRESS SPACE 2 *-----------------------------------------------------------* * ERROR DURING VSAM PROCESSING. THE EXLST BROUGHT US HERE. * *-----------------------------------------------------------* VSERROR DS 0F LA R2,IFGRPL SHOWCB RPL=(R2),FIELDS=FDBK,AREA=FEEDBACK,LENGTH=4 ICM R5,B'1111',FEEDBACK RETRIEVE FEEDBACK CODES STCM R5,B'0100',$VSRC+1 AND VSAM RETURN CODE STCM R5,B'0010',$VSFUNC+1 AND VSAM FUNCTION CODE STCM R5,B'0001',$VSREAS+1 AND VSAM REASON CODE SPACEOUT SYSPRLIN XR R5,R5 LH R5,$VSREAS Reason= bit CL R5,=F'08' DUPLICATE KEY BE VSERRTX1 * CL R5,=F'12' SEQUENCE CHECK * BE VSERRTX2 CL R5,=F'16' RECORD NOT FOUND BE VSERRTX3 MVC SYSPRLIN(36),ERRDUMP VSAM RC=nnn, FC=nnn, REASON CODE=nnn STM R5,R6,VSERSAV2 LH R5,$VSRC RC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+8(3),NUMBUF LH R5,$VSFUNC FC= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+16(3),NUMBUF LH R5,$VSREAS Reason= bit CVD R5,NUMBUF UNPK NUMBUF(3),NUMBUF+6 OI NUMBUF+2,C'0' MVC SYSPRLIN+33(3),NUMBUF PUT SYSPRINT,SYSPRLIN SPACEOUT SYSPRLIN B VSERROR0 VSERRTX1 MVC SYSPRLIN(L'ERDUPKEY),ERDUPKEY PUT SYSPRINT,SYSPRLIN B VSERROR0 VSERRTX3 MVC SYSPRLIN(L'ERNOKEY),ERNOKEY PUT SYSPRINT,SYSPRLIN * B VSERROR0 VSERROR0 LM R5,R6,VSERSAV2 * **** IF WE WERE DOING A STARTGE OR WRITE THEN THE * RPL WAS MODIFIED AND WE NEED TO SET IT BACK L R7,RECOVRPL RECOVERY ACTION ADDRESS LTR R7,R7 BZ VSERROR1 NO ACTION NEEDED XR R4,R4 CLEAR RECOVERY ADDR TO OREVENT ANY ST R4,RECOVRPL CHANCE OF RECURSION BR R7 ELSE DO IT VSERROR1 B READCARD ERROR HANDLED, GET NEXT SYSIN CARD VSERSAV2 DS 2F SPACE 2 *-----------------------------------------------------------* * EOF ON VSAM FILE, REQUESTED RECORD NOT FOUND ?, BUT NO * * ERROR MESSAGE AS THIS MAY JUST BE EOF FROM A LIST/ALL * *-----------------------------------------------------------* VSEOF DS 0F B READCARD AND GET NEXT SYSIN CARD EJECT *-----------------------------------------------------------* * CHECK THE VOLSER THAT IS BEING USED TO ENSURE IT IS SIX * * BYTES WITH NO SPACES. * * ONLY CALLED ON INSERTS. NOT NEEDED ELSEWHERE AS IF A CARD * * HAS AN ILLEGAL VOLSER FOR OTHER FUNCTIONS THE RECORD NOT * * FOUND ERROR IS PERFECTLY ADEQUATE. * *-----------------------------------------------------------* CHKVOLSR DS 0F STM R4,R5,CHKSAVE2 LA R4,$IOAREA L R5,ZERO COUNTER ZERO CHKVOLS0 CLI 0(R4),C' ' IS BYTE N A SPACE ? BE CHKVOLS1 YES, BAD VOLSER A R5,ONE ADD 1 TO COUNTER CL R5,FIVE NO, HAVE WE CHECKED 6 BYTES ? BE CHKVOLS2 YES, DONE A R4,ONE ADD 1 TO ADDR BEING CHECKED B CHKVOLS0 AND CHECK THE NEXT ADDR CHKVOLS1 DS 0F SPACEOUT SYSPRLIN MVC SYSPRLIN(L'ERVOLLEN),ERVOLLEN MVC SYSPRLIN(VOLSRLEN),$IOAREA PUT SYSPRINT,SYSPRLIN LM R4,R5,CHKSAVE2 B READCARD JUST GO GET NEXT CARD CHKVOLS2 LM R4,R5,CHKSAVE2 BR R4 RETURN TO CALLER, WE CONTINUE CHKSAVE2 DS 2F EJECT SUCCESSM DS 0F ST R4,SAVER4 SPACEOUT SYSPRLIN MVC SYSPRLIN(L'SUCCESS),SUCCESS PUT SYSPRINT,SYSPRLIN L R4,SAVER4 BR R4 LTORG *-----------------------------------------------------------* * THIS ACCESS CONTROL BLOCK IS USED AS A MODEL TO BUILD * * VSAM ACB'S DYNAMICALLY. * *-----------------------------------------------------------* ACBMODEL ACB DDNAME=VSAMDD,EXLST=EXL001 SPACE 1 *-----------------------------------------------------------* * THE REQUEST PARAMETER BLOCK HERE IS USED AS A MODEL TO * * BUILD REQUESTS DYNAMICALLY AS NEEDED. * *-----------------------------------------------------------* RPLMODEL RPL ACB=ACBMODEL SPACE 1 *-----------------------------------------------------------* *-----------------------------------------------------------* EXL001 EXLST LERAD=VSERROR,SYNAD=VSERROR,EODAD=VSEOF SPACE 2 LTORG *-----------------------------------------------------------* * DATA AREAS USED * *-----------------------------------------------------------* FEEDBACK DS 0F RECOVRPL DS 0F $RC DS H $VSRC DS H $VSFUNC DS H $VSREAS DS H $DDNAME DC CL8'TAPEVOLS' DDNAME USED $RECLEN DS H $RKP DS H $KEYLEN DS H $RRN EQU $RKP SPACE 2 LTORG *-----------------------------------------------------------* * THE ACTUAL ACB AND RPL USED * *-----------------------------------------------------------* IFGACB DSECT=NO $ACBLEN EQU (*-IFGACB) IFGRPL DSECT=NO $RPLLEN EQU (*-IFGRPL) SPACE 2 *-----------------------------------------------------------* * THE IO RECORD/DATA AREA, ADDRESS USING R10 * *-----------------------------------------------------------* $IOAREA DS CL150' ' RECORD IS 132 BYTES, ALLOW MORE * AT LEAST 50 MORE IF POSSIBLE SPACE 1 *===========================================================* * END OF VSAM IO CODE BLOCK * *===========================================================* SPACE 2 LTORG SAVEAREA DS 18F SAVER4 DS 1F SPACE 2 LTORG SYSPRINT DCB DDNAME=SYSPRINT,MACRF=(PM),DSORG=PS,RECFM=F, X LRECL=132,BLKSIZE=132 SYSIN DCB DDNAME=SYSIN,MACRF=(GL),DSORG=PS,EODAD=EXIT SPACE 2 LTORG CARDLEN EQU 80 CARDLINE DS CL80 SYSPRLIN DC CL132' ' ERVOLLEN DC CL27'vvvvvv IS AN INVALID VOLSER' ERDUPKEY DC CL13'RECORD EXISTS' ERNOKEY DC CL18'NO MATCHING RECORD' ERSYSIN DC CL21'I-O ERROR ON DD SYSIN' ERTAPVOL DC CL24'I-O ERROR ON DD TAPEVOLS' ERRDUMP DC CL36'VSAM RC=nnn, FC=nnn, REASON CODE=nnn' BADCARD DC CL21'INVALID CARD, IGNORED' SUCCESS DC CL7'SUCCESS' ISLIST DC CL8'LIST ALL' ISLISTS DC CL12'LIST SCRATCH' ISINSERT DC CL7'INSERT ' ISDELETE DC CL7'DELETE ' ISSCRTCH DC CL8'SCRATCH ' NULLJOB DC CL8'--------' DEFAULT NO JOBNAME ZEROS5 DC CL5'00000' DEFAULT EXP-DATE YYDDD LTORG ZERO DC F'0' ONE DC F'1' FIVE DC F'5' TEN DC F'10' SPACES6 DC CL6' ' NUMBUF DC D'0' SPACE 2 LTORG * THE VSAM FIELD RECORD LAYOUT VOLSRLEN EQU 6 FOR LA STATEMENTS TO CLEAR THE KEY * AND FOR MOVING INTO MESSAGES PRINT GEN DBREC PRINT NOGEN EJECT * REGISTER EQUATES R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END /* //SYSPUNCH DD SYSOUT=* //SYSGO DD DISP=(MOD,PASS,DELETE),UNIT=SYSDA, // DSN=&&OBJLIB,SPACE=(TRK,(10,2)) //LKED1 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(TAPEMUTL),DISP=SHR //SYSLIN DD DSN=&&OBJLIB,DISP=(OLD,PASS,DELETE) //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //LKED2 EXEC PGM=IEWL, // PARM='XREF,LIST,LET,TEST,AC=0', // REGION=1024K,COND=(0,NE) //SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(8,1)) //SYSPRINT DD SYSOUT=* //SYSLIN DD * INCLUDE SYSLMOD(TAPEMUTL) ENTRY TAPEMUTL NAME TAPEMUTL(R) /* // ./ ADD NAME=IEECVXIT ******************************************************************* * * IEECVXIT - AUTOMATION EXIT * * BASED ON THE BSPPILOT IEECVXIT * * -------------------------------------------------------- * ON TURNKEY3 SYSTEMS THE CORRECT WAY TO INSTALL THIS EXIT * IS TO * (A) - REPLACE THE MEMBER SYS1.UMODSRC(IEECVXIT) * (B) - RUN THE JOB SYS1.UMODCNTL(ZUM0003) TO SMP INSTALL IT * IF YOU MUST DO IT MANUALLY SEE NOTES AT THE END OF COMMENT BLOCK * -------------------------------------------------------- * * MARK DICKINSONS MODIFICATIONS... * 2006-2007 MISC CHANGES FOR TAPE MOUNT AUTOMATION VIA 'S xxx' * 2008 REMOVED TAPE AUTOMATION, THAT IS NOW DONE BY MMPF * 2008 MOVED A LOT OF MESSAGE HANDLING FROM HERE TO MMPF * 2008 ADDED NUKECNSL FOR WTO BUFFER SHORTAGES * 2009 Feb ADDED RULE FOR * IEF863I DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS * TO 'P MMPF' ON DATASET ENQUEUES FOR IT * 2012 Sep Generated IEECODES codes for action required * messages (then found a copy in SYS1.UMODMACS) * 2014 Dec ADDED RULE FOR * RAKF0005 INVALID ATTEMPT TO ACCESS RESOURCE * ------> RAKF000A GUEST1 ,GUEST1J ,TAPEVOL ,MARK01 * TO CANCEL ANY JOB ACCESSING A TAPE THEY ARE * NOT AUTHOURISED FOR... ONLY "TAPEVOL" * RESOURCES TRIGGER THE RULE. * NEEDED AS IF RAKF CORRECTLY REJECTS THE MOUNT * THE OS CORRECTLY ASKS FOR ANOTHER TAPE TO BE * MOUNTED INSTEAD... AND IT EXHAUSTS THE * TAPEMAN3 SCRATCH POOL. NOTE: AS THE CANCEL * ON THE RAKF000A CANCELS THE JOB BEFORE THE * RAKF000A REACHES THE CONSOLE OR JOBLOG THE FULL * MESSAGE IS DOCUMENTED ABOVE... UNFORTUNATELY * THE USER WILL NEVER SEE THE RAKF000A MESSAGE * SO ADMINS NEED TO GUESS IT IS A TAPE RESOURCE * left a commented IEF176I example of how to highlight a msg * 2017 Mar CHANGED 'P MMPF' TO * 'F BSPPILOT,SCRIPT=MMPFCYCL' TO HANDLE * CHANGED REQUIREMENTS DUE TO MMPF CHANGES * * -------------------------------------------------------- * As noted above on TURNKEY3 systems you should SMP * install this, but it you must do it manually here are * some quick howto notes. * -------------------------------------------------------- * * YOU MUST INCLUDE MACRO LIBRARY SYS1.UMODMACS IN YOUR JCL * IT PROVIDES. * MACRO YREGS * MACRO SVC34 * MACRO BSPENTER * MACRO BSPRET * MACRO BSPEND * MACRO IEECODES * ASSEMBLY OPTIONS * ASM='RENT,NODECK,OBJECT', * LKED='XREF,RENT,REUS,LIST,LET,MAP' * * MANUAL LKED STATEMENTS * INCLUDE SYSLMOD(IGC0003E) * ORDER IEAVVWTO(P),IEAVMWTO,IGC0203E,IEECVXIT(P) * ENTRY IEAVVWTO * NAME IGC0003E(R) * ******************************************************************* IEECVXIT TITLE 'WTO Exit to allow automatic operations' GBLC &PGMSP , subpool for program storage GBLC &SRBSP , subpool for SRB storage GBLC &ORESCAN , number or ORE chain scans GBLC &MAXORE , max number of OREs / Scan GBLC &WAITIME , wait time in seconds AIF ('&SYSPARM' EQ '').NOSYSP AGO .CONT01 .NOSYSP ANOP .CONT01 ANOP &WAITIME SETC '2' , Waittime before reacting &ORESCAN SETC '5' , max num of ORE chain scans &MAXORE SETC '20' , max num of ORE per scan &PGMSP SETC '250' , SQA, fixed &SRBSP SETC '245' , SQA, fixed TITLE 'User-defined DSECTS' ********************************************************************** * Table of messages with reply texts ********************************************************************** SPACE REPLNTRY DSECT REPLMSG DS CL8 , ID of msg to suppress REPLNUM DS AL4 , ID of reply text REPLNTRL EQU *-REPLNTRY , length of entry SPACE 2 ********************************************************************** * Table of messages with changes to routing codes ********************************************************************** ROUTNTRY DSECT ROUTMSG DS CL8 , ID of msg to suppress ROUTCA DS A , Address of descriptor code ROUTNTRL EQU *-ROUTNTRY , length of entry ********************************************************************** * Table of messages with changes to descriptor codes ********************************************************************** SPACE DESCNTRY DSECT DESCMSG DS CL8 , ID of msg to suppress DESCDA DS A , Address of descriptor code DESCNTRL EQU *-DESCNTRY , length of entry ********************************************************************** * Table of messages that should be suppressed ********************************************************************** SPACE SUPPNTRY DSECT SUPPMSG DS CL8 , ID of msg to suppress SUPPNTRL EQU *-SUPPNTRY , length of entry ********************************************************************** * Table of messages that have specific actions associated ********************************************************************** SPACE ACTNNTRY DSECT ACTNMSG DS CL8 , message ID to act on ACTNRTNA DS A , address of action routine ACTNNTRL EQU *-ACTNNTRY , length of entry PRINT GEN IEECVXIT BSPENTER BASE=(R12),RENT=YES,SP=&PGMSP TITLE 'Assemblers Symbols and Equates' PARMREG EQU R1 , parameter pointer CUCMCBAR EQU R2 , pointer to IEECUCM TITLE 'Initialization and setup' L CUCMCBAR,0(PARMREG) , tell assembler USING UCMEXIT,CUCMCBAR , tell assembler L R8,X'74'(R5) , get VPARMAD MVC $ECB,4(R8) , save the ECB address LR R10,R13 , common area DROP R13 , not needed any more USING WORKAREA,R10 , tell assembler TITLE 'Search Autopilot (BSPPILOT)' *********************************************************************** * This routine is supposed to work if and only if the autopilot task * * is active. We scan the ASCB chain, and if the autopilot task is not* * found then we just finish * *********************************************************************** USING PSA,0 , tell assembler L R3,CVTPTR , get address of CVT pointer USING CVT,R3 , tell assembler L R1,CVTTCBP , get address of TCB list L R1,12(R1) , get our ASCB USING ASCB,R1 , tell assembler DROP R1 , no longer needed L R3,CVTASVT , get address of ASVT DROP R3 , not needed any more USING ASVT,R3 , tell assembler LA R14,ASVTENTY-4 , point to first entry - 1 entry L R15,ASVTMAXU , number of ASIDs SCANASVT DS 0H , search for AUTOPILOT BCTR R15,R0 , decrement number of ASISs LTR R15,R15 , Last one? BZ RETURN , yes, get out, no AUTOPILOT LA R14,4(R14) , next ASVT entry USING ASVTENTY,R14 , tell assembler ICM R3,B'1111',ASVTENTY , Get address of ASCB BM SCANASVT , try next if not active USING ASCB,R3 , R3 now points to ASCB ICM R4,B'1111',ASCBJBNS , address of STC name BZ CHKJOB1 , if none, must be jobname CLC =CL8'INIT',0(R4) , is it 'INIT' BNE CHKIT1 , bif not CHKJOB1 DS 0H , check for jobname ICM R4,B'1111',ASCBJBNI , address of JOB name BZ SCANASVT , if not, go araound again CHKIT1 DS 0H , is task/job our AUTOPILOT? CLC =CL8'BSPPILOT',0(R4) , test for jobname BNE SCANASVT , if not ours, try next DROP R3,R14 , not needed any more * B PROCATBL , and continue TITLE 'Do defined action on certain messages' *********************************************************************** * Autopilot is active. We now test for any action rules defined * *********************************************************************** PROCATBL DS 0H , process the action table LA R1,ACTNTABL , point to action table USING ACTNNTRY,R1 , tell assembler LA R3,(ACTNTABE-ACTNTABL)/ACTNNTRL , R3 = Num of entries SCANATBL DS 0H , scan the action table CLC ACTNMSG,UCMMSTXT , is message in table? BE FNDATBL , yes, leave loop LA R1,ACTNNTRL(R1) , next entry address BCT R3,SCANATBL , and go around again B PROCSTBL , not found, process suppress tbl FNDATBL DS 0H , found entry in table L R15,ACTNRTNA , get address of routine BR R15 , and branch to that routine DROP R1 , not needed any more TITLE 'Action Routines' CTAPEVOL DS 0H , RAKF TAPEVOL DENY RAKF000A * NOTE: because we cancel the job the user never sees the RAKF000A * SOOOOOOO.... make it highlighted for MMPF to manage instead ??? * RAKF0005 INVALID ATTEMPT TO ACCESS RESOURCE * RAKF000A GUEST1 ,GUEST1J ,TAPEVOL ,MARK01 * We must build the command in the dsect work area in order to * remain re-entrant which is why we do not use the SVC34 macro here CLC =C'TAPEVOL',UCMMSTXT+28 ONLY C ON TAPEVOL RESOURCE BNE RETURN , Not tapevol, ignore it * , else build SVC34 string here LA R1,14 , length of cmd in 1st AL2 field STH R1,CTAPVOLM LA R1,0 , 0 in second AL2 field STH R1,CTAPVOLM+2 MVC CTAPVOLM+4(2),=C'C ' Move in jobname to cmd MVC CTAPVOLM+6(8),UCMMSTXT+19 Move in jobname to cmd LA R1,CTAPVOLM address command buffer DS 0H SR R0,R0 SVC 34 issue cancel command B RETURN STSO DS 0H , S TSO action routine SVC34 'S TSO' , just issue start command B RETURN , and finish SMFFULL DS 0H CLC =C'SYS1.MANX',UCMMSTXT+27 BE SMFFULLX SMFFULLY DS 0H SVC34 'S SMFDAILY,,,MAN=Y' B RETURN SMFFULLX DS 0H SVC34 'S SMFDAILY,,,MAN=X' B RETURN NUKECNSL DS 0H , WTO buffer shortage triggered SVC34 'S NUKECNSL' , clear console buffers B RETURN SPACE 2 TAPEVCHK DS 0H CLC =C'VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS',UCMMSTXT+12 BNE RETURN , not that dataset so ignore SVC34 'F BSPPILOT,SCRIPT=MMPFCYCL' bounce MMPF B RETURN SPACE 2 TITLE 'Process table of messages to be suppressed' PROCSTBL DS 0H , process msgs to be suppressed LA R1,SUPPTABL , point to action table USING SUPPNTRY,R1 , tell assembler LA R3,(SUPPTABE-SUPPTABL)/SUPPNTRL , R3 = Num of entries SCANSTBL DS 0H , scan the action table CLC SUPPMSG,UCMMSTXT , is message in table? BE FNDSTBL , yes, leave loop LA R1,SUPPNTRL(R1) , next entry address BCT R3,SCANSTBL , and go around again B PROCDTBL , go process descriptor codes FNDSTBL DS 0H , we found a message to suppress MVC UCMROUTC(2),SUPROUTC , ROUTCD=14 MVC UCMDESCD(2),SUPDESCD , DESC=4 B RETURN , and exit DROP R1 , not needed any more SPACE 2 TITLE 'Process table of Descriptor code changes' PROCDTBL DS 0H , process msgs list LA R1,DESCTABL , point to action table USING DESCNTRY,R1 , tell assembler LA R3,(DESCTABE-DESCTABL)/DESCNTRL , R3 = Num of entries SCANDTBL DS 0H , scan the action table CLC DESCMSG,UCMMSTXT , is message in table? BE FNDDTBL , yes, leave loop LA R1,DESCNTRL(R1) , next entry address BCT R3,SCANDTBL , and go around again B PROCRTBL , go process routing codes FNDDTBL DS 0H , we found a message to suppress L R1,DESCDA , get address of DESCD DROP R1 , not needed any more MVC UCMDESCD(2),0(R1) , insert descriptor code * B PROCRTBL , go process routing codes SPACE 2 TITLE 'Process table of Routing code changes' PROCRTBL DS 0H , process msgs list LA R1,ROUTTABL , point to routcode table USING ROUTNTRY,R1 , tell assembler LA R3,(ROUTTABE-ROUTTABL)/ROUTNTRL , R3 = Num of entries SCANRTBL DS 0H , scan the action table CLC ROUTMSG,UCMMSTXT , is message in table? BE FNDRTBL , yes, leave loop LA R1,ROUTNTRL(R1) , next entry address BCT R3,SCANRTBL , and go around again B PROCPTBL , go process rePly tables FNDRTBL DS 0H , we found a message to suppress L R1,ROUTCA , get address of Routcode bytes DROP R1 , not needed any more MVC UCMROUTC(2),0(R1) , insert descriptor code * B PROCPTBL , go process rePly table SPACE 2 TITLE 'Process msgs that need replies' PROCPTBL DS 0H , process automatic replies LA R1,REPLTABL , point to routcode table USING REPLNTRY,R1 , tell assembler LA R3,(REPLTABE-REPLTABL)/REPLNTRL , R3 = Num of entries SCANPTBL DS 0H , scan the action table CLC REPLMSG,UCMMSTXT , is message in table? BE FNDPTBL , yes, leave loop LA R1,REPLNTRL(R1) , next entry address BCT R3,SCANPTBL , and go around again B RETURN , nothing else, return FNDPTBL DS 0H , we found an entry L R1,REPLNUM , get reply identifier CLC =C'IEF238D',UCMMSTXT , special treatment for this BNE DOSRB , bif not LA R3,UCMMSTXT+19 , search for WAIT LA R4,1 , search increment LA R5,UCMMSTXT+39 , upper limit of scan SCAN238 DS 0H CLI 0(R3),C'W' , search for "WAIT" in msg BE DOSRB , we found it, give a reply BXLE R3,R4,SCAN238 , go around again B RETURN , no "WAIT", then exit DS 0F , alignment needed *********************************************************************** * return to caller after freemaining the acquired storage * *********************************************************************** RETURN EQU * BSPRET RC=0 TITLE 'Schedule R2D2' *********************************************************************** * We will schedule a subroutine to process the WTOR requests. The * * SRB will run in the address space of the BSPPILOT address space * * If this address space is not active, no WTOR processing will take * * place * *********************************************************************** SPACE DOSRB DS 0H , setup for scheduling SRB STH R1,$REASON , save reply text ID code L R1,CVTPTR , point to CVT L R1,0(R1) , get ASCB list address L R1,12(R1) , get our ASCB address MVC $ASID,36(R1) , save ASID GETMAIN R,LV=WORKAL,SP=&SRBSP fixed storage for SRB etc LR R3,R1 , R3 ---> acquired storage MVC 0(WORKAL-L'WTOAREA,R3),WORKAREA Copy out data to SQA PUSH USING , save assembler info DROP R10 , not used for the moment USING WORKAREA,R3 , use R3 for addressing instead XC SRB(SRBSIZE),SRB , set SRB low low-values MVC SRBID,=CL4'SRB ' , put in eyecatcher SPACE 2 *********************************************************************** * Check again if BSPPILOT is running. If not, we cannot reply to the * * WTOR. We do this by scanning the ASCB chain (again) for BSPPILOT * *********************************************************************** SPACE 1 L R2,CVTPTR , R2 ---> CVT USING CVT,R2 , tell aseembler L R2,CVTASVT , get ASVT USING ASVT,R2 , and tell Assembler LA R14,ASVTENTY-4 , backup one entry L R15,ASVTMAXU , get number of ASCBs NEXTASCB DS 0H , entry to loop BCTR R15,R0 , Minus 1 LTR R15,R15 , Last ASCB tested BZ RETURN , then exit LA R14,4(R14) , bump to next ASVTENTY USING ASVTENTY,R14 , tell assembler ICM R2,15,ASVTENTY , get ASCB address BM NEXTASCB , if not active, go around again USING ASCB,R2 , R2 points to an ASCB ICM R7,15,ASCBJBNS , is this started task? BZ CHKJOB , no. Check for Jobname CLC =CL8'INIT',0(R7) , is this an initiator? BNE CHKIT , bif not to test STC name CHKJOB ICM R7,15,ASCBJBNI , get address of jobname BZ NEXTASCB , if no Jobname, go araound CHKIT CLC 0(8,R7),=CL8'BSPPILOT' , Autopilot task? BNE NEXTASCB , if not, try next ASCB ST R2,SRBASCB , Place ASCB address into SRB L R1,ASCBASXB , get ASXB address L R1,ASXBFTCB-ASXB(R1) , get TCB address of BSPPILOT ST R1,SRBPTCB , and place it into SRB MVC SRBPASID,ASCBASID , put BSPPILOT ASID into SRB DROP R2 , we are done with R2 LA R1,IEECR2D2 , point to SRB routine address ST R1,SRBEP , and place address into SRB LA R1,SRBCLEAN , get address of cleanup routine ST R1,SRBRMTR , put address into SRB ST R3,SRBPARM , Work area address into SRB too SCHEDULE SRB=SRB,SCOPE=LOCAL , schedule the SRB POP USING , restore assembler info B RETURN , everything is done, exit SPACE 2 ********************************************************************** * The SRB Cleanup routine is rather simple. Just take a look * ********************************************************************** SPACE 1 SRBCLEAN BR R14 , just exit TITLE 'Constants - Literal Pool' LTORG TITLE 'Action Table' *********************************************************************** * List of specific messages and the address of routines to invoke * * if this message is issued * *********************************************************************** ACTNTABL DS 0D DC CL8'IST020I ',A(STSO) start TSO DC CL8'IEE362A ',A(SMFFULL) start SMFDAILY DC CL8'IEA405E ',A(NUKECNSL) clear all console buffers DC CL8'IEF863I ',A(TAPEVCHK) check if tapevols DC CL8'RAKF000A',A(CTAPEVOL) cancel if deny is TAPEVOL ACTNTABE EQU * TITLE 'Suppress Table' *********************************************************************** * List of messages that get suppressed (I.E, routing code 00000000) * *********************************************************************** SUPPTABL DS 0D DC CL8'$HASP000' , HASP Ok message SUPPTABE EQU * TITLE 'Messages where descriptor code should be changed' *********************************************************************** * List of messages that have their descriptor codes changes. * * The descriptor codes are generated via the IEECODES macro * * and can be found at label XXXDESCD, where XXX is the value on the * * ID keyword of the IEECODES macro * *********************************************************************** DESCTABL DS 0D DC CL8'IEA911E ',A(ROLDESCD) , dump on XXXX for asid NNNN DC CL8'IEA994E ',A(ROLDESCD) , dump on XXXX for asid NNNN DC CL8'IEA994A ',A(ROLDESCD) , all dump datsets are full DC CL8'IGF995I ',A(ROLDESCD) , I/O Restart scheduled DC CL8'IGF991E ',A(ROLDESCD) , IGF msg for mount, swap * BELOW WOULD CREATE AN ACTION MESSAGE * DC CL8'IEF176I ',A(ACTDESCD) , WTR waiting for work (MID) DESCTABE EQU * TITLE 'Messages where routecode code should be changed' *********************************************************************** * List of messages that have their routing codes changed. * * The routing codes are generated via the IEECODES macro and can be * * found at label XXXROUTC, where XXX is the value on the ID keyword * * of the IEECODES macro * *********************************************************************** ROUTTABL DS 0D DC CL8'IEA911E ',A(ROLROUTC) , dump on XXXX for asid NNNN DC CL8'IEA994E ',A(ROLROUTC) , dump on XXXX for asid NNNN DC CL8'IEA994A ',A(ROLROUTC) , all dump datsets are full DC CL8'IGF995I ',A(ROLROUTC) , I/O Restart scheduled DC CL8'IGF991E ',A(ROLROUTC) , IGF msg for mount, swap * DC CL8'IEF176I ',A(ACTROUTC) , WTR waiting for work (MID) ROUTTABE EQU * TITLE 'Message Reply Table' *********************************************************************** * List of messages and their canned reply codes * *********************************************************************** REPLWAIT EQU 0 , R XX,WAIT REPLNHLD EQU 4 , R XX,NOHOLD REPLU EQU 8 , R XX,U REPLGO EQU 12 , R XX,GO REPLPOST EQU 16 , R XX,POST REPLSIC EQU 20 , R XX,SIC REPLCANC EQU 24 , R XX,CANCEL REPLRETR EQU 28 , R XX,RETRY REPLTABL DS 0D DC CL8'IEF238D ',A(REPLWAIT) DC CL8'IEF433D ',A(REPLNHLD) DC CL8'IEF434D ',A(REPLNHLD) DC CL8'IKT010D ',A(REPLSIC) TSO SHUTDOWN DC CL8'IKT012D ',A(REPLU) TSO SHUTDOWN DC CL8'IEC804A ',A(REPLPOST) DC CL8'IFA006A ',A(REPLCANC) DC CL8'IKT003D ',A(REPLRETR) TSO ACB NOT READY REPLTABE EQU * TITLE 'Routing- and Descriptor codes definitions' IEECODES ID=ROL,ROUTCDE=2,DESC=4 IEECODES ID=SUP,ROUTCDE=14,DESC=4 * MID: 2012/10/09 ADDED TO GET EVENTUAL ACTION CODES IEECODES ID=ACT,ROUTCDE=1,DESC=2 DROP TITLE 'IEECR2D2 - SRB Routine for processing WTORs' *********************************************************************** * Actually, the SRB routine does not process the WTOR requests at * * all. What it does is to schedule an Interrupt Request Routine * * which in turn will do what we need to do, namely isue the WTOR * * reply via SVC34 * *********************************************************************** IEECR2D2 DS 0H , entry point for our Robot BALR R10,R0 , set up base address USING *,R10 , and tell assembler LR R7,R14 , save retrun address LR R2,R1 , get workarea address USING WORKAREA,R2 , and tell assembler *********************************************************************** * We want to issue SVC 34, which means that we need an IRB. To get * * the IRB via the CIRB macro, we need the local lock * *********************************************************************** GETLOCK SETLOCK OBTAIN, , ask for a lock + TYPE=LOCAL, , we want the local lock + REGS=USE, + MODE=UNCOND, , wait until we get the lock + RELATED=FREELOCK , here we will free the lock *********************************************************************** * Create an IRB and an IQE. For branch entry calls to CIRB we need * * R4 to point to the TCB * *********************************************************************** L R4,SRBPTCB , get address of TCB from SRB CIRB EP=IRBROUT, , address of IRB routine + KEY=SUPR, , run in key 0 + MODE=PP, , run in problem mode + BRANCH=YES, , use branch entry, R4->TCB + SVAREA=YES, , get a save area + STAB=(DYN), , IRB is freed at termination + RETIQE=NO, , do not return IQE to queue + WKAREA=30 , 30 doubleword workarea LR R3,R1 , R3 ---> IRB3 USING RBBASIC,R3 , tell assembler L R1,RBNEXAV , R1 ---> IQE USING IQESECT,R1 , tell assembler ST R3,IQEIRB , put IRB address into IQE ST R2,IQEPARM , put worlarea address into IQE ST R4,IQETCB , put TCB address in IQE LCR R1,R1 , complement IQE address L R12,CVTPTR , get address of CVT USING CVT,R12 , tell assembler L R14,CVT0EF00 , branch entry for SCHEDXIT BALR R14,R14 , schedule the IQE DROP R12 , CVT bas enolonger needed FREELOCK SETLOCK RELEASE, , release + TYPE=LOCAL, , the local lock + REGS=USE, + RELATED=GETLOCK , that we obtained above LR R14,R7 , restore return address BR R14 , back to dispatcher DROP , all USINGs TITLE 'IRBROUT - IRB Routine that REALLY processes the WTOR' IRBROUT SAVE (14,12) , save callers register LR R12,R15 , R12 is out new base register USING IRBROUT,R12 , tell assembler LR R10,R1 , R10 points to WORKAREA USING WORKAREA,R10 , tell assembler ST R13,WORKAREA+4 , higher SA into our SA ST R10,8(R13) , or SA into higher SA LR R13,R10 , R13 ---> our save area STIMER WAIT,BINTVL=WAITTIME , WAIT !, immediate scan is fast * and gets the reply number so * quick when the reply is issued * the prompt hasn't reached the * console yet (loop occurs on * new reply numbers as we get * reply not outstanding on the * ones we found before the OS * did so move onto the next) B SCANIT , then scan ORE chain SHRTWAIT DS 0H , Wait only for STIMER WAIT,BINTVL=WAITTIME , two seconds SCANIT DS 0H , before scanning ORE chain TITLE 'Scan the ORE chain' *--------------------------------------------------------------------* * Some WTOR is active that needs a reply. We scan the ORE chain for * * the request, determine the reply number, and issue the reply * * via SVC 34. We might have to scan the chain more than once, though* *--------------------------------------------------------------------* LA R7,&ORESCAN , load maximum number of scans FNDORE DS 0H , locate operator request element LA R2,&MAXORE , load max length of search L R1,CVTPTR , R1 ---> CVT USING CVT,R1 , tell assembler L R1,CVTCUCB , R1 ---> Table with console UCBs DROP R1 , CVT not needed any longer USING UCM,R1 , tell assembler L R1,UCMRPYQ , UCMRPYQ = address of first ORE LTR R1,R1 , is there any? BZ ENDLOOK , not yet. try again later DROP R1 , no longer needed GETORE DS 0H LA R1,0(R1) , clear high order byte USING OREF,R1 , tell assembler CLC $ASID,OREASID , is this our ASID? ID ? BNE NEXTORE , no, get next ORE ICM R6,B'0111',OREECBA , get user's ECB address LA R6,0(R6) , clear higher byte C R6,$ECB , is this the one we want? BE FOUND , yes, go process it NEXTORE DS 0H , otherwise L R1,ORELKP , address of next ORE DROP R1 , no longer needed LTR R1,R1 , last ORE? BZ ENDLOOK , test if we want another round BCT R2,GETORE , else try next ORE ENDLOOK DS 0H , ORE wasn't found, therefore STIMER WAIT,BINTVL=WAITTIME , wait for 2 seconds BCT R7,FNDORE , and try again B $EXIT , so many tries - but no success SPACE , just leave FOUND DS 0H , We found the RQE we needed LR R7,R1 , R7 ---> RQE SR R11,R11 , clear branch register LH R11,$REASON , get message ID code CH R11,=Y((REPLYE-REPLY)) , within bounds? BNL $EXIT , get out if code too high B REPLY(R11) , and branch to routine needed REPLY B RWAIT , 00: R XX,WAIT B RNOHOLD , 04: R XX,NOHOLD B RU , 08: R XX,U B RGO , 0C: R XX,GO B RPOST , 10: R XX,POST B RSIC , 14: R XX,SIC B RCANCEL , 18: R XX,CANCEL B RRETRY , 1c: R XX,RETRY REPLYE EQU * , end of branch table RNOHOLD EQU * MVC WTOAREA(REPLY1L),REPLY1 B ISSUE RU EQU * MVC WTOAREA(REPLY2L),REPLY2 B ISSUE RGO EQU * MVC WTOAREA(REPLY3L),REPLY3 B ISSUE RPOST EQU * MVC WTOAREA(REPLY4L),REPLY4 B ISSUE RWAIT EQU * MVC WTOAREA(REPLY5L),REPLY5 B ISSUE RSIC EQU * MVC WTOAREA(REPLY6L),REPLY6 B ISSUE SPACE RCANCEL EQU * MVC WTOAREA(REPLY7L),REPLY7 B ISSUE RRETRY EQU * MVC WTOAREA(REPLY8L),REPLY8 B ISSUE SPACE ISSUE EQU * MVC WTOAREA+6(2),4(R7) , insert reply number from ORE LA R1,WTOAREA , point to command buffer SR R0,R0 , clear R0 for SVC 34 SVC 34 , send command * B $EXIT , and exit $EXIT DS 0H , we are done LR R1,R13 , unchain workarea L R13,WORKAREA+4 , address of higher SA FREEMAIN R,A=(1),LV=WORKAL,SP=245 free SQA storage LM R14,R12,12(R13) , restore resgisters LA R15,0(0,0) , RC = 0 BR R14 , and exit TITLE 'Constants' *------------------------------------------------------------------* REPLY1 WTO 'R XX,''NOHOLD'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY1L EQU *-REPLY1 *------------------------------------------------------------------* REPLY2 WTO 'R XX,''U'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY2L EQU *-REPLY2 *------------------------------------------------------------------* REPLY3 WTO 'R XX,''GO'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY3L EQU *-REPLY3 *------------------------------------------------------------------* REPLY4 WTO 'R XX,''POST'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY4L EQU *-REPLY4 *------------------------------------------------------------------* REPLY5 WTO 'R XX,''WAIT'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY5L EQU *-REPLY5 *------------------------------------------------------------------* REPLY6 WTO 'R XX,''SIC'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY6L EQU *-REPLY6 *------------------------------------------------------------------* REPLY7 WTO 'R XX,''CANCEL'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY7L EQU *-REPLY7 *------------------------------------------------------------------* REPLY8 WTO 'R XX,''RETRY'' <<<<<< BY IEECVXIT',DESC=(5), + ROUTCDE=(1,2,11),MF=L REPLY8L EQU *-REPLY8 *------------------------------------------------------------------* WAITTIME DC A(&WAITIME*100) , Wait some time LTORG TITLE 'DSECTS USED BY IEECVXIT' WORKAREA DSECT $ECB DS A , requestor's ECB address $ASID DS H , requestor's ASID $REASON DS H , reply code * 0 = WAIT * 4 = NOHOLD * 8 = U * 12 = GO * 16 = POST * 20 = SIC * 24 = CANCEL * * CTAPVOLM is for dynamically built cancel command DS 0H CTAPVOLM DS AL2,AL2 DS CL10'C xxxxxxxx' * SCRATCH DS 0F'0',CL130 ORG SCRATCH SRB DS 0A SRBSECT EQU * SRBID DS CL4 EBCDIC ACRONYM FOR SRB SRBFLNK DS A FORWARD CHAIN FIELD SRBASCB DS A PTR TO ASCB OF ADDRESS SPACE * SRB IS TO BE DISPATCHED TO SRBFLC DS 0CL8 SRB AREA MOVED TO LOW CORE SRBCPAFF DS BL2 CPU AFFINITY MASK SRBPASID DS H PURGEDQ ASID IDENTIFIER SRBPTCB DS A PURGEDQ TCB IDENTIFIER SRBEP DS A ENTRY POINT OF ROUTINE SRBRMTR DS A ADDRESS OF RESOURCE MGR RTN SRBPARM DS A USER PARAMETER SRBSAVE DS A SAVE AREA POINTER SRBPKF DS B PROTECT KEY INDICATION SRBPRIOR DS 0B PRIORITY LEVEL INDIC SRBFLGS DS B SRB OPTION FLAGS SRBLLREQ EQU X'80' LOCAL LOCK REQUIRED SRBLLHLD EQU X'40' LOCAL LOCK HELD SRBFRREQ EQU X'20' FRR REQUESTED SRBFRRCL EQU X'10' CLEAR FRR PARM AREA SRBSUSP EQU X'08' SUSPENDED SRB ONLY ON FOR * SSRB SRBPNONQ EQU X'04' NON QUIESCABLE SRB SRBRESV3 EQU X'02' RESERVED FLAG SRBRESV4 EQU X'01' RESERVED FLAG SRBPSYS EQU X'00' SYSTEM PRIORITY LEVEL SRBHLHI DS BL1 INDICATION OF SUSPEND LOCKS * HELD AT SRB SUSPENSION DS BL1 RESERVED SRBFRRA DS A FRR ROUTINE ADDRESS SRBEND EQU * END OF SRB SRBSIZE EQU SRBEND-SRB SIZE OF SRB WTOAREA EQU SRB WORK AREA FOR WTO -MUST BE LAST ORG WORKEND EQU * WORKAL EQU WORKEND-WORKAREA PRINT OFF,NOGEN SPACE 4 IEECUCM DSECT=YES,FORMAT=NEW CVT DSECT CVT LIST=YES PRINT OFF ASCB DSECT IHAASCB ASXB DSECT IHAASXB ASVT DSECT IHAASVT IHAPSA DSECT IHAPSA IHARB DSECT IHARB SYS=AOS2 IHAORE , operator request element IHAIQE , interrupt queue element SPACE 1 PRINT ON,GEN BSPEND , of module ./ ADD NAME=IEECODES MACRO IEECODES &ROUTCDE=13,&DESC=,&ID=IEE .* ************************************************ .* A COPY I GENERATED .* YOU SHOULD PROBABLY USE THE ONE IN SYS1.UMODMACS .* ************************************************ LCLC &CD(4) LCLA &I,&N LCLB &B(32) .* .* DESCRIPTOR CODES .* &I SETA 1 .DCHK AIF (T'&DESC EQ 'O').RCHK &N SETA &DESC(&I) &I SETA &I+1 AIF (&N GE 1 AND &N LE 16).ASSIGND MNOTE 8,'&DESC(&I) IS INVALID DESCRIPTOR - IGNORED' AGO .NXTD .ASSIGND ANOP &B(&N) SETB 1 .NXTD AIF (&I LE N'&DESC).DCHK &I SETA 1 .* .* ROUTE CODES .* .RCHK AIF (T'&ROUTCDE EQ 'O').ASSIGNC &N SETA &ROUTCDE(&I) &I SETA &I+1 AIF (&N GE 1 AND &N LE 16).ASSIGNR MNOTE 8,'ROUTCDE(&I) IS INVALID ROUTE - IGNORED' AGO .NXTR .ASSIGNR ANOP &B(&N+16) SETB 1 .NXTR AIF (&I LE N'&ROUTCDE).RCHK .ASSIGNC ANOP &I SETA 1 &CD(&I) SETC '&B(1)&B(2)&B(3)&B(4)&B(5)&B(6)&B(7)&B(8)' &CD(&I+1) SETC '&B(9)&B(10)&B(11)&B(12)&B(13)&B(14)&B(15)&B(16)' &CD(&I+2) SETC '&B(17)&B(18)&B(19)&B(20)&B(21)&B(22)&B(23)&B(24)' &CD(&I+3) SETC '&B(25)&B(26)&B(27)&B(28)&B(29)&B(30)&B(31)&B(32)' &ID.DESCD DC BL2'&CD(1)&CD(2)' &ID.ROUTC DC BL2'&CD(3)&CD(4)' MEND ./ ADD NAME=MDDIAG8 //MARKDIG8 JOB (0),'ASSEMBLE MDDIAG8',CLASS=A,MSGCLASS=T //ASMLKD EXEC ASMFCL,MAC='SYS1.AMODGEN',MAC1='MVSSRC.SYM101.F01', // PARM.ASM='OBJECT,NODECK,TERM,XREF(SHORT)', // PARM.LKED='LIST,MAP,NCAL,AC=1' //ASM.SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB //ASM.SYSIN DD * PRINT NOGEN TITLE 'MDDIAG8 - ISSUE VM CP COMMAND FROM MVS3.8J' *********************************************************************** * * * MDDIAG8 - Mark Dickinson, 2015 * * Release level : MVS3.8J (OS/VS2) ... turnkey3 under hercules * * * * FUNCTION * * Use the DIAGNOSE 0008 function to issue a command to the CP, which * * in the case of MVS3.8J under hercules is to issue a command to * * hercules itself (ie: tape devinits etc). * * * * - Command to be issued is passed as a program parm, max 128 bytes * * - The caller must have access to resource FACILITY DIAG8, if that * * resource is not defined or there is no security product access is * * permitted (the security auth checks can be omitted from program * * by toggling the &USERAKF flag in the code if you really must) * * - command is passed to the CP to execute via DIAG8 and the response * * from the CP is wto'ed to the console * * * * REQUIREMENTS * * This program must be assempled with AC=1 and reside in an APF * * authorised library, as it must switch to supervisor mode to issue * * the diagnose instruction. * * Also of course the MVS system needs to be running as a guest under * * a control program such as hercules. * * * * References: GC20-1807-7 VM370 System Programmers Guide Rel 6.4-81 * * * * Enhancements you may want ToDo * * (1) Use a getmained area as a reply buffer to allow a larger * * response buffer area. I don't need that at the moment. * * (2) The manual says interrupts should be disabled during the diag * * call, I don't; doesn't seem to be an issue, yet. * * (3) The manual says there should always be a check to make sure the * * O/S is running as a guest under a CP, I don't as I will always * * be running under hercules. * * * *********************************************************************** LCLB &USERAKF &USERAKF SETB 1 1=USE SECURITY(FOR RAKF), 0=NO SECURITY CHECKS * MDDIAG8 CSECT STM R14,R12,12(13) BALR R12,R0 USING *,R12 LA R15,SAVEAREA ST R15,8(R13) ST R13,4(R15) LR R13,R15 SPACE 3 *********************************************************************** * * * TEST THAT A PARM WAS PROVIDED * * * *********************************************************************** LTR R1,R1 TEST FOR PARM BEING PROVIDED BZ ERRPARM NO PARM PROVIDED L R2,0(,R1) ADDRESS PARM AREA, PARM LEN HALFWORD SR R3,R3 CLEAR R3 LH R3,0(,R2) GET PARM LENGTH C R3,=F'128' WE ALLOW MAX LEN 128 BYTES BL TESTLEN0 IF < 128 THEN MAYBE OK L R3,=F'128' ELSE SET TO 128 TESTLEN0 C R3,=F'0' BE ERRPARM ST R3,COMMANDL SAVE PARM LENGTH LA R2,2(,R2) ADDRESS PARM DATA BYTES EX R3,EXCPYPRM SAVE PARM DATA STRING, LEN IN R3 EJECT AIF (&USERAKF EQ 0).NORAKF1 *********************************************************************** * * * CHECK RAKF AUTHORISATION TO FACILITY DIAG8 * * - if access to resource is authorised, proceed * * - if there is no security rule for the resource, proceed * * - if there is no security product installed, proceed * * - if there is a resource rule and access is denied, to not proceed * * * *********************************************************************** MVC AUTHCHK(LRACHECK),RACHECKL INIT RACHECK MACRO RACSVC RACHECK CLASS=RACLASS,ENTITY=RAOBJECT,MF=(E,AUTHCHK) SR R3,R3 SET DEFAULT RC C R15,=F'0' RC < OR = 0? 0 = PERMITTED BE DIAG8GO C R15,=F'8' EXPLICITLY NOT AUTHORIZED? BE ERRRAKF C R15,=F'4' 4 = RESOURCE NOT PROTECTED BNE CHKERR (RAKF RETURNS 0 NOT 4) WTO 'MDDIAG8:WARNING-NO SECURITY RULES ON FACILITY DIAG8' B DIAG8GO CHKERR DS 0H WTO 'MDDIAG8:INVALID RETURN CODE FROM RACHECK, ALLOWING' EJECT .NORAKF1 ANOP *********************************************************************** * * * Diag8 as usable in MVS3.8J is documented in IBM manual * * GC20-1807-7 VM370 System Programmers Guide Rel 6.4-81 * * which is available at bitsavers.org * * * * SWITCH TO SUPERVISOR MODE AND ISSUE THE COMMAND * * Rx - real address of command * * Rx+1 - real address of reponse buffer * * Ry - length of command * * Ry+1 - max length of response we accept * * on response * * Rx+1 - either 0 if OK, or the CP error code * * Ry - response will be in response buffer * * Ry+1 - actual length of response, or is response was too long * * contains number of response bytes that would not fit * * SWITCH BACK TO PROBLEM MODE WHEN DONE * * * * Note: we set the flags to X'40' to request the response be returned * * to this program (by default output would be written to the CP * * terminal, which is the hercules console). * * * *********************************************************************** DIAG8GO CNOP 0,4 * MAX WTO LEN IS 115, TRUNCATED AFTER THAT IN MVS38J * SO TRUNCATE PARM TO FIT INTO BUFFER IF WE MUST L R3,COMMANDL RETRIEVE LEN OF COMMAND C R3,=F'117' SEE IF MAX FOR WTO BL OKTOLOG IF < THEN OK LA R3,117 ELSE ONLY LOG 117 BYTES OKTOLOG EX R3,EXLOGPRM DIAGLOG WTO 'MDDIAG8: X X ' END OF WTO LINE MODESET KEY=ZERO,MODE=SUP LRA R2,COMMAND LRA OF STORAGE VADDR L R4,COMMANDL COMMAND LEN ST R4,WORKREG LAZY WAY OF SETTING BYTE1 FLAG MVI WORKREG,X'40' FLAGS X'40', WE WANT A RESPONSE L R4,WORKREG LRA R3,RESPONS LRA OF RESPONSE VADDR LA R5,RESPONSL RESPONSE BUFFER LENGTH (MAX4K) CNOP 0,8 DOUBLEWORD ALIGN DC X'83',X'24',XL2'0008' DIAGNOSE CODE 8 MODESET KEY=NZERO,MODE=PROB * * CHECK THE CP RC WAS 0 AND THERE IS DATA IN THE RESPONSE BUFFER * IF NON-ZERO OR NO DATA, JUST EXIT LTR R4,R4 RETURN CODE 0 (OK) ? BNZ EXIT04 NO, WE ARE DONE LTR R5,R5 ANY RESPONSE DATA ? BZ EXIT NO, WE ARE DONE * *********************************************************************** * * * PARSE THE DATA IN THE RESPONSE BUFFER, WRITING IT ONE LINE AT A * * TIME TO THE CONSOLE AS AN AUDIT TRAIL. * * * *********************************************************************** LA R3,RESPONS ADDRESS RESPONSE BUFFER AR R3,R5 ADD LENGTH RETURNED MVI 0(R3),X'15' ENSURE TERMINATION CHAR EXISTS * LA R3,RESPONS PARSE THE RESPONSE AREA SLR R4,R4 KEEP BYTE COUNT LA R5,WTORESP+16 OFFSET IN OUTPUT BUFFER NEXTCHAR CLI 0(R3),X'15' END OF RESPONE ? BE EXIT ALL RESPONSE DATA SHOWN CLI 0(R3),X'25' END OF LINE ? BE WTORESP MVC 0(1,R5),0(R3) MOVE CHAR TO OUTPUT C R4,=F'69' CHECK COUNTER BNL WTORESP IF MAX FLUSH OUTPUT BUFFER A R3,=F'1' INC PTR A R4,=F'1' INC COUNTER A R5,=F'1' INC PTR B NEXTCHAR GO GET NEXT CHARACTER * ALLOW 70 REPONSE BYTES PER WTO WTORESP WTO 'MDDIAG8: X ' SLR R4,R4 RESET BYTE COUNT LA R5,WTORESP+16 RESET OFFSET IN OUTPUT BUFFER A R3,=F'1' INC PTR PAST X'15' B NEXTCHAR GO GET NEXT RESPONSE CHARACTER EJECT *********************************************************************** * * * ALL DONE - EXIT * * * *********************************************************************** EXIT CNOP 0,4 L R13,SAVEAREA+4 RESTORE POINTER TO CALLER'S SAVE AREA LM R14,R12,12(R13) RESTORE REGISTERS SLR R15,R15 EXIT CODE 0 BR R14 RETURN TO SYSTEM * * ANY ERROR MESSAGES WE REQUIRE ERRPARM WTO 'MDDIAG8:INVALID OR NO PARM PROVIDED' B EXIT04 AIF (&USERAKF EQ 0).NORAKF2 ERRRAKF WTO 'MDDIAG8:YOU ARE NOT AUTHORISED FOR THIS RESOURCE' B EXIT04 .NORAKF2 ANOP ERRCP WTO 'MDDIAG8:ERROR RESPONSE FROM CP, CHECK CP CONSOLE LOG' EXIT04 L R13,SAVEAREA+4 RESTORE POINTER TO CALLER'S SAVE AREA LM R14,R12,12(R13) RESTORE REGISTERS LA R15,4 EXIT CODE 4 BR R14 RETURN TO SYSTEM SPACE 5 *********************************************************************** * * * D A T A A R E A B I T S * * * *********************************************************************** SAVEAREA DC 18F'0' MAIN PROGRAM SAVE AREA EXCPYPRM MVC COMMAND(0),0(R2) EX CMD TO SAVE PARM TO COMMAND EXLOGPRM MVC DIAGLOG+16(0),COMMAND EX CMD TO LOG COMMAND AIF (&USERAKF EQ 0).NORAKF3 * * VARIABLES USED FOR SECURITY AUTH CHECKING RACLASS DC AL1(L'RACLASSN) CLASS NAME FOR RACCHECK RACLASSN DC C'FACILITY' CLASS NAME FOR RACCHECK RACHECKL RACHECK MF=L LRACHECK EQU *-RACHECKL LENGTH OF RACHECK MACRO AUTHCHK RACHECK MF=L * NOT SURE HOW LONG A FACILITY NAME IS, 20 BYTES GIVES ENOUGH PADDING RAOBJECT DC CL20'DIAG8 ' OBJECT WITHIN CLASS TO CHECK .NORAKF3 ANOP * * VARIABLES USED FOR DIAG8 SECTION WORKREG DS F WORK AREA DS 0D COMMAND DC CL128' ' MAX CP CMDLEN IS 128 COMMANDL DS F ACTUAL LENGTH OF CMD FROM PARM RESPONS DC CL250' ' DC CL250' ' DC CL250' ' DC CL250' ' RESPONSL EQU *-RESPONS DC X'15' PARANOID, TERMINATE RESPONSE AREA EJECT * STANDARD REGISTER EQUATES HERE R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 END MDDIAG8 //ASM.SYSTERM DD SYSOUT=* //LKED.SYSLMOD DD DSN=INSTALL.TAPEMAN3.LINKLIB(MDDIAG8),DISP=SHR // ./ ENDUP QQ //DOCLIB EXEC PGM=IEBUPDTE,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.DOC //SYSUT2 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.DOC //SYSIN DD DATA,DLM=QQ ./ ADD NAME=@ABOUT ============================================================ $ABOUT.doc - TAPEMAN overview ============================================================ Provides AUTOMATION OF TAPE MOUNTS for HERCULES MVS3.8J systems. Latest version available at: http://mdickinson.dyndns.org/hercules/downloads/tapeman.php SINCE VERSION3: ONLY IF THOSE SYSTEMS HAVE MY MMPF UTILITY INSTALLED (MMPF is also available from my website, and a lot easier to implement than TAPEMAN3 itself; plus MMPF automates more that just tape messages, so try it; http://mdickinson.dyndns.org/hercules/downloads/mmpf.php) Functional Summary ------------------ Maintains a catalogue of tape volser names. These volsers are used to provide a pool of (.aws tape files only) tapes that will be automatically mounted when mount requests for either named volsers or scratch tapes are issued by the OS. Named tapes are self explainatory, if they are in the catalogue they will be mounted when called for by name, and their expiry updated by +14 days from the current date. Scratch tape mounts have an extra step, if a scratch tape (one that has expired) is found in the catalogue it is mounted and the expiry updated (it is no longer scratch). If however no scratch tapes are left the operators are WTOR'ed to provide a volser; see details for how this is handled. SEE BELOW SECTIONS... DETAILS - what it actually will do for you LIMITATIONS - what limitations are known DETAILS ========= NAMED VOLSER MOUNT REQUESTS --------------------------- When a mount for a named tape volser XXXXXX is requested, check to see if the tape volser is in the catalogue YES - issue the 'devinit CUU tapes/XXXXX.aws' command to mount it. CUU and XXXXX are taken from the mount message. --AND-- update expiry date on volser by +14 days from the current date. NO - WTO (highlighted) that the volser is not automated TAP005A MANUALLY MOUNT vvvvvv ON cuu, JOB JJJJJJJJ (I use MMPF to cancel job JJJJJJJJ when that is issued as I assume a 'guest' is requesting a tape they should not be using, guest typo). reasoning a) you could be installing new software, the tape files for that are probably somewhere other than your 'tapes' directory so trying to automount would be bad. If I deliberately want to mount a non-automated tape I would disable the MMPF cancel rule; if you do not have MMPF you will have the job sitting there waiting for a manual mount. b) if you had a typo in the jcl of your job and were asking for a volser that did not exist you would go into an endless loop of devinits for non-existent files, resulting in device switch prompts, which if answered to would repeat the cycle again.., until you cancelled the job. better that tapeman just WTOs and ignores it so you can sort it out. c) expiry by +14 days always !. cannot tell the difference between read/write requests from the mount message (and cannot wait for a K(lear) message as another job may have asked for a scratch, so for any mount we manage just +14 expiry (no probs, if a read then someone wants the files anyway, so keeping longer is good). SCRATCH TAPE MOUNT REQUESTS --------------------------- When a mount for a scratch tape is requested (where volser is PRIVAT) scan the catalogue for any available scratch tapes scratch tape found YES - issue the 'devinit CUU tapes/XXXXX.aws' command to mount it. CUU and XXXXX are taken from the mount message. NO - pain in the butt, but it happens (1) issue a WTO saying no scratch tapes are availabe. (2) issue a WTOR asking for a tape volser or 'CANCEL' (2.1) operator replies with a volser in our catalogue. We mount it and update the expiry to +14 days from today with the new jobname that used it (2.2) EXCEPTION CASE ALLOWED operator replies with a volser NOT in our catalogue. We mount it but do not track it. this is simply because as manual action is required we trust the support staff to ensure this volser exists, presumably created as a one-off response to no existing volsers being free. Notes: if between the time the WTOR is issued and the reply givin the new tape is added to the catalogue it is treated as per 2.1 when the WTOR is finally replied to and updated with an expiry of +14 days from today. LIMITATIONS AT PRESENT ====================== - tape files must be named XXXXXX.aws, volser then .aws , .het suffixes are not implemented as I don't use them - all tapes must be in the 'tapes' directory under the path you were in when you started hercules - expiry times for catalog entries hard coded in TAPEMAN program, currently set to +14 days - when a scratch tape is used expiry is set to +14 days - ...actually when any tape is used expiry is set to +14 day, as a) can't trigger on the Klear message as another job may have asked for a scratch and got the same tape by then, so it has to be allocated at the mount request time b) can't really distinguish between write.read mount requests, so have to put the new expiry on any mount request c) doesn't matter, it someone restores from a tape the tape is still needed so probably should bump expiry anyway. MAJOR LIMITATION ================ Version 3 of TAPEMAN can no longer be triggered from IEECVXIT. In order to use the latest version of TAPEMAN you require my MMPF message automation product. http://mdickinson.dyndns.org/hercules/downloads/mmpf.php ./ ADD NAME=@BUGS KNOWN BUGS ========== THERE ARE FOUR KNOWN ISSUES. ISSUE 2. IS NOT AN ISSUE WITH THE TAPEMAN TOOLKIT BUT WITH HOW THE O/S LOCKS FILES. WORKAROUND PROVIDED. ISSUE 4. IS A DESIGN LIMITATION, NOT A BUG 1. (LOW) HANDLING WHEN THE VSAM DATASET WASN'T PROPERLY CLOSED AS TAPEMAN ABSULUTELY MUST RUN TO MOUNT TAPES, WHEN IT HAS AN OPEN ERROR ON THE VSAM FILE IT JUST ASSUMES THIS IS BECAUSE A PREVIOUS JOB ABENDED AND DIDN'T CLOSE IT. IT RETRIES THE OPEN ONCE, IF SUCESSFULL ON THE RETRY CARRIES ON. THE BUG HERE IS WHEN IT CARRIES ON THERE ARE A LOT OF VSAM MESSAGES WRITTEN TO THE CONSOLE, AND WHEN TAPEMAN COMPLETES THE TAPE MOUNT AN ABEND SC03 OCCURS. HOWEVER TAPEMAN HAS COMPLETED ALL OPERATIONS AND THE FILE HAS BEEN SUCESSFULLY CLOSED. **THIS IS PROBABLY NOT A REAL ISSUE IN V3 AS MMPF GENERALLY CONTROLS THE TAPE CATALOG FILE, JUST SHUTDOWN MMPF CLEANLY. ACTION NEEDED: NONE. 2. (HIGH) WITH THE OS NOT THE PROGRAM EVEN THOUGH ALL MY BACKUP JOBS USE FILES WITH A DISP=SHR SOMETIMES THE OS LOCKS THEM SO TAPEMAN WAITS FOR ITS OWN PROGRAM LIBRARY TO BECOME FREE, EFFECTIVELY TAPEMAN CAN DEADLOCK. THIS IS NOT UNIQUE TO TAPEMAN, I HAVE BACKUP JOBS THAT DEADLOCK ON FILES LIKE SYS1.VTAMLST WHILE NET IS RUNNING, MY APF LIBRARIES WHEN MY AUTOMATION STC IS RUNNING ETC. ACTION NEEDED: THIS WILL PROBABLY TAKE YOU A WHILE, EACH SITE WILL HAVE IT'S OWN REQUIREMENTS. YOU NEED TO IDENTIFY ALL LIBRARIES LOCKED THIS WAY BY THE O/S AND REMOVE THEM FROM REGULAR BACKUP SCHEDULES. CREATE A SEPERATE JOB TO BACK THESE FILES UP WHILE AUTOMATION IS SHUTDOWN (CRITICAL) AND ANY OTHER STCS YOU RUN THAT COULD LOCK FILES SHUTDOWN U S I N G THE TAPEMCUU PROGRAM TO REQUEST AND MOUNT A SCRATCH TAPE. AUTOMATION MUST BE SHUTDOWN WHEN USING TAPEMCUU TO PREVENT AUTOMATION TRYING TO HANDLE THE MOUNT MESSAGE THAT TAPEMCUU IS GOING TO BE HANDLING. (SEE TAPEMCUU DOCUMENTATION) 3. (MEDIUM) NEW WITH VERSION 3 NOW MMPF NEEDS A DD FOR THE VSAM FILE THE UTILITY PROGRAMS CANNOT BE RUN WHILE MMPF IS RUNNING, THE EXAMPLE DD CARD FOR MMPF HAS A DISP=OLD TO ENFORCE THIS. USING A DISP=SHR WAS OK FOR MMPF BUT RUNNING THE UTILITY PROGRAMS WITH A DISP OF SHARE ALSO CREATED IO ERRORS ON THE VSAM DATABASE, NO DAMAGE IS DONE THEY JUST CANNOT ACCESS IT; MUST BE SHARING MANAGEMENT AT THE VSAM LEVEL. SO YOU MUST SHUTDOWN MMPF TO MANUALLY WORK WITH THE DATABASE FILE!. ACTION NEEEDED: JUST ENSURE YOU SHUTDOWN MMPF WHEN DOING ANY MANUAL DATABASE MAINTENANCE (ADDING, DELETING, TAPES ETC) YOU CAN WAIT FOR THE WAITING FOR DATASETS MESSAGE FROM YOU JOB AND JUST STOP/START MMPF AS NEEDED. NOTES: THIS WAS NEVER AN ISSUE IN VERSION 1 AND 2 SIMPLY BECAUSE ALL JOBS USED A DISP OF OLD THEN, AS IEECVXIT TRIGGERED A PROC ONLY ON DEMAND THE DATABASE WAS NORMALLY UNALLOCATED. *** UPDATE *** IN MY SITE I NOW USE DISP=OLD ON THE VSAM CATALOG AT ALL TIMES, IN ALL JOBS TO ENFORCE THAT... AND USE AUTOMATION TO SHUTDOWN MMPF WHEN A UTILITY PROGRAM WANTS TO ACCESS THE DATABASES (AND AUTOMATION RESTARTS MMPF WHEN DONE) THAT WORKS FOR ME, SO I WILL NOT BE FOLOWING UP THIS ISSUE. - IEECVXIT DOES A 'F BSPPILOT,SCRIPT=MMPFCYCL' IF A JOBS 'WAITING ON DATASET' MESSAGE CONTAINS THE TAPEMAN3 VSAM DATABASE, WHICH STOPS/WAITS/STARTS MMPF TO WORK AROUND THE LOCK. 4. (LOW) NOT A BUG, A LIMITATION TAPEMSCR (DAILY SCRATCH JOB) REPORTS ON THE NUMBER OF FREE SCRATCH TAPES AVAILABLE, AS CODED IT IS LIMITED TO REPORTING UP TO 999 TAPES (THREE DIGITS). I WILL NEVER HAVE THAT MANY SO DO NOT INTEND TO DO ANYTHING ABOUT THAT UNLESS THERE IS A USER REQUEST FOR IT. ./ ADD NAME=@FILES These are all the files provided with the TAPEMAN distribution, and a desription of what each member within the files is used for as shipped. TAPEMAN.SRC This is the source code for all the program files, excluding the herccmd program for which I do not have the source. TAPEMAN - tapeman tape mounter program itself TAPEMCUU - batch mounter on CUU when automation is shutdown TAPEMDES - untested. should update the tape description TAPEMEXP - manually alter a tape expiry, for testing expiry TAPEMUTL - vsam database update utility TAPEMSCR - daily scratch program IEECVXIT - an example of my IEECVXIT with a rule to 'F BSPPILOT,SCRIPT=MMPFCYCL' on tape catalog dsn enqueues (if you use my MMPF utility) plus a rule to cancel any job that RAKF denies a tape resource to (to prevent the OS requesting endless 'retry' tape mounts until the tapeman scratch pool is exhausted, the job needs to be cancelled) ZMD0001 - a usermod for TK4- to update IEECVXIT with the message handling needed for TAPEMAN3 (note: for TK4-, not for turnkey3) ZMD0001R - a job to backout usermod ZMD0001; it backs out to the base level so Jurgens usermods for TK4- need to be manually re-applied (doc in member) TAPEMAN.LINKLIB These are assembled modules. See the documentation for those that need to be in apf libraries and those that don't. TAPEMAN - tapeman program itself TAPEMCUU - batch mounter when automation is shutdown TAPEMDES - untested. should update the tape description TAPEMEXP - manually alter a tape expiry, for testing expiry TAPEMUTL - vsam database utility program TAPEMSCR - daily scratch program TAPEMAN.INSTALL Jobs to run to setup the environment for tapeman. The order these should be run is covered in the TAPEMAN.DOC file. $README - basically says dont run any jobs without reading the $INSTALL in the TAPEMAN.DOC file. CREATEDB - create the vsam database PROC - example proc to place into your system proclib CTAPEMAN - copy load modules to your system libraries TAPEMAN.CONTROL These are sample jobs to manage the tape database. UTLADD - sample job to add tape volers to the vsam database UTLDEL - sample job to delete tapes from the vsam database UTLSCR - sample job to change volsers back to scratch state UTLLIST - sample job with various volser list options TAPLABEL - sample batch job to label new tapes DAILYSCR - sample daily scratch job TAPEMAN.DOC This is documentation on how to install TAPEMAN, and also documentation on how to use the utility programs. $ABOUT - basic info on purpose of toolkit $BUGS - known bugs and workarounds $$INSTALL - how to install $FILES - this member MMPF - how to configure MMPF for tape automation TAPEMCUU - manual on TAPEMCUU TAPEMSCR - manual on TAPEMSCR TAPEMUTL - manual on TAPEMUTL ./ ADD NAME=@INSTALL TAPEMAN - INSTALLATION PROCEDURE ================================ Assumptions: That you have sucessfully run the JCL stream to create all the installation files, and are reading this from the installed .TAPEMAN3.DOC file. =============================================================== INSTALLATION STEPS =============================================================== This is a quick list of what needs doing. It may look complicated but should take less than 20 minutes after filling out the preparation sheet in Apendix B. All the tasks are covered in detail after this index. 0. Backup 1. Preparation - gather information you will need 2. Create a 'tapes' directory and create some .aws tape files in it. You will need to initialise them also. 3. Copy the programs to your system libraries 4. Create the VSAM 'volser' database 5. Load some tape volsers into the VSAM database 6. Ensure some tape units are online after an IPL 6.1 - update the hercules config file 6.2 - ensure they are varied online at IPL time 7. Update the hercules config file (again) 8. Automate tape mount messages using MMPF 8.1 Add the required message rules to MMPF parmlib member(s) 8.2 Update your MMPF procedure The below is required only if you do not have a vsam dataspace area already assigned at your site. Appendix A - Create a dedicated VSAM volume A.1 - create the volume A.2 - add the new device to your hercules config file A.3 - create a new catalogue and dataspace Appendix B - preparation datasheet Appendix C - installtion checklist (very short) Appendix D - user exit changes, manual for TK3 usermod for TK4- (optional unless use use RAKF) --------------------------------------------------------------- BACKUP --------------------------------------------------------------- 0. Backup This goes without saying. But it is supprising how often it is overlooked. Of course you are using a linux server, so shutdown your hercules system and tar -zcvf your entire hercules site somewhere before beginning this. Then if you have any problems you can untar it back. --------------------------------------------------------------- PREPARATION --------------------------------------------------------------- 1. Preparation - Identify all the aws tape volumes your site uses, you will need to know these in order to migrate them to a 'tapes' directory where the automation expects them to be. - Locate your VSAM dataspaces and the file aliases that can live within them (I assume you have some). The volser database is a VSAM file so needs a VSAM dataspace to be created in. If you do not have one already see... Appendix A: create a dedicated VSAM volume (3330) - Identify an APF authorised library you can use, that is in the linklist. Both the MDDIAG8 and TAPEMAN3 programs must be in APF authorised libraries that are also in the linklist. - Check you have all the expected files from the tape .TAPEMAN3.SRC source files .TAPEMAN3.CONTROL sample management jobs .TAPEMAN3.INSTALL installation jobs .TAPEMAN3.LINKLIB populated by the install JCL assemblies .TAPEMAN3.DOC documentation 2. Create the expected unix (or if you have to, dos) environment - Under the directory you start hercules from create a directory 'tapes'. ***DOS/WIN*** the TAPEMAN3 program builds the MDDIAG8 comand as tapes/.aws and as I have never tried to use this under DOS/WIN you may need to change the tapes/ to a tapes\ in the code. (dunno) - Copy all the existing tape files you have you want to be automated into that directory, or preferably create a pool of new AWS tapes in that directory using hetinit (why new ?, any old ones will be treated as scratch tapes until overwritten by a TAPEMAN3 mount so you probably don't want to lose existing backups). - For any tapes created initialise them. A sample job is provided in .TAPEMAN3.CONTROL(TAPLABEL) C R I T I C A L - all tape volsers must be VOLSER.aws, the VOLSER is the internal tape label you have labelled them with and MUST be in upper case, as the TAPEMAN3 program will attempt to locate the volume based on the volser in the MVS WTO message which is in upper case. The suffix must be .aws in lower case, thats hard coded in TAPEMAN. --------------------------------------------------------------- INSTALL THE PROGRAMS --------------------------------------------------------------- 3. Copy the program modules into your system libraries. Install job CTAPEMAN will do this. --------------------------------------------------------------- CREATE THE DATA FILES NEEDED --------------------------------------------------------------- 4. Create the VSAM 'volser' database The tape volser database is an indexed VSAM file. You need to have identified a file prefix (alias) and a volume with a VSAM dataspace file, that still has space :-). If you do not have any dataspaces created already you should refer to 'Appendix A' which walks through creating a 3330 pack that is dedicated to VSAM files (the dataspace will fill that pack). Once you have the info needed... Edit .TAPEMAN3.INSTALL(CREATEDB) with the volume and file prefix you will be using. You should also review the RECORD line in the database creation info and adjust to meet your expected needs. Then run the job. 5. Populate your VSAM 'volser' database with entries OK. You have an empty database by now, but there are no scratch tapes in it yet. Edit .TAPEMAN3.CONTROL(UTLADD). Yes, it is not in the install file. This is a job you will probably be running often so it is in the control file. You need to alter the volumes in the SYSIN data to be the volumes you have placed (or created) in the tapes directory from step 2. ONLY the volser of course, don't include the .aws *CAUTION* When the volser entries are added they are added as SCRATCH tapes available to be overwritten, so don't include your latest backup tapes in the first add job. 6. Ensure some tape units are online after an IPL 6.1 - update the hercules config file In your hercules configuration file add some (all you want to be automated) tape unit device number entries as per the below samples for devices 310 and 311. This will assign them and allow them to be varied online without getting channel errors. 0310 3420 * 0311 3420 * 6.2 - ensure they are varied online at IPL time In SYS1.PARMLIB, member COMMND00 you should vary the devices online so they are available immediately after IPL time. Just add lines like the below to the COMMND00 member. V 310,ONLINE V 311,ONLINE --------------------------------------------------------------- CUSTOMISE THE HERCULES CONFIG FILE --------------------------------------------------------------- 7. Update the hercules config file (again) Yes, I could have included that in the earlier update step of this file, but I'm trying to do this in an order that will cause no disruption if you decide to stop halfway through and continue on another day. The change this time is to ensure you have the line DIAG8CMD ENABLE present in your hercules config file. The diag8 interface is used by the MDDIAG8 program to issue the devinit command to mount your tape files, so it must be present. You should also add the below entry to your hercules config file SHCMDOPT DISABLE to stop your turnkey3 system from being able to run shell scripts via the DIAG8CMD... unless you need to be able to issue shell commands from the hercules program itself, which you shouldn't. While you need to exit/restart hercules to pick up this change don't do it just yet. You may as well do the last step first. --------------------------------------------------------------- AUTOMATE THE TAPE MOUNT MESSAGES --------------------------------------------------------------- 8. Automate the messages using MMPF 8.1 Update your MMPF procedure To use TAPEMAN from MMPF simply add the extra DD card to your MMPF procedure to enable MMPF to use the tape catalog. The filename is the name of the VSAM file you created earlier. //TAPEVOLS DD DISP=OLD, // DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS Yes, disp must be old !. shr will run in mmpf ok but then all other utilities trying to share the database will get IO errors on sharing violations. 8.2 Add the required message rules to MMPF parmlib member(s) add the five lines below to your MMPF configuration file (or a new test one if you are not ready to go live yet) and activate the new rules with F MMPF,MMPF=xx where nn is the number/characters of your MMPF member being used. The five lines to add to the MMPF control file are * THE NEXT THREE ARE TAPE MOUNT REQUESTS THAT TRIGGER AUTOMATIC MOUNTS IEC501A LNK TAPEMAN3 &WORD1 &WORD3 &WORD4 &WORD8 IEF233A LNK TAPEMAN3 &WORD1 &WORD3 &WORD4 &WORD6 IEC701D LNK TAPEMAN3 &WORD2 &WORD4 &WORD9 &WORD1 * TAP005A USED TO CANCEL JOBS THAT ASK FOR A NON-AUTOMATED TAPE TAP005A CMK CANCEL &WORD8 IMPORTANT: This is not as failsafe as using IEECVXIT as MMPF is a master console screen scraper, so if an operator (in the hercules environment that would be you) deletes a mount request message from the console before MMPF see's it it obviously won't be automated. HOWEVER MMPF is much easier to use, and does not require you playing with assembler code in IEECVXIT and filling your dump datasets :-) 8.3 Optional (BUT RECOMENDED), IEECVXIT changes Any attempt to update the tape catalog will enqueue on the file while MMPF is using it. For 'lights out' use an entry should be added to IEECVXIT to terminate mmpf... and of course it needs to be restarted again externally to ieecvxit. Refer to Appendix D which details what changes are required to IEECVXIT and options available. --------------------------------------------------------------- APPENDIX A - If needed create a VSAM volume --------------------------------------------------------------- Appendix A - Create a dedicated VSAM volume You can use this if your site does not already have existing VSAM dataspaces defined for use with VSAM datasets. These steps will create a 3330 volume named VSAM01 that has its own user catalogue and is totally dedicated as a VSAM database volume. A.1 - create the volume (unix commandline) Create a file vsam01.cfg with the contents below (starting in column 1 of the vsam01.cfg file) vsam01 3330 * sysvtoc vtoc trk 15 Run the command below to create disk file vsam01.3330 dasdload vsam01.cfg vsam01.3330 2 A.2 - add the new device to your hercules config file This is site dependant. Locate your hercules start command, which will contain the name of the config file you use. Add a line for the new device as a 3330 volume. If you are unsure what 3330 devices you have free try the MVS command 'D U,DASD,OFFLINE' and look for any 3330 devices. Edit the MVS fuile SYS1.PARMLIB, member VATLST00. Add an entry in the member for the new volume similar to the below. VSAM01,0,2,3330 ,Y PERMANENT,PRIVATE,3330,MOUNTMSG Stop (completely exit) hercules, and restart it to pick up the changed config file. A.3 - create a new catalogue and dataspace You will need to know the master catalogue password for your site for this step. You will be prompted for it twice. (unless you are running RAKF and have given yourself access to create new catalogs and datasets) Run the below batch job. It will create a 30 cylinder user catalogue named USERCAT.VSAM and an alias of VSAM that can be used for any VSAM files you wish to create. The rest of the pack will be allocated as VSAM dataspace //SYSPROGU JOB 'MID',CLASS=A,MSGLEVEL=(1,1),MSGCLASS=T //* //* 3330 - 404 CYLS, 19 TRKS PER CYLS = TOTAL 7676 TRACKS //* I USED 15 TRKS FOR VTOC - REMAINING 7661 TRACKS //* VTOC SHOWS ONLY 7660 AVAILABLE //* USE REMAINING 7660 TRACKS FOR VSAM DATASPACE //* USE DATA/INDEX TO MAKE CATALOG SPACE 30 TRACKS... //* ...THE REST OF THE SPACE IS AVAILABLE FOR VSAM FILES //* //CREATCAT EXEC PGM=IDCAMS,REGION=4096K //SYSPRINT DD SYSOUT=* //* THIS VOLUME WILL ALSO HOUSE THE VSAM CATALOGUE //* SO CREATE THAT FIRST. //VSAM01 DD UNIT=3330,VOL=SER=VSAM01,DISP=OLD //AMSDUMP DD DUMMY //SYSIN DD * DEFINE USERCATALOG ( - NAME (USERCAT.VSAM) - VOLUME (VSAM01) - TRACKS (7660 0) - FOR (9999) ) - DATA (TRACKS (15 5)) - INDEX (TRACKS (15)) /* //* THE ADD THE FILE PREFIX THAT WILL BE RECORDED IN THIS //* CATALOGUE. //ALIAS1 EXEC PGM=IDCAMS,REGION=4096K,COND=(0,NE) //SYSPRINT DD SYSOUT=* //VSAM01 DD UNIT=3330,VOL=SER=VSAM01,DISP=OLD //AMSDUMP DD DUMMY //SYSIN DD * DEFINE ALIAS ( NAME(VSAM) RELATE(USERCAT.VSAM) ) /* // --------------------------------------------------------------- APPENDIX B - PREPARATION DATASHEET --------------------------------------------------------------- Appendix B - preparation datasheet +-------------------------------------------------------------+ ** TAPE VOLUMES TO INITIALLY USE IN THE tapes/ DIRECTORY | +-------------------------------------------------------------+ | | | | | | | | | | | | | | | | +-------------------------------------------------------------+ ** VSAM DATAFILE INFORMATION | +-------------------------------------------------------------+ | Volume with VSAM dataspace area : | | VSAM catalogue Name : | | VSAM file prefix : | | VSAM file name for datafile : | | | +-------------------------------------------------------------+ ** LOAD MODULE LIBRARY LOCATIONS | +-------------------------------------------------------------+ | APF Authorised library to use : | | Non APF Authorised library : | | | +-------------------------------------------------------------+ ** MMPF MEMBER TO USE +-------------------------------------------------------------+ | Check MMPF is installed : | | MMPF Member name to use : | | MMPF Proc to customise known : | | | | MMPF is available at | | http://mdickinson.dyndns.org/hercules/downloads/mmpf.php | | | +-------------------------------------------------------------+ --------------------------------------------------------------- APPENDIX C - INSTALLATION CHECKLIST --------------------------------------------------------------- Appendix C - installation checksheet +-------------------------------------------------------------+ | | | [ ] Restored files | | [ ] Read $ABOUT | | [ ] Read $INSTALL (this file) | | [ ] Installed MDDIAG8 to an APF authorised library | | [ ] Copied TAPEMAN to an APF authorised library | | [ ] Copied UTILITY programs (or STEPLIBed jobs) | | [ ] Created the VSAM datafile | | [ ] Loaded tape volsers into the VSAM datafile | | [ ] Created and initalised all the tape volumes | | [ ] Copied the procedure to one of the JES2 proclibs | | as a member named TAPEMAN | | [ ] Customised the MMPF proc to include the TAPEMAN VSAM | | database DD card | | [ ] Added the new MMPF rules, and activated them | | | +-------------------------------------------------------------+ --------------------------------------------------------------- Appendix D - user exit changes, manual for TK3 usermod for TK4- --------------------------------------------------------------- These are the IEECVXIT changes required to use TAPEMAN3 under MMPF (which is the only supported way of running it). The first requirement is that with MMPF holding the tape catalog dataset any batch jobs will enqueue on the dataset, so mmpf must be automatically stopped/started as needed to work around that. TK3 and TK4- have BSPPILOT running and I use that, to issue a 'F BSPPILOT,SCRIPT=MMPFCYCL' which stops/waits/starts mmpf. (An example MMPFCYCL member is in the .SRC dataset; if you use that it needs to be copied to SYS1.PARMLIB as bsppilot only runs scripts from there). If you have another way that works for you you should use it, this should fit in with your system not replace it :-) Another issue is that if RAKF denies a tape volume mount there is an endless loop of tape mount requests. THIS IS NOT A TAPEMAN3 ISSUE, it happens for any mount denied by RAKF and any site runing RAKF should already have code in IEECVXIT to cancel any job that trigers that condition. The hard way, manual changes ============================ If doing the changes manually for your customised IEECVXIT user exit the minimum changes you must make are * for a RAKF deny on a tape volser you must cancel the job requesting the mount or there will be an endless loop of mount requests being rejected by RAKF ... this is needed even if you do not use my tapeman3 utility as it is jolly old RAKF causing that * for an enqueue (waiting for dataset) on the tape volser catalog file you must stop MMPF, assuming you are using my MMPF utility of course (this documentation assumes you are) to release the file. A simple batch job to list tapes will cause an enqueue. Oh, and you need a way of starting it again of course, which is why I use a bsppilot script. TK3 - Manual changes required ============================= An EXAMPLE IEECVXIT member for TK3 is provided, you should merge the changes with any customisations you have already made to your own TK3 exit. And re-running SYS1.UMODSRC(ZUM0003) to apply your updates should work just fine. TK4- - Changes via SMP only =========================== The TK4- release has had usermods TMVS805 and ZJW0006 applied on top of the TK3 base ZUM0003; so you cannot just rerun the ZUM0003 usermod for TK4-. I have provided usermod ZMD0001 which merges the changes made in those usermods with the changes needed for TK4-. If you have made any customisations to the TK4- IEECVXIT yourself you will have to do a lot of work... beter in that case to review my usermod changes and merge them with yours... assuming you used a usermod, which you really should have if changing IEECVXIT under TK4-. If using my usermod FIRST CHANGE the VSAM database name used in the enqueue test :-). (search on VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS) Also provided is ZMD0001J which rolls back my usermod plus the two Jurgen applied that locked zmu0003, and also backs out zmu0003, it lists the usermods that have to be applied to get back to tk4- level. ./ ADD NAME=TAPEMCUU TAPEMCUU - a TAPEMAN Utility Program ==================================== This program should ONLY BE RUN WITH AUTOMATION SHUT DOWN. The purpose of this program is to provide a way of automating scratch tape mounts during those occasions that the automation STC needs to be shutown. There are many reasons you would shutdown automation, for example to backup libraries that are locked by automation or system tasks. Any automation of tape mounts MUST BE DISABLED before this program is run, as it interfaces with TAPEMAN to obtain and mount a scratch tape; if automation was running there would be a conflict and you would have a tape unloaded midway through use (which from experience causes device overrun errors and switched the master console to a diagnostic/recovery console instead of a system message console). The program accepts a parameter of a valid tape CUU, which is expected to be online. The program will then call TAPEMAN3 with the MOUNTSCRATCH option specifying the CUU unit required and the jobname the scratch tape is to be assigned to. The TAPEMAN3 code will delay 30 seconds before mounting the tape, this is to allow your batch job to start the step that requests the tape mount to actually issue the mount request before the tape is mounted (if the tape is mounted to early then when the jobstep specifying the unit gets started the tape will be unmounted, and a new mount request issued; which is what we are trying to avoid). SINCE TAPEMAN Version 3 TAPEMCUU links directly to the TAPEMAN3 program now it cannot be run inline in a batch job anymore, that would just delay the batch job 30 secs and unload the tape when the next step starts... ...as TAPEMCUU is a workaround for mounting a tape when automation is shutdown, and I don't really want to write workarounds to get a workaround working, I have not modified TAPEMCUU but instead modified my jobs that use it to run it outside the batch job that needs it as below... Note: the TAPEMCUU parm is used to select device 487, in STEP2 the UNIT=487 is used to select the specific unit. Do not use unit=tape. Unit 487 MUST be online. Example Job using TAPEMCUU ========================== //DEMOJOB JOB (0),'DEMO TAPEMCUU',CLASS=A,MSGCLASS=T //* //* WE MUST RUN TAPEMCUU OUTSIDE THE CURENT BATCH JOB //* NOW THAE WE HAVE OBSOLETED THE TAPEMAN PROC AND //* LINK TO TAPEMAN3 DIRECTLY, SO JUST MOVE THE STEP //* THAT USED TO BE HERE WITH TAPEMAN TO A SUBMITTED //* JOB FOR THE TAPEMAN3 IMPLEMENTATION. //* //STEP1 EXEC PGM=IEBGENER //SYSIN DD DUMMY //SYSPRINT DD SYSOUT=* //SYSUT2 DD SYSOUT=(A,INTRDR) //SYSUT1 DD DATA,DLM=ZZ //TAPEMCUU JOB (0),'SPAWN TAPEMCUU',CLASS=A,MSGCLASS=T //STEPMCUU EXEC PGM=TAPEMCUU,PARM='487' //TAPEVOLS DD DISP=OLD, // DSN=VSAM.INSTALL.TAPEMAN33.VVDS.VOLSERS // ZZ //* //* RUN THE NEXT STEP IMMEDIATELY TO REQUEST THE //* TAPE MOUNT, THEN WHEN THE TAPEMCUU 30SEC TIMER //* EXPIRES AND MOUNTS THE TAPE WE WILL USE IT //* //STEP2 EXEC PGM=IEBCOPY //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=SYSPROG.LIB.USERCAT.JCL //SYSUT2 DD DISP=(NEW,KEEP),UNIT=487,LABEL=(1,SL), // DSN=SYSPROG.LIB.USERCAT.JCL, // DCB=*.SYSUT1 //SYSIN DD * COPY INDD=SYSUT1,OUTDD=SYSUT2 /* // ./ ADD NAME=TAPEMDES TAPEMDES - a TAPEMAN Utility Program ==================================== The TAPEMDES program is used to change the description field for a tape volume in the catalog. THIS IS STILL BEING TESTED. I intend to use it to insert the disk file name of the backup listing associated with a backup job into the catalog entry. But I havn't got around to doing this in any of my jobs yet. JCL sample to be provided when I have tested and finalised this utilty program. ./ ADD NAME=TAPEMEXP TAPEMEXP - a TAPEMAN Utility Program ==================================== The TAPEMEXP program is used to change the expiry date field of a volser in the catalog. This is primarily used by me for testing the expiry handling of tapes and should probably not be used in the real world. As it is a simple test program it does no verification on the date field passed. --------------------------------------------------------------------- sample jobdeck for running this. --------------------------------------------------------------------- //MARKTUTL JOB (0),'TAPE MAINT',CLASS=A,MSGCLASS=T //TAPEMUTL EXEC PGM=TAPEMUTL //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * TAPE01 07099 TAPE02 08360 /* // --------------------------------------------------------------------- SYSIN CARD FORMAT vvvvvv yyddd i) replace vvvvvv with an uppercase tape volser. ii) replace yyddd with a valid julian date for the new expiry iii) each card starts in column 1 See the example above. --------------------------------------------------------------------- ./ ADD NAME=TAPEMSCR TAPEMSCR - a TAPEMAN Utility Program ==================================== The TAPEMSCR program should be run daily to check the VSAM database used by TAPEMAN for any expired volume entries. It's only purpose in life is to scan for any volsers that have an expiry date prior to the current days date, and change them to scratch tape entries. If you do not run this regularly you will eventually run out of scratch tapes. In the file .TAPEMAN.CONTROL, where is the prefix you use to restore these files down, the member DAILYSCR has a sample jobdeck for running this. The contents of that member are below //MARKDSCR JOB (0),'DAILY TAPE SCRATCH',CLASS=A,MSGCLASS=T //* //* SHOULD BE RUN DAILY TO EXPIRE TAPED IN THE SCRATCH POOL //* THAT HAVE PASSED THEIR EXPIRY DATES. //* //DAILYSCR EXEC PGM=TAPEMSCR //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS VSAM FILE //SYSPRINT DD SYSOUT=* // If you have assembled/copied the programs into a program library in your systems linklist the steplib is not required. The INSTALL prefix on the TAPEVOLS DD will need to be updated to relect where you created your tape volume database. There is no SYSIN or equivalent DD card required, the program requires no parameters. NOTES: I have this in my COMMND00 member as well as triggered daily by ZTIMER (ZTIMER is from the CBTTAPE site) ./ ADD NAME=TAPEMUTL TAPEMUTL - a TAPEMAN Utility Program ==================================== The TAPEMUTL program is used to ADD, DELETE and LIST tape volser entries that are stored in the VSAM datafile. In the file .TAPEMAN.CONTROL, where is the prefix you use to restore these files down, there are sample jobs UTLADD - add new tapes UTLDEL - delete tapes UTLSCR - make tapes not yet due to expire, expire now UTLLIST - list entries --------------------------------------------------------------------- sample jobdeck for running this. --------------------------------------------------------------------- //MARKTUTL JOB (0),'TAPE MAINT',CLASS=A,MSGCLASS=T //TAPEMUTL EXEC PGM=TAPEMUTL //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * INSERT TAPE01 INSERT TAPE02 LIST ALL SCRATCH TAPE01 DELETE TAPE02 /* // The VSAM prefix on the TAPEVOLS DD will need to be updated to relect where you created your tape volume database. --------------------------------------------------------------------- SYSIN CARDS PERMITTED i) replace vvvvvv with an uppercase tape volser. ii) each card starts in column 1 Terminology: a 'scratch' tape is one that is available for use by any job that asks for a scratch tape. --------------------------------------------------------------------- function INSERT vvvvvv inserts a new volser as a scratch volser DELETE vvvvvv deletes an existing volser from the file SCRATCH vvvvvv force an existing volser back to scratch LIST vvvvvv list info for one volser LIST ALL list all volsers LIST SCRATCH list all volsers in scratch state ./ ENDUP QQ //INSTLIB EXEC PGM=IEBUPDTE,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.INSTALL //SYSUT2 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.INSTALL //SYSIN DD DATA,DLM=QQ ./ ADD NAME=CREATEDB //MARKALLC JOB (0),'ALLOC DATA FILE',CLASS=A,MSGCLASS=T //* ************************************************************ //* //* $CREATDB: CREATE THE DATA FILE NEEDED BY TAPEMAN. //* //* - CHANGE VSAM01 TO ONE OF YOUR VSAM DATASPACE VOLUMES //* - CHANGE THE VSAM.INSTALL.TAPEMAN3 PREFIX TO A PREFIX YOU HAVE IN //* IN ONE OF YOUR CATALOGUES, PREFERABLY ONE USED BY THE //* USER CATALOGUE ON YOUR VSAM VOLUME IF YOU WANT IT TO WORK //* - CHANGE THE 'RECORDS' VALUES IN THE DATA AREA DEFINITION //* TO MATCH HOW MANY TAPES YOU EXPECT TO BE MANAGED. //* //* ************************************************************ //CREATEDB EXEC PGM=IDCAMS,COND=(0,NE) //SYSPRINT DD SYSOUT=* //* RECORD LAYOUT, //* A 00000 IN EXPIRES IS A SCRATCH TAPE //* THE THE EXPIRY //* VOLSER JOBNAME DATE //* //* ....+....1....+....2....+....3....+....4....+....5....+....6....+. //* VVVVVV JJJJJJJJ YYDDD DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD //* VVVVVV -------- 00000 Desctiption, up to 44 bytes for a filename //* //* Plus 66 bytes of padding, reserved for future use plus brings the //* record length up to 132 bytes, which space filled (by a DC in the //* DBREC definition) fits nicely with sysprin output. //* //SYSIN DD * DELETE (VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS) CLUSTER SCRATCH SET MAXCC = 0 DEFINE CLUSTER - (NAME(VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS) - VOLUMES(VSAM01) - RECORDS(100 50)) - DATA - (NAME(VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS.DATA) - KEYS(6 0) - RECORDSIZE(132 132) - FREESPACE(20 10) - BUFFERSPACE(2000) ) - INDEX - (NAME(VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS.INDEX) ) /* // ./ ADD NAME=CTAPEMAN //MARKCOPY JOB (0),'COPY',CLASS=A,MSGCLASS=T //* ----------------------------------------------- //* COPY THE TAPEMAN PROGRAMS THAT ARE AUTHORISED //* TO AN APF AUTHORISED LIBRARY //* TAPEMAN - AS IT MUST CALL MDDIAG8 WHICH IS //* AUTHORISED. //* TAPEMCUU - AT IT USES SVC34 TO INVOKE //* TAPEMAN //* MDDIAG8 - NEEDS TO SWITCH TO SUPERVISOR //* MODE TO ISSUE DIAGNOSE 0008 TO //* PASS COMMANDS TO THE CP. //* //* AND //* //* COPY THE TAPEMAN UTILITY PROGRAMS THAT DO NOT NEED //* TO BE APF AUTHORISED INTO A PROGRAM LIBRARY THAT IS //* IN THE DEFAULT SEARCH LINKLST. //* ----------------------------------------------- //STEP1 EXEC PGM=IEBCOPY //SYSPRINT DD SYSOUT=* //SYSUT1 DD DSN=INSTALL.TAPEMAN3.LINKLIB,DISP=SHR //AUTHLIB DD DSN=SYS9.LINKLIB.APFAUTH,DISP=SHR //USERLIB DD DSN=SYS9.LINKLIB,DISP=SHR //SYSIN DD * COPY INDD=SYSUT1,OUTDD=AUTHLIB SELECT MEMBER=TAPEMAN3 SELECT MEMBER=TAPEMCUU SELECT MEMBER=MDDIAG8 COPY INDD=SYSUT1,OUTDD=USERLIB SELECT MEMBER=TAPEMSCR SELECT MEMBER=TAPEMUTL SELECT MEMBER=TAPEMDES /* // ./ ADD NAME=@README ALL THESE JOBS ARE REFERENCED FROM THE XXX.TAPEMAN.DOC($INSTALL) MEMBER. DO NOT RUN THESE BLINDLY (IN THE ORDER THEY APPEAR). REFER TO THE $INSTALL MEMBER FOR WHEN TO RUN THEM, WHAT CHANGES ARE NEEDED, AND WHICH ONES YOU DON'T NEED TO RUN. ./ ENDUP QQ //CTRLLIB EXEC PGM=IEBUPDTE,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.CONTROL //SYSUT2 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.CONTROL //SYSIN DD DATA,DLM=QQ ./ ADD NAME=DAILYSCR //MARKDSCR JOB (0),'DAILY TAPE SCRATCH',CLASS=A,MSGCLASS=T //* //* SHOULD BE RUN DAILY TO EXPIRE TAPED IN THE SCRATCH POOL //* THAT HAVE PASSED THEIR EXPIRY DATES. //* //DAILYSCR EXEC PGM=TAPEMSCR //STEPLIB DD DISP=SHR,DSN=INSTALL.TAPEMAN3.LINKLIB //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* // ./ ADD NAME=TAPLABEL //MARKTAPE JOB (0),'LABEL TAPES',CLASS=A,MSGCLASS=T //* //* THIS IS A SAMPLE JOB SHOWING HOW TO LABEL TAPES IN A BATCH JOB. //* THE TAPE FILES MUST HAVE BEEN PREVIOUSLY CREATED WITH HETINIT //* FROM THE UNIX COMMAND LINE. //* //* THIS JOB LABELS TAPES MARK01 THROUGH MARK30, IT WILL USE THE //* SAME TAPE UNIT FOR ALL TAPE LABEL REQUESTS (THE TAPE1 DD WILL //* USE THE FIRST FREE TAPE UNIT) //* //* TO THE WTOR PROMPTS, WHEN THE TAPE IS MOUNTED REPLY M (NOT U) //* //* I HAVE AUTOMATED THE 'M' REPLY UNDER MMPF, CAN'T REMEMBER IF I //* ALSO DID THAT IN THE IEECVXIT SAMPLE. //* //INITTAPE EXEC PGM=IEHINITT //SYSPRINT DD SYSOUT=* //TAPE1 DD UNIT=(TAPE,,DEFER),DCB=DEN=3 //SYSIN DD * TAPE1 INITT SER=MARK01,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK02,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK03,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK04,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK05,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK06,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK07,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK08,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK09,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK10,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK11,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK12,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK13,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK14,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK15,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK16,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK17,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK18,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK19,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK20,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK21,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK22,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK23,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK24,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK25,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK26,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK27,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK28,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK29,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND TAPE1 INITT SER=MARK30,NUMBTAPE=1,OWNER='MVS38J/MID',DISP=REWIND /* // ./ ADD NAME=UTLADD //MARKADD JOB (0),'ADD TAPES',CLASS=A,MSGCLASS=T //* //* ADD SOME NEW SCRATCH TAPES INTO THE VSAM FILE //* //ADDTAPES EXEC PGM=TAPEMUTL //STEPLIB DD DISP=SHR,DSN=INSTALL.TAPEMAN3.LINKLIB //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * INSERT MARK01 INSERT MARK02 INSERT MARK03 INSERT MARK04 INSERT MARK05 INSERT MARK06 INSERT MARK07 INSERT MARK08 INSERT MARK09 INSERT MARK10 INSERT MARK11 INSERT MARK12 INSERT MARK13 INSERT MARK14 INSERT MARK15 INSERT MARK16 INSERT MARK17 INSERT MARK18 INSERT MARK19 INSERT MARK20 INSERT MARK21 INSERT MARK22 INSERT MARK23 INSERT MARK24 INSERT MARK25 INSERT MARK26 INSERT MARK27 INSERT MARK28 INSERT MARK29 INSERT MARK30 INSERT MARK31 INSERT MARK32 INSERT MARK33 INSERT MARK34 INSERT MARK35 INSERT MARK36 INSERT MARK27 INSERT MARK38 INSERT MARK39 INSERT MARK40 INSERT MARK41 INSERT MARK42 INSERT MARK43 INSERT MARK44 INSERT MARK45 INSERT MARK46 INSERT MARK47 INSERT MARK48 INSERT MARK49 INSERT MARK50 INSERT MARK51 INSERT MARK52 INSERT MARK53 INSERT MARK54 INSERT MARK55 /* // ./ ADD NAME=UTLDEL //MARKDEL JOB (0),'DELETE TAPES',CLASS=A,MSGCLASS=T //* //* DELETE EXISTING TAPES FROM THE VSAM FILE //* //DELTAPES EXEC PGM=TAPEMUTL //STEPLIB DD DISP=SHR,DSN=INSTALLS.TAPEMAN.LINKLIB SITE SPECIFIC //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * DELETE MARK01 DELETE MARK02 /* // ./ ADD NAME=UTLEXP //MARKEXP JOB (0),'TAPE EXPIRY MAINT',CLASS=A,MSGCLASS=T //* //* CHANGE EXPIRY DATES ON SELECTED TAPES IN THE VSAM FILE //* CARD SYNTAX IS 'TAPE-VOLSER SPACE NEW-YYDDD EXPIRY' //* //EXPIRCTL EXEC PGM=TAPEMEXP //STEPLIB DD DISP=SHR,DSN=INSTALL.TAPEMAN3.LINKLIB SITE SPECIFIC //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * MARK01 09360 MARK02 09310 MARK03 10001 /* // ./ ADD NAME=UTLLIST //MARKLIST JOB (0),'LIST TAPES',CLASS=A,MSGCLASS=T //* //* LIST TAPE ENTRIES FROM THE TAPE CATALOG FILE. //* //* POSSIBLE LIST OPTIONS ARE //* LIST ALL - EVERY TAPE //* LIST SCRATCH - EVERY TAPE IN SCRATCH STATE //* LIST VOLSER - ONLY LIST SELECTED VOLSER //* //LSTTAPES EXEC PGM=TAPEMUTL //STEPLIB DD DISP=SHR,DSN=INSTALL.TAPEMAN3.LINKLIB SITE SPECIFIC //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * LIST ALL LIST SCRATCH LIST MARK01 /* // ./ ADD NAME=UTLSCR //MARKSCR JOB (0),'SCRATCH TAPES',CLASS=A,MSGCLASS=T //* //* FORCE AN ALLOCATED TAPE TO BECOME AN EXPIRED TAPE //* NOTES: ONLY AFFECTS CATALOGUE ENTRY, DOESN'T CHANGE ANY //* PHYSICAL TAPE LABEL. //* //SCRTAPES EXEC PGM=TAPEMUTL //STEPLIB DD DISP=SHR,DSN=INSTALL.TAPEMAN3.LINKLIB //TAPEVOLS DD DISP=OLD,DSN=VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS //SYSPRINT DD SYSOUT=* //SYSIN DD * SCRATCH MARK01 SCRATCH MARK02 SCRATCH MARK03 SCRATCH MARK04 SCRATCH MARK05 SCRATCH MARK06 SCRATCH MARK07 SCRATCH MARK08 SCRATCH MARK09 SCRATCH MARK10 SCRATCH MARK11 SCRATCH MARK12 SCRATCH MARK13 SCRATCH MARK14 SCRATCH MARK15 SCRATCH MARK16 SCRATCH MARK17 SCRATCH MARK18 SCRATCH MARK19 SCRATCH MARK20 SCRATCH MARK21 SCRATCH MARK22 SCRATCH MARK23 SCRATCH MARK24 SCRATCH MARK25 SCRATCH MARK26 SCRATCH MARK27 SCRATCH MARK28 SCRATCH MARK29 SCRATCH MARK30 SCRATCH MARK41 SCRATCH MARK42 SCRATCH MARK43 SCRATCH MARK44 SCRATCH MARK45 SCRATCH MARK46 SCRATCH MARK47 SCRATCH MARK48 SCRATCH MARK49 SCRATCH MARK50 SCRATCH MARK51 SCRATCH MARK52 SCRATCH MARK53 SCRATCH MARK54 SCRATCH MARK55 /* // ./ ENDUP QQ //* //* //* //* USERMODS FOR TK4- //* Use iebgener to install these to avoid their iebcopy command //* cards screwing up iebcopy if that was used to install them. //* //* //USERMODI EXEC PGM=IEBGENER //SYSPRINT DD SYSOUT=* //SYSUT1 DD DATA,DLM=QQ //ZMD0001 JOB (SMP), // 'Usermod ZMD0001', // CLASS=A, // MSGCLASS=A, // MSGLEVEL=(1,1), // REGION=4096K //* //********************************************************************* //* //* Name: SYS1.UMODCNTL(ZMD0001) //* //* Desc: Install usermod ZMD0001 //* Requirements: This usermod is for TK4- and will not work with TK3 //* //* Update IEECVXIT WTO message automation exit: //* //* o If a RAKF deny on a TAPEVOL resource cancel the JOB //* requesting the tape to prevent endless mount requests //* o If an ENQ on VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS then issue //* a 'P MMPF' to release it from MMPF (taskmon will restart MMPF) //* o Remove the code to start printer and punch devices, that is //* now handled by my MMPF //* o INCLUDE INLINE ALL CHANGES MADE BY ZJW0006 or they //* would be lost. //* //* ************* NOTE: ****************************************** //* TK4- HAS USERMOD ZJW0006 APPLIED ON TOP OF ZUM0003 (IEECVXIT) //* This usermod superceeds that and includes the changes to //* ieecvxit made by that usermod. //* ************* END NOTE *************************************** //* //* M. Dickinson, 01/2016 //* //********************************************************************* //UPDATE EXEC PGM=IEBUPDTE //SYSUT1 DD DISP=SHR,DSN=SYS1.UMODSRC //SYSUT2 DD DISP=(,PASS),UNIT=SYSDA, // DCB=(LRECL=80,RECFM=FB,BLKSIZE=3120), // SPACE=(TRK,(15,5),RLSE) //SYSPRINT DD SYSOUT=* //SYSIN DD * ./ CHANGE NAME=IEECVXIT,NEW=PS GBLC &VNETSW reactivation time for switched lines 00082000 GBLC &VNETLS reactivation time for leased lines 00084000 COPY BSPSGLBL , set globals 00086000 &VNETSW SETC '1' reactivation time for switched lines 00173000 &VNETLS SETC '10' reactivation time for leased lines 00176000 CTAPEVOL DS 0H , RAKF TAPEVOL DENY RAKF000A ZMD0001 01330002 * NOTE: because we cancel the job the user never sees RAKF000A ZMD0001 01330003 * RAKF0005 INVALID ATTEMPT TO ACCESS RESOURCE ZMD0001 01330005 * RAKF000A GUEST1 ,GUEST1J ,TAPEVOL ,MARK01 ZMD0001 01330006 * We must build the command in the dsect work area in order to ZMD0001 01330007 * remain re-entrant. ZMD0001 01330008 CLC =C'TAPEVOL',UCMMSTXT+28 ONLY C ON TAPEVOL RULE ZMD0001 01330009 BNE RETURN Not tapevol, ignore it ZMD0001 01330010 * else build SVC34 string here ZMD0001 01330011 LA R1,14 length of cmd in 1st AL2 fld ZMD0001 01330012 STH R1,CTAPVOLM ZMD0001 01330013 LA R1,0 0 in second AL2 field ZMD0001 01330014 STH R1,CTAPVOLM+2 ZMD0001 01330015 MVC CTAPVOLM+4(2),=C'C ' Move in jobname to cmd ZMD0001 01330016 MVC CTAPVOLM+6(8),UCMMSTXT+19 ZMD0001 01330017 LA R1,CTAPVOLM address command buffer ZMD0001 01330018 DS 0H ZMD0001 01330019 SR R0,R0 ZMD0001 01330020 SVC 34 issue cancel command ZMD0001 01330021 B RETURN ZMD0001 01330022 TAPEVCHK CLC =C'VSAM.INSTALL.TAPEMAN3.VVDS.VOLSERS',UCMMSTXT+12 D0001 01330024 BNE RETURN not that dataset so ignore ZMD0001 01330025 SVC34 'F BSPPILOT,SCRIPT=MMPFCYCL' bounce MMPF ZMD0001 01330026 B RETURN ZMD0001 01330027 ./ DELETE SEQ1=01590000,SEQ2=01770000 VARYIACT DS 0H vary automated terminal inactive 01770100 * 0----+----1----+----2----+----3----+----4----+----5----+ 01770200 * LGN001I TSO logon in progress at MTHD terminal LUNAME 01770300 CLC UCMMSTXT+33(4),=C'VTAM' is it a VTAM terminal? 01770400 BNE RETURN -> no, don't touch it 01770500 LA R3,UCMMSTXT+47 address LUNAME 01770600 BAL R1,AUTOTERM is this an automated terminal? 01770700 LA R1,VNET point R1 to V NET,... plist 01770800 MVC 0(LVINACT,R1),VINACT move SVC 34 plist to workarea 01770900 MVC VINACTLU(8,R1),0(R3) insert LUNAME into V NET command 01771000 SR 0,0 setup and .. 01771100 SVC 34 .. call SVC 34 01771200 B RETURN exit 01771300 VARYACT DS 0H vary automated terminal active 01771400 * 0----+----1----+----2----+----3----+ 01771500 * IST105I LUNAME NODE NOW INACTIVE 01771600 LA R3,UCMMSTXT+9 address LUNAME 01771700 BAL R1,AUTOTERM is this an automated terminal? 01771800 LA R1,VNET V NET,... plist in workarea 01771900 MVC 0(LVACT,R1),VACT move SVC 34 plist to workarea 01772000 MVC VACTLU(8,R1),0(R3) insert LUNAME into V NET command 01772100 LA R1,EXECVNET have R2D2 execute .. 01772200 B DOSRB .. time delayed SVC 34 01772300 VARYFAIL DS 0H suppress IST073I for auto term 01772400 * 0----+----1----+----2----+----3----+----4----+ 01772500 * IST073I VARY FAILED FOR ID= T327AL11 01772600 LA R3,UCMMSTXT+33 address LUNAME 01772700 BAL R1,AUTOTERM is this an automated terminal? 01772800 CLC UCMMSTXT+62(4),=C'DEAC' is it being deactivated? 01772900 BNE RETURN -> no, leave message alone 01773000 MVC UCMROUTC(2),DELROUTC -> yes, delete .. 01773100 MVC UCMDESCD(2),DELDESCD .. message 01773200 B RETURN exit 01773300 AUTOTERM DS 0H check if terminal is automated 01773400 CLC 0(5,R3),=C'T327A' automated 3270 terminal? 01773500 BNE CHK3767 -> no, check for 3767 01773600 BR R1 -> yes, go automate! 01773700 CHK3767 CLC 0(5,R3),=C'T376A' automated 3767 (TTY) terminal? 01773800 BNE RETURN -> no, don't touch it 01773900 BR R1 -> yes, go automate! 01774000 VACT DC AL2(LVACT) SVC 34 plist.. 01774100 DC AL2(0) .. for .. 01774200 DC C'V NET,ACT,ID=' .. v net,act command 01774300 VACTLU EQU *-VACT offset to LUNAME 01774400 DC CL8' ' LUNAME goes here 01774500 LVACT EQU *-VACT length of SVC 34 plist 01774600 DS 0H 01774700 VINACT DC AL2(LVINACT) SVC 34 plist.. 01774800 DC AL2(0) .. for .. 01774900 DC C'V NET,INACT,ID=' .. v net,inact command 01775000 VINACTLU EQU *-VINACT offset to LUNAME 01775100 DC CL8' ' LUNAME goes here 01775200 LVINACT EQU *-VINACT length of SVC 34 plist 01775300 ./ DELETE SEQ1=02560000,SEQ2=02560000 * We will schedule a subroutine to process the action requests. The * 02560000 ./ DELETE SEQ1=02580000,SEQ2=02590000 * If this address space is not active, no action processing will * 02580000 * take place * 02586000 ./ DELETE SEQ1=02780000,SEQ2=02790000 * Check again if BSPPILOT is running. If not, we cannot process the * 02780000 * action. We do this by scanning the ASCB chain (again) for BSPPILOT * 02786000 ./ DELETE SEQ1=03370000,SEQ2=03370000 DC CL8'IEF863I ',A(TAPEVCHK) check if tape vsam ds ZMD0001 03380002 DC CL8'RAKF000A',A(CTAPEVOL) c if deny is TAPEVOL ZMD0001 03380003 DC CL8'LGN001I ',A(VARYIACT) deactivate automated term 03382000 DC CL8'IST105I ',A(VARYACT) activate automated term 03384000 DC CL8'IST073I ',A(VARYFAIL) delete if automated term 03386000 ./ DELETE SEQ1=03770000,SEQ2=03770000 * List of messages and their canned actions * 03770000 REPLYES EQU 32 , R XX,YES 03863000 EXECVNET EQU 36 V NET,ACT,ID= 03866000 DC CL8'IST183A ',A(REPLYES) 03955000 * IEECODES ID=DEL,ROUTCDE=0,DESC=0 04002000 DELDESCD DC H'0' 04004000 DELROUTC DC H'0' 04006000 ./ DELETE SEQ1=04040000,SEQ2=04040000 * Actually, the SRB routine does not process the action requests at * 04040000 ./ DELETE SEQ1=04060000,SEQ2=04070000 * which in turn will do what we need to do, namely issue a WTOR * 04060000 * reply or other command via SVC34 * 04066000 ./ DELETE SEQ1=04570000,SEQ2=04570000 TITLE 'IRBROUT - IRB Routine that REALLY processes the action' 04570000 ./ DELETE SEQ1=04660000,SEQ2=04660000 CLC $REASON,=YL2(EXECVNET) is it a V NET,... request? 04660000 BNE CHKPWD -> no, check for passwd request 04660800 LA R1,VNET point R1 to V NET,... plist 04661600 CLI VACTLU+5(R1),C'S' is it a switched terminal? 04662400 BE WAITSW -> yes, go wait 04663200 STIMER WAIT,BINTVL=VNETLS wait &VNETLS seconds 04664000 B DOVNET go execute 04664800 WAITSW STIMER WAIT,BINTVL=VNETSW wait &VNETSW seconds 04665600 DOVNET LA R1,VNET point R1 to V NET,... plist 04666400 B DOSVC34 execute V NET,... command 04667200 CHKPWD CLC $REASON,=YL2(REPLCAT) , is it a password request? 04668000 B RYES , 20: R XX,YES 05255000 RYES EQU * 05542000 MVC WTOAREA(REPLY9L),REPLY9 05544000 B ISSUE 05546000 SPACE 05548000 ./ DELETE SEQ1=05580000,SEQ2=05580000 DOSVC34 SR R0,R0 , clear R0 for SVC 34 05580000 REPLY9 WTO 'R XX,''YES'' <<<<<< BY BSPPILOT',DESC=(5), +06012000 ROUTCDE=(1,2,11),MF=L 06014000 REPLY9L EQU *-REPLY9 06016000 *------------------------------------------------------------------* 06018000 VNETSW DC A(&VNETSW*100) reactivation time for switched lines 06033000 VNETLS DC A(&VNETLS*100) reactivation time for leased lines 06036000 * CTAPVOLM is for dynamically built cancel command ZMD0001 06160001 DS 0H ZMD0001 06160002 CTAPVOLM DS AL2,AL2 ZMD0001 06160003 DS CL10'C xxxxxxxx' ZMD0001 06160004 * 28 = NOPASSWD 06161000 * 32 = YES 06162000 * 36 = Execute delayed V NET,... command 06163000 VNET DS 0C V NET,... commands go here 06164000 ORG *+LVINACT length of V NET,... commands 06165000 ./ ENDUP /* //* //* Assemble //* //SMPASM EXEC SMPASM,M=IEECVXIT //ASM.SYSIN DD DISP=(OLD,DELETE),DSN=*.UPDATE.SYSUT2 //* //* Receive and apply //* //RECAPP EXEC SMPAPP,COND=(0,NE) //SMPPTFIN DD * ++USERMOD(ZMD0001). ++VER(Z038) FMID(EBB1102) PRE(TMVS805) SUP(ZJW0006). ++MOD(IEECVXIT) TXLIB(UMODOBJ). //SMPCNTL DD * RECEIVE SELECT(ZMD0001). APPLY SELECT(ZMD0001). /* // QQ //SYSUT2 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(ZMD0001) //SYSIN DD DUMMY //USERMODR EXEC PGM=IEBGENER //SYSPRINT DD SYSOUT=* //SYSUT1 DD DATA,DLM=QQ //ZMD0001R JOB (SMP), // 'Remove UMOD ZMD0001', // CLASS=A, // MSGCLASS=A, // MSGLEVEL=(1,1), // REGION=4096K //* //********************************************************************* //* //* Name: SYS1.UMODCNTL(ZMD0001R) //* //* Desc: Remove installed usermod ZMD0001 //* //* Revert IEECVXIT WTO message automation exit: //* CLPA is required to implement //* //* Can only restore back to the base level, not remove just a single //* usermod here, due the the PRE and SUP requirements used all the //* way through. Messy but I want to ensure the TK4- updates are //* back at the TK4- level so I have not done it the sensible way //* of removing the TK3 and TK4- usermods and just applying my own //* //* We must... //* o restore ALL the usermods applied to this module back to the //* base level //* o MANUALLY re-apply all the others to get back to where Jurgen //* had TK4- positioned. //* //* M. Dickinson, 01/2016 //* //********************************************************************* //REJECT EXEC SMPAPP,COND=(0,NE) //SMPCNTL DD * RESTORE S(ZMD0001,ZJW0006,ZUM0003,TMVS805). /* //AOSC5 DD DISP=SHR,DSN=SYS1.AOSC5 //* //* YOU MUST NOW MANUALLY RUN SYS1.UMODCNTL MEMBERS //* ZUM0003 //* TMVS805 //* ZJW0006 // QQ //SYSUT2 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(ZMD0001R) //SYSIN DD DUMMY //* //* //* Submit the jobs to assemble into the install load library //* //SUBJOBS EXEC PGM=IEBGENER,COND=(0,NE) //SYSPRINT DD SYSOUT=* //SYSUT1 DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(TAPEMCUU) // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(TAPEMDES) // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(TAPEMEXP) // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(TAPEMSCR) // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(TAPEMUTL) // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(TAPEMAN3) // DD DISP=SHR,DSN=INSTALL.TAPEMAN3.SRC(MDDIAG8) //SYSUT2 DD SYSOUT=(A,INTRDR) //SYSIN DD DUMMY //