10 REM > 6502.ProgTips.DofWeek16a
   20 REM Calculate day of week for 16-bit Gregorian date
   30 REM Works for any date in Gregorian 400-year cycle
   40 :
   50 DIM mc% 200
   60 FOR P=0 TO 1
   70   P%=mc%:O%=P%
   80   [OPT P*2+4
   90   \ On entry  day           = day,   1-31
  100   \           month         = month, 1-12
  110   \           year+0,year+1 = year,  0-39999
  120   \ On exit   A=day of week 0=Sun, 6=Sat
  130   \           X=corrupted
  140   \           Y=corrupted
  150   \ Size      160 bytes, 4 bytes workspace
  160   \           129 bytes if zero page workspace
  170   \
  180   \ Uses the formula:
  190   \   if (m < 3) then y = y-1
  200   \   return (y + y/4 - y/100 + y/400 + t[m-1] + d) mod 7
  210   \
  220   .DayOfWeek
  230   LDA day:LDX month
  240   CLC:ADC DofWOffsets-1,X:STA day :\ acc=t[m]+d, offset to prevent
  250   LDA #1:STA month                :\ overflow with small numbers
  260   CPX #3:BCS DayOfWeekMarch       :\ March or later
  270   :
  280   LDX year+0:BNE DayOfWeekSub2    :\ Year>255
  290   LDA year+1:BNE DayOfWeekSub1    :\ Not year n*400+0
  300   LDX #5:INC year+1               :\ Adjust for year zero
  310   .DayOfWeekSub1
  320   DEC year+1                      :\ Do a 16-bit decrement
  330   .DayOfWeekSub2
  340   DEX:STX year+0                  :\ year=year-1
  350   :
  360   .DayOfWeekMarch
  370   JSR DayOfWeekAdd                :\ acc=y+t[m]+d
  380   JSR DayOfWeekDiv4               :\ acc=y+y/4+t[m]+d
  390   LDX #255:SEC
  400   .DayOfWeekDiv100Lp
  410   LDA year+0:SBC #25:STA year+0   :\ Divide year/4 by 25 to get year/100
  420   LDA year+1:SBC #00:STA year+1
  430   INX:BCS DayOfWeekDiv100Lp
  440   STX year+0:INC year+1           :\ year=y/100
  450   SEC:LDA day:SBC year+0:STA day  :\ acc=y+y/4-y/100+t[m]+d
  460   LDA month:SBC #0:STA month
  470   JSR DayOfWeekDiv4               :\ acc=y+y/4-y/100+y/400+t[m]+d
  480   :
  490   TAY:LDX day
  500   .DayOfWeekMod7
  510   TXA:PHA:SBC #7:TAX              :\ A=(y+y/4-y/100+y/400+t[m]+d) MOD 7
  520   TYA:SBC #0:TAY:PLA
  530   BCS DayOfWeekMod7
  540   RTS
  550   :
  560   .DayOfWeekDiv4
  570   LSR year+1:ROR year+0           :\ y=y/4
  580   LSR year+1:ROR year+0
  590   .DayOfWeekAdd
  600   CLC:LDA day:ADC year+0:STA day  :\ acc=acc+y or acc=acc+y/4
  610   LDA month:ADC year+1:STA month
  620   RTS
  630   :
  640   .DofWOffsets
  650   EQUB 4:EQUB 0:EQUB 6:EQUB 2     :\ Month offsets
  660   EQUB 4:EQUB 0:EQUB 2:EQUB 5
  670   EQUB 1:EQUB 3:EQUB 6:EQUB 1
  680   :
  690   .year :EQUW 0
  700   .month:EQUB 0
  710   .day  :EQUB 0
  720 ]NEXT
  730 DEFFNday(A%):=MID$("SunMonTueWedThuFriSat",A%*3-2,3)
  740 Y%=2023
  750 FOR X%=1 TO 12
  760   FOR A%=1 TO 31
  770     !year=Y%:?month=X%:?day=A%
  780     U%=(USR DayOfWeek) AND 255:PRINT A%;"/";X%;"/";Y%;" - ";U%;" ";FNday(1+U%)
  790     IF A%=30:IF X%=4 OR X%=6 OR X%=9 OR X%=11:A%=32
  800     IF A%=28:IF X%=2:IF (Y% MOD 4) OR (Y% MOD 400):A%=32
  810     IF A%=29:IF X%=2:A%=32
  820   NEXT
  830 NEXT