Day of the week: Difference between revisions
Added solution for EDSAC.
(→{{header|Vlang}}: Rename "Vlang" in "V (Vlang)") |
(Added solution for EDSAC.) |
||
Line 1,707:
</syntaxhighlight>
This code solves a specific task, but can easily be modified as a generic function to return the DayOfWeek for any day after 1 AD.
=={{header|EDSAC order code}}==
Uses a version of Zeller's congruence that finds the day of the week for any Gregorian date up to 28 Feb 43699.
<syntaxhighlight lang="edsac">
[Day of week for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
[Library subroutine M3 - prints header and is then overwritten.]
[Here, the last character sets the teleprinter to figures.]
PF GK IF AF RD LF UF OF E@ A6F G@ E8F EZ PF
*CHRISTMAS!DAY!ON!SUNDAY@&#
..PZ [blank tape, then resync]
[Subroutine to find day of week in Gregorian calendar, by Zeller's method.]
[This EDSAC implementation is valid up to and including 28 Feb 43699.]
[Input: 4F = year, 5F = month, 6F = day of month (all preserved).]
[Output: 7F = day of week: 0 = Saturday, 1 = Sunday, ..., 6 = Friday.]
[Workspace: 0F]
T128K GK
A3F T41@ [plant return link as usual]
[January and February are taken as months 13 and 14 of the previous year]
A5F [load month]
S43@ [subtract 3 to test for Jan or Feb]
E9@ [jump if not Jan or Feb]
A45@ [add 16 to make month + 1]
T7F [to 7F]
S42@ [acc := -1]
G11@ [join common code]
[9] A44@ [not Jan, Feb; make month + 1]
T7F [to 7F; acc := 0]
[11] A4F [here with acc = 0 or -1; add year]
TF [adjusted year to 0F]
H46@ [mult reg := 13/20 (near enough)]
V7F [times (month + 1)]
L1F [shift 2 left]
T7F [7F := 13*(month + 1) div 5]
AF [year]
R1F [shift 2 right]
AF [year + (year div 4)]
A7F [add into 7F]
T7F
H47@ [mult reg := 64/100 (approx, OK for dates as above)]
VF [times year]
R16F [shift 6 right]
UF [0F := year div 100]
R1F [shift 2 more right]
SF [(year div 400) - (year div 100)]
A6F [add day of month]
A7F [add into 7F]
T7F
[Finally take 7F modulo 7. Suppose 7F = 7*q + r (0 <= r < 7)]
H48@ [mult reg := 4/7 (near enough)]
V7F [acc := 4*q + (4/7)*r]
R1F [shift 2 right: acc := q + r/7]
TF [0F := acc high word = q]
H49@ [mult reg := 7/8 (exact)]
A7F [acc := 7*q + r]
R2F [shift 3 right, acc := (7*q + r)/8]
NF [subtract (7/8)*q, acc := r/8]
L2F [shift 3 left, acc := r as required]
T7F [return result r in 7F]
[41] ZF [(planted) jump back to caller]
[Constants]
[42] PD [1]
[43] P1D [3]
[44] P2F [4]
[45] P8F [16]
[46] J819D [0.A667 hex, approx 13/20]
[47] J492F [0.A3D8 hex, approx 64/100]
[48] O293F [0.924A hex, approx 4/7]
[49] KF [0.1110 hex = 7/8]
[Subroutine to print non-negative 17-bit integer.]
[Parameters: 0F = integer to be printed (not preserved)
1F = character for leading zero (preserved)]
[Workspace: 4F..7F, 38 locations]
T64K
GK A3F T34@ A1F T7F S35@ T6F T4#F AF T4F H36@ V4F RD A4#F R1024F H37@ E23@ O7F A2F
T6F T5F V4#F YF L8F T4#F A5F L1024F UF A6F G16@ OF TF T7F A6F G17@ ZF P4F Z219D TF
[Main routine]
T400K GK
[Constants]
[0] P1004F [2008]
[1] P1060D [2121]
[2] P6F [12 (December)]
[3] P12D [25]
[4] PD [1]
[5] @F [carriage return]
[6] &F [line feed]
[7] K4096F [null char]
[Variable]
[8] PF [year]
[Enter with acc = 0]
[9] A7@ T1F [1F := null for print subroutine]
A@ [load first year]
[12] U8@ T4F [save year, and pass to Zeller subroutine]
A2@ T5F [pass month 12 to Zeller subroutine]
A3@ T6F [pass day 25 to Zeller subroutine]
A18@ G128F [call Zeller subroutine]
A7F S4@ [load day of week, subtract 1]
G32@ [jump if day = 0]
S4@ E32@ [subtract 1, jump if day >= 2]
TF [here if day = 1 (Sunday); clear acc]
A4F TF [pass year to print subroutine]
A28@ G64F [call print subroutine (overwrites 4F)]
O5@ O6@ [print CR, LF]
[32] TF [common code; clear acc]
A8@ S1@ [test for end]
E39@ [jump to exit if so]
A1@ [restore acc after test]
A4@ E12@ [inc year and loop back]
[39] O7@ [done; print null]
ZF [halt the machine]
E9Z [define entry point]
PF [acc = 0 on entry]
[end]
</syntaxhighlight>
{{out}}
<pre>
CHRISTMAS DAY ON SUNDAY
2011
2016
2022
2033
2039
2044
2050
2061
2067
2072
2078
2089
2095
2101
2107
2112
2118
</pre>
=={{header|Elixir}}==
| |||