program Paschal { BP7, TP7, D3 DCC32 -cc } ;

{$I version.pas}
{$IFDEF WINDOWS} uses WinCrt ; {$ENDIF}
{$IFDEF DELPHI} uses Windows, SysUtils ; {$ENDIF}

const PID = 'PASCHAL.PAS - www.merlyn.demon.co.uk  >= 2008-01-30' ;


(* www.merlyn.demon.co.uk       1996-10-04 ff.     OK to FAQ.

  PeterDuffettSmith1() agrees with the 1996 IoP diary, PD-S's book p.5 2000,
  & samples from the Book of Common Prayer of the Church of England.

  PD-S is using an algorithm of 1876 from Butcher's Ecclesiastical Calendar,
  said to be valid from 1583 Gregorian onwards.

  PD-S and CT agree for all years in word; EGR & CDWF never disagreed, and
  now after range-acceptance modifications agree for all years in word.

  All agree with The Calendar FAQ for Easter 2001.

  The Gregorians agree among themselves, and with samples from diaries
  and the Book of Common Prayer ; the Julian/Dionysians lack much
  independent verification.

  Once the dates are known, a lookup table should generally be used.

  Visit  http://cssa.stanford.edu/~marcos/ec-cal.html  for more information.
  or follow links from my http://www.merlyn.demon.co.uk/index.htm

  To get the results of both DIV & MOD together, see MS in my remaindr.txt.

  I have not optimised all for speed, but retained resemblance to sources.

  Oct 2005 : Zeller's routines seem faster, try one here.

  Jan 2008 : adding jrsEaster, after estr-bcp.htm
  *)


(* Clive Feather, in http://www.davros.org/misc/easter.html 2000-05-25,
  Gregorian =>
  {}                        a := Yr mod 19 ;
  b := Yr div 100 ;         c := Yr mod 100 ;
  d := b div 4 ;            e := b mod 4 ;
  f := c div 4 ;            g := c mod 4 ;
  h := (8*b+13) div 25 ;
  {}                        j := (19*a+b-d-h+15) mod 30 ;
  m := (a+11*j) div 319 ;
  {}                        k := (2*e+2*f-g-j+m+32) mod 7 ;
  Mo := (j-m+k+90) div 25 ;
  {}                        Dy := (j-m+k+19+Mo) mod 32 ;

  That makes CDWF1; CDWF2 is deduced from that page (on 2000-06-09),
  with empirical weekday-phase adjustment.
  *)


(* See Peter Duffett-Smith (Downing College, Cambridge),
  Practical Astronomy with your Calculator, 2nd Ed, CUP 1981, p.4
  z.a := Y/19
  b.c := Y/100
  d.e := b/4
  f.z := (b + 8)/25
  g.z := (b - f + 1)/3
  z.h := (19*a + b - d - g + 15)/30
  i.k := c/4
  z.l := (32 + 2*e + 2*i - h - k)/7
  m.z := (a + 11*h + 22*l)/451
  n.p := (h + l - 7*m + 114)/31
  Month of Easter Sunday is now n (3=Mar, 4=Apr),
  and the day of the month is p+1.
  *)

(* The routine on p.80 of "The Calendar, David Ewing Duncan, Fourth
  Estate, 1999, ISBN 1-85702-979-8, and ascribed to "modern-day Catholic
  astronomers, is visibly the same. *)


