10
20
30
40 :
50 DIM mc% 99
60 FOR P=0 TO 1
70 P%=mc%:O%=P%
80 [OPT P*2+4
90 \ On entry R0=day, 1..31
100 \ R1=month, 1..12
110 \ R2=year-1900, 0..255
120 \ On exit R0=day of week 0..6 for Sun..Sat, needs incrementing with
130 \ ADD R0,R0,#1 after calling to become standard 1..7 range
140 \ Size 76 bytes (68 bytes if year 1900 reduction removed)
150 \
160 .DayOfWeek0
170 SUB R2,R2,#1900 AND &FF00 :\ Reduce year 1900+y to y
180 SUB R2,R2,#1900 AND &00FF
190 .DayOfWeek
200 CMP R1,#3
210 SUBLOS R2,R2,#1 :\ If Jan or Feb, decrement year
220 MOVMI R2,#5 :\ 1900 is not a leap year
230 ADD R0,R0,R2 :\ R0=day+year
240 ADD R0,R0,R2,LSR #2 :\ R0=day+year+year/4
250 CMP R2,#2100-1900 :\ 2100 is not a leap year
260 SUBHS R0,R0,#1 :\ R0=day+year+year/4-(year>2099)
270 ADR R2,dowMonths-1 :\ R2=>month offsets
280 LDRB R1,[R2,R1] :\ R1=month offset
290 ADD R0,R0,R1 :\ R0=day+year+year/4-(year>2099)+offset[month]
300 .dowMOD7
310 SUBS R0,R0,#7:BCS dowMOD7 :\ Reduce MOD 7
320 ADD R0,R0,#7 :\ Restore for last SUB, change to ADD R0,R0,#8
330 MOV PC,R14 :\ to return 1..7
340 :
350 .dowMonths
360 EQUB 1:EQUB 4:EQUB 3:EQUB 6 :\ Month offsets
370 EQUB 1:EQUB 4:EQUB 6:EQUB 2
380 EQUB 5:EQUB 0:EQUB 3:EQUB 5
390 \
400 ]NEXT
410 DEFFNday(A%):=MID$("SunMonTueWedThuFriSat",A%*3-2,3)
420 C%=2001-1900
430 FOR B%=1 TO 12
440 FOR A%=1 TO 31
450 U%=(USR DayOfWeek) AND 255
460 PRINT A%;"/";B%;"/";1900+C%;" - ";FNday(1+(U% AND 255));" ";~U%
470 IF A%=30:IF B%=4 OR B%=6 OR B%=9 OR B%=11:A%=32
480 IF A%=28:IF B%=2:IF (C% MOD 4) OR ((C%+1900) MOD 400):A%=32
490 IF A%=29:IF B%=2:A%=32
500 NEXT
510 NEXT