WURZBACH@OSHKOSHW.BITNET ("William F. Wurzbach") (01/05/90)
Regarding the recent inquiry about extracting the day of the week
from the date, this is a program I wrote for the mainframe world, but I'm
sure it can be adapted for micro use. I use this program as the first step
in a daily job that must execute different programs on different days of
the week. Because this program returns the day of the week as a condition
code, it can be use to conditionally execute any following steps. Thus,
you can run the same job every day, but different things will happen,
based on what day of the week it is. :-)
Essentially, the formula used is
weekday = D + [(13M-1)/5] + Y + [Y/4] + [C/4] - 2C mod 7
where: D=day number M=month number Y=year number C=century number
1 - 31 1 - 12 00 - 99 19 - ?
[ ... ] means "largest INTEGER less than or equal to"
ie) calculate and drop any remainder
mod 7 means "divide by seven and *keep* only the remainder"
Note also that month numbers are slightly shifted as follows:
1 = March 2 = April ... 11 = January 12 = February
Actually, since I could only get a Julian date from the system, the first
half of the program is spent just calculating day, month, and year numbers.
If you already have these, you can start right in at the section labelled
CALCDAY, where the above formula is calculated, or use any other conversion
routine you like.
Also note that, technically, the weekday number is zero-based
(eg. 0=Sun, 1=Mon, 2=Tue, ... 6=Sat ), but the last instruction before
exiting in the program adds one to the answer so that the condition code
is non-zero and corresponds to the values shown at the top of the program.
The constant CENTURY is also not necessary if you already have the
Gregorian date -- I simply couldn't infer it from my system Julian date
and so had to hardcode it. Clumsy but functional.
Sorry for the length of this reply, but there is room for confusion
here. Hope this helps.
WEEKDAY CSECT
**********************************************************************
* FUNCTION : RETURN A CONDITION CODE EQUAL TO THE CURRENT DAY
* OF THE WEEK, ACCORDING TO THE FOLLOWING FORMAT :
*
* 1 - SUN 2 - MON 3 - TUE 4 - WED
* 5 - THU 6 - FRI 7 - SAT
*
* VALID FOR ALL DATES AFTER MARCH 1, 1600.
*
* AUTHOR : BILL WURZBACH DECEMBER 22, 1986
*
* VERSIONS : OS/MVS/SP 1.3.3 TSO/E REL 2.0
*
* --- NOTE --- NOTE --- NOTE --- NOTE --- NOTE --- NOTE ---
*
* CHANGE VALUE OF CENTURY TO 20 ON DECEMBER 31,1999 .
*
**********************************************************************
*
R00 EQU 00 WORK REG
R01 EQU 01 PACKED JULIAN DATE FROM TIME
R02 EQU 02 WORK REG
R03 EQU 03 WORK REG
R04 EQU 04 WORK REG
R05 EQU 05 WORK REG
R06 EQU 06 DAY NUMBER
R07 EQU 07 MONTH NUMBER AND WORK REG
R08 EQU 08 YEAR NUMBER
R09 EQU 09 CENTURY NUMBER
R10 EQU 10 WORK REG
R11 EQU 11 WORK REG
R12 EQU 12 PROGRAM BASE REGISTER
R13 EQU 13 REGISTER SAVE AREA POINTER
R14 EQU 14 RETURN ADDRESS REGISTER
R15 EQU 15 WEEKDAY CODE RETURN REG
*
EJECT
PRINT ON,GEN
SETUP DS 0F
***********************************************************************
* SAVE REGISTERS AND ESTABLISH ADDRESSIBILITY
***********************************************************************
STM R14,R12,12(R13) SAVE REGISTERS
BALR R12,0 ESTABLISH PROGRAM BASE ADDRESS
USING *,R12 ADDRESSIBILITY
LA R11,SAVEREGS LOAD ADDRESS OF SAVE AREA
ST R13,4(R11) BACKWARD SAVE AREA POINTER
ST R11,8(R13) FORWARD SAVE AREA POINTER
LR R13,R11 ADDRESS OF SAVE AREA IN R13
SPACE 2
***********************************************************************
* GET JULIAN DATE AND YEAR FROM SYSTEM
***********************************************************************
JULGET XR R06,R06 CLEAR R06
ST R06,DBLWORD CLEAR TOP OF DOUBLEWORD
TIME
ST R01,DBLWORD+4 SAVE PACKED DATE IN WORK AREA
CVB R07,DBLWORD CONVERT TO BINARY
D R06,F1000 R06 = DAY / R07 = YEAR
ST R07,YEAR SAVE YEAR FOR LATER USE
LTR R07,R07 YEAR = 00 ?
BNZ *+8 NO - USE YEAR VALUE
L R07,CENTURY YES - USE CENTURY
N R07,F3 MOD 4
IC R07,JULADD(R07) ADJUST IF LEAP YEAR
STC R07,JULTAB+5 SAVE IN TABLE
LA R07,JULTAB-4 PREPARE FOR LOOP
SPACE 2
***********************************************************************
* CONVERT TO MONTH AND DAY FORMAT
***********************************************************************
JULOOP LA R07,4(R07) POINT TO NEXT MONTH
SH R06,0(R07) SUBTRACT DAYS FOR THIS MONTH
BP JULOOP LOOP WHILE > 0
AH R06,0(R07) ADD DAYS BACK
EJECT
***********************************************************************
* CALCULATE DAY OF THE WEEK
***********************************************************************
CALCDAY DS 0H R06 = DAY
LH R07,2(R07) R07 = MONTH
L R08,YEAR R08 = YEAR
L R09,CENTURY R09 = CENTURY
C R07,F11 JAN OR FEB ?
BL *+18 NO
LTR R08,R08 YES - YEAR = 00 ?
BNZ *+10 NO - KEEP AS IS
LA R08,100(R08) YES - RESET TO 99
BCTR R09,0 ADJUST CENTURY FOR JAN/FEB
BCTR R08,0 ADJUST YEAR FOR JAN/FEB
LR R15,R06
XR R06,R06
M R06,F13 D
BCTR R07,0
XR R06,R06
D R06,F5 + !(13M - 1)/5!
AR R15,R07
AR R15,R08 + Y
SRA R08,2
AR R15,R08 + ! Y/4 !
SLA R09,1
SR R15,R09 - 2C
SRA R09,3
AR R15,R09 + ! C/4 !
LTR R15,R15
BNM MOD7SUB
MOD7ADD A R15,F7 MODULO 7
BM MOD7ADD
MOD7SUB S R15,F7
BNM MOD7SUB
A R15,F7
LA R15,1(R15) SHIFT TO 1 BASED
SPACE 2
***********************************************************************
* RESTORE REGISTERS AND RETURN
***********************************************************************
EXIT L R13,4(R13) RELOAD CALLER SAVE AREA ADDRESS
L R14,12(R13) RELOAD CALLER RETURN ADDRESS
LM R00,R12,20(R13) RESTORE CALLER REGISTERS
BR R14 RETURN TO CALLER
SPACE 4
***********************************************************************
* STORAGE AND WORK AREAS
***********************************************************************
LTORG
*
DBLWORD DS D
SAVEREGS DC 18F'0'
F3 DC F'3'
F5 DC F'5'
F7 DC F'7'
F11 DC F'11'
F13 DC F'13'
F1000 DC F'1000'
CENTURY DC F'19'
YEAR DS F
JULADD DC X'1D1C1C1C'
JULTAB DC X'001F000B001C000C001F0001001E0002001F0003001E0004'
DC X'001F0005001F0006001E0007001F0008001E0009001F000A'
*
END WEEKDAY
=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
William Wurzbach, System Programmer | Fax : (414) 424 - 0010
c/o Computer Services | Phone : (414) 424 - 3018
University of Wisconsin - Oshkosh | Bitnet : WURZBACH@OSHKOSHW
800 Algoma Blvd. | Internet : WURZBACH@OSHKOSH.WISC.EDU
Oshkosh, Wisconsin 54901 |
=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=