+ added binarytrees benchmark

git-svn-id: trunk@4864 -

.gitattributes

@@ -5103,6 +5103,7 @@ tests/bench/drystone.pas svneol=native#text/plain
 tests/bench/pi.c -text
 tests/bench/pi.pp svneol=native#text/plain
 tests/bench/shootout/README.txt svneol=native#text/plain
+tests/bench/shootout/io/binarytrees-output.txt svneol=native#text/plain
 tests/bench/shootout/io/moments.in -text
 tests/bench/shootout/io/moments.out -text
 tests/bench/shootout/io/recursive-output.txt svneol=native#text/plain
@@ -5148,6 +5149,7 @@ tests/bench/shootout/obsolete/strcat.pp svneol=native#text/plain
 tests/bench/shootout/obsolete/takfp.pp svneol=native#text/plain
 tests/bench/shootout/obsolete/wc.pp svneol=native#text/plain
 tests/bench/shootout/src/bench.c -text
+tests/bench/shootout/src/binarytrees.pp svneol=native#text/plain
 tests/bench/shootout/src/hello.pp svneol=native#text/plain
 tests/bench/shootout/src/nsieve.pp svneol=native#text/plain
 tests/bench/shootout/src/recursive.pp svneol=native#text/plain

tests/bench/shootout/io/binarytrees-output.txt

@@ -0,0 +1,6 @@
+stretch tree of depth 11	 check: -1
+2048	 trees of depth 4	 check: -2048
+512	 trees of depth 6	 check: -512
+128	 trees of depth 8	 check: -128
+32	 trees of depth 10	 check: -32
+long lived tree of depth 10	 check: -1

tests/bench/shootout/src/binarytrees.pp

@@ -0,0 +1,91 @@
+{ The Great Computer Language Shootout
+  http://shootout.alioth.debian.org
+
+  contributed by Ales Katona
+}
+
+program BinaryTrees;
+
+{$mode objfpc}
+
+type
+  PNode = ^TNode;
+  TNode = record
+    l, r: PNode;
+    i: Longint;
+  end;
+
+function CreateNode(l2, r2: PNode; const i2: Longint): PNode;
+begin
+  Result := GetMem(SizeOf(TNode));
+  Result^.l:=l2;
+  Result^.r:=r2;
+  Result^.i:=i2;
+end;
+
+procedure DestroyNode(ANode: PNode);
+begin
+  if ANode^.l <> nil then begin
+    DestroyNode(ANode^.l);
+    DestroyNode(ANode^.r);
+  end;
+  FreeMem(ANode, SizeOf(TNode));
+end;
+
+function CheckNode(ANode: PNode): Longint;
+begin
+  if ANode^.l = nil then
+    Result:=ANode^.i
+  else
+    Result:=CheckNode(ANode^.l) + ANode^.i - CheckNode(ANode^.r);
+end;
+
+function Make(i, d: Longint): PNode;
+begin
+  if d = 0 then Result:=CreateNode(nil, nil, i)
+  else Result:=CreateNode(Make(2 * i - 1, d - 1), Make(2 * i, d - 1), i);
+end;
+
+const
+  mind = 4;
+
+var
+  maxd : Longint = 10;
+  strd,
+  iter,
+  c, d, i : Longint;
+  tree, llt : PNode;
+
+begin
+  if ParamCount = 1 then
+    Val(ParamStr(1), maxd);
+
+  if maxd < mind+2 then
+     maxd := mind + 2;
+
+  strd:=maxd + 1;
+  tree:=Make(0, strd);
+  Writeln('stretch tree of depth ', strd, #9' check: ', CheckNode(tree));
+  DestroyNode(tree);
+
+  llt:=Make(0, maxd);
+
+  d:=mind;
+  while d <= maxd do begin
+    iter:=1 shl (maxd - d + mind);
+    c:=0;
+    for i:=1 to Iter do begin
+      tree:=Make(i, d);
+      c:=c + CheckNode(tree);
+      DestroyNode(tree);
+      tree:=Make(-i, d);
+      c:=c + CheckNode(tree);
+      DestroyNode(tree);
+    end;
+    Writeln(2 * Iter, #9' trees of depth ', d, #9' check: ', c);
+    Inc(d, 2);
+  end;
+
+  Writeln('long lived tree of depth ', maxd, #9' check: ', CheckNode(llt));
+  DestroyNode(llt);
+end.

tests/bench/shootout/src/nsieve.pp

@@ -1,41 +1,41 @@
-{ Sieve of Erathostenes }
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org
 
-program sieve;
-uses SysUtils;
+  contributed by Joost van der Sluis
+}
 
-var
-    NUM, i, k, count : integer;
-    flags : array[0..8192] of integer;
+program nsieve;
 
-begin
-    if ParamCount = 0 then
-        NUM := 1
-    else
-        NUM := StrToInt(ParamStr(1));
+{$mode objfpc}
 
-    if NUM < 1 then NUM := 1;
+var n : integer;
 
-    while NUM > 0 do
+procedure primes(n : integer); inline;
+var flags : array of boolean;
+    size,i,j,count : integer;
+begin
+  size := 10000 shl n;
+  SetLength(flags, size+1);
+  for i := 2 to size do flags[i] := true;
+//fillchar(flags[0],length(flags),ord(true));
+  count := 0;
+  for i := 2 to size do
+    if flags[i] then
     begin
-        Dec(NUM);
-        count := 0;
-        for i := 0 to 8192 do
-        begin
-            flags[i] := i;
-        end;
-        for i := 2 to 8192 do
-        begin
-            if flags[i] <> -1 then
-            begin
-                k := i+i;
-                while k <= 8192 do
-                begin
-                    flags[k] := -1;
-                    Inc(k, i);
-                end;
-                Inc(count);
-            end;
-        end;
+      count := count + 1;
+      j := i + i;
+      while j <= size do begin
+//      flags[j] := false;
+        if flags[j] then flags[j] := false;
+        j := j + i;
+      end;
     end;
-    WriteLn('Count: ' + IntToStr(Count));
-end.
+  writeln('Primes up to', size:9, count:9);
+end;
+
+begin
+  val(ParamStr(1), n);
+  primes(n);
+  primes(n-1);
+  primes(n-2);
+end.