//MARKA JOB (0),'ASSEMBLE',CLASS=A,MSGCLASS=T, // USER=MVSUSERN,PASSWORD=MVSPASSW //* The above user/pswd are replaced by the macro I use to //* netcat jobs to the card reader //* //ASMLKD EXEC ASMFCL,MAC='SYS1.AMODGEN',MAC1='MVSSRC.SYM101.F01', // PARM.ASM='OBJECT,NODECK,TERM,XREF(SHORT)', // PARM.LKED='RENT,LIST,MAP,NCAL,AC=0' //ASM.SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB // DD DISP=SHR,DSN=SYS1.AMODGEN // DD DISP=SHR,DSN=MVSSRC.SYM101.F01 //ASM.SYSIN DD * TITLE 'MID3503D - DISPLAY COMMAND EXTENTIONS' *********************************************************************** * * * MODULE NAME = MID3503D * * * * BASED ON LOGIC IN MVSSRC.SYM101.F13(IEE3503D) * * CALLED BY MY MODIFICATIONS TO IEE3503D WHICH * * WILL CALL THIS PROGRAM TO HANDLE ADDITIONAL * * COMMANDS. * * -----> SEE KNOWN BUGS BEFORE USING <----- * * -----> SEE REMOVED FEATURES BEFORE USING <----- * * * * REQUIRES = MY USERMOD ZMD0002, TO MAKE IEE3503D TRY TO RESOLVE* * UNKNOWN CONSOLE DISPLAY COMMANDS USING THIS PROGRAM* * * * DESCRIPTION = EXTENTION MODULE FOR ADDITIONAL CONSOLE DISPLAY * * COMMANDS. CALLED FROM IEE3503D IF A DISPLAY * * COMMAND IS NOT A KNOWN MVS DISPLAY COMMAND. * * * * COPYRIGHT = N/A * * * * STATUS = VS/2 - TEST ====>BETA<==== * * * * FUNCTION = THIS MODULE PROVIDES ADDITIONAL DISPLAY COMMANDS * * OPERANDS: D APF APF LIST * * APF[LIST] APF LIST * * IPL IPL INFO and IPL time * * TIME * * SMF SMF DATASET USE * * SMF,D SMF DATASET USE * * * * RESTRICTIONS = TIME SHARING TERMINALS SHOULD NOT BE PERMITTED * * TO ISSUE THE ADDITIONAL COMMANDS HERE AT THIS * * TIME (WTO IS USED, TPUT NOT YET IMPLEMENTED) * * * * KNOWN BUGS = <------- READ THE SECTION BELOW ---------------- * * Currently no known bugs. * * KNOWN BUGS = <------- READ THE SECTION ABOVE ---------------- * * * * REMOVED FEATURES = <------- READ THE SECTION BELOW ------------ * * (1) The 'D SMF,O' code has been comented out using * * a comment flag of '*X*'... EXCEPT the WTO template * * definitions are still uncommented as I do not want * * to lose the continuation formatting that a global * * uncomment change would cause. To uncomment the * * 'D SMF,O' code just globally change '*X*' to ''. * * H O W E V E R it has been commented out because * * it exceeds the symbol table size and code block * * size (and there are no spare REGs to setup a * * second base register)... caused by the code added * * to actually populate the SYS1.MAN? dataset usage, * * which I think is of more use than the options. * * If you uncomment the options display code you will * * have to remove something else. * * REMOVED FEATURES = <------- READ THE SECTION ABOVE ------------ * * * * ATTRIBUTES = REENTRANT, SUPERVISOR MODE, KEY ZERO, * * PAGED LPA * * * * ENTRY POINT = MID3503D FROM IEE3503D * * LINKAGE = LINK=EP * * INPUT DATA = REGISTER 2 POINTS TO XSA * * XAL POINTS TO 1ST OPERAND IN BUFFER * * XAU IS 1-BYTE UCMI (X'00' COMMAND ISSUED * * INTERNALLY OR FROM THE INPUT STREAM) * * XAA CONTAINS THE ASID (X'0000' = NON-TS) * * XAN CONTAINS THE VERB CODE X'68' - DISPLAY * * X'C4' - TRACK * * XAR POINTS TO THE LENGTH FIELD AT THE * * BEGINNING OF THE COMMAND BUFFER * * XAV CONTAINS THE COMMAND VERB * * XAP CONTAINS ADDRESS OF END OF BUFFER +1 * * * * REGISTERS * * (as we can save nothing until we have a code base and storage)* * TRASHED = R0,R1,R12(PGM BASE),R13(ADDRESS WORK AREA) * * SAVED/RESTORED = R2-R11 PLUS R14 * * R15 ON EXIT = 0 COMMAND WAS HANDLED, 4 COMMAND UNSUPPORTED * * * *********************************************************************** EJECT MID3503D CSECT *********************************************************************** * * * REGISTER EQUATES * * * *********************************************************************** R0 EQU 0 WORK REGISTER R1 EQU 1 WORK REGISTER R2 EQU 2 (RESERVED) INPUT - BASE REG FOR XSA R3 EQU 3 (SAVED/RESTORED) BASE REG OF IEE3503D, WORK REG R4 EQU 4 (RESERVED) USED FOR UCMI R5 EQU 5 WORK REGISTER R6 EQU 6 (RESERVED) TABLE POINTER IN IEE3503D R7 EQU 7 WORK REGISTER R8 EQU 8 WORK REGISTER R9 EQU 9 WORK REGISTER R10 EQU 10 WORK REGISTER R11 EQU 11 WORK REGISTER R12 EQU 12 (RESERVED/TRASHED) MODULE BASE REGISTER R13 EQU 13 (RESERVED/TRASHED) USED TO MAP GETMAINED WORK AREA R14 EQU 14 (SAVED/RESTORED) RETURN ADDRESS, USED AS WORK REG R15 EQU 15 WORK REGISTER EJECT *********************************************************************** * * * ESTABLISH ADDRESSABILITY FOR MODULE AND XSA * * * *********************************************************************** USING *,R15 B AROUNDID DC CL8'MID3503D' DC CL1'-' DC CL8'&SYSDATE' DC CL1'-' DC CL8'&SYSTIME' DC CL1'-' DC CL8'V1.R1.M3' DC CL1'-' AROUNDID DS 0H DROP R15 *********************************************************************** * NON-STANDARD ENTRY, BECAUSE R13 DOES NOT POINT TO A SAVEAREA * * IN THE CALLER SO WE CANNOT SAVE REGISTERS WITH NORMAL ENTRY CODE * *********************************************************************** BALR R12,0 COPY BASE REGISTER USING *,R12 GETMAIN RU,LV=MIDSALEN GET WORKING STORAGE LR R13,R1 SET SAP AND BASE FOR W.S. USING SA,R13 MAP THE WORKING STORAGE AREA STM R2,R11,SAVEAREA SAVE ALL REGS 2-11 ST R14,SAVEAREA+48 SAVE R14 (RETURN ADDRESS) * MID - Q? - expects R2 to be passed from caller unchanged ? * ok, reading the mvs doco yes, potentially unreliable USING IEEXSA,R2 MAP THE PASSED XSA DATA AREA *********************************************************************** * * * WE DO NOT ALLOW TSO USERS TO USE THESE COMMANDS * * (BECAUSE I AM NOT BOTHERING TO TEST IF TSO-TPUT/CONSOLE-WTO REQD) * * * *********************************************************************** LH R1,XAA TEST ASID LTR R1,R1 TERMINAL REQUEST BNZ EXIT00 TSO USER, JUST EXIT *********************************************************************** * * * WHAT IS THE COMMAND TO BE CHECKED ? * * * *********************************************************************** CLC 0(3,R5),=C'APF' DISPLAY APF BE DDAPF CLC 0(3,R5),=C'IPL' DISPLAY IPL INFO BE DDIPL CLC 0(6,R5),=C'UPTIME' DISPLAY IPL INFO (ALIAS) BE DDIPL CLC 0(5,R5),=C'SMF,D' ASKING FOR DATASET INFORMATION? BE DDSMFD YES, GO DISPLAY IT *X* CLC 0(5,R5),=C'SMF,O' ASKING FOR SMF OPTIONS? *X* BE DDSMFO YES, GO DISPLAY IT CLC 0(3,R5),=C'SMF' DISPLAY SMF BE DDSMFD CLC 0(4,R5),=C'TIME' DISPLAY FORMATTED TIME BE DDTIME2 * ELSE NOT A COMMAND WE HANDLE SPACE 2 * WE RETURN RC=04 IF WE DO NOT HANDLE THE COMMAND EXIT04 DS 0H LM R2,R11,SAVEAREA RESTORE R2-R11 L R14,SAVEAREA+48 GET BACK R14 FREEMAIN RU,LV=MIDSALEN,A=(R13) FREE GOTTEN STORAGE LA R15,4 RC=0004 BR R14 RETURN TO IEE3503D SPACE 2 * WE RETURN RC=00 IF WE PROCESSED THE COMMAND EXIT00 DS 0H LM R2,R11,SAVEAREA RESTORE R2-R11 L R14,SAVEAREA+48 GET BACK R14 FREEMAIN RU,LV=MIDSALEN,A=(R13) FREE GOTTEN STORAGE SLR R15,R15 RC=0000 BR R14 RETURN TO IEE3503D LTORG EJECT *********************************************************************** * * DISPLAY APF * *********************************************************************** DDAPF DS 0H * ********************************************************************* * * DO INITILIZATION * SAVE THE REGISTERS * GET STORAGE FOR WTO MESSAGE * GET THE POINTER TO THE TABLE FROM THE CVT, * GET THE NUMBER OF ENTRIES, * AND MOVE THE HEADING TO GOTTEN STORAGE AREA. * * ********************************************************************* SPACE 3 STM R0,R15,SA2 SAVE REGISTERS SPACE 1 GETMAIN RU,LV=2048 GET STRG FOR MESSAGE AREA ST R1,STRGAREA AND SAVE THE POINTER TO IT LR R10,R1 COPY MSG AREA POINTER SPACE 3 L R1,CVTPTR POINT TO THE CVT USING CVT,R1 AND MAP IT L R4,CVTAUTHL POINT TO THE START OF THE APF TABLE DROP R1 DROP CVT MAPPING SR R5,R5 LH R5,0(R4) GET COUNT OF NUMBER OF ENTRIES LA R4,2(R4) POINT PAST NMBR OF ENTRIES FEILD MVC 0(59,R10),WTOMSG MOVE INITIAL WTO MSG HEADER TO STRG LA R10,8(R10) ADJUST POSITION SR R8,R8 CLEAR LINE COUNTER SPACE 3 * ********************************************************************* * * PROCESS EACH ENTRY * CLEAR THE OUTPUT LINE, * GET ENTRY LENGTH * WRITE OUT THE VOLSER * WRITE OUT THE VARIABLE LENGTH DSNAME, * ADJUST TO GET THE NEXT ENTRY, * WRITE THE RESULTS, * AND DO OVER AGIN IF NEED BE. * * ********************************************************************* SPACE 3 LISTNTRY DS 0H LA R8,1(R8) ADD 1 TO LINE COUNTER LA R10,52(R10) POINT TO NEXT AREA MVC 0(52,R10),WTOMSG+60 MOVE SUBSEQUENT WTO MSG TO STRG SR R6,R6 CLEAR ENTRY LENGTH REG ICM R6,X'0001',0(R4) ST ENTRY LENGTH IN REG LR R7,R6 SAVE LENGTH MVC 15(6,R10),1(R4) MOVE VOLSER TO BUFFER S R6,=F'6' SUBTRACT VOLSER LENGTH S R6,=F'1' SUBTRACT 1 FOR EX INSTRUCTION C R6,=F'28' IS THE DSNAME LENGTH > 28? BNH APFLENT1 NO - CONTINUE L R6,=F'28' YES - SET DSNAME MAX LEN TO 28 APFLENT1 DS 0H EX R6,MOVEDSN1 MOVE DATASET NAME IN WTO STRG BUFR SPACE 3 AR R4,R7 POINT PAST DSNAME LA R4,1(R4) ADD 1 TO ACCOUNT FOR LENGTH FIELD SPACE 3 C R8,=F'39' DID WE REACH THE MAX FOR WTO? BH APFMAXM YES - SET MORE MESSAGE AND END SPACE 3 BCT R5,LISTNTRY GO PROCESS THE ENTRY B TERM BYPASS THE OVERFLOW MESSAGE SPACE 3 * ********************************************************************* * * END OF LIST ROUTINE - SET WTO MSG WITH # LINES, SET THE LAST LINE, * ISSUE THE WTO, AND EXIT. * * ********************************************************************* SPACE 1 APFMAXM DS 0H MVC 15(10,R10),=C' ' MVC 25(06,R10),=C'(MORE)' MVC 31(26,R10),=C' ' SPACE 3 * ********************************************************************* * * END OF LIST ROUTINE - SET WTO MSG WITH # LINES, SET THE LAST LINE, * ISSUE THE WTO, AND EXIT. * * ********************************************************************* SPACE 1 TERM DS 0H SPACE 1 LR R9,R10 SAVE NEXT RECORD POINTER MVI 2(R9),X'30' SET LAST LINE IN WTO MSG L R10,STRGAREA GET WTO MESSAGE STRG AREA LA R8,1(R8) ADD 1 IN LINE COUNT TO INCL HEADER STC R8,59(R10) SET NUMBER OF LINES IN WTO MSG AREA LA R11,1000(R10) AND SET THE END LR R0,R4 PUT UCMI INTO REG 0 SR R4,R4 IC R4,XAU LH R5,XAA LR R0,R4 PUT UCMI INTO REG 0 L R10,STRGAREA GET WTO MESSAGE STRG AREA WTO MF=(E,(R10)) ISSUE WTO * FREEMAIN RU,LV=2048,A=(R10) SPACE 1 LM R0,R15,SA2 RESTORE REGISTERS SPACE 1 B EXIT00 GO EXIT THIS ROUTINE SPACE 3 * EXECUTE COMMANDS FOR APF ROUTINE SPACE 3 MOVEDSN1 MVC 23(0,R10),7(R4) MOVE DSNAME TO BUFFER SPACE 3 * WTO MSG FOR APF ROUTINE SPACE 3 WTOMSG WTO ('SKVAPF01I CURRENT APF ENTRIES ',C), X (' VOLSER DSNAME ',D), X (' ',DE),X DESC=(5),MCSFLAG=(REG0,RESP),MF=L WTOMSGL EQU * SPACE 3 MSGLNE1 DS 0C DS CL1 MSGLNE1V DS CL6 DS CL1 MSGLNE1D DS CL44 MSGLNE1L EQU *-MSGLNE1 LTORG EJECT ******************************************************************* * * DISPLAY SMF OPTIONS * ******************************************************************* *X*DDSMFO DS 0H *X* STM R0,R15,SA2 SAVE REGISTERS *X* SPACE 3 *X* GETMAIN RU,LV=2048 *X* LR R7,R1 *X* ST R7,STRGAREA AND SAVE THE POINTER TO IT *X* MVC 469(2,R7),=2XL1'00' *X* MVC 0(DSMRMSKX,R7),DSMRMSKD MOVE BASE MSG TO W.S. *X* MVC 83(20,R7),0(R5) *X* MVC 79(2,R7),3(R5) *X* LA R6,79(R7) *X* MVI 78(R7),C'*' *X* MVI 81(R7),C'*' *X* SR R4,R4 *X* IC R4,XAU *X* LH R5,XAA *X* LR R0,R4 PUT UCMI INTO REG 0 *X* WTO MF=(E,(R7)) WRITE TO OPERATOR - SMF INFO *X* SPACE 3 *X* L R3,CVTPTR POINT TO THE CVT *X* USING CVTMAP,R3 MAP THE CVT *X*BYPX DS 0H *X* L R6,CVTSMCA POINT TO THE SMF'S SMCA *X* USING SMCABASE,R6 MAP THE SMCA *X* DROP R3 *X* SPACE 3 *X*BYPZ DS 0H *X* SR R0,R0 *X* LR R8,R7 POINT TO RECEIVING FIELD *X* LH R9,=H'424' SET LENGTH FOR MESSAGE *X* LA R14,DSMRMSGD POINT TO SENDING FIELD *X* LH R15,=H'424' SET FILL CHAR *X* MVCL R8,R14 MOVE MESSAGE TO BUFFER *X* MVC 64+037(L'SMCASID,R7),SMCASID SET SID *X* TM SMCAOPT,SMCAOPT1 JOB ACCOUNTING? *X* BNO BYP0 NO - SKIP *X* MVC 116+012(3,R7),=C'JOB' YES - SET IT *X* MVC 376+004(1,R7),=C'1' YES - SET IT *X*BYP0 DS 0H *X* TM SMCAOPT,SMCAOPT2 STEP ACCOUNTING? *X* BNO BYP1 NO - SKIP *X* MVC 116+016(4,R7),=C'STEP' YES - SET IT *X* MVC 376+004(1,R7),=C'2' YES - SET IT *X* B BYP1 GO CONTINUE *X*BYP1 DS 0H *X* SPACE 3 *X*BYP2 DS 0H *X* TM SMCAOPT,SMCADSA DATASET ACCOUNTING? *X* BNO BYP3 NO - SKIP *X* MVC 168+010(2,R7),=C'DS' YES - SET IT *X* MVC 376+020(1,R7),=C'2' YES - SET IT *X* B BYP3 GO CONTINUE *X*BYP3 DS 0H *X* TM SMCAOPT,SMCAVOL STEP ACCOUNTING? *X* BNO BYP4 NO - SKIP *X* MVC 168+013(3,R7),=C'VOL' YES - SET IT *X* MVC 376+020(1,R7),=C'1' YES - SET IT *X* B BYP4 GO CONTINUE *X*BYP4 DS 0H *X* TM SMCAOPT,SMCADSA+SMCAVOL DSET AND VOL ACCOUNTING? *X* BNO BYP5 NO - SKIP *X* MVC 376+020(1,R7),=C'3' YES - SET IT *X* B BYP5 GO CONTINUE *X*BYP5 DS 0H *X* SPACE 3 *X* TM SMCAOPT,SMCAEXT EXITS TAKEN? *X* BNO BYP6 NO - SKIP *X* MVC 220+007(3,R7),=C'YES' YES - SET IT *X* MVC 376+011(3,R7),=C'YES' SET EXT= *X* B BYP6 GO CONTINUE *X*BYP6 DS 0H *X* SPACE 3 *X* MVC 376+034(4,R7),=C'NONE' SET NO RECORDING MAN= *X* MVC 64+024(5,R7),=C'INACT' SAA - SET SMF *X* MVC 64+005(5,R7),=C'INACT' SAA - SET RECORDING *X* MVC 324+006(6,R7),=C'INACT ' SAA - SET ACTIVE D.S. *X* MVC 324+030(6,R7),=C'INACT ' SAA - SET ACTIVE D.S. *X* TM SMCAMISC,SMCAUSER+SMCAMAN ALL RECORDING ? *X* BNO BYP8 NO - SKIP *X* MVC 64+005(6,R7),=C'ACTIVE' SET SMF ACTIVE *X* MVC 324+006(6,R7),=C'ACTIVE' SET ACTIVE D.S. *X* MVC 324+030(6,R7),=C'INACT ' SET ACTIVE D.S. *X* MVC 376+034(4,R7),=C'ALL ' YES - SET IT *X* MVC 64+024(6,R7),=C'ACTIVE' YES - SET IT *X* B BYPE GO CONTINUE *X*BYP8 DS 0H *X* TM SMCAMISC,SMCAMAN USER RECORDING ? *X* BNO BYPE NO - SKIP *X* MVC 64+005(6,R7),=C'ACTIVE' SET SMF ACTIVE *X* MVC 324+006(6,R7),=C'ACTIVE' SET ACTIVE D.S. *X* MVC 324+030(6,R7),=C'INACT ' SET ACTIVE D.S. *X* MVC 376+034(4,R7),=C'USER' YES - SET IT *X* MVC 64+034(6,R7),=C'ACTIVE' YES - SET IT *X* B BYPE GO CONTINUE *X*BYPE DS 0H *X* TM SMCASWA,SMCADSTR ERROR RECORDING? *X* BNO BYP9 NO - SKIP *X* MVC 64+024(6,R7),=C'(FULL)' YES - SET IT *X* MVC 324+006(6,R7),=C'*FULL ' SAA - SET ACTIVE D.S. *X* MVC 324+030(6,R7),=C'*FULL ' SAA - SET ACTIVE D.S. *X* B BYP9 GO CONTINUE *X*BYP9 DS 0H *X* SPACE 3 *X* MVC 376+044(3,R7),=C'NO ' OPERATOR NOT ALLOWED TO CHANGE *X* TM SMCAMISC,SMCAOPI OPERATOR ALLOWED TO CHANGE? *X* BNO BYPA NO - SKIP *X* MVC 376+044(3,R7),=C'YES' YES - SET OPI= *X* B BYPA GO CONTINUE *X*BYPA DS 0H *X* SPACE 3 *X* MVC 324+004(1,R7),SMCAXORY SET ACTIVE DATASET *X* MVC 324+014(6,R7),SMCAPDEV SET ACTIVE VOLSER *X* MVC 324+028(1,R7),SMCAYORX SET INACTIVE DATASET *X* MVC 324+037(6,R7),SMCAADEV SET INACTIVE VOLSER *X* SPACE 3 *X* L R1,SMCABSIZ GET BUFFER SIZE *X* CVD R1,480(R7) CONVERT SIZE TO PACKED FORM *X* UNPK 272+016(8,R7),480(R7) CONVERT TO READABLE AND DISPLAY *X* OI 272+016+7(R7),X'F0' CONVERT TO READABLE AND DISPLAY *X* SPACE 3 *X* SR R14,R14 *X* L R15,SMCAJWT GET JOB WAIT TIME *X* M R14,MSHIFT CONVERT FROM *X* D R14,MICROSEC MICROSECONDS TIMER UNITS *X* CVD R14,480(R7) CONVERT TO READABLE SUB-MINUTES *X* CVD R15,490(R7) CONVERT TO READABLE SUB-MINUTES *X* CLC 480+4(4),LTH ARE WE TO ROUND UP? *X* BL BYPB NO - GO CONTINUE *X* AP 490+4(4),PONE ROUND UP BY ONE MINUTE *X*BYPB DS 0H *X* MVC 500(R7),EMASK *X* ED 500(R7),490+6(R7) *X* MVC 272+005(4,R7),500(R7) *X*BYPC DS 0H *X* MVC 376+027(1,R7),=C'0' SET DEFAULT REC= *X* TM SMCAMISC,SMCATDS TEMP DS? *X* BNO BYPD NO - SKIP *X* MVC 168+025(4,R7),=C'TEMP' YES - SET IT *X* MVC 376+027(1,R7),=C'2' SET REC= *X** B BYPD GO CONTINUE *X*BYPD DS 0H *X* SPACE 3 *X* SR R4,R4 *X* IC R4,XAU *X* LH R5,XAA *X* LR R0,R4 PUT UCMI INTO REG 0 *X* WTO MF=(E,(R7)) WRITE TO OPERATOR - SMF INFO *X* SPACE 3 *X*BYPF DS 0H *X* FREEMAIN RU,LV=2048,A=(R7) *X* LM R0,R15,SA2 RESTORE REGISTERS *X* B EXIT00 GO EXIT THIS ROUTINE *X* LTORG *X* EJECT ***************************************************************** * * DISPLAY SMF DATASETS * ******************************************************************* DWSMFD1 WTO 'SKVD001I SMF DATASETS STARTED ',MF=L, X DESC=(5),MCSFLAG=(REG0,RESP) DWSMFD1L EQU *-DWSMFD1 DDSMFD DS 0H STM R0,R15,SA2 SAVE REGISTERS MVC DSNAME,=CL44'SYS1.MAN?' INITIALISE DSNAME SPACE 3 GETMAIN RU,LV=2048 LR R7,R1 L R3,CVTPTR POINT TO THE CVT USING CVTMAP,R3 MAP THE CVT L R6,CVTSMCA POINT TO THE SMF'S SMCA USING SMCABASE,R6 MAP THE SMCA MVC 0(DSMDMSGL,R7),DSMDMSGD LR R0,R4 PUT UCMI INTO REG 0 SR R4,R4 IC R4,XAU LH R5,XAA LR R0,R4 PUT UCMI INTO REG 0 MVC 115+009(1,R7),SMCAXORY SET ACTIVE DATASET MVC 115+012(6,R7),SMCAPDEV SET ACTIVE VOLSER MVC 115+019(5,R7),=C' YES ' SET AS IN USE BYPSD1 DS 0H TM SMCAPSTA,SMCAPNAV IS DATASET NOT AVAILABLE? BNO BYPSD1M *MID* WAS BYPSD2 MVC 115+021(6,R7),=C'NOT AVA' SET AS NOT AVAILABLE BYPSD1M MVC DSNAME+8(1),SMCAXORY *MID* FOR SPACE USED MVC DSATSER(6),SMCAPDEV *MID* FOR SPACE USED BAL R1,SMFUSED *MID* FOR SPACE USED MVC 115+026(5,R7),TRKSTOTL *MID* FOR SPACE USED MVC 115+032(5,R7),TRKSUSED *MID* FOR SPACE USED MVC 115+041(2,R7),CPCTUSED *MID* FOR SPACE USED BYPSD2 DS 0H MVC 165+011(1,R7),SMCAYORX SET INACTIVE DATASET MVC 165+014(6,R7),SMCAADEV SET INACTIVE VOLSER MVC 165+021(6,R7),=C' INACT' DEFAULT NO, TEST BELOW IF OK TM SMCASTA,SMCAPMTY IS DATASET READY TO BE USED? BNO BYPSD3 MVC 165+021(6,R7),=C' AVAIL' SET AS AVAILABLE BYPSD3 DS 0H TM SMCASTA,SMCAPNAV IS DATASET NOT AVAILABLE? BNO BYPSD4 MVC 165+021(6,R7),=C'NOT AVA' SET AS NOT AVAILABLE BYPSD4 DS 0H TM SMCASWA,SMCADSTR DISASTER BIT SET? BNO BYPSD4M NO - BYPASS MVC 115+018(6,R7),=C'* FULL' SET DS AS FULL MVC 165+021(6,R7),=C'* FULL' SET DS AS FULL BYPSD4M MVC DSNAME+8(1),SMCAYORX *MID* FOR SPACE USED MVC DSATSER(6),SMCAADEV *MID* FOR SPACE USED BAL R1,SMFUSED *MID* FOR SPACE USED MVC 165+028(5,R7),TRKSTOTL *MID* FOR SPACE USED MVC 165+034(5,R7),TRKSUSED *MID* FOR SPACE USED MVC 165+043(2,R7),CPCTUSED *MID* FOR SPACE USED BYPSD5 DS 0H WTO MF=(E,(R7)) WRITE TO OPERATOR - SMF DS INFO BYPY DS 0H DDSMFX EQU * FREEMAIN RU,LV=2048,A=(R7) LM R0,R15,SA2 RESTORE REGISTERS B EXIT00 GO EXIT THIS ROUTINE DROP R3 GO CONTINUE DROP R6 SPACE 3 DSMRMSE1 WTO 'SKV0002E: SMCA ADDRESS NOT SET.', X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DSMRMSX1 EQU *-DSMRMSE1 DSMRMSE2 WTO 'SKV0003E: SMCA AREA BAD.', X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DSMRMSX2 EQU *-DSMRMSE2 DGSM1MSG WTO 'IEE967I SMF PARAMETERS',MF=L, X DESC=(5),MCSFLAG=(REG0,RESP) DGSM1LN EQU *-DGSM1MSG DGSM2MSG WTO ' NO INFORMATION AT THIS TIME.',MF=L, X DESC=(5),MCSFLAG=(REG0,RESP) DGSM2LN EQU *-DGSM2MSG SPACE DSMRMSKD WTO ('SKV0001I SMF XAL:12345678 XAV:12345678 ',C), X (' XAR:12345678 R5:12345678 ',D), X (' ',DE),X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DSMRMSKX EQU *-DSMRMSKD DSMRMSGD WTO ('SKV0001I SMF PARAMETER DETAIL ',C), X ('SMF: ----- RECORDING: ----- SID: ---- ',D), X ('ACCOUNTING: --- ---- ',D), X ('DATASETS: -- --- ',D), X ('EXITS: --- ',D), X ('JWT: --- BUF: ---- ',D), X ('MAN-X ACTIVE (123456) MAN-: INACT (123456) ',D), X ('OPT=- EXT=NO DSV=0 REC=- MAN=---- OPI=--- ',DE),X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DSMRMSGX EQU *-DSMRMSGD MICROSEC DC F'60000000' MSHIFT DC F'1048576' LTH DC F'50000000' PONE DC PL4'1' EMASK DC X'40202020' SPACE 5 DSMDMSGD WTO ('SKV0001I SMF DATASET USAGE DETAIL ',C), X (' DSNAME VOLSER IN-USE ALLOC USED %FULL ',D), X ('SYS1.MAN- 111111 ----- ----- --% ',D), X ('SYS1.MAN+ 222222 ----- ----- --% ',DE),X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DSMDMSGL EQU *-DSMDMSGD LTORG EJECT SPACE 2 EJECT *********************************************************************** * * DISPLAY IPL INFO * *********************************************************************** DDIPL DS 0H STM R0,R15,SA2 SAVE REGISTERS SPACE 3 GETMAIN RU,LV=2048 ST R1,STRGAREA SAVE ADDR OF GETMAINED AREA LR R10,R1 R10 TO INDEX WTO BUFFER STRG MVC 0(DIPLMSGX,R10),DIPLMSGD MOVE WTO MSG BUFFER TO STRG * -------------------------------------------------------------------- * Get basic IPL info from easy to access system control blocks * -------------------------------------------------------------------- L R7,CVTPTR CVTPTR IS DEFINED IN CVT (16) USING CVTMAP,R7 CVTMAP IN CVT ADDRESSES CVT L R8,CVTSMCA USING SMCABASE,R8 MVC 138(4,R10),SMCASID SMFID INTO OUTPUT LINE * - R8 STILL ADDRESSING SMCA, GET THE IPL VOLUME AND CCUU L R1,CVTSYSAD ADDRESS CVTSYSAD WITH R1 MVC 79(6,R10),28(R1) SYSRES VOLSER FROM CVTSYSAD L R1,48(R7) GET SYSRES CCUU FROM CVT UNPK UNPKFLD(5),4(3,R1) UNPK BINARY CCUU + 1 BYTE TR UNPKFLD(4),TRTAB-240 MAKE IT DISPLAYABLE HEX MVC 91(4,R10),UNPKFLD GET UNIT ADDRESS DROP R8 DROP R8 USAGE TO CVTSMCA * L R8,CVTASMVT ADDRESS CVTASMVT WITH R8 USING ASMVT,R8 TM ASMFLAG2,ASMQUICK CVIO QUICK START ? BNO IPLTYPE2 MVC 125(4,R10),=CL4'CVIO' B IPLTYPEX IPLTYPE2 TM ASMFLAG2,ASMWARM WARM START ? BNO IPLTYPE3 MVC 125(4,R10),=CL4'WARM' B IPLTYPEX IPLTYPE3 MVC 125(4,R10),=CL4'CLPA' CLPA START IPLTYPEX EQU * DROP R8 DROP R8 USAGE TO CVTASMVT DROP R7 DROP R7 CVT ADDRESSING FOR NOW BAL R1,V1IPLDAT MVC 178(3,R10),D370DNAM MVC 182(4,R10),D370YEAR MVC 187(2,R10),D370MMDD MVC 190(2,R10),D370MMDD+2 MVC 194(2,R10),D370YEAR+2 MVC 197(3,R10),D370JDAY MVC 203(2,R10),D370TIME MVC 206(2,R10),D370TIME+2 MVC 209(2,R10),D370TIME+4 SR R4,R4 IC R4,XAU LH R5,XAA LR R0,R4 PUT UCMI INTO REG 0 WTO MF=(E,(R10)) WRITE THE RESPONSE MSG L R1,STRGAREA GET BACK ADDR OF STORAGE FREEMAIN RU,LV=2048,A=(R1) AND FREE IT LM R0,R15,SA2 RESTORE REGISTERS B EXIT00 GO EXIT THIS ROUTINE DIPLMSGD WTO ('MID137I IPL INFORMATION, ',C), X ('SYSRES: VOLSER=vvvvvv UNIT=ccuu ',D), X ('IPLTYPE: cccc, SMFID: dddd ',D), X ('IPL TIME: xxx yyyy/mm/dd (yy.ddd), hh:mm:ss ',DE),X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DIPLMSGX EQU *-DIPLMSGD SPACE 2 LTORG EJECT DDTIME2 STM R0,R15,SA2 SAVE REGISTERS SPACE 3 GETMAIN RU,LV=2048 ST R1,STRGAREA SAVE ADDR OF GETMAINED AREA LR R10,R1 R10 TO INDEX WTO BUFFER STRG MVC 0(DTIMMSGX,R10),DTIMMSGD MOVE WTO MSG BUFFER TO STRG BAL R1,V1USECUR MVC 18(2,R10),D370TIME MVC 21(2,R10),D370TIME+2 MVC 24(2,R10),D370TIME+4 MVC 33(4,R10),D370YEAR MVC 38(2,R10),D370MMDD MVC 41(2,R10),D370MMDD+2 MVC 45(2,R10),D370YEAR+2 MVC 48(3,R10),D370JDAY MVC 53(3,R10),D370DNAM LR R0,R4 PUT UCMI INTO REG 0 SR R4,R4 IC R4,XAU LH R5,XAA LR R0,R4 PUT UCMI INTO REG 0 WTO MF=(E,(R10)) WRITE THE RESPONSE MSG L R1,STRGAREA GET BACK ADDR OF STORAGE FREEMAIN RU,LV=2048,A=(R1) AND FREE IT LM R0,R15,SA2 RESTORE REGISTERS B EXIT00 GO EXIT THIS ROUTINE DTIMMSGD WTO 'MID136I TIME=hh:mm:dd DATE=yyyy/mm/dd (yy.ddd) www', X DESC=(5),MCSFLAG=(REG0,RESP),MF=L DTIMMSGX EQU *-DTIMMSGD LTORG TITLE 'MID3503D - DISPLAY COMMAND EXTENTIONS - DATE ROUTINES' EJECT * ===================================================================== * START OF DATE TIME COMMON ROUTINES * * CANNOT USE R2 -- addesses ieexsa storage area * CANNOT USE R13 -- address getmained data dsect * CANNOT USE R12 -- addresses program code * * THESE ARE AN E X A M P L E ONLY, THIS CODE YOU SHOULD NOT NORMALLY * INCLUDE INLINE DUE TO IT'S SIZE... IT IS A 'BUTCHERED' SUBSET OF * MY DATE LIBRARIES PASTED IN THIS EXAMPLE CODE TO PROVIDE THE IPL * TIME NEEDED FOR THE 'D IPL' COMMAND (and as the code is here for * my formatted 'D TIME' example. * * As we must use STCK timestamps to get the IPL time I also use STCK * timestamps in get current time requests, so this can be used as * common code. * * ENTRY POINTS ARE * BAL R1,V1USECUR - format current datetime timestamp * BAL R1,V1IPLDAT - format last ipl datetime timestamp * ===================================================================== * --------------------------------------------------------------------- * We have been requested to use the current date. Use time deviation. * --------------------------------------------------------------------- V1USECUR STM R0,R15,MIDSAV00 SAVE ALL REGISTERS, WE USE THE LOT STCK VALSTCK STORE THE TIME-OF-DAY CLOCK LM R0,R1,VALSTCK L R15,16 GET CVT ADDRESS A 0,304(R15) ADD LOCAL TIME DEVIATION... STM R0,R1,VALSTCK Save the adjusted timestamp B FRMTDATE Go convert to human readable * --------------------------------------------------------------------- * We have been requested to provide the IPL time. * Calculating the IPL time from the current STCK plus local time * deviation, and subtracting the RMCTTOD (1024Usecs since IPL). * --------------------------------------------------------------------- V1IPLDAT STM R0,R15,MIDSAV00 SAVE ALL REGISTERS, WE USE THE LOT STCK VALSTCK STORE THE TIME-OF-DAY CLOCK LM R0,R1,VALSTCK L R15,16 GET CVT ADDRESS A 0,304(R15) ADD LOCAL TIME DEVIATION... SRDL 0,12 ISOLATE NUMBER OF MICROSECONDS * ----- whats in the RMCTTOD * 1024 Micro Seconds since the system was IPLed L R5,16 POINT TO THE CVT. L R5,604(,R5) POINT TO THE RMCT. L R5,124(,R5) LOAD RMCTTOD. XR R4,R4 Zeros in upper word, rmcttod in lower M R4,=F'1024' M R4,R5 pair by 1024 STM R4,R5,VALTTOD Store result * ----- ok subtract microsecs since IPL from STCK microsecs * and see what result we get now. It will be the IPL time. SL R1,VALTTOD+4 Subtract low order byte BC 11,*+6 Branch if no borrow BCTR R0,0 Perform borrow SL R0,VALTTOD Complete the substraction * ----- Roll the bits back up to the expected STCK format and save SLDL 0,12 MOVE BACK UP TO STCK FORMAT STM R0,R1,VALSTCK Save the new adjusted timestamp * B FRMTDATE Go convert to human readable EJECT * --------------------------------------------------------------------- * The STCK timestamp we are to format is in VALSTCK now, go format it. * --------------------------------------------------------------------- * ---------------------- START STCKCONV ------------------------ * The STCKCONV block will work out the correct HH:MM:SS plus * the weekday number (0=sun thru 6=sat) and dayname (SUN-SAT) * -------------------------------------------------------------- FRMTDATE LA R7,STCKVWA R7 SET TO THE WORKAREA WE USE LM R0,R1,VALSTCK GET BACK SAVED STCK VALUE STM R0,R1,8(R7) AND STORE WHERE EXPECTED SRDL R0,12 ISOLATE NUMBER OF MICROSECONDS D R0,=F'60000000' DIVIDE BY 60M (R1=MINUTES AFT EPOCH) LR R15,R0 COPY REMAINDER OF MICS TO GET SECS SR R14,R14 CLEAR FOR DIVIDE D R14,=F'951424' DIVIDE TO GET REMAINING SECONDS (R5) LR R14,R15 COPY TO WORK REG STCK001 SL R14,=F'60' DECREMENT BY 60 SECONDS BM STCK002 LESS THAN SIXTY, CONTINUE SL R15,=F'60' MORE THAN SIXTY, ADJUST FOR LEAP AL R1,=F'1' BUMP MINUTES B STCK001 CHECK AGAIN STCK002 CVD 15,8(R7) CONVERT SECONDS TO PACKED FORMAT UNPK 24(4,R7),14(2,R7) UNPACK SECONDS FOR PRINT OI 27(R7),X'F0' SET UP FOR PRINTING MVC D370TIME+4(2),26(R7) MOVE THE SECONDS CVD 1,8(R7) CONVERT MINUTES TO PACKED FORMAT DP 8(8,R7),=P'60' DIVIDE INTO HOURS AND MINUTES UNPK 24(4,R7),14(2,R7) UNPACK THE MINUTES OI 27(R7),X'F0' SET UP FOR PRINTING MVC D370TIME+2(2),26(R7) MOVE THE MINUTES ZAP 8(8,R7),8(6,R7) RESET TO FULL LENGTH DP 8(8,R7),=P'24' DIVIDE INTO DAYS AND HOURS UNPK 24(4,R7),14(2,R7) UNPACK THE HOURS OI 27(R7),X'F0' SET UP FOR PRINTING MVC D370TIME(2),26(R7) MOVE THE HOURS ZAP 8(8,R7),8(6,R7) RESET TO FULL LENGTH DP 8(8,R7),=P'7' DIVIDE BY NUMBER OF DAYS IN A WEEK ZAP 8(8,R7),15(1,R7) FILL DOUBLEW WITH THE REMAINDER CVB R0,8(R7) CONVERT RELATIVE DAY TO BINARY A R0,=F'1' 0-MON TO 6-SUN TO 0-SUN TO 6 SAT C R0,=F'7' ABOVE 6 ? BL WKDYOK IF LOW THEN OK LA R0,0 ELSE SET TO 0 WKDYOK STC R0,D370WKDY SET RELATIVE DAY OF WEEK OI D370WKDY,X'F0' MAKE PRINTABLE XR R4,R4 Zeros in upper word LR R5,R0 Day name number to locate M R4,=F'3' Find Offset LA R4,STCKDAYS Address day name field AR R4,R5 Add offset into field MVC D370DNAM(3),0(R4) Store day name *--------------------------------------------------------------------- * FINDDATE: * ALL THE WORK REQUIRED TO PROCESS A STCK FORMAT TIMESTAMP TO * EXTRACT THE CCYY, MM, DD AND DDD VALUES FROM THE DATE. * R0,R1,R3,R6,R7 work registers * R8 address days in month table * R10 tracking year * R0,R1,R3,R6,R7 work registers * R8 address days in month table *--------------------------------------------------------------------- LM R0,R1,VALSTCK Initialised earlier * ------------------------------------------------------------- * Get the number of DAYS since EPOC, thats all we need here * D - even reg is remainder, odd reg is quotient * ------------------------------------------------------------- *** Divide to get minutes only *** Divide that result to get days SRDL R0,12 SHIFT TO MICROSECS D 0,=F'60000000' Div by 60M (MINUTES AFT EPOC IN R1) XR R0,R0 r1 has minutes ? D 0,=F'1440' div r0,r1 by 60*24 to get days to r1 LR R0,R1 quotient to R0 (days?) A R0,=F'1' days from 1 not 0 ST R0,FINDDV02 save days left * * ------------------------------------------------------------- * * At this point R0 is the number of days since EPOC (starting * with day 0). * * Need to find CCYY and DDD. * Loop through each year decrementing days for each year * (366 for leap, 365 for non-leap) until we are left with * a DDD number of days into the year. * We have correct year as we increment the year number * as we do each years days deletion. * * Leap year logic (source Wikipedia) * if year is divisible by 400 then * is_leap_year * else if year is divisible by 100 then * not_leap_year * else if year is divisible by 4 then * is_leap_year * else * not_leap_year * * ------------------------------------------------------------- L R10,=F'1899' starts at 1900, but we add 1 top of loop FINDDL00 A R10,=F'1' bump year ST R10,FINDDV01 save for tests and retrieval L R1,=F'365' default is not a leap year LA R8,STCKVT default is not a leap year * Check if divisable by 400, always a leap year SLR R6,R6 LA R3,400 LR R7,R10 DR R6,R3 LTR R6,R6 BZ SETLEAP evenly divisible * Check if divisable by 100, is so and not divisable * by 400 (checked above) then it is not a leap year. SLR R6,R6 LA R3,100 divisible by 100 ? LR R7,R10 DR R6,R3 LTR R6,R6 BZ FINDDL01 evenly divisible, not leap year * If a multiple of 4 after checks above, is a leap year SLR R6,R6 LA R3,4 divisible by 4 ? LR R7,R10 DR R6,R3 LTR R6,R6 BNZ FINDDL01 not evenly divisible, not leap year SETLEAP L R1,=F'366' leap year, use leap year values LA R8,STCKVTL leap year FINDDL01 ST R0,FINDDV02 save days left ST R0,FINDDV04 save ddd, we need it later SR R0,R1 subtract days in yr from R0 BP FINDDL00 if positive go round again L R0,FINDDV04 get lastpositive ddd back * ------------------------------------------------------------- * Similar to above * Decrement the number of days one month at a time, incrementing * the month each time we subtract a bunch of days. And we will * end up with the month number and day number. * * Have a year (R10) and days left (R0) in the year now (YYYYDDD) * yyyy saved in FINDDV01 * ddd saved in FINDDV02 and FINDDV04 * * R10 still has year as yyyy * R8 still addresses the correct year/leapyear days table (I think) * R0 still has days as ddd < 366 or less for the year now * ------------------------------------------------------------- LA R1,1 for incrementing by 1 SLR R6,R6 month offset in days tbl SLR R7,R7 for number of days insert FINDDL02 IC R7,0(R6,R8) # days in month CR R0,R7 too many? BNH FINDDL03 no, br; now know month SR R0,R7 reduce ddd by days in mnth AR R6,R1 bump month table entry B FINDDL02 FINDDL03 AR R6,R1 inc, month from 1 not 0 ST R6,FINDDV03 save mm month ST R0,FINDDV02 save dd days left * * ------------------------------------------------------------- * Make the results displayable in our output data area now. * ------------------------------------------------------------- L R0,FINDDV02 dd CVD R0,FINDDV05 UNPK D370MMDD+2(2),FINDDV05+6(2) UNPACK DAY INTO OUTPUT L R1,FINDDV03 mm CVD R1,FINDDV05 UNPK D370MMDD(2),FINDDV05+6(2) UNPACK MONTH INTO OUTPUT L R2,FINDDV01 yyyy CVD R2,FINDDV05 UNPK D370YEAR(4),FINDDV05+5(3) UNPACK YEAR INTO OUTPUT OI D370MMDD+1,C'0' INSURE NUMERICS OI D370MMDD+3,C'0' INSURE NUMERICS OI D370YEAR+3,C'0' INSURE NUMERICS L R3,FINDDV04 ddd CVD R3,FINDDV05 UNPK D370JDAY(3),FINDDV05+6(2) UNPACK DDD INTO OUTPUT OI D370JDAY+2,C'0' INSURE NUMERICS LM R0,R15,MIDSAV00 RESTORE ALL REGISTERS TO PRIOR STATE BR R1 BACK TO WHERE WE WERE CALLED FROM LTORG EJECT *********************************************************************** * SMFUSED: *MID* * * GET SPACE USED BY SMF DATASETS * * ENTRY : BAL R1,SMFUSED * * * * REGISTERS THAT CANNOT BE USED * * CANNOT USE R2 -- addesses ieexsa storage area * * CANNOT USE R13 -- address getmained data dsect * * CANNOT USE R12 -- addresses program code * * R3.R6 to be safe, addressing fields in the routine that brached here* * Unfortunately I am using R6 as I have run out of registers, lets * * hope this does not cause too much trouble; they have been dropped * * before here but we branch back into the code that still uses them. * *********************************************************************** SMFUSED STM R0,R15,MIDSAV00 SAVE ALL REGISTERS * INITIALISE DEFAULTS MVC TRKSTOTL,=C' 0' MVC TRKSUSED,=C' 0' MVC CPCTUSED,=C' 0' * BUILD OBTAIN REQUEST BLOCK FOR LATER USE - SEARCH FOR DCB1 ENTRY LM R4,R7,SEARCH OBTAIN, SEARCH LA R5,DSNAME DSNAME LA R6,DSATSER VOLSER LA R7,DSATFMT1 DCB1 DATA MAPPING AREA STM R4,R7,DSATDCB1 SAVE REQUEST BLOCK * BUILD OBTAIN REQUEST BLOCK FOR LATER USE - SEEK TO DCB3 ENTRY LM R4,R7,SEEK OBTAIN, SEEK LA R5,DS1PTRDS A FIELD FROM FMT1 DCB WHEN READ LA R6,DSATSER VOLSER LA R7,DSATFMT3 DCB3 MAPPING AREA STM R4,R7,DSATDCB3 SAVE DCB3 REQUEST BLOCK * OBTAIN THE DCB1 ENTRY FOR THE FILE OBTAIN DSATDCB1 GET FORMAT 1 DSCB LTR R15,R15 TEST RETURN CODE BNZ DSNERR * IF IT EXISTS, OBTAIN THE DCB3 ENTRY FOR THE FILE NC DS1PTRDS,DS1PTRDS SEE IF THERE IS A FORMAT 3 DSCB BZ HAVEDCBS OBTAIN DSATDCB3 GET THE FORMAT 3 DSCB LTR R15,R15 TEST RETURN CODE BNZ DSNERR HAVEDCBS CNOP 0,4 *********************************************************************** * R5 - EXECUTE TABLE POINTER ??? SET BY OBTAIN ??? * * R6 - TRACKS ALLOCATED * * R7 - EXTENT DESCRIPTION POINTER/TRACKS USED * * R8 - R13 - RESERVED * *********************************************************************** SPACE 2 *--------GET TRACK ALLOCATION SR R4,R4 CLEAR REGISTER 4 SR R5,R5 CLEAR REGISTER 5 SR R6,R6 CLEAR REGISTER 6 SR R7,R7 CLEAR REGISTER 7 ST R7,FTRKUSE ZERO TRACKS USED ST R7,FTRKTOT ZERO TRACKS TOTAL IC R4,DS1NOEPV LOAD NUMBER OF EXTENTS DSATTRKS EX R0,DSATADDR(R5) PROCESS EXTENT BLOCK CLI 0(R7),X'00' BE DSATUTRK LA R7,2(R7) LOAD ADDRESS OF STARTING TRACK MVC HALF(2),4(R7) LOAD ENDING CYL NUMBER LH R1,HALF MVC HALF(2),0(R7) LOAD STARTING CYL NUMBER SH R1,HALF SUBTRACT STARTING FROM ENDING * MH R1,TRKPRCYL MULTIPLY BY TRACKS PER CYL MH R1,=H'30' HARD CODE FOR 3350 MVC HALF(2),6(R7) LOAD ENDING TRACK AH R1,HALF ADD TO TRACK COUNT MVC HALF(2),2(R7) LOAD STARTING TRACK SH R1,HALF SUBTRACT FROM TRACK COUNT AR R6,R1 ACCUMULATE TOTAL LA R6,R1(R6) ADD 1 TRACK LA R5,4(R5) BCT R4,DSATTRKS DECREMENT EXTENT COUNT DSATUTRK ST R6,FTRKTOT SAVE TOTAL TRACKS CVD R6,DSATPDEC CONVERT TRACKS TO DECIMAL MVC DSATDEC,DECMASK MOVE MASK ED DSATDEC,DSATPDEC+4 EDIT MVC TRKSTOTL(5),DSATDEC+3 SAVE FORMATTED TOTAL TRACKS *--------GET TRACKS USED LH R7,DS1LSTAR LOAD TRACKS USED NC DS1LSTAR,DS1LSTAR TEST FOR ZERO BZ DSATPCTF LA R7,1(R7) ADD 1 ST R7,FTRKUSE SAVE TRACKS USED CVD R7,DSATPDEC CONVERT TO DECIMAL MVC DSATDEC,DECMASK MOVE MASK ED DSATDEC,DSATPDEC+4 EDIT MVC TRKSUSED(5),DSATDEC+3 SAVE FORMATTED USED TRACKS *--------CALCULATE PERCENTAGE USED DSATPCTF XR R6,R6 CLEAR R6 OR R6,R7 PAIR L R7,FTRKUSE R7 HAS TRACKS USED M R6,=F'100' TRKS USED * 100 D R6,FTRKTOT THEN / TRKS TOT TO GET % * Remainder in R6, %pct is in R7 CVD R7,DSATPDEC CONVERT TO DECIMAL MVC DSATDEC,DECMASK MOVE MASK ED DSATDEC,DSATPDEC+4 EDIT MVC CPCTUSED(2),DSATDEC+6 MOVE %USED INTO FIELD B SMFUSEDX BRANCH OVER TABLE *--------LOAD EXTENT DESCRIPTIONS LOOKUP TABLE DSATADDR LA R7,DS1EXT1 << EXECUTED INSTRUCTION >> LA R7,DS1EXT2 << EXECUTED INSTRUCTION >> LA R7,DS1EXT3 << EXECUTED INSTRUCTION >> LA R7,DS3EXT01 << EXECUTED INSTRUCTION >> LA R7,DS3EXT02 << EXECUTED INSTRUCTION >> LA R7,DS3EXT03 << EXECUTED INSTRUCTION >> LA R7,DS3EXT04 << EXECUTED INSTRUCTION >> LA R7,DS3EXT05 << EXECUTED INSTRUCTION >> LA R7,DS3EXT06 << EXECUTED INSTRUCTION >> LA R7,DS3EXT07 << EXECUTED INSTRUCTION >> LA R7,DS3EXT08 << EXECUTED INSTRUCTION >> LA R7,DS3EXT09 << EXECUTED INSTRUCTION >> LA R7,DS3EXT10 << EXECUTED INSTRUCTION >> LA R7,DS3EXT11 << EXECUTED INSTRUCTION >> LA R7,DS3EXT12 << EXECUTED INSTRUCTION >> LA R7,DS3EXT13 << EXECUTED INSTRUCTION >> SMFUSEDX LM R0,R15,MIDSAV00 RESTORE ALL REGISTERS TO PRIOR STATE BR R1 DSNERR CVD R15,DSATPDEC CONVERT RTNCODE TO DECIMAL MVC DSATDEC,DECMASK MOVE MASK ED DSATDEC,DSATPDEC+4 EDIT MVC DSNERRW+38(5),DSATDEC+3 MOVE INTO MESSAGE MVC DSNERRW+44(9),DSNAME SYS1.MAN? + any garbage byte MVC DSNERRW+54(6),DSATSER VOLSER DSNERRW WTO 'MID3503D DATASET OBTAIN ERROR nnnnn SYS1.MAN? vvvvvv' B SMFUSEDX LTORG * ===================================================================== * END OF DATE TIME COMMON ROUTINES * ===================================================================== TITLE 'MID3503D - DISPLAY COMMAND EXTENTIONS' EJECT * ------------------------------------------------------- * TRTAB is a constant needed in code space * ------------------------------------------------------- TRTAB DC C'0123456789ABCDEF' * ------------------------------------------------------- * These must be initialised, so must be in code space * ------------------------------------------------------- * MID: FOR STCK DATE CALCULATIONS STCKVT DC AL1(31,28,31,30,31,30,31,31,30,31,30,31) MONTH TABLE STCKVTL DC AL1(31,29,31,30,31,30,31,31,30,31,30,31) LEAP YEAR STCKDAYS DC C'SUNMONTUEWEDTHUFRISAT' DECMASK DC X'4020202020202120' * MID: CONSTANTS ADDED FOR SMF DATASET USAGE SEARCH CAMLST SEARCH,0,0,0 SEEK CAMLST SEEK,0,0,0 LTORG EJECT IEEXSA DSECT IEEXSA SA DSECT SAVEAREA DS 18F SA2 DS 18F ROUTINE'S REGISTER SAVE AREAS STRGAREA DS F GOTTEN STORAGE FOR GETMAINS MIDSAV00 DS 16F SAVE/RESTORE ALL REGISTERS ACROSS MY CODING WTOAREA DS 0C DS CL255 DS CL255 DS CL255 DS CL255 EJECT * MID: Additional for date manipluations FINDDV01 DS F hold the year we are testing FINDDV02 DS F days left at the moment FINDDV03 DS F current month FINDDV04 DS F need to keep a copy of DDD FINDDV05 DS D CVD work area VALSTCK DS 2F VALTTOD DS 2F STCKVWA DS 18F R13 ADDRESSED WORKAREA DYDDDBIN DS 2F THE BINARY DDD PART OF THE DATE UNPKFLD DS CL5 UDATEVAR DS 0F D370YEAR DS CL4 CCYY D370JDAY DS CL3 DDD D370MMDD DS CL4 MMDD D370WKDY DS CL1 0-6 D370TIME DS CL8 HHMMSSth D370DNAM DS CL3 SUN-SAT * MID: Additional for SMF dataset extent calculations DSATDCB1 CAMLST SEARCH,0,0,0 DSATDCB3 CAMLST SEEK,0,0,0 DSNAME DC CL44'SYS1.MANX' SMF DATASET NAME (X OR Y) DSATSER DC CL6'PUB002' SMF DATASET VOLSER HALF DS H HALFWORD ALIGNED WORK AREA DSATDEC DS D WORK AREA FOR DECIMAL CONVERSION DSATPDEC DS D WORK AREA FOR DECIMAL CONVERSION FTRKTOT DS F SAVE TRACK ALLOCATION TOTAL FTRKUSE DS F SAVE TRACK USED AMOUNT TRKSTOTL DS CL5 total tracks allocated TRKSUSED DS CL5 total tracks used CPCTUSED DS CL2 percent trksused/trkstotal DSATFMT1 DS 0D,148C FORMAT 1 DSCB (DS DESCRIPTION) DSATFMT3 DS 0D,148C FORMAT 3 DSCB (ADD EXTENTS) TITLE 'FORMAT 1 DSCB MAP' PRINT GEN ORG DSATFMT1-44 IECSDSL1 1 PRINT NOGEN TITLE 'FORMAT 3 DSCB MAP' * DO NOT USE 'IECSDSL1 3' TO BUILD THE DSCB ENTRY * USE THE REMAPPING FROM CBT249.FILE048(#VTCFMT3) ORG DSATFMT3 * FORMAT 3 DSCB DESCRIPTION * #VTCFMT3 * DESCRIPTION OF FOURTH THROUGH SIXTEENTH EXTENTS OF A * #VTCFMT3 * DATA SET * #VTCFMT3 DS3KEY DS XL4 KEY - 03030303 #VTCFMT3 DS3EXT01 DS XL10 EXTENT 4 DESCRIPTION #VTCFMT3 DS3EXT02 DS XL10 5 #VTCFMT3 DS3EXT03 DS XL10 6 #VTCFMT3 DS3EXT04 DS XL10 7 #VTCFMT3 DS3FMTID DS X DSCB FORMAT 3 IDENTIFIER, X'F3' #VTCFMT3 DS3EXT05 DS XL10 EXTENT 8 DESCRIPTION #VTCFMT3 DS3EXT06 DS XL10 9 #VTCFMT3 DS3EXT07 DS XL10 10 #VTCFMT3 DS3EXT08 DS XL10 11 #VTCFMT3 DS3EXT09 DS XL10 12 #VTCFMT3 DS3EXT10 DS XL10 13 #VTCFMT3 DS3EXT11 DS XL10 14 #VTCFMT3 DS3EXT12 DS XL10 15 #VTCFMT3 DS3EXT13 DS XL10 16 #VTCFMT3 ORG MIDSALEN EQU *-SAVEAREA LENGTH OF WORK DSECT TITLE 'MID3503D - DISPLAY COMMAND EXTENTIONS' EJECT CVT DSECT=YES,LIST=YES IEESMCA UCB DSECT IEFUCBOB LIST=YES ILRASMVT DSECT=YES END //ASM.SYSTERM DD SYSOUT=* //LKED.SYSLMOD DD DSN=SYS9.LINKLIB(MID3503D),DISP=SHR //