DAYCALC is a routine to calculate the day of the week, and Gregorian date, using TIME SVC date X'01YYDDDF' input. I like to see a pretty day and date so I don't have to think. To use it, either do a TIME SVC, or set reg-1 to zero and the routine does the SVC. The routine adjusts for leap year and calculates day and date, from 2024 to 2099. The source includes the driver code to test multiple years and show the output. The actual code begins with START. (And you can change the label.)
The routine is re-entrant, so you could assemble it inline, or use it as a subroutine, or include it in the system for common use. DAYCALC is non-standard in that it doesn't create a save-area, rather it just uses the caller's save-area to save 14-1 and the rest of the caller's save-area as work area. The working routine (w/o the test driver) is about 100 lines of code (20% comments), and about 270 bytes of memory. The printed output from the test routine looks like:
INPUT DATES ARE ..YYDDDF WHERE F/C=+ SIGN.
START DATE = JAN 1, 2024 (MONDAY). GOOD TO 2099.
24001F Mon 01/01/24
24059F Wed 02/28/24
24060F Thu 02/29/24
24061F Fri 03/01/24
24365F Mon 12/30/24
25001C Wed 01/01/25
25059C Fri 02/28/25
25060C Sat 03/01/25
25061C Sun 03/02/25
25365C Wed 12/31/25
and the code is:
AGO .PAST
C:\USERS\LIN\DOCUMENTS\Z390CODE\DAYCALC
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\DAYCALC
SET SYSPRINT=%G%.SYSPRINT.TXT
BAT\ASMLG %G%.MLC TIME(1)
THIS ROUTINE CALCULATES THE DAY AND GREGORIAN DATE.
.PAST ANOP
DAYCALC START 0
USING *,R13
B STM-*(R15)
DC 17F'0'
IDMSG DC C'DAYCALC V01.02 TEST ROUTINE AT START'
* V01.01 WORKED.
* V01.02 STRAIGHTENED OUT SPEGITTI CODE. READS EASIER
STM STM R14,12,12(R13)
ST R13,4(R15)
ST R15,8(R13)
LA R13,0(R15)
PUSH PRINT
PRINT NOGEN
YREGS
OPEN (SYSPRINT,OUTPUT)
POP PRINT
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
PUT SYSPRINT,H2
LA R10,DATES
LA R12,20
LOOP L R1,0(R10) LOAD DATE THAT TIME SVC CREATES
CLI 0(R10),C' '
BNE CALL
MVC LINE,LINE-1
PUT SYSPRINT,LINE-1
LA R10,1(R10)
B LOOP
CALL LA 0,LINE+9
BAL BAL R14,START
UNPK LINE+1(7),1(4,R10)
TR LINE+1(7),HEX-240
MVI LINE+7,C' '
AP 0(4,R10),=P'0001000'
*
PUT SYSPRINT,LINE-1
LA R10,4(R10)
CLI 0(R10),0
BNE LOOP
LA R10,DATES
BCT R12,LOOP
B CLOSE
*
PUSH PRINT
PRINT NOGEN
CLOSE CLOSE (SYSPRINT)
POP PRINT
*
RET L R13,4(R13)
LM R14,12,12(R13)
SR R15,R15
BR R14
*
* ======================================
* THIS IS THE ROUTINE. I CHANGED IT SO THAT IT ONLY USES REGS 14-1
* SO THAT THE ROUTINE CAN BE PUT SOMEWHERE ELSE W/O WORRYING IF IT
* HAS MESSED WITH A BASE REGISTER.
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
START DS 0H
******* TIME DEC
* R13 DSECT
* 08(2) YEAR
* 10(2) LOW 2 BITS OF YEAR, 00=LEAP YEAR
* 20(8) TIME AND DATE
* 28(8) YEAR PACKED (R14)
* 36(8) DAY OF YEAR
* 44(2) DAY BINARY
* 48(2) CALC PACKED YEAR
* 56(8) CALC CAY OF MONTH
*
* INPUT IS, R0 = PRINT AREA
* R1 = DATE FROM TIME SVC. IF 0, THEN WE DO THE TIME SVC.
*
* ROUTINE IS RE-ENTRANT. DOES NOT CREATE A SAVE AREA.
* USES CALLER'S SAVEAREA TO SAVE 14,1 AND THE REST FOR WORK-AREA.
*
STM R14,R1,12(R13) SAVE TIME (R0) AND DATE (R1)
LTR R1,R1
BNZ DAYCALCA
TIME DEC
ST R1,24(13)
* -------------------SAVE YEAR, PACKED+BINARY DAY, PACKED+BINARY---
DAYCALCA ZAP 36(8,R13),26(2,R13) PACK DAY OF YEAR
MVI 35(R13),X'0F' JUST CREATE PACKED SIGN
MVO 28(8,R13),25(1,R13) PACK YEAR.
*
CVB R14,28(R13) YEAR
STH R14,8(R13) SAVE YEAR
STH R14,10(R13) TWICE
NC 10(2,R13),=X'0003' LEAP YEAR FLAG 0=LEAP YEAR
*
CVB R0,36(R13)
STH R0,44(R13) DAY BINARY
*
* IF PROCESSING IS DONE AT NIGHT, AND THIS MIGHT RUN
* BEFORE MIDNIGHT SOME DAYS, AND AFTER MIDNIGHT OTHER DAYS,
* THEN YOU WANT TO CHECK THE TIME, AND ADJUST THE DAY
* SO THAT PROCESSING SHOWS THE SAME REGARDLESS OF TIME.
* EG, ANYTHING BEFORE NOON IS CONSIDERED THE PRIOR DAY.
* OR THE REVERSE, ANYTHING AFTER 6PM IS THE NEXT DAY.
*
* ----------------------------- CALC DAY
SH R14,=H'24'
MH R14,=H'365'
LA R1,3(R14) <===== 'CAUSE THIS WORKS!!!
SRL R1,2 CALC # LEAP YEARS
AH R1,44(13)
LA R1,0(R14,R1)
* ============================= DAY OF WEEK ==================
SR R0,R0
D R0,=F'7' AFTER DIVIDE= ODD REG=QUOTION,
LR R1,R0 EVEN REG=REMAINDER.
SLL R1,2
LA R15,DAYTBL(R1)
* --------------------------------------
L R1,20(13) LOAD PRINT LINE LOCATION
MVC 0(4,R1),0(15) MOVE DAY TO PRINT LOCATION
NC 1(2,R1),=X'BFBF'
* ================================== DAY DONE, GET CALENDAR MONTH+DAY
LH 14,44(R13) LOAD DAY
LA R15,MONTHTBL-1 DAYS IN A MONTH
CLI 11(R13),0 Q. IS THIS A LEAP YEAR?
BNE *+8 NO, OKAY
LA R15,12(R15) YES, POINT TO LEAP YEAR TBL
SR R0,R0
ZAP 48(2,13),P0 INIT MONTH=00
*
MONTHLOP LA R15,1(R15) FIRST/NEXT MONEY
AP 48(2,13),P1 ADD 1 TO MONTH
IC R0,0(R15) LOAD DAYS THIS MONTH
SR R14,R0 SUBT = # DAS LEFT
BP MONTHLOP Q. STILL POSITIVE, LOOP
AR R14,R0 NO, ADD LAST MONTH'S DAYS BACK
CVD R14,56(13) STORE TODAY'S DAY#
OI 63(13),X'0F' TODAY'S DATE SIGN
*
OI 49(13),X'0F' MONTH SIGN
UNPK 3(3,1),48(2,13) UNPK MONTH
MVI 3(1),C' ' ERASE HIGH 0
*
UNPK 6(3,1),62(2,13) UNPK DAY OF MONTH
MVI 6(1),C'/'
*
UNPK 9(3,R1),34(2,R13) UNPK YEAR PASSED
MVI 9(R1),C'/'
LM 14,1,12(13)
BR 14
* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*
MONTHTBL DC AL1(31,28,31,30,31,30,31,31,30,31,30,99)
DC AL1(31,29,31,30,31,30,31,31,30,31,30,99)
DAYTBL DC C'SUN MON TUE WED THU FRI SAT SUN '
*
* 0126 = JULY 2026 205 = DAY OF YEAR (JULY 24, 2026)
*
* BIN ==> R0= 004E7D54 R1= 0126205F
* DEC==> R0= 14212162 R1= 0126205F
*
LTORG
*DW DC D'-1'
*HW DC H'0'
P0000 DC PL8'0'
P0 DC X'0F'
P1 DC X'1F'
DC C'TEST OF TIME SVC AND DAY CALC'
*
PRINT NOGEN
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,RECFM=FT,LRECL=80,MACRF=PM
*
DATES DC C' '
DC X'0124001F'
DC X'0124059F'
DC X'0124060F'
DC X'0124061F'
DC X'0124365F'
DC X'00' '
*
H2 DC C' START DATE = JAN 1, 2024 (MONDAY). GOOD TO 2099. '
LINE DC CL80' INPUT DATES ARE ..YYDDDF WHERE F/C=+ SIGN.'
*
HEX DC C'0123456789ABCDEF'
* -------------------------------------------------
@@PAD#0 EQU *-DAYCALC
@@PAD#1 EQU @@PAD#0+4095
@@PAD#3 EQU @@PAD#1/(4097)
@@PAD#4 EQU (@@PAD#3*4096)
ORG DAYCALC+@@PAD#4
*
END