ibm:vm370-lib:cp:dmkmid.assemble_src
Table of Contents
DMKMID Source
References
- Fixes Applied : 3
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [HRC019DK]
Source Listing
- DMKMID.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkmid.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator