DA$MPF01 TITLE ' Append the date to some messages' *********************************************************************** *** *** ** ** ** Module Name = DA$MPF01 ** ** ** ** Descriptive Name = Append the current date to some messages. ** ** ** ** Reference = GC28-1147 MVS-XA SPL: User Exits ** ** ** ** Activated by = Specifed in active MPF member of Parmlib: ** ** - SET MPF=XX ** ** - WHERE XX IS A MEMBER IN PARMLIB: ** ** 'SYS1.PARMLIB(MPFLSTXX)' ** ** - REFERENCE IN MPFLSTXX: ** ** IEF403I,SUP(NO),USEREXIT(DA$MPF01) ** ** IEF404I,SUP(NO),USEREXIT(DA$MPF01) ** ** $HASP373,SUP(NO),USEREXIT(DA$MPF01) ** ** $HASP395,SUP(NO),USEREXIT(DA$MPF01) ** ** ** ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** ** ** ** Change: ** ** ** ** IEF403I IBMUSERP - STARTED - TIME=16.38.17 ** ** IEF404I IBMUSERP - ENDED - TIME=16.38.23 ** ** ** ** To: ** ** ** ** IEF403I IBMUSERP - STARTED - TIME=16.38.17 - 25-FEB-1997 ** ** IEF404I IBMUSERP - ENDED - TIME=16.38.23 - 25-FEB-1997 ** ** ** ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ** ** ** ** If "MONITOR JOBNAMES" is not active, then we update these as ** ** well: ** ** ** ** $HASP373 IBMUSERZ STARTED - INIT 1 - CLASS U - SYS DA$5 ** ** $HASP395 IBMUSERZ ENDED ** ** ** *** *** *********************************************************************** EJECT IEZVX100 , WTO exit parameter list PRINT NOGEN IHAPSA , Prefixed Save Area IHAASCB , Address Space Control Block IHAASSB , ASCB Secondard block IAZJSAB , Job Schedular Address spc YREGS , Equate registers to R0-R15 PRINT GEN * ** Using the official ASMH/HLASM distinction trick, simulate the ** SYSVER and SYSDATEC variables of HLASM when assembled under ** ASMH...Taken from Gilbert Saint-flour's SHOWMVS. * LCLA &ASMH_HLASM AIF (T'&ASMH_HLASM EQ 'N').ASMH1X &SYSVER SETC 'ASMH' &SYSDATC SETC '20'.'&SYSDATE'(7,2)'&SYSDATE'(1,2)'&SYSDATE'(4,2) AIF ('&SYSDATC' LT '20500000').ASMH1X &SYSDATC SETC '19'.'&SYSDATE'(7,2)'&SYSDATE'(1,2)'&SYSDATE'(4,2) .ASMH1X ANOP *-Convert assembly date from SYSDATC format "YYYYMMDD" to "YYYY/MM/DD" LCLC &ASMDATE &ASMDATE SETC '&SYSDATC'(1,4).'/'.'&SYSDATC'(5,2).'/'.'&SYSDATC'(7,2) EJECT *********************************************************************** *** *** ** Intialization ** *** *** *********************************************************************** SPACE 2 DA$MPF01 CSECT , DA$MPF01 AMODE 31 DA$MPF01 RMODE ANY * ** Create a standard O/S eyecatcher * EC B ECL(0,R15) Bump past Eyecatcher DC AL1(L'ECLIT) Length of eyecatcher ECLIT DC C'DA$MPF01 &ASMDATE &SYSTIME - Echo message to TSO user' DS 0H Ensure halfword alignment ECL EQU *-EC * ** Standard ESA entry housekeeping * BAKR R14,0 Save regs LAE R12,0(R15,0) Get base register USING DA$MPF01,R12 Get addressibility SAC 0 SYSSTATE ASCENV=P STORAGE OBTAIN,LENGTH=WORKDSL,LOC=BELOW Obtain storage LR R13,R1 Point to Save Area MVC 4(4,R13),=C'F1SA' Indicate stack SA USING WORKDS,R13 Get addressibility to area * ** Locate MPF exit parameter list and message area * EREG R0,R1 Restore regs 0 and 1 L R2,0(R1) Get CTXT Address ICM R3,B'1111',CTXTTXPJ-CTXT(R2) Locate Major BZ EXIT Shouldn't happen, but leave * ** See we want to touch these guys * TM CTXTMTY1-CTXT(R2),CTXTMTYA Monitor jobnames active? BNO TEST$X No, hit the JES2 start/stop CLC CTXTTMSG-CTXTATTR(7,R3),=C'$HASP373' BE EXIT CLC CTXTTMSG-CTXTATTR(7,R3),=C'$HASP395' BE EXIT TEST$X DS 0H * ** Append the current date onto the end of the message * TIME BIN Get current time and date STM R0,R1,DOUBLE Save time and date LA R15,CTXTTMSG-CTXTATTR(R3) Locate to start of message SLR R14,R14 Clear register ICM R14,B'0011',CTXTTLEN-CTXTATTR(R3) Get length AR R15,R14 MVC 0(3,R15),=C' - ' LA R15,3(R15) LM R0,R1,DOUBLE Save time and date BAS R14,CONVERT_TO_TODSTRING Convert the time and date LA R14,CTXTTMSG-CTXTATTR(R3) Locate to start of message SR R15,R14 STCM R15,B'0011',CTXTTLEN-CTXTATTR(R3) Set new length OI CTXTRFB1-CTXT(R2),CTXTRCMT Say we changed it * ** Release resources and return to caller * EXIT DS 0H LR R2,R13 Get storage address STORAGE RELEASE,LENGTH=WORKDSL,ADDR=(R2) Release storage SLR R15,R15 Set return code PR Return to caller EJECT *********************************************************************** *** *** ** Convert input binary time and packed decimal julian date to a ** ** fancy output string of "dd-mmm-ccyy hh:mm:ss pm" ** ** ** ** Input: R0 - Time in binary ** ** R1 - Date in packed decimal ** ** R15 - points to the output area ** ** ** ** Output: the area in R15 will be filled in and R15 updated with ** ** address just past the filled in area. ** *** *** *********************************************************************** SPACE 2 CONVERT_TO_TODSTRING DS 0H ST R15,CTT_OUT Save output area address ST R14,CTT_RA Save return address * ** Get the input time (binary) and date (packed decimal) and convert ** it to a STCK TOD format * LA R14,CTT_CIN Locate routine Time/Date area XC 0(CTAREAL,R14),0(R14) Clear to binary zeros STCM R0,B'1111',CTAREA_TIME-CTAREA(R14) Save Time STCM R1,B'1111',CTAREA_DATE-CTAREA(R14) Save Date * CONVTOD CONVVAL=CTT_CIN, Convert this Time/Date @ TODVAL=CTT_TOD, ..To TOD format @ TIMETYPE=BIN, ..Time is binary format @ DATETYPE=YYDDD, ..Date is julian 0CYYDDDf @ MF=(E,PARMLIST) LTR R15,R15 CONVTOD worked? BNZ CTT$JUL Failed, do primitive way * ** Convert the TOD stamp into time and date formats * STCKCONV STCKVAL=CTT_TOD, Convert this TOD Stamp @ CONVVAL=CTT_SOUT, ..Into these date/time areas @ TIMETYPE=DEC, ..Output time format @ DATETYPE=DDMMYYYY, ..Output Date format @ MF=(E,PARMLIST) LTR R15,R15 CONVTOD worked? BNZ CTT$JUL Failed, do primitive way * ** Format the date * L R15,CTT_OUT Locate output area * D D - M M - C C Y Y MVC 0(11,R15),=X'40,20,20,60,20,20,60,20,20,20,20' ED 0(11,R15),CTT_SOUT+8 Edit it to " dd-mm-ccyy" MVC 0(3,R15),1(R15) Move "dd-" over "dd-...-ccyy" PACK DOUBLE(8),4(2,R15) Get month in decimal CVB R14,DOUBLE Convert to binary BCTR R14,0 Make relative to zero MH R14,=H'3' Multiply for month offset LA R1,=C'JanFebMarAprMayJunJulAugSepOctNovDec' AR R1,R14 Locate month entry MVC 3(3,R15),0(R1) Move "mmm" to "dd-mmm-ccyy" OI 0(R15),X'F0' Ensure leading zero LA R15,11(R15) Bump past date * MVC 0(3,R15),=C' - ' LA R15,3(R15) CTT$JUL DS 0H UNPK DOUBLE2(9),#CTTPMD(5) * MVZ DOUBLE2(8),=8X'00' ** Hex convert TR DOUBLE2(8),=C'0123456789ABCDEF' * * CLI #CTTPMD,0 Century = 19xx? BE CTT$Y19 CLI #CTTPMD,1 Century = 20xx? BE CTT$Y20 CLI #CTTPMD,2 Century = 21xx? BNE CTT$YX MVC 0(2,R15),=C'22' LA R15,2(R15) B CTT$YX CTT$Y19 DS 0H MVC 0(2,R15),=C'19' LA R15,2(R15) B CTT$YX CTT$Y20 DS 0H MVC 0(2,R15),=C'20' LA R15,2(R15) CTT$YX DS 0H MVC 0(2,R15),DOUBLE2+2 Get yy from "0cyydddf" MVI 2(R15),C'.' Insert dot MVC 3(3,R15),DOUBLE2+4 Get ddd from "0cyydddf" LA R15,6(R15) Locate past "yy.ddd' L R14,CTT_RA Get return address BSM 0,R14 Return to caller #CTTPMD EQU CTT_CIN+(CTAREA_DATE-CTAREA) Generate offset EJECT *********************************************************************** *** *** ** Constants ** *** *** *********************************************************************** SPACE 2 LTORG , EJECT *********************************************************************** *** *** ** GETMAINed work area ** *** *** *********************************************************************** SPACE 2 DS 0D WORKDS DSECT , DS 18F Register Save Area DOUBLE DS D DOUBLE2 DS 2D PARMLIST DS 10F DS 0D CTT_TOD DS D ..TOD (STCK) area CTT_OUT DS F ..Output area address CTT_RA DS F ..Return address CTT_CIN DS XL(CTAREAL) ..CONVTOD input area CTT_SOUT DS XL16 ..STCKCON output area DS 0D WORKDSL EQU *-WORKDS * ** Map CONVTOD area * CTAREA DSECT , CTAREA_TIME DS XL4 DS XL4 CTAREA_DATE DS XL4 DS XL4 CTAREAL EQU *-CTAREA END