.MCALL .MODULE .MODULE IWEEKD,VERSION=03,COMMENT=,IDENT=NO,LIB=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL Functional Description ; RT-11 System Library (SYSLIB) Function ; ; CALLABLE ENTRY: IWEEKD ; ; FUNCTIONAL DESCRIPTION: ; ; This function returns the day of the week of a given date as an ; integer value between one and seven. One represents SUNDAY, ; while seven represents SATURDAY. ; ; CALLING SEQUENCE: ; ; IWDAY = IWEEKD( MONTH, IDAY, IYEAR) ; ; PASSED ARGUMENTS: ; ; MONTH - INTEGER*2 month between 1 and 12 ; IDAY - INTEGER*2 day between 1 and 31 ; IYEAR - INTEGER*2 year, between 72 and 199 ; or between 1972 and 2099 ; ; All three arguments must be supplied; there are no defaults. ; ; Passed values of MONTH, IDAY and IYEAR are checked against limits. ; If any passed value is out of range, the function returns with ; an error. ; ; RETURNED ARGUMENT VALUES: ; ; ; ; RETURNED FUNCTION VALUE: ; ; IWDAY is a value from 1 through 7, representing the day of ; the date specified. ; or -1, which indicates bad or missing arguments .PSECT SYS$S,D .GLOBL $SYSLB ; Include system library work area. .IIF NDF EIS$I EIS$I = 0 .IIF EQ EIS$I .MCALL SOB .MCALL .ASSUME .CKXX .CKXX ; To prevent overflow for years greater than 2061, the following ; constants are defined. Note that 32767 is both the largest positive ; 16-bit integer and evenly divisible by seven (no. of days in a week). ; When adding bulk years to the day accumulator, the algorithm checks ; to see when the accumulator can hold only two more years or less. ; (TOOBIG = 32767 minus TWO years of weeks). When this happens, a ; one-time adjustment is made (REDUCE). TOOBIG =: 32767.-<106.*7> ; ready to overflow REDUCE =: TOOBIG-7 ; adjustment to prevent overflow ; Limits table. Checks are made against input variables to ensure that ; they are in range. LIMITS: L.LOMO: .WORD 1. ; lowest valid month number L.HIMO: .WORD 12. ; highest valid month number L.LODA: .WORD 1. ; lowest valid day number L.HIDA: .WORD 31. ; highest valid day number (so-so) L.LOYR: .WORD 72. ; lowest valid year number L.HIYR: .WORD 2099. ; highest valid year number L.FXYR: .WORD 1900. ; base of extended year number L.1SYR: .BYTE 72. ; base year number L.LEAP: .BYTE 3. ; mask for leap year determination ; ; NOTE: fails in 2100, but that is ; not a valid date ... L.FEB: .BYTE 2. ; number assigned to month w/leap day L.WEEK: .BYTE 7. ; days in a week IG$MTB: .WORD 0 ; days before Jan 1 .WORD 31. ; days before Feb 1 .WORD 31.+28. ; days before Mar 1 .WORD 31.+28.+31. ; ... .WORD 31.+28.+31.+30. .WORD 31.+28.+31.+30.+31. .WORD 31.+28.+31.+30.+31.+30. .WORD 31.+28.+31.+30.+31.+30.+31. .WORD 31.+28.+31.+30.+31.+30.+31.+31. .WORD 31.+28.+31.+30.+31.+30.+31.+31.+30. .WORD 31.+28.+31.+30.+31.+30.+31.+31.+30.+31. .WORD 31.+28.+31.+30.+31.+30.+31.+31.+30.+31.+30. .PSECT SYS$I,I .ENABLE LSB ; Entry IWEEKD - Get passed arguments, and check their validity IWEEKD::MOV (R5)+,R4 ; Get arg count MOV R5,R2 ; Save pointer to arg table MOV #3,R3 ; loop to get 3 args MOV #LIMITS,R1 ; point to limits table CK.R1=LIMITS 10$: CALL $NXVAL ; Get argument (MONTH, DAY or YEAR) BCS 120$ ; error if arg is missing CMP R0,(R1)+ ; make sure it's high enough BLO 120$ CMP R0,(R1)+ ; make sure it's low enough BHI 120$ SOB R3,10$ ;Checks for the above loop CK.R1 L.LOMO,+2 CK.R1 L.HIMO,+2 CK.R1 L.LODA,+2 CK.R1 L.HIDA,+2 CK.R1 L.LOYR,+2 CK.R1 L.HIYR,+2 ; if (IYEAR .gt. 1900) IYEAR = IYEAR - 1900 ; iy = 72 ! base year ; ndays = 5 ! 1-JAN-72 MOV R0,R5 ; let R5 = year value passed CK.R1 L.FXYR,+2 MOV (R1)+,R4 ; get 2nd tier year constant CMP R5,R4 ; if >=1900 passed, BLT 20$ SUB R4,R5 ; adjust it down CK.R1 L.1SYR,+1 20$: MOVB (R1)+,R3 ; init base year CMP R5,R3 ; final year check BLO 120$ CMP R5,#199. BHI 120$ ; Count the number of days since the RT-11 base day, Saturday 1-Jan-72. ; Accumulate the number in R0. MOV #5,R0 ; account for 1-Jan-72 = Saturday ;30 if (IYEAR .eq. iy) goto 60 ; ndays = ndays+365 ; if ((iy .and. 3) .eq. 0) ndays = ndays+1 ; iy = iy + 1 ; go to 30 CK.R1 L.LEAP,+1 MOVB (R1)+,R4 ; constant for loops 30$: CMP R5,R3 ; Year agrees? BEQ 60$ ; If the next addition of one year of days will overflow the accumulator, ; then reduce the value by a large multiple of seven so that the modulus ; will be preserved. CMP R0,#TOOBIG ; if almost ready to overflow, BLO 40$ SUB #REDUCE,R0 ; reduce by large multpl of 7 40$: ADD #365.,R0 ; add a year to day count BIT R4,R3 ; leapyear? BNE 50$ ; branch if not INC R0 ; otherwise, add a day 50$: INC R3 ; bump comparison year BR 30$ ; and try again. ; if (MONTH .GT. 2 .and. (iy .and. 3) .eq. 0) ndays = ndays + 1 ; ndays = ndays+montab(MONTH) 60$: MOV @(R2)+,R5 ; get month number CK.R1 L.FEB,+1 CMPB R5,(R1)+ ; is it passed FEB? BLE 70$ ; no BIT R4,R3 ; leapyear? BNE 70$ ; no INC R0 ; Yes. Add a day for FEBRUARY 70$: ASL R5 ; make into word index ADD (R5),R0 ; add month's days to year ;80 ndays = ndays + DAY ; iday = MOD(ndays, 7) 80$: ADD @(R2),R0 ; add day of month MOV #<7*7*7>,R3 ; do quick mod 7 (let thing = 7*49) CK.R1 L.WEEK MOVB @R1,R4 ; constant for use in loop 90$: CMP R0,R3 ; can we subtract any more things? BLT 100$ ; branch if not SUB R3,R0 ; otherwise subtract thing BR 90$ ; and loop some more. 100$: CMP R3,R4 ; already in slow mode? (thing=7?) BEQ 110$ ; if so, done. MOV R4,R3 ; let thing = 7 and try some more BR 90$ 110$: INC R0 ; make day 1-based RETURN 120$: MOV #-1,R0 ; error return RETURN .DSABL LSB .END