10 REM > 6502.ProgTips.DofWeek16b
   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-65535
  120   \ On exit   A=day of week 0=Sun, 6=Sat
  130   \           X=corrupted
  140   \           Y=preserved
  150   \ Size      139 bytes, 4 bytes workspace
  160   \           116 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 + t[m-1] + d + fudge) mod 7
  210   \ where fudge is an adjustment for year n*400+0
  220   \
  230   .DayOfWeek
  240   SEC:LDX year+0:LDY year+1
  250   .DayOfWeekMod400
  260   TXA:SBC #400 AND 255:TAX        :\ Get year MOD 400
  270   TYA:SBC #400 DIV 256:TAY
  280   BCS DayOfWeekMod400
  290   TXA:ADC #400 AND 255:STA year+0
  300   TYA:ADC #400 DIV 256:STA year+1
  310   LDA day:LDX month
  320   :
  330   \ Enter here with A=day, X=month, year=year MOD 400
  340   .DayOfWeek1
  350   CLC:ADC DofWOffsets-1,X:STA day :\ t[m]+d
  360   CPX #3:BCS DayOfWeekMarch       :\ March or later
  370   :
  380   LDX year+0:BNE DayOfWeekSub2    :\ Year>255
  390   LDA year+1:BNE DayOfWeekSub1    :\ Not year n*400+0
  400   LDX #5:INC year+1               :\ Adjust for year n*400+0
  410   .DayOfWeekSub1
  420   DEC year+1                      :\ Do a 16-bit decrement
  430   .DayOfWeekSub2
  440   DEX:STX year+0                  :\ year=year-1
  450   :
  460   .DayOfWeekMarch
  470   LDA year+1:LSR A
  480   LDA year+0:ROR A:LSR A:PHA      :\ A=year/4
  490   CLC:ADC day:STA day             :\ y/4+t[m]+d
  500   :
  510   LDX #1:PLA:SEC
  520   .DayOfWeekDiv100
  530   DEX:SBC #25:BCS DayOfWeekDiv100 :\ X=-(year/100)
  540   TXA:ADC day                     :\ y/4-y/100+t[m]+d
  550   :
  560   CLC:ADC year+0:TAX              :\ y+y/4-y/100+t[m]+d
  570   LDA year+1:ADC #0:TAY:SEC
  580   .DayOfWeekMod7
  590   TXA:PHA:SBC #7:TAX              :\ (y+y/4-y/100+t[m]+d) MOD 7
  600   TYA:SBC #0:TAY:PLA
  610   BCS DayOfWeekMod7
  620   \ADC #1                         :\ Include to return 1..7
  630   RTS
  640   :
  650   .DofWOffsets
  660   EQUB 0:EQUB 3:EQUB 2:EQUB 5     :\ Month offsets
  670   EQUB 0:EQUB 3:EQUB 5:EQUB 1
  680   EQUB 4:EQUB 6:EQUB 2:EQUB 4
  690   \
  700   .year :EQUW 0
  710   .month:EQUB 0
  720   .day  :EQUB 0
  730 ]NEXT
  740 DEFFNday(A%):=MID$("SunMonTueWedThuFriSat",A%*3-2,3)
  750 Y%=2023
  760 FOR X%=1 TO 12
  770   FOR A%=1 TO 31
  780     !year=Y%:?month=X%:?day=A%
  790     U%=(USR DayOfWeek) AND 255:PRINT A%;"/";X%;"/";Y%;" - ";U%;" ";FNday(1+U%)
  800     IF A%=30:IF X%=4 OR X%=6 OR X%=9 OR X%=11:A%=32
  810     IF A%=28:IF X%=2:IF (Y% MOD 4) OR (Y% MOD 400):A%=32
  820     IF A%=29:IF X%=2:A%=32
  830   NEXT
  840 NEXT