← 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/binarytrees.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/binarytrees.pp
 
1
{ The Great Computer Language Shootout
 
2
  http://shootout.alioth.debian.org
 
3
 
 
4
  contributed by Ales Katona
 
5
}
 
6
 
 
7
program BinaryTrees;
 
8
 
 
9
{$mode objfpc}
 
10
 
 
11
type
 
12
  PNode = ^TNode;
 
13
  TNode = record
 
14
    l, r: PNode;
 
15
    i: Longint;
 
16
  end;
 
17
 
 
18
function CreateNode(l2, r2: PNode; const i2: Longint): PNode;
 
19
begin
 
20
  Result := GetMem(SizeOf(TNode));
 
21
  Result^.l:=l2;
 
22
  Result^.r:=r2;
 
23
  Result^.i:=i2;
 
24
end;
 
25
 
 
26
procedure DestroyNode(ANode: PNode);
 
27
begin
 
28
  if ANode^.l <> nil then begin
 
29
    DestroyNode(ANode^.l);
 
30
    DestroyNode(ANode^.r);
 
31
  end;
 
32
  FreeMem(ANode, SizeOf(TNode));
 
33
end;
 
34
 
 
35
function CheckNode(ANode: PNode): Longint;
 
36
begin
 
37
  if ANode^.l = nil then
 
38
    Result:=ANode^.i
 
39
  else
 
40
    Result:=CheckNode(ANode^.l) + ANode^.i - CheckNode(ANode^.r);
 
41
end;
 
42
 
 
43
function Make(i, d: Longint): PNode;
 
44
begin
 
45
  if d = 0 then Result:=CreateNode(nil, nil, i)
 
46
  else Result:=CreateNode(Make(2 * i - 1, d - 1), Make(2 * i, d - 1), i);
 
47
end;
 
48
 
 
49
const
 
50
  mind = 4;
 
51
 
 
52
var
 
53
  maxd : Longint = 10;
 
54
  strd,
 
55
  iter,
 
56
  c, d, i : Longint;
 
57
  tree, llt : PNode;
 
58
 
 
59
begin
 
60
  if ParamCount = 1 then
 
61
    Val(ParamStr(1), maxd);
 
62
 
 
63
  if maxd < mind+2 then
 
64
     maxd := mind + 2;
 
65
 
 
66
  strd:=maxd + 1;
 
67
  tree:=Make(0, strd);
 
68
  Writeln('stretch tree of depth ', strd, #9' check: ', CheckNode(tree));
 
69
  DestroyNode(tree);
 
70
 
 
71
  llt:=Make(0, maxd);
 
72
 
 
73
  d:=mind;
 
74
  while d <= maxd do begin
 
75
    iter:=1 shl (maxd - d + mind);
 
76
    c:=0;
 
77
    for i:=1 to Iter do begin
 
78
      tree:=Make(i, d);
 
79
      c:=c + CheckNode(tree);
 
80
      DestroyNode(tree);
 
81
      tree:=Make(-i, d);
 
82
      c:=c + CheckNode(tree);
 
83
      DestroyNode(tree);
 
84
    end;
 
85
    Writeln(2 * Iter, #9' trees of depth ', d, #9' check: ', c);
 
86
    Inc(d, 2);
 
87
  end;
 
88
 
 
89
  Writeln('long lived tree of depth ', maxd, #9' check: ', CheckNode(llt));
 
90
  DestroyNode(llt);
 
91
end.