\def\date{20 Nov 2011}\def\source{V1F1, p.\ 49}\def\author{Udo Wermuth}\input mmix =4 !\gts Computation of Easter Sunday with look-up table for $Z$ t IS $255 y GREG 0 ! Year $y$ in binary acc GREG 0 ! Accumulator ext GREG 0 ! Second accumulator LOC Data_Segment _z GREG @ !\gts The table lists $\lfloor((8*i+13)/25)-5+43\rfloor$ for $i=0,1,...,99$ BYTE 38,38,39,39,39,40,40,40,41,41,41,42,42,42,43,43 BYTE 43,43,44,44,44,45,45,45,46,46,46,47,47,47,48,48 BYTE 48,49,49,49,50,50,50,51,51,51,51,52,52,52,53,53 BYTE 53,54,54,54,55,55,55,56,56,56,57,57,57,58,58,58 BYTE 59,59,59,59,60,60,60,61,61,61,62,62,62,63,63,63 BYTE 64,64,64,65,65,65,66,66,66,67,67,67,67,68,68,68 BYTE 69,69,69,70 OCTA 0 !\gts The table lists all possible values for the Easter Sunday and leaves room for the year !\gts Each entry in the table consists of 32 bytes BYTE "22 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "23 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "24 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "25 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 _np26 GREG @ ! Base address for this table BYTE "26 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "27 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "28 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "29 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "30 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "31 March ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "01 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "02 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "03 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "04 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "05 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "06 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "07 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "08 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "09 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "10 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "11 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "12 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "13 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "14 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "15 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "16 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "17 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "18 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "19 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "20 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "21 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "22 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "23 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "24 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 BYTE "25 April ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 LOC #100 !\gts Compute Easter Sunday for a given year $y$; $1582 < y < 100000$ !\gts Calling sequence: {\tt PUSHJ \$0,Easter} !\gts Entry conditions: the year is stored in global register \m y !\gts Exit conditions: string of form {\tt dd mmmmm, yyyyy} is written to \mb{StdOut} !\gts Changed global registers: \mmm acc, \mmm ext; new global registers are defined !\gts Changed special registers: $\mm rM\gets \mb{\h\#000f0f00000f0f0f}$ WS IS 32 ! Word size is \mb{TETRA} _ten2p5 GREG 10*10*10*10*10 ! 5 digits are present _ten2m5 GREG 1//(10*10*10*10*10)+1 _lowtetra GREG #00000000ffffffff ! Mask for low tetra _rMmask GREG #000f0f00000f0f0f ! \mm rM for BCD-ASCII conversion _bcdmux GREG #0a3030202c303030 ! This is ``\h\#a00\vs,000'' _outform GREG #0810044002200180 ! \quad and this transfoms it into ``,\vs00000\h\#a'' yht4 GREG 0 ! $y_h = \lfloor y/10000\rfloor$ and $\mb{yht4}=y_h\times4$ ym GREG 0 ! $y_m = \lfloor (y-10^5y_h)/100\rfloor$ yasc GREG 0 ! $y$ as ASCII digits Easter SET ext,_ten2p5 ! Convert binary $y$ to ASCII via BCD coding and SLU acc,y,WS ! \quad store decimal digits of $y$ in \mb{yht4} and \mm ym OR acc,acc,ext ! \quad (see TAOCP V2, 3rd ed., 320--321). MULU acc,acc,_ten2m5 GET acc,rH ! $\mmm acc\gets\rb{result of the hi-mult}$. 2ADDU ext,acc,0 8ADDU acc,acc,ext ! $\mmm acc\gets 10*\mmm acc$. SRU ext,acc,WS ! $\mmm ext\gets \rb{hi-mult result}$. SET yasc,ext ! Init \mb{yasc} with first digit. AND acc,acc,_lowtetra ! Delete hi-result. SL yht4,ext,2 ! $\mb{yht4}\gets y_h\times4$ with $y_h =\lfloor y/10000\rfloor$. 2ADDU ext,acc,0 ! Repeat for each digit. 8ADDU acc,acc,ext SRU ext,acc,WS 16ADDU yasc,yasc,ext ! Add new digit to \mb{yasc}. AND acc,acc,_lowtetra 4ADDU ym,ext,ext ! First digit of \mm ym times 5. 2ADDU ext,acc,0 8ADDU acc,acc,ext SRU ext,acc,WS 16ADDU yasc,yasc,ext AND acc,acc,_lowtetra 2ADDU ym,ym,ext ! $y_m \gets \lfloor(y-10^5y_h)/100\rfloor$. 2ADDU ext,acc,0 8ADDU acc,acc,ext SRU ext,acc,WS 16ADDU yasc,yasc,ext AND acc,acc,_lowtetra 2ADDU ext,acc,0 8ADDU acc,acc,ext SRU ext,acc,WS 16ADDU yasc,yasc,ext SL t,yasc,36 ! Now convert BCD to ASCII. OR yasc,yasc,t PUT rM,_rMmask ! Init \mm rM. MUX yasc,yasc,_bcdmux ! Extract, join, and MOR yasc,yasc,_outform ! \quad format for output. _f19 GREG #4033000000000000 ! 19 as float gm1 GREG 0 ! Golden Number minus 1 E1 FLOT acc,y ! \step E1. Compute golden number. FREM acc,acc,_f19 FIX gm1,acc ADD ext,gm1,19 CSN gm1,gm1,ext ! $\mmm gm1\gets G-1$ c GREG 0 ! Century Number E2 4ADDU acc,yht4,yht4 ! \step E2. Century. $\mmm acc\gets 20y_h$. 4ADDU acc,acc,acc ! $\mmm acc\gets100y_h$. ADD acc,acc,1 ADD c,acc,ym ! $\m c \gets C = 100*y_h + y_m + 1$. xp12 GREG 0 ! Number of dropped leap years plus 12 E3X 2ADDU acc,c,c ! \step E3. Corrections. Compute dropped leap years. SR xp12,acc,2 ! $\mb{xp12}\gets X+12$ zp43 GREG 0 ! Moon orbit correction plus 43 as $43-11-12=20$ (see E5). E3Z LDB acc,_z,ym ! Compute moon orbit correction with look-up table. 8ADDU zp43,yht4,acc ! $\mb{zp43} = Z + 43$. dm2 GREG 0 ! Sunday minus 2 E4 4ADDU acc,y,y ! \step E4. Find Sunday. SR acc,acc,2 SUB dm2,acc,xp12 ! $\mmm dm2 \gets D-2$. _f30 GREG #403e000000000000 ! 30 as float e GREG 0 ! Epact E5 2ADDU acc,gm1,gm1 ! \step E5. Epact. 8ADDU acc,gm1,acc ! $\mmm acc\gets 11G - 11$. ADD acc,acc,zp43 ! $\mmm acc \gets 11G + Z + 32$. SUB acc,acc,xp12 ! $\mmm acc \gets 11G + Z - X + 20$. FLOT acc,acc FREM acc,acc,_f30 FIX e,acc ADD ext,e,30 CSN e,e,ext ! $\m e \gets \mmm acc \bmod 30$. E5e25 CMP t,e,25 ! Is $\rb{Epact} = 25$? PBNZ t,E5e24 ! No, go to test if $\rb{epact} = 24$. CMP t,gm1,10 ! Yes, test $G$. !\gts Step E6 results in 3 cases: $N=48$, $N=49$, and $N$ not yet known E6_4849 BP t,E7_N48 ! \step E6. Find full moon. $N \gets \ite(\m t>0?48:49)$. n GREG 0 ! Day of Full Moon _low9bit GREG #1FF _octm GREG #6b1a2358d11ac688 ! 6543210 repeated as octals (remainders for dvision by 7) E7_N49 ADD acc,dm2,49+2 ! \step E7. Advance to Sunday. $N=49$, $\mmm acc \gets D+N = D+49$. AND ext,acc,_low9bit ! Compute $(D+N) \bmod 7$ by a digit sum. SRU acc,acc,9 ! \quad (see ``Hacker's Delight'', 10--18 (add-on to the book)). ADDU acc,acc,ext ! Compute digit sum (9 bits). AND ext,acc,#3F SRU acc,acc,6 ADDU acc,acc,ext ! Compute digit sum (6 bits). AND ext,acc,#7 ! $\mmm ext \gets \mmm acc \bmod 8$. SRU acc,acc,3 ! $\mmm acc \gets \mmm acc \rb{ div } 8$. ADDU acc,acc,ext 2ADDU acc,acc,acc ! 3 digits for each entry in look-up register \mb{\l\_octm}. SRU acc,_octm,acc AND acc,acc,#7 ! $\mmm acc \gets (D+N) \bmod 7$. NEG n,49+7-26,acc ! $\m n \gets N-26$. SL acc,n,5 ! Get month. LDA t,_np26,acc STO yasc,t,8 ! Store $y$ in ASCII form. TRAP 0,Fputs,StdOut ! Output POP 0,0 ! \quad and return. E5e24 CMP t,e,24 ! Is $\rb{Epact} = 24$? E6_49XX BZ t,E7_N49 ! \step E6. Find full moon. $N = \ite(\m t=0?49:\rb{unknown})$ E6 NEG n,25,e ! \step E6. Find full moon. Case $N$ is unknown. ADD acc,n,30 CSN n,n,acc ! $\m n \gets N-19$. E7 ADD acc,dm2,n ! \step E7. Advance to Sunday. $\mmm acc = D+N-21$. AND ext,acc,_low9bit ! Compute $(D+N) \bmod 7 = (D+N-21) \bmod 7$ as above; SRU acc,acc,9 ! \quad the code is repeated to avoid a \mb{JMP}. ADDU acc,acc,ext AND ext,acc,#3F SRU acc,acc,6 ADDU acc,acc,ext AND ext,acc,#7 SRU acc,acc,3 ADDU acc,acc,ext 2ADDU acc,acc,acc SRU acc,_octm,acc AND acc,acc,#7 SUB n,n,acc SL acc,n,5 LDA t,_np26,acc STO yasc,t,8 TRAP 0,Fputs,StdOut POP 0,0 E7_N48 ADD acc,dm2,48+2 ! \step E7. Advance to Sunday. $\mmm acc \gets D+N = D+48$. AND ext,acc,_low9bit ! Compute $(D+N) \bmod 7$ as above. SRU acc,acc,9 ADDU acc,acc,ext AND ext,acc,#3F SRU acc,acc,6 ADDU acc,acc,ext AND ext,acc,#7 SRU acc,acc,3 ADDU acc,acc,ext 2ADDU acc,acc,acc SRU acc,_octm,acc AND acc,acc,#7 NEG n,48+7-26,acc SL acc,n,5 LDA t,_np26,acc STO yasc,t,8 TRAP 0,Fputs,StdOut POP 0,0 BYEAR IS 1950 ! For main program: start _eyear GREG 2000 ! \quad and end value Main SET y,BYEAR ! Initialize \m y. 1H PUSHJ $0,Easter INCL y,1 CMP t,y,_eyear ! Compare to end value. PBNP t,1B TRAP 0,Halt,0 ! \eop !\endprogram\bye