← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/tests/bench/shootout/src/recursive.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/tests/bench/shootout/src/recursive.pp
 
1
(* The Computer Language Shootout
 
2
   http://shootout.alioth.debian.org/
 
3
 
 
4
   contributed by Josh Goldfoot
 
5
   modified by Vincent Snijders
 
6
*)
 
7
 
 
8
program recursive;
 
9
 
 
10
{$I-}
 
11
 
 
12
var
 
13
   n : integer;
 
14
 
 
15
function Ack(x : integer; y : integer): integer;
 
16
begin
 
17
   if x = 0 then
 
18
      Ack := y + 1
 
19
   else if y = 0 then
 
20
      Ack := Ack(x - 1, 1)
 
21
   else Ack := Ack(x-1, Ack(x, y-1));
 
22
end; { Ack }
 
23
 
 
24
function Fib(n : integer): integer;
 
25
begin
 
26
   if n < 2 then
 
27
      Fib := 1
 
28
   else Fib := Fib(n - 2) + Fib(n - 1)
 
29
end; { Fib }
 
30
 
 
31
function FibFP(n : double): double;
 
32
begin
 
33
   if n < 2 then
 
34
      FibFP := 1
 
35
   else FibFP := FibFP(n - 2) + FibFP(n - 1)
 
36
end; { FibFP }
 
37
 
 
38
function Tak(x : integer; y: integer; z : integer): integer;
 
39
begin
 
40
   if y < x then
 
41
      Tak := Tak( Tak(x-1, y, z), Tak(y-1, z, x), Tak(z-1, x, y) )
 
42
   else Tak := z;
 
43
end; { Tak }
 
44
 
 
45
function TakFP(x : double; y: double; z : double): double;
 
46
begin
 
47
   if y < x then
 
48
      TakFP := TakFP( TakFP(x-1, y, z), TakFP(y-1, z, x), TakFP(z-1, x, y) )
 
49
   else TakFP := z;
 
50
end; { TakFP }
 
51
 
 
52
begin
 
53
   if ParamCount = 1 then begin
 
54
      Val(ParamStr(1), n);
 
55
      n := n - 1;
 
56
   end
 
57
      else n := 2;
 
58
 
 
59
   writeLn('Ack(3,', n + 1, '): ', Ack(3, n+1));
 
60
   writeLn('Fib(', (28.0 + n):1:1, '): ', FibFP(28.0 + n):1:1);
 
61
   writeLn('Tak(', 3 * n,',', 2 * n, ',', n, '): ', Tak(3*n, 2*n, n));
 
62
   writeLn('Fib(3): ', Fib(3));
 
63
   writeLn('Tak(3.0,2.0,1.0): ', TakFP(3.0,2.0,1.0):1:1);
 
64
end.