BARTHO@CGEUGE54.BITNET ("PAUL BARTHOLDI, OBSERVATOIRE DE GENEVE") (06/06/90)
Hello,
Many people have asked for a general program that would give easter dates.
Here is one (old) that I wrote 6 years ago. I checked it with Mitch Bradley
forthmacs on my sun this morning, still OK (it was written on a HP1000 ...)
As for so many other problems, the reference is ... Knuth: The Art ...
If you do not have 'VALUE' and 'TO',
you can replace VALUE with CONSTANT and TO XXX with ['] XXX >BODY !
or VALUE with VARIABLE , XXX with XXX @ and TO XXX with XXX !
I hope this can help.
Regards, Paul Bartholdi, Geneva Observatory
================================================================================
( Calculates easter dates according to Knuth algorithm )
( see The Art of Computer Programming, vol 1 p 155-156 )
FORTH DECIMAL
0 VALUE C ( same constant as used by Knuth )
0 VALUE D
0 VALUE E
0 VALUE G
0 VALUE N
0 VALUE X
0 VALUE Z
0 VALUE YEAR
( Now the real algorithm ... )
( try " 1990 NEASTR . ", should give " 46 " ... that is for 15 april 1990)
: NEASTR DUP DUP TO YEAR ( year NEASTR --- day of easter starting march 1st)
19 MOD 1+ TO G ( see Knuth for details ! )
100 / 1+ DUP DUP TO C
3 * 4 / 12 - TO X
8 * 5 + 25 / 5 - TO Z
YEAR 5 * 4 / X - 10 - TO D
G 11 * 20 + Z + X - 30 MOD DUP
0< IF 30 + THEN DUP DUP TO E
25 = G 1 > AND SWAP 24 = OR IF E 1+ TO E THEN
44 E - DUP TO N
21 < IF N 30 + TO N THEN
N DUP 7 + SWAP D + 7 MOD -
DUP DUP TO N ; ( returns 2 copies of n on the stack )
: EASTER NEASTR 31 > IF 31 - 4 .R ." APRIL " ( prints the full date )
ELSE 4 .R ." MARCH "
THEN
YEAR 4 .R ;
( CYCLE will be used only for printing, nothing to do with easter )
( : NA1+ ADDR --- ADDR+CELL_SIZE DEFINED IN FORTHMACS. 4 + ; )
( : >BODY CFA --- PFA )
: CYCLE CREATE , 0 , ( n CYCLE XX , XX will provide successive )
( values 0 1 2 ... n-1 0 1 ... )
DOES> DUP DUP @ ( fetch n )
SWAP NA1+ @ ( fetch current value : i )
SWAP OVER 1+ ( keep i, get next i+1 )
SWAP MOD ROT NA1+ ! ; ( get modulo n and store as 2. param )
5 CYCLE CRC 5 CYCLE CBL ( to get 5 years per line, )
( and a blank line every 5 ones)
: EASTER-DATES ( y1 y2 --- prints all easter dates from year y1 to y2 )
1 ['] CRC >BODY NA1+ ! 1 ['] CBL >BODY NA1+ ! ( reset CRC etc)
30 SPACES ." ***** Easter Dates *****" CR CR
1+ SWAP DO I EASTER CRC 0= IF CR
CBL 0= IF CR THEN
THEN
LOOP CR ;
======================================== end =================================