(* Claus Tondering's "The Calendar FAQ", as at end 1998, contained :

  2.9.6. Isn't there a simpler way to calculate Easter?
  -----------------------------------------------------
  This is an attempt to boil down the information given in the previous
  sections (the divisions are integer divisions, in which remainders are
  discarded):
  G = year mod 19
  For the Julian calendar:
  I = (19*G + 15) mod 30
  J = (year + year/4 + I) mod 7
  For the Gregorian calendar:
  C = year/100
  H = (C - C/4 - (8*C+13)/25 + 19*G + 15) mod 30
  I = H - (H/28)*(1 - (H/28)*(29/(H + 1))*((21 - G)/11))
  J = (year + year/4 + I + 2 - C + C/4) mod 7
  Thereafter, for both calendars:
  L = I - J
  EasterMonth = 3 + (L + 40)/44
  EasterDay = L + 28 - 31*(EasterMonth/4)
  This algorithm is based in part on the algorithm of Oudin (1940) as
  quoted in "Explanatory Supplement to the Astronomical Almanac",
  P. Kenneth Seidelmann, editor.
  People who want to dig into the workings of this algorithm, may be
  interested to know that
  G is the Golden Number-1
  H is 23-Epact (modulo 30)
  I is the number of days from 21 March to the Paschal full moon
  J is the weekday for the Paschal full moon (0=Sunday, 1=Monday, etc.)
  L is the number of days from 21 March to the Sunday on or before
  the Paschal full moon (a number between -6 and 28)

  Nov 2001, FAQ version 2.4 omits the second (H/28)* in I, which is
  superfluous in principle.  However, as was, it prevents run-time error.
  I now have simplified, faster versions below, Gregorian & Julian; in
  those, L is changed.
  *)


(* The algorithms below are taken from Mapping Time by E.G.Richards,
  as given on his Web site.
  ----
  Algorithm N
  To calculate the 'day of March' of Easter Sunday for year Y according
  to the Dionysian canon (short form)
  1   A = MOD(Y,19)
  2   B = 22 + MOD(225 - 11*A,30)
  3   S = B + MOD(56 + 6*Y  - Y/4 - B,7)
  ----
  Algorithm P
  To calculate the 'day of March' of Easter Sunday for year Y according
  to the Gregorian canon (short form)
  1   A = Y/100
  2   B = A - A/4
  3   C = MOD(Y,19)
  4   D = MOD(15 + 19*C + B - (A - (A - 17)/25)/3,30)
  5   E = D - (C+11*D)/319
  6   S = 22 + E + MOD(140004 - Y - Y/4 + B - E,7)
  ----
  Algorithm Q
  To calculate day, D, and month, M (March=3, April=4) of Easter Sunday
  given the 'Day of March', S.
  1   M = 3 + S/32
  2   D = 1 + MOD(S-1,31)
  ----
  *)

(* The algorithm below is taken from my zel-incl.js and derives from
  Zeller's 1885 paper; it returns Day-Of-March.
  *)


type TYear = {$IFDEF PASCAL} word {$ENDIF} {$IFDEF DELPHI} cardinal {$ENDIF} ;
const Loops : word = 1 ;


