Source code in the edsac programming language

[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]