MID TITLE 'DMKMID (CP) VM/370 - RELEASE 6' 00001000 *. 00002000 * MODULE NAME - 00003000 * 00004000 * DMKMID 00005000 * 00006000 * FUNCTION - 00007000 * 00008000 * TO CHANGE THE DATE IN SYSTEM LOW STORAGE 00009000 * AT MIDNITE AND RESET THE CLOCK COMPARATOR FOR 00010000 * THE NEXT MIDNITE EVENT. ALSO SEND MESSAGES TO 00011000 * ALL USERS ABOUT THE DATE CHANGE. 00012000 * 00013000 * ATTRIBUTES - 00014000 * 00015000 * RE-ENTERABLE, PAGEABLE, CALLED VIA SVC 00016000 * 00017000 * ENTRY POINTS - 00018000 * 00019000 * DMKMIDNT - CHANGE DATE AT MIDNITE 00020000 * 00021000 * ENTRY CONDITIONS - 00022000 * 00023000 * GPR10 - TRQBLOK FOR TIMER EVENT 00024000 * GPR12 - BASE ADDRESS 00025000 * GPR13 - SAVE AREA 00026000 * 00027000 * EXIT CONDITIONS - 00028000 * 00029000 * TIMER EVENTS RESET FOR NEXT MIDNITE 00030000 * MESSAGES ISSUED TO ALL USERS 00031000 * DATE ADJUSTED 00032000 * NO RETURN CONDITIONS TO CALLER 00033000 * 00034000 * CALLS TO OTHER ROUTINES - 00035000 * 00036000 * DMKERMSG - TO WRITE ERROR MESSAGE 00037000 * DMKSCHST - TO SCHEDULE NEXT MIDNITE EVENT 00038000 * DMKCVTDT - TO GET NEW DATE AND TIME 00039000 * DMKLOKSW - SWITCH TO ANOTHER VMBLOK IF SYSTEM IS AP-MODE 00039100 * 00040000 * EXTERNAL REFERENCES - 00041000 * 00042000 * DMKSYSTI - TO GET TIME ZONE 00043000 * DMKSYSDW - TO CHANGE DAY OF THE WEEK 00044000 * DMKSYSVM - TO FIND ALL VMBLOKS FOR MESSAGES 00045000 * DMKSYSMU - TO RESET MAXIMUM NUMBER OF USERS 00045100 * DMKSYSNM - USED TO RESET DMKSYSMU 00045200 * 00046000 * TABLES / WORK AREAS - 00047000 * 00048000 * VMBLOK 00049000 * TRQBLOK 00050000 * DATE - IN PSA 00051000 * TODATE - IN PSA 00052000 * WKDAY - DAY OF THE WEEK TABLE 00053000 * MTBL - DAYS IN MONTH TABLE 00054000 * 00055000 * REGISTER USAGE - 00056000 * 00057000 * R0-R9 SCRATCH AND LINKAGE AND CALLING PARAMETERS 00058000 * R10 - TRQBLOK 00059000 * R11 - VMBLOKS FOR MESSAGES 00060000 * R12 - BASE 00061000 * R13 - SAVE AREA 00062000 * R14-R15 - LINKAGE 00063000 * 00064000 * NOTES - 00065000 * 00066000 * IF THE DATE IS NOT VALID THE DAY OF THE WEEK IS 00067000 * CHANGED AND THE NEXT MIDNITE EVENT IS SCHEDULED 00068000 * BUT THE DATE IS NOT ADJUSTED. THE DATE CAN BE 00069000 * MANUALLY CHANGED BY STORING (STCP) IN THE DATE 00070000 * FIELD IN PSA .... WITH EXTREME CARE OF COURSE. 00071000 * 00072000 * OPERATION - 00073000 * 00074000 * 1. ADJUST THE TIMER EVENT IN THE TRQBLOK FOR NEXT 00075000 * MIDNITE AND CALL DMKSCHST TO SET THE EVENT 00076000 * 00077000 * 2. VALIDATE THE PRESENT DATE ... IT MUST BE IN THE 00078000 * FORM -- MM/DD/YY, WITH NO DIGIT LESS THAN 0 OR 00079000 * GREATER THAN 9. ISSUE ERROR MSG DMKMID310E IF ERROR 00080000 * 00081000 * 3. CONVERT MM DD YY TO BINARY FOR ARITHMETIC 00082000 * 00083000 * 4. ADJUST THE DAY BY ADDING ONE. 00084000 * ADJUST THE MONTH BY ONE IF THE DAY IS OVER THE 00085000 * MONTH LIMIT ( CHECK AGAINST THE MTBL). 00086000 * ADJUST THE YEAR BY ONE IF THE MONTH GOES TO 13. 00087000 * SET THE DAY TO ONE FOR A NEW MONTH. 00088000 * SET THE MONTH TO ONE FOR A NEW YEAR. 00089000 * 00090000 * 5. CONVERT THE MM DD YY TO DECIMAL AND STORE BACK 00091000 * IN THE DATE FIELD 00092000 * 00093000 * 6. SET THE DAY OF THE WEEK FIELD IN DMKSYSDW 00094000 * 00095000 * 7. SEND A MESSAGE TO ALL USERS ABOUT THE DATE CHANGE 00096000 * 00097000 * 7A.RESET DMKSYSMU (MAXIMUM NUMBER OF USERS THAT HAVE 00097100 * LOGGED ON THE SYSTEM) SO THE RESPONSE TO "QUERY 00097200 * CPSYS" WILL BE MORE MEANINGFUL. (DMKSYSMU IS SET TO 00097300 * THE CURRENT NUMBER OF USER'S LOGGED ON THE SYSTEM, 00097400 * DMKSYSNM). 00097500 * 00097600 * 8. RETURN TO CALLER ( DMKSCH ) 00098000 * 00099000 * ERROR MESSAGES - 00100000 * 00101000 * DMKMID310E DATE MM/DD/YY INVALID; NOT CHANGED 00102000 * 00103000 *. 00104000 EJECT 00104100 COPY OPTIONS @V407508 00104200 COPY LOCAL OPTIONS @V407508 00104300 EJECT 00104400 DMKMID START 00105000 MODID DC CL8'DMKMID' MODULE IDENTIFIER @V305435 00106000 EXTRN DMKERMSG @V305435 00107000 EXTRN DMKDMPTD,DMKDMPDT EXTERNAL TIME AND DATE @VA08237 00107101 EXTRN DMKSYSMU HRC019DK 00107201 EXTRN DMKSYSNM HRC019DK 00107301 EXTRN DMKSCHST,DMKCVTDT,DMKSYSTI,DMKSYSDW @V200820 00108000 EXTRN DMKENTKC,DMKSTKCP,DMKSYSTS,DMKSYSTE,DMKPRGMC,DMKSYSAT 00108100 EXTRN DMKMNIST @VMD0138 00108250 USING *,R12 BASE 00109000 USING VMBLOK,R11 00110000 USING SAVEAREA,R13 00111000 DMKMIDNT RELOC ENTRY PRINT FOR MIDNIGHT @V305435 00112000 USING PSA,R0 00113000 USING TRQBLOK,R10 00114000 LA R2,TRQBVAL POINT TO CLOCK COMP VALUE 00115000 BAL R3,ADJTIME SET FOR NEXT MIDNITE 00116000 LR R1,R10 POINT TO TRQBLOK 00117000 CALL DMKSCHST SCHEDULE NEXT EVENT 00118000 LA R2,TODATE POINT TO MIDNITE CONSTANT 00119000 BAL R3,ADJTIME ADJUST FOR NEW MIDNITE 00120000 L R2,=A(DMKDMPTD) GET DUMP'S MIDNIGHT @VA07902 00120010 STM R4,R5,0(R2) AND REFRESH IT @VA07902 00120020 L R14,PREFIXA GET PREFIX ADDRESS OF THIS PROC @VA09181 00120030 MVC TODATE-PSA(,R14),TODATE NEW MIDNIGHT CONSTANT @VA09181 00120050 * INTO ABSOLUTE PSA 00120070 L R14,PREFIXB GET PREFIX ADDRESS OF OTHER PROC @V4M0222 00120100 MVC TODATE-PSA(,R14),TODATE MOVE NEW MIDNIGHT @V4M0222 00120200 * CONSTANT INTO OTHER PROC'S PSA @V4M0222 00120300 SPACE 2 00121000 * NOW CHECK THE DATE FOR VALIDITY 00122000 MVI YEARSW,00 CLEAR SW 00123000 LA R7,DATE POINT TO DATE 00124000 LA R8,8 COUNTER 00125000 DTLOOP CLI 0(R7),C'0' IS IT LESS THAN ZERO ?? 00126000 BL TSTSLSH YES, CAN ONLY BE A / 00127000 CLI 0(R7),C'9' IS IT BIGGER THAN NINE ?? 00128000 BH DATERR YES, NO GOOD 00129000 DTNXT LA R7,1(R7) POINT TO NEXT BYTE 00130000 BCT R8,DTLOOP LOOP FOR ALL OF DATE 00131000 B DATEOK DATE IS OK .. 00132000 TSTSLSH CLI 0(R7),C'/' IS IT A SLASH 00133000 BE DTNXT YES, OK 00134000 DATERR LA R2,310 ERROR MESSAGE NUMBER @V305435 00135000 LA R0,L'DATE LENGTH OF TEXT OF MESSAGE @V305435 00136000 ICM R0,B'1110',MODID+3 MODULE IDENTIFIER @V305435 00137000 ICM R2,B'1000',ERMPARM PARMS FOR DMKERMSG @V305435 00138000 CALL DMKERMSG CALL THE MESSAGE WRITTER @V305435 00139000 B SETDAY ADJUST DAY BUT NOT DATE 00140000 SPACE 2 00141000 * DATE IS OK .. CONVERT MM DD YY TO BINARY 00142000 DATEOK LA R2,DATE POINT TO MM 00143000 BAL R3,DTBIN CONVERT 00144000 STH R0,BINMM SAVE 00145000 LA R2,DATE+3 POINT TO DD 00146000 BAL R3,DTBIN CONVERT 00147000 STH R0,BINDD SAVE 00148000 LA R2,DATE+6 POINT TO YY 00149000 BAL R3,DTBIN CONVERT 00150000 STH R0,BINYY SAVE 00151000 TM BINYY+1,X'03' TEST FOR LEAP YEAR 00152000 BNZ NOTLPY NO, FEB OK IN TABLE 00153000 MVI FEB+1,29 SET FEB FOR LEAP YEAR 00154000 SPACE 1 00155000 * NOW ADJUST THE MM DD YY 00156000 NOTLPY LH R1,BINDD GET DAY 00157000 LA R1,1(R1) UP THE DAY 00158000 STH R1,BINDD SET DAY 00159000 LH R1,BINMM GET MONTH 00160000 SLL R1,1 TIMES TWO 00161000 LA R2,MTBL-2(R1) POINT TO MONTH DAY TABLE 00162000 LH R1,0(R2) GET MAX DAYS PER MONTH 00163000 CH R1,BINDD HAVE WE GONE OVER ?? 00164000 BNL SETDATE NO, DAY AND MONTH OK 00165000 LA R1,1 SET DAY ONE 00166000 STH R1,BINDD .. 00167000 LH R1,BINMM GET MONTH 00168000 LA R1,1(R1) NEXT MONTH 00169000 STH R1,BINMM SET MONTH 00170000 CH R1,=H'13' NEW YEAR ?? 00171000 BL SETDATE MONTH OK 00172000 LA R1,1 MONTH ONE 00173000 STH R1,BINMM SET MONTH 00174000 LH R1,BINYY GET YEAR 00175000 LA R1,1(R1) NEXT YEAR 00176000 STH R1,BINYY SET NEW YEAR 00177000 OI YEARSW,X'01' SET NEW YEAR SWITCH 00178000 SPACE 1 00179000 * NOW SET DATE TO DECIMAL FOR ARITHMETIC 00180000 SETDATE LH R0,BINMM GET MONTH 00181000 BAL R3,DTDEC CONVERT TO DECIMAL 00182000 MVC DATE(2),TEMPSAVE+2 SET MONTH 00183000 LH R0,BINDD GET DAY 00184000 BAL R3,DTDEC CONVERT 00185000 MVC DATE+3(2),TEMPSAVE+2 SET DAY 00186000 LH R0,BINYY GET YEAR 00187000 BAL R3,DTDEC CONVERT 00188000 MVC DATE+6(2),TEMPSAVE+2 00189000 L R14,PREFIXA GET PREFIX ADDRESS OF THIS PROC @VA09181 00189025 MVC DATE-PSA(,R14),DATE NEW DATE INTO ABSOLUTE PSA @VA09181 00189075 L R14,PREFIXB GET PREFIX ADDRESS OF OTHER PROC @V4M0222 00189100 MVC DATE-PSA(,R14),DATE MOVE NEW DATE INTO OTHER @V4M0222 00189200 * PROCESSOR'S PSA @V4M0222 00189300 L R2,=A(DMKDMPDT) MUST REFRESH DMKDMP'S .... @VA08237 00189400 MVC 0(8,R2),DATE DATE AS WELL @VA08237 00189500 SPACE 2 00190000 * NOW RESET THE DAY OF THE WEEK 00191000 SETDAY L R1,=A(DMKSYSDW) GET ADDRESS OF CURRENT DAY 00192000 SR R2,R2 CLEAR 00193000 IC R2,0(R1) GAT DAY OF WEEK NUMBER 00194000 LA R2,1(R2) NEXT DAY 00195000 MH R2,=H'11' INDEX FOR TABLE 00196000 LA R2,WKDAY-22(R2) INDEX INTO TABLE 00197000 * NOTE .. 02 = TUESDAY .... 08 = MONDAY .. THINK ABOUT IT !! 00198000 MVC 0(11,R1),0(R2) SET NEW DAY OF WEEK DATA 00199000 MVC MDWEEK(9),2(R2) SET DAY OF WEEK 00200000 MVI MDWEEK+9,C' ' ... FOLLOWED BY A BLANK @VA05017 00200500 L R2,=A(DMKSYSTI) GET ZONE ID ADDRESS 00201000 MVC MDZONE,0(R2) GET ZONE 00202000 SR R2,R2 CLEAR 00203000 IC R2,1(R1) GET LENGTH OF WEEKDAY 00204000 LA R1,MDATE(R2) INDEX FOR DATE POSITION 00205000 LA R2,MTIME TIME POSITION 00206000 MVC MDATEL,=CL8' ' CLEAR AREA 00207000 CALL DMKCVTDT GET DATE AND TIME 00208000 LA R1,MMSG NEW DAY MESSAGE 00209000 LA R0,MMSGL SIZE 00210000 BAL R3,MSGALL GIVE ALL THE MESSAGE 00211000 L R1,=A(DMKSYSNM) POINTER TO CURRENT USER CNT HRC019DK 00211001 L R1,0(,R1) GET THE ACTUAL COUNT HRC019DK 00211002 L R2,=A(DMKSYSMU) POINTER TO MAX USER COUNTER HRC019DK 00211003 ST R1,0(,R2) SET MAX TO CURRENT HRC019DK 00211004 L R4,=A(DMKSYSTS) GET THE START TIME @V50A2B5 00211010 L R5,=A(DMKSYSTE) GET THE END TIME @V50A2B5 00211020 CLC 0(8,R4),ZEROES DID IT START AT 0 @V50A2B5 00211030 BNE CALLST NO @V50A2B5 00211040 CLC 0(8,R5),HRS24 WILL IT END AT HOUR 24 @V50A2B5 00211050 BNE CALLST @V50A2B5 00211060 L R4,=A(DMKPRGMC) SEE IF MONITOR ALREADY ON @V50A2B5 00211070 ICM R4,B'1111',0(R4) @V50A2B5 00211080 BZ EXITS NO @V50A2B5 00211090 L R4,=A(DMKSYSAT) SEE IF AUTODISK IS ON @V50A2B5 00211100 TM 0(R4),AUTGO @V50A2B5 00211110 BNO EXITS NO @V50A2B5 00211120 LA R0,CPEXSIZE @V50A2B5 00211130 CALL DMKFREE GET A CPEXBLOK @V50A2B5 00211140 USING CPEXBLOK,R1 @V50A2B5 00211150 STM R0,R15,CPEXR0 PUT IN THE REGISTERS @V50A2B5 00211160 L R5,=A(DMKENTKC) ADDRESS OF ROUTINE @V50A2B5 00211170 ST R5,CPEXADD @V50A2B5 00211180 ST R5,CPEXR12 AND R12 @V50A2B5 00211190 L R5,ASYSOP OPERATOR DOES IT @V50A2B5 00211200 ST R5,CPEXR11 @V50A2B5 00211210 CALL DMKSTKCP STACK THE BLOCK @V50A2B5 00211220 B EXITS @V50A2B5 00211230 CALLST CALL DMKMNIST HANDLE THE TRQS @VMD0138 00211245 EXITS EQU * @V50A2B5 00211250 EXIT 00212000 EJECT 00213000 * DMKMID SUBROUTINES 00214000 DTBIN SR R0,R0 CLEAR 00215000 ST R0,TEMPSAVE CLEAR 00216000 ST R0,TEMPSAVE+4 CLEAR 00217000 PACK TEMPSAVE+6(2),0(2,R2) PACK MM DD OR YY 00218000 NI TEMPSAVE+7,X'F0' SIGN OFF 00219000 OI TEMPSAVE+7,X'0C' MAKE SIGN C 00220000 CVB R0,TEMPSAVE CONVERT TO BINARY 00221000 BR R3 RETURN 00222000 SPACE 2 00223000 DTDEC CVD R0,TEMPSAVE CONVERT TO DECIMAL 00224000 OI TEMPSAVE+7,X'0F' MAKE SIGN F 00225000 UNPK TEMPSAVE(4),TEMPSAVE+6(2) UNPACK DATA 00226000 BR R3 RETURN 00227000 SPACE 2 00228000 ADJTIME LM R4,R5,0(R2) GET TIME TO ADJUST 00229000 LA R8,1 CONSTANT 00230000 LM R6,R7,HRS24 24 HOURS IN MICRO SECONDS SHIFTED 00231000 ALR R5,R7 ADD 1 WORD 00232000 BC 12,*+6 NO OVERFLOW 00233000 ALR R4,R8 ADD 1 00234000 ALR R4,R6 ADD 2 WORD 00235000 STM R4,R5,0(R2) RESET TIME 00236000 BR R3 RETURN 00237000 SPACE 2 00238000 MSGALL DS 0H SEND MESSAGE TO ALL @V407508 00239100 STM R0,R1,SAVEWRK2 SAVE REGS DESTROYED BY SWTCHVM @V407508 00239200 L R1,ASYSVM GET ADDRESS OF SYSTEM VMBLOK @V407508 00239300 L R1,VMPNT-VMBLOK(,R1) POINT TO STRING OF USERS @V407508 00239400 LTR R1,R1 ARE THERE ANY? @V407508 00239500 BE MSGEXIT NO - EXIT 00243000 LR R9,R1 REMEMBER THE FIRST VMBLOK @V407508 00244100 NXTM DS 0H @V407508 00244200 TM VMMLEVEL-VMBLOK(R1),VMMSGON RECEIVING MESSAGES? @V407508 00244300 BZ NXTUSER NO FIND NEXT GUY 00247000 SWTCHVM LOCK THIS VMBLOK @V407508 00247100 LM R0,R1,SAVEWRK2 RESTORE SAVED REGISTERS @V407508 00247200 L R2,OPTIONS SET UP OPTION PARMS FOR DMKQCNWT @VA15404 00248100 CALL DMKQCNWT SEND MESSAGE @VA15404 00248200 LR R1,R11 SET UP REG 1 CORRECTLY @V407508 00249100 NXTUSER DS 0H GET THE NEXT VMBLOK @V407508 00249200 L R1,VMPNT-VMBLOK(,R1) GET NEXT VMBLOK ADDRESS @V407508 00249300 CR R9,R1 BACK TO START ?? @V407508 00249400 BNE NXTM NO - NEXT MESSAGE, PLEASE 00252000 SPACE 00253000 MSGEXIT DS 0H SET UP TO EXIT @V407508 00254100 L R1,SAVER11 GET CALLERS VMBLOK ADDRESS @V407508 00254200 SWTCHVM LOCK CALLERS VMBLOK @V407508 00254300 BR R3 EXIT 00256000 EJECT 00257000 * DMKMID TABLES AND WORK AREAS 00258000 YEARSW DC H'0' SWITCH 01 FOR NEW YEAR 00259000 SPACE 2 00260000 HRS24 DS 0D 00261000 DC X'000141DD76000000' 24 HOURS IN TOD CLOCK UNITS 00262000 SPACE 1 00263000 WKDAY DC X'02',X'06',CL9'TUESDAY' 00264000 DC X'03',X'08',CL9'WEDNESDAY' 00265000 DC X'04',X'07',CL9'THURSDAY' 00266000 DC X'05',X'05',CL9'FRIDAY' 00267000 DC X'06',X'07',CL9'SATURDAY' 00268000 DC X'07',X'05',CL9'SUNDAY' 00269000 DC X'01',X'05',CL9'MONDAY' 00270000 BINMM DC H'0' MONTHS IN BINARY 00271000 BINDD DC H'0' DAYS 00272000 BINYY DC H'0' YEARS 00273000 SPACE 2 00274000 MTBL DC H'31' JAN 00275000 FEB DC H'28' FEB 00276000 DC H'31' MAR 00277000 DC H'30' APR 00278000 DC H'31' MAY 00279000 DC H'30' JUN 00280000 DC H'31' JUL 00281000 DC H'31' AUG 00282000 DC H'30' SEP 00283000 DC H'31' OCT 00284000 DC H'30' NOV 00285000 DC H'31' DEC 00286000 EJECT 00287000 ERMPARM DC X'B0' PARM=RETURN+OPERATOR+ALARM @V305435 00288000 OPTIONS DC A(ALARM+NORET+NOTRESP) MASK FOR MIDNIGHT MSG @VA15404 00288100 * PASSED ONTO DMKQCNWT @VA15404 00288200 SPACE 2 00289000 MMSG DC X'151515' 00290000 DC C'TIME IS ' 00291000 MTIME DC CL8' ' 00292000 DC C' ' 00293000 MDZONE DC CL3' ' 00294000 DC C' ' 00295000 MDWEEK DC CL10' ' 00296000 MDATE EQU MDWEEK+2 00297000 MDATEL DC CL8' ' 00298000 DC X'1515' CR 00299000 MMSGL EQU *-MMSG 00300000 EJECT 00301000 COPY SAVE 00302000 COPY VMBLOK 00303000 COPY EQU 00304000 PSA 00305000 COPY MONBLOKS @V50A2B5 00305100 COPY TIMER 00306000 END 00307000