procedure Empty(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
var X : TYear ;
begin X := 3 ; Mo := X end {Empty} ;



(* See above *)
procedure ZEG1885(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
var a, b, d, g, K, J, Ko4, Jo4, e : TYear ;
begin { Gregorian }
  K := Yr mod 100 ; J := Yr div 100 ;
  Ko4 := K div 4 ; Jo4 := J div 4 ; e := J mod 4 ;
  a := (K + 5*J) mod 19 ;
  g := J - Jo4 - (8*J+13) div 25  ;
  b := ( 19*a+15 + g ) mod 30 ;
  d := (b + K + Ko4 + 2 + 5*e) mod 7 ;
  if (d=0) and ( (b=29) or ((b=28) and (a>10)) ) then d := 7 ;
  Dy := 28 + b - d ;
  if Dy<32 then Mo := 3 else begin Mo := 4 ; Dec(Dy, 31) end ;
  end {ZEG1885} ;



(* See above *)
procedure PeterDuffettSmith1(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
{} procedure proc(var u, v : TYear ; const P, Q : TYear) ;
{    Note - PDS would be much faster with proc inlined rather than called;
  and the MS trick would speed it too }
{} begin u := P div Q ; v := P mod Q end {proc} ;
var a, b, c, d, e, f, g, h, i, k, l, m, n, p, z : TYear ;
begin
  proc(z, a, Yr, 19) ;
  proc(b, c, Yr, 100) ;
  proc(d, e, b, 4) ;
  proc(f, z, (b + 8), 25) ;
  proc(g, z, (b - f + 1), 3) ;
  proc(z, h, (19*a + b - d - g + 15), 30) ;
  proc(i, k, c, 4) ;
  proc(z, l, (32 + 2*e + 2*i - h - k), 7) ;
  proc(m, z, (a + 11*h + 22*l), 451) ;
  proc(n, p, (h + l - 7*m + 114), 31) ;
  (* Month of Easter Sunday is now n (3=Mar, 4=Apr),
    and the day of the month is p+1 *)
  Mo := N ; Dy := Succ(P) end {PeterDuffettSmith1} ;


(* See above *)
procedure PeterDuffettSmith2(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
{ Optimised from PDS1 by JRS }
var A, B, H, L, Z : TYear ;
begin
  A := Yr mod 19 ;
  B := Yr div 100 ;
  H := (19*A + B - (B shr 2) - (B - (B + 8) div 25 + 1) div 3 + 15) mod 30 ;
  L := (32 + 2*(B and 3) + 2*((Yr mod 100) div 4) - H - (Yr and 3)) mod 7 ;
  Z := H + L - 7*((A + 11*H + 22*L) div 451) + 114 ;
  Mo := 3 + Ord(Z>=31*4) ;
  Dy := Succ(Z mod 31) ;
  end {PeterDuffettSmith2} ;


(* See above *)
procedure ClausTondering1(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
var g, c, h, i, j : TYear ; L : integer ;
begin { Gregorian }
  g := Yr mod 19 ;
  c := Yr div 100 ;
  h := (c - c div 4 - (8*c+13) div 25 + 19*g + 15) mod 30 ;
  i := h - (h div 28)*(1 - (h div 28)*(29 div (h+1))*((21-g) div 11)) ;
  j := (Yr mod 7 + Yr div 4 + i + 2 - c + c div 4) mod 7 ;
  L := integer(i) - integer(j) ;
  Mo := 3 + (L + 40) div 44 ;
  Dy := L + 28 - 31*(Mo div 4) ;
  end {ClausTondering1} ;


(* See above *)
procedure ClausTondering1a(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
var g, c, i, j : TYear ; h: integer ; L : integer ;
begin { Gregorian }
  g := Yr mod 19 ;
  c := Yr div 100 ;
  h := (c - c div 4 - (8*c+13) div 25 + 19*g + 15) mod 30 ;
  i := h - (h div 28)*(1 - {(h div 28)*}(29 div (h+1))*((21-g) div 11)) ;
  j := (Yr mod 7 + Yr div 4 + i + 2 - c + c div 4) mod 7 ;
  L := integer(i) - integer(j) ;
  Mo := 3 + (L + 40) div 44 ;
  Dy := L + 28 - 31*(Mo div 4) ;
  end {ClausTondering1a} ;


(* See above *)
procedure TonderingRevised(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
var g, c, h, i, j, L : TYear ;
begin { Gregorian }
  g := Yr mod 19 { 0..18 } ;
  c := Yr div 100 ;
  h := (c - c div 4 - (8*c+13) div 25 + 19*g + 15) mod 30 { 0..29 } ;

  (*  if h<28 then i := h
    else i := h - (1 - (29 div (h+1)) * ((21-g) div 11)) ;  *)

  (*  if h<28 then i := h
    else
    if h=28 then i := h - (1 - { (29 div (h+1)) * } ((21-g) div 11)   )
    else i := h - (1 { - (29 div (h+1)) *   ((21-g) div 11) } ) ; *)

  (*  if h<28 then i := h
    else
    if h=28 then i := h - (1 - ((21-g) div 11)   )
    else i := h - 1 ; *)

  (*  if h<28 then i := h
    else
    if h=28 then i := h - Ord(g>10) {(1 - ((21-g) div 11)   ) }
    else i := h - 1 ; *)

  if (h<28) or ((h=28) and (g<=10)) then i := h else i := h - 1 ;

  j := (Yr mod 7 + Yr div 4 + i + 2 - c + c div 4) mod 7 ;
  (*  L := integer(i) - integer(j) ;
    . Mo := 3 + (L + 12) div 44 ;
    . Dy := L - 31*(Mo div 4) ; *)
  L := (i+28) - j ;
  if L<=31 then begin Mo := 3 ; Dy := L    end
  {}       else begin Mo := 4 ; Dy := L-31 end ;
  end {TonderingRevised} ;


(* See above *)
procedure ClausTondering2(var Mo, Dy : byte ; const Yr {Juln.} : TYear) ;
var g, i, j : TYear ; L : integer ;
begin { Julian }
  g := Yr mod 19 ;
  i := (19*g + 15) mod 30 ;
  {  j := (Yr       + Yr div 4 + i) mod 7 ; }
  {} j := (Yr mod 7 + Yr div 4 + i) mod 7 { JRS mod } ;
  (*  L := integer(i) - integer(j) ;
    Mo := 3 + (L + 40) div 44 ;
    Dy := L + 28 - 31*(Mo div 4) ; *)
  L := (i+28) - j ;
  if L<=31 then begin Mo := 3 ; Dy := L    end
  {}       else begin Mo := 4 ; Dy := L-31 end ;
  end {ClausTondering2} ;


(* See above *)
procedure EGRichards1(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
{ Algorithm P+Q : To calculate the 'day of March' of Easter Sunday
  for year Y according to the Gregorian canon (short form) }
var A, B, C, D, E, S : TYear ;
begin { Tested ok *after* 1699 ; now OK 0..65535 }
  A := Yr div 100 ;
  B := A - A div 4 ;
  C := Yr mod 19 ;
  {  D := (15 + 19*C + B - (A     - (A-17) div 25) div 3) mod 30 ; }
  {} D := (15 + 19*C + B - (A + 1 - (A+ 8) div 25) div 3) mod 30 { JRS mod } ;
  E := D - (C+11*D) div 319 ;
  S := 22 + E + (140004 - Yr - Yr div 4 + B - E) mod 7 ;
  Mo := 3 + S div 32 ;
  Dy := 1 + (S-1) mod 31 ;
  end {EGRichards1} ;


(* See above *)
procedure EGRichards3(var Mo, Dy : byte ; const Yr {Juln.} : TYear) ;
{ Algorithm N+Q : To calculate the 'day of March' of Easter Sunday
  for year Y according to the Dionysian canon (short form) }
var A, B, S : TYear ;
begin { seemed OK *up*to* 10912 ; now seems OK 0..65535 }
  A := Yr mod 19 ;
  B := 22 + (225-11*A) mod 30 ;
  {  S := B + (56 + 6* Yr        -  Yr div 4        - B) mod 7 ; }
  {} S := B + (56 + 6*(Yr mod 7) - (Yr div 4) mod 7 - B) mod 7 { JRS mod } ;
  Mo := 3 + S div 32 ;
  Dy := 1 + (S-1) mod 31 ;
  end {EGRichards3} ;


(* See above *)
procedure CDWF1(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
var a, b, c, d, e, f, g, h, j, k, m : TYear ;
begin { Tested ok *after* ???? ; now OK ???? }
  {}                        a := Yr mod 19 ;
  b := Yr div 100 ;         c := Yr mod 100 ;
  d := b div 4 ;            e := b mod 4 ;
  f := c div 4 ;            g := c mod 4 ;
  h := (8*b+13) div 25 ;
  {}                        j := (19*a+b-d-h+15) mod 30 ;
  m := (a+11*j) div 319 ;
  {}                        k := (32+2*e+2*f-g-j+m) mod 7 {reordered} ;
  Mo := (j-m+k+90) div 25 ;
  {}                        Dy := (j-m+k+19+Mo) mod 32 ;
  end {CDWF1} ;


(* See above *)
procedure CDWF2(var Mo, Dy : byte ; const Yr {Juln.} : TYear) ;
const KK = 0 { empirical } ;
FullMoon : array [1..19] of byte { day of March } =
  (36,25,44,33,22,41,30, 49,38,27,46,35,24, 43,32,21,40,29,48) ;
var GoldNo, PaschFM, DoWk : TYear ;
begin { Tested ok }
  GoldNo := Succ(Yr mod 19) ;
  PaschFM := FullMoon[GoldNo] ;
  DoWk := ((Yr mod 7) + (Yr div 4) + PaschFM + KK) mod 7 ;
  Mo := 3 ;
  Dy := PaschFM + 7 - DoWk ;
  if Dy>31 then begin Dec(Dy, 31) ; Inc(Mo) end ;
  end {CDWF2} ;







(* Found in  http://www.gnomehome.demon.nl/uddf/pages/dates.htm#dates1

  function TtheCalendar.CalcEaster:String;
  var B,D,E,Q:Integer;
  GF:String;
  begin
  B:=225-11*(Year Mod 19);
  D:=((B-21)Mod 30)+21;
  If D>48 then Dec(D);
  E:=(Year+(Year Div 4)+D+1)Mod 7;
  Q:=D+7-E;
  If Q<32 then begin
  If ShortDateFormat[1]='d' then
  Result:=IntToStr(Q)+'/3/'+IntToStr(Year)
  else Result:='3/'+IntToStr(Q)+'/'+IntToStr(Year);
  end
  else begin
  If ShortDateFormat[1]='d' then
  Result:=IntToStr(Q-31)+'/4/'+IntToStr(Year)
  else Result:='4/'+IntToStr(Q-31)+'/'+IntToStr(Year);
  end;
  {calc good friday}
  If Q<32 then begin
  If ShortDateFormat[1]='d' then  GF:=IntToStr(Q-2)+'/3/'+IntToStr(Year)
  else GF:='3/'+IntToStr(Q-2)+'/'+IntToStr(Year);
  end
  else begin
  If ShortDateFormat[1]='d' then
  GF:=IntToStr(Q-31-2)+'/4/'+IntToStr(Year)
  else GF:='4/'+IntToStr(Q-31-2)+'/'+IntToStr(Year);
  end;

  end;
  *)


(* Converted to BP7 *)
procedure UDDF(var Mo, Dy : byte ; const Year {Greg., 1900..2099} : TYear) ;
var B, D, E, Q : longint ;
begin
  B := 225-11*(Year mod 19) ;
  D := ((B-21) mod 30)+21 ;
  if D>48 then Dec(D) ;
  E := (longint(Year)+(Year div 4)+D+1) mod 7 ;
  Q := D+7-E ;
  if Q<32 then
    begin Mo := 3 ; Dy := Q end else
    begin Mo := 4 ; Dy := Q-31 end ;
  end {UDDF} ;




{$IFDEF DELPHI}
type NearYear = 1900..2099 (* CARE *) ;
function NearEaster(const Year : NearYear) : TDateTime ;
{ Origin unknown; quoted by AGL; tested by JRS; modified }
var B, D, E, Q : integer ;
begin
  B := 225 - (11 * (Year mod 19)) ;
  D := ((B - 21) mod 30) + 21 ;
  if D > 48 then dec(D);
  E := (Year + (Year div 4) + D + 1) mod 7 ;
  Q := D + 6 - E ;
  Result := EncodeDate(Year, 3, 1) + Q ;
  end {NearEaster} ;
{$ENDIF}





{$IFDEF DELPHI ???}

(* Good JavaScript from estr-bcp.htm :
function DoMtoMMM_dD(DM) { // DayOfMarch to M D
  return (DM<32 ? "Mar" : "Apr") + SpcsTo(1 + (DM-1)%31, 3) }

function jrsEaster(YR) { // Fast JRSEaster, unsigned 32-bit year
  var gn, xx, cy, DM
  gn = YR % 19					// gn ~ GoldenNumber
  xx = (YR/100)|0
  cy = ((3*(xx+1)/4)|0) - (((13+xx*8)/25)|0)	// cy ~ BCPcypher
  xx = ( 6 + YR + ((YR/4)|0) - xx + ((YR/400)|0) ) % 7
  DM = 21 + (gn*19 + cy + 15)%30 ; DM -= ((gn>10) + DM > 49) // PFM
  return DM + 1 + (66-xx-DM)%7 /* Day-of-March */ }
*)

(* Tested for a FEW YEARS only *)

function jrsEaster(const YR : integer) : integer ;
  (* Fast JRSEaster, unsigned 32-bit year - Delphi/Pascal ?
     TRACEABLE via estr-bcp.htm (qv) to Prayer Book & Calendar Act *)
var gn, xx, cy, DM : integer ;
begin
  gn := YR mod 19 ;				{ gn ~ GoldenNumber }
  xx := YR div 100 ;
  cy := 3*(xx+1) div 4 - (13+xx*8) div 25 ;	{ cy ~ BCPcypher }
  xx := ( 6 + YR + YR div 4 - xx + YR div 400 ) mod  7 ;
  DM := 21 + (gn*19 + cy + 15) mod 30 ;
  Dec(DM, Ord( Ord(gn>10) + DM > 49 )) ;	{ PFM }
  jrsEaster := DM + 1 + (66-xx-DM) mod 7 ;	{ Day-of-March }
  end {jrsEaster} ;

function DoMtoMMM_dD(const DM : integer) : string ; { DayOfMarch to M D }
const MA : array [boolean] of string [3] = ('Mar', 'Apr') ;
begin
  (* Pascal : var S : string [3] ; Str(1 + (DM-1) mod 31 : 3, S) ;
     DoMtoMMM_dD := MA[DM>31] + S ; *)
  DoMtoMMM_dD := Format('%s %2d', [MA[DM>31], 1 + (DM-1) mod 31]) ;
  end {DoMtoMMM_dD} ;

procedure myEaster(var Mo, Dy : byte ; const Yr {Greg.} : TYear) ;
  (* Fast JRSEaster, unsigned 32-bit year - Delphi/Pascal ?
     TRACEABLE via estr-bcp.htm (qv) to Prayer Book & Calendar Act *)
var gn, xx, cy, DM : integer ;
begin
  gn := YR mod 19 ;				{ gn ~ GoldenNumber }
  xx := YR div 100 ;
  cy := 3*(xx+1) div 4 - (13+xx*8) div 25 ;	{ cy ~ BCPcypher }
  xx := ( 6 + YR + YR div 4 - xx + YR div 400 ) mod  7 ;
  DM := 21 + (gn*19 + cy + 15) mod 30 ;
  Dec(DM, Ord( Ord(gn>10) + DM > 49 )) ;	{ PFM }
  Dy := DM + 1 + (66-xx-DM) mod 7 ;	{ Day-of-March }
  Mo := 3 + Ord(Dy>31) ; if Dy>31 then Dec(Dy, 31) ;
  end {myEaster} ;

{$ENDIF}





(*
  function Tix : longint ; assembler ;
  asm  mov ah,0 ; int $1a { Get $40:$6C 18.2Hz clock - not midnight-safe } ;
  {$IFDEF PASCAL} mov ax,dx ; mov dx,cx ; {$ENDIF}
  {$IFDEF DELPHI} mov ax,cx ; shl eax,16 ; mov ax,dx ; {$ENDIF}
  end {Tix} ;
  *)

function Timer : longint { P: 55ms; D: 1ms } ;
{$IFDEF PASCAL} assembler ; {$ENDIF}
{$IFDEF BORPAS}
asm
    mov es,[Seg0040] ;
  @1: mov ax,[es:$6c] ; mov dx,[es:$6e] ; mov cl,[es:$70]
    cmp ax,[es:$6c] ; jne @1
    cmp cl,0 ; je @2
    add ax,$B0 ; adc dx,$18 ;
  @2:
    end {$ENDIF}
{$IFDEF __TMT__} asm  mov eax,[$046C]  end {$ENDIF}
{$IFDEF DELPHI} begin Timer := GetTickCount end {$ENDIF}
{Timer} ;


procedure Wr(const ID : string ; const Y : TYear ; const Cal : string ;
  const M, D : byte) ;
begin Writeln(' (', ID:4, ':) In AD ', Y, ', ', Cal:9,
    ' Easter Sunday = Month ', M, ' Day ', D) end {Wr} ;


procedure SomeYear(const Year : TYear) ;
var Month, Day : byte ; {$IFDEF DELPHI} Y, M, D : word ; {$ENDIF}
begin
  ZEG1885(Month, Day, Year) ;
  Wr('ZEG5 ', Year, 'Gregorian', Month, Day) ;
  PeterDuffettSmith1(Month, Day, Year) ;
  Wr('PDS1 ', Year, 'Gregorian', Month, Day) ;
  PeterDuffettSmith2(Month, Day, Year) ;
  Wr('PDS2 ', Year, 'Gregorian', Month, Day) ;
  ClausTondering1(Month, Day, Year) ;
  Wr('CT1  ', Year, 'Gregorian', Month, Day) ;
  ClausTondering1a(Month, Day, Year) ;
  Wr('CT1a ', Year, 'Gregorian', Month, Day) ;
  TonderingRevised(Month, Day, Year) ;
  Wr('CTrev', Year, 'Gregorian', Month, Day) ;
  EGRichards1(Month, Day, Year) ;
  Wr('EGR1 ', Year, 'Gregorian', Month, Day) ;
  CDWF1(Month, Day, Year) ;
  Wr('CDWF1', Year, 'Gregorian', Month, Day) ;
  if (Year>=1900) and (Year<=2099) then begin
    UDDF(Month, Day, Year) ;
    Wr('UDDF ', Year, 'Gregorian', Month, Day) end ;
  {$IFDEF DELPHI}
  if (Year>=1900) and (Year<=2099) then begin
    DecodeDate(NearEaster(Year), Y, M, D) ;
    Wr('NearE', Year, 'Gregorian', M, D) end ;
  myEaster(Month, Day, Year) ;
  Wr('myE  ', Year, 'Gregorian', Month, Day) ;
  {$ENDIF}
  Writeln ;
  ClausTondering2(Month, Day, Year) ;
  Wr('CT2  ', Year, 'Julian', Month, Day) ;
  EGRichards3(Month, Day, Year) ;
  Wr('EGR3 ', Year, 'Dionysian', Month, Day) ;
  CDWF2(Month, Day, Year) ;
  Wr('CDWF2', Year, 'Julian', Month, Day) ;
  end {SomeYear} ;


procedure Consistency ;
var Y : TYear ; Month, Day, M, D : byte ;
{$IFDEF DELPHI} YY, MM, DD : word ; {$ENDIF}
begin
  Writeln('   65536 years : consistency check,',
    ' then each routine is timed in ',
    {$IFDEF PASCAL} '55', {$ENDIF}
    {$IFDEF DELPHI} '1', {$ENDIF}
    'ms units :') ;
  for Y := 0 to 65535 do begin
    Write(^M, Y:5, #32) ;
    PeterDuffettSmith1(Month, Day, Y) ;
    (* if Y>=532 then begin
      PeterDuffettSmith1(M, D, Y-532)  { not matching } ;
      if (Month<>M) or (Day<>D) then Writeln(' K') ;
      end ; *)
    PeterDuffettSmith2(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' w') ;
    ZEG1885(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' z') ;
    ClausTondering1(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' x') ;
    ClausTondering1a(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' t') ;
    TonderingRevised(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' u') ;
    EGRichards1(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' y') ;
    CDWF1(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' f') ;

    if (Y>=1900) and (Y<=2099) then begin
      UDDF(M, D, Y) ;
      if (Month<>M) or (Day<>D) then Writeln(' u') ;
      end ;

    {$IFDEF DELPHI}
    if (Y>=1900) and (Y<=2099) then begin
      DecodeDate(NearEaster(Y), YY, MM, DD) ;
      if (Month<>MM) or (Day<>DD) then Writeln(' n') ;
      end ;
    MyEaster(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' J') ;
    {$ENDIF}

    ClausTondering2(Month, Day, Y) ;
    if Y>=532 then begin { check repeat }
      ClausTondering2(M, D, Y-532) ;
      if (Month<>M) or (Day<>D) then Writeln(' Q') ;
      end ;

    EGRichards3(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' z') ;
    CDWF2(M, D, Y) ;
    if (Month<>M) or (Day<>D) then Writeln(' g') ;
    end { Test all years } ;
  Writeln ;
  end {Consistency} ;


procedure Timing ;
var T : longint ; Y : TYear ; Q : word ; Month, Day : byte ;
{$IFDEF DELPHI} DT : TDateTime ; {$ENDIF}
begin

  Writeln('  Calibrating :') ;
  repeat
    T := Timer ;
    for Q := 1 to Loops do
      for Y := 0 to 65535 do Empty(Month, Day, Y) ;
    T := Timer-T ;
    Write(' ', T) ;
    if T>4 {$IFDEF DELPHI} *15 {$ENDIF} then BREAK ;
    Loops := Loops + 1 + Loops div 5 until false ;
  Writeln ;
  Writeln ;

  Writeln('  Times : Call :') ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do Empty(Month, Day, Y) ;
  Writeln('   Empty ', Timer-T:5) ;
  Writeln ;

  Writeln('  Times : Greg :') ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do PeterDuffettSmith2(Month, Day, Y) ;
  Writeln('   PDS2  ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do ZEG1885(Month, Day, Y) ;
  Writeln('   ZEG5  ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do CDWF1(Month, Day, Y) ;
  Writeln('   CDWF1 ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do ClausTondering1(Month, Day, Y) ;
  Writeln('   CT1   ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do ClausTondering1a(Month, Day, Y) ;
  Writeln('   CT1a  ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do TonderingRevised(Month, Day, Y) ;
  Writeln('   CTrev ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do EGRichards1(Month, Day, Y) ;
  Writeln('   EGR1  ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do PeterDuffettSmith1(Month, Day, Y) ;
  Writeln('   PDS1  ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do UDDF(Month, Day, Y) ;
  Writeln('   UDDF  ', Timer-T:5) ;

  {$IFDEF DELPHI}
  DT := 1 ;
  T := Timer ; 
  for Q := 1 to Loops do
    for Y := 0 to 65535 do DT := NearEaster(1900 + Y mod 200) ;
  Writeln('   NearE ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do myEaster(Month, Day, Y) ;
  Writeln('   Mine  ', Timer-T:5) ;
  if DT=0 then Writeln ;
  {$ENDIF}

  Writeln ;
  Writeln('  Times : Juln :') ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do CDWF2(Month, Day, Y) ;
  Writeln('   CDWF2 ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do ClausTondering2(Month, Day, Y) ;
  Writeln('   CT2   ', Timer-T:5) ;
  T := Timer ;
  for Q := 1 to Loops do
    for Y := 0 to 65535 do EGRichards3(Month, Day, Y) ;
  Writeln('   EGR3  ', Timer-T:5) ;
  Writeln ;
  end {Timing} ;


var Year, X : TYear ;

BEGIN Writeln(PID) ;
repeat
  Write('Year (>0) ? ') ; Readln(Year) ;

  if Year=0 then begin
    Write('   0=QUIT / 1=Autotest / 2=back ? ') ; Readln(X) ;

    case X of
      0 :  BREAK ;
      1 : begin Consistency ; Timing end ;
      end {case} ;

    CONTINUE ;
    end {Year=0} ;

  SomeYear(Year) ;

  until false ;

Writeln('Done.') ;

END.