Merged revisions 9142-9144,9150,9185,9211,9236-9238,9246,9260,9262,9266,9269-9272,9276-9278,9295,9307-9308,9310,9322,9337,9340,9343-9344,9359,9373-9375,9387,9396,9399,9401-9402,9434,9450-9456,9459-9463,9466,9468-9469,9472-9473,9476-9477,9480,9491-9492,9529,9536,9550,9566-9568,9571,9573,9576-9577,9579,9583,9587,9615,9632-9637,9655-9656,9658,9668-9671,9676-9677,9691 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r9142 | peter | 2007-11-05 20:40:33 +0100 (Mon, 05 Nov 2007) | 2 lines
  
    * regex implementation from S. Fisher
........
  r9143 | peter | 2007-11-05 21:27:24 +0100 (Mon, 05 Nov 2007) | 2 lines
  
    * optimize loop to use pchar
........
  r9144 | peter | 2007-11-05 22:15:50 +0100 (Mon, 05 Nov 2007) | 2 lines
  
    * fixed off-by-one by S. Fisher
........
  r9150 | florian | 2007-11-07 21:15:50 +0100 (Wed, 07 Nov 2007) | 2 lines
  
  + new fannkuch.pp from S. Fisher
........
  r9246 | marc | 2007-11-13 22:53:53 +0100 (Tue, 13 Nov 2007) | 2 lines
  
  + added shootout thread-ring benchmark
........
  r9615 | vincents | 2008-01-02 16:18:25 +0100 (Wed, 02 Jan 2008) | 1 line
  
  improved version of mandelbrot benchmark, uses now sse2 exclusively.
........
  r9668 | vincents | 2008-01-07 12:09:07 +0100 (Mon, 07 Jan 2008) | 1 line
  
  * improved fannkuch benchmark
........
  r9669 | vincents | 2008-01-07 13:20:48 +0100 (Mon, 07 Jan 2008) | 1 line
  
  * cleanup
........
  r9670 | vincents | 2008-01-07 13:30:58 +0100 (Mon, 07 Jan 2008) | 1 line
  
  * current version of sumcol benchmark by Steve Fisher
........
  r9671 | vincents | 2008-01-07 14:51:34 +0100 (Mon, 07 Jan 2008) | 3 lines
  
  o improved sumcol benchmark
  * read line in string and convert to integer using val, like gcc does
  * cache input text file, to avoid calling fpc_get_input all the time.
........
  r9676 | vincents | 2008-01-08 09:14:04 +0100 (Tue, 08 Jan 2008) | 1 line
  
  + current version of nbody benchmark
........
  r9677 | vincents | 2008-01-08 11:31:00 +0100 (Tue, 08 Jan 2008) | 1 line
  
  * renamed nbody to n_body
........
  r9691 | jonas | 2008-01-09 01:14:30 +0100 (Wed, 09 Jan 2008) | 2 lines
  
    - deleted since it has been renamed to n_body
........

git-svn-id: branches/fixes_2_2@9761 -

.gitattributes

@@ -5834,12 +5834,15 @@ 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/chameneos.pp svneol=native#text/plain
+tests/bench/shootout/src/fannkuch.pp svneol=native#text/plain
 tests/bench/shootout/src/fasta.pp svneol=native#text/plain
 tests/bench/shootout/src/hello.pp svneol=native#text/plain
 tests/bench/shootout/src/knucleotide.pp svneol=native#text/plain
 tests/bench/shootout/src/mandelbrot.pp svneol=native#text/plain
 tests/bench/shootout/src/message.pp svneol=native#text/plain
 tests/bench/shootout/src/meteorshower.pp svneol=native#text/x-pascal
+tests/bench/shootout/src/n_body.pp svneol=native#text/plain
+tests/bench/shootout/src/nbody.pp svneol=native#text/plain
 tests/bench/shootout/src/nsieve.pp svneol=native#text/plain
 tests/bench/shootout/src/partialsums.pp svneol=native#text/plain
 tests/bench/shootout/src/recursive.lpi svneol=native#text/plain
@@ -5848,6 +5851,7 @@ tests/bench/shootout/src/regexdna.pp svneol=native#text/plain
 tests/bench/shootout/src/simple_hash.pp svneol=native#text/plain
 tests/bench/shootout/src/spectralnorm.pp svneol=native#text/plain
 tests/bench/shootout/src/sumcol.pp svneol=native#text/plain
+tests/bench/shootout/src/thread_ring.pp svneol=native#text/pascal
 tests/bench/shortbench.pp svneol=native#text/plain
 tests/bench/stream.pp svneol=native#text/x-pascal
 tests/bench/timer.pas svneol=native#text/plain

tests/bench/shootout/src/fannkuch.pp

@@ -0,0 +1,126 @@
+program fannkuch;
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org/
+
+  contributed by Florian Klaempfl
+  modified by Micha Nelissen
+  modified by Vincent Snijders
+  modified by Steve Fisher
+
+  Compile with
+  fpc -O3 fannkuch.pp
+}
+
+{$INLINE ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+
+type
+    TIntegerArray = Array[0..99] of longint;
+
+var
+   permu, permu_copy, count: TIntegerArray;
+   r, n, answer: longint;
+
+procedure swap(var a, b: longint); inline;
+var  tmp: longint;
+begin  tmp := a;  a := b;  b := tmp   end;
+
+procedure reverse( k: longint); inline;
+var
+  pi, pj : pLongint;
+begin
+  pi := @permu_copy[1];
+  pj := @permu_copy[k-1];
+  while pi<pj do
+  begin
+    swap(pi^, pj^);
+    inc(pi);
+    dec(pj);
+  end;
+end;
+
+function countflips: longint; inline;
+var
+  last: LongInt;
+  tmp: LongInt;
+begin
+  countflips := 0;
+  last := permu_copy[0];
+  repeat
+    // Reverse part of the array.
+    reverse(last);
+
+    tmp := permu_copy[last];
+    permu_copy[last] := last;
+    last := tmp;
+    inc(countflips);
+  until last = 0;
+end;
+
+function NextPermutation: boolean;
+var
+  tmp: LongInt;
+  i : longint;
+begin
+  NextPermutation := true;
+  repeat
+    if r = n then
+    begin
+      NextPermutation := false;
+      break;
+    end;
+    tmp := permu[0];
+    for i := 1 to r do
+      permu[i-1] := permu[i];
+    permu[r] := tmp;
+
+    dec(count[r]);
+    if count[r] > 0 then
+      break;
+    inc(r);
+  until false;
+end;
+
+function fannkuch: longint;
+var
+  print30, m, i, flips: longint;
+begin
+  print30 := 0;
+  fannkuch := 0;
+  m := n - 1;
+
+  // Initial permutation.
+  for i := 0 to m do   permu[i] := i;
+
+  r := n;
+  repeat
+    if print30 < 30 then
+    begin
+      for i := 0 to m do
+        write(permu[i] + 1);
+      writeln;
+      inc(print30);
+    end;
+    while r <> 1 do
+    begin
+      count[r-1] := r;
+      dec(r);
+    end;
+    if (permu[0]<>0) and (permu[m]<>m) then
+    begin
+      move(permu[0], permu_copy[0], sizeof(longint)*n);
+      flips := countflips;
+      if flips > fannkuch then
+        fannkuch := flips;
+    end;
+  until not NextPermutation;
+end;
+
+begin
+  n := 7;
+  if paramCount() = 1 then
+    Val(ParamStr(1), n);
+  answer := fannkuch;
+  writeln('Pfannkuchen(', n, ') = ', answer);
+end.

tests/bench/shootout/src/mandelbrot.pp

@@ -9,59 +9,64 @@ program mandelbrot;
 
 {$FPUTYPE SSE2}{$I-}
 
-var n, x, y, bits,bit: Longint;
-    Cx, Cy: double;
+var n: longint;
+    TextBuf: array[0..$FFF] of byte;
+    OutFile: PText;
+    
 
-procedure CalculatePoint; nostackframe;
-const
-  Limit: double =4.0;
-  zero: double = 0.0;
+procedure run;
 var
-  i: longint;
-  OutOfLimit: boolean;
-  Cr, Ci, Zr, Zi, Ti, Tr: Double;
-  
-begin
-  Cr := Cx; Ci := Cy;
-  Zr := zero;  Zi := zero; Tr := zero; Ti := zero;
-  i := 0;
-  repeat
-    Zi := 2*Zr*Zi + Ci;
-    Zr := Tr - Ti + Cr;
-    Ti := Zi * Zi;
-    Tr := Zr * Zr;
-    inc(i);
-    OutOfLimit := (Tr + Ti>=limit);
-  until OutOfLimit or (i=50);
+  Cy, Step: double;
+  x, y, bits,bit: Longint;
+  function CalculatePoint(Cx, Cy: double): boolean; nostackframe; inline;
+  const
+    Limit = 4;
+  var
+    i: longint;
+    Zr, Zi, Ti, Tr: Double;
 
-  if OutOfLimit then
-    bits := bits xor bit;
-end;
+  begin
+    Zr := 0;  Zi := 0; Tr := 0; Ti := 0;
+    for i := 1 to 50 do begin
+      Zi := 2*Zr*Zi + Cy;
+      Zr := Tr - Ti + Cx;
+      Ti := Zi * Zi;
+      Tr := Zr * Zr;
+      if (Tr + Ti>=limit) then exit(true);
+    end;
 
-{$FPUTYPE X87}
+    CalculatePoint := false;
+  end;
 
 begin
-  Val(ParamStr(1), n);
-  writeln('P4');
-  writeln(n,' ',n);
+  Step := 2/n;
   for y := 0 to n-1 do
   begin
-    Cy := y * 2 / n - 1;
+    Cy := y * Step - 1;
     bits := 255;  bit := 128;
     for x := 0 to n-1 do
     begin
-      Cx := x * 2 / n  - 1.5;
-
-      CalculatePoint;
+      if CalculatePoint(x * Step  - 1.5, Cy) then
+        bits := bits xor bit;
 
       if bit > 1 then
         bit := bit shr 1
       else
       begin
-        write(chr(bits));
+        write(OutFile^, chr(bits));
         bits := 255;  bit := 128;
       end;
     end;
-    if bit < 128 then write(chr(bits xor((bit shl 1)-1)));
+    if bit < 128 then write(OutFile^, chr(bits xor((bit shl 1)-1)));
   end;
+end;
+
+begin
+  OutFile := @Output;
+  SetTextBuf(OutFile^, TextBuf);
+
+  Val(ParamStr(1), n);
+  writeln(OutFile^, 'P4');
+  writeln(OutFile^, n,' ',n);
+  run;
 end.

tests/bench/shootout/src/n_body.pp

@@ -0,0 +1,149 @@
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org
+
+  contributed by Ian Osgood,
+  modified by Florian Klaempfl
+  modified by Ales Katona
+  modified by Vincent Snijders
+}
+{$mode objfpc}
+
+program n_body;
+
+uses Math;
+
+type
+  Body = record
+    x, y, z,
+    vx, vy, vz,
+    mass : double;
+  end;
+  PBody = ^Body;
+
+const pi = 3.141592653589793;
+      solarMass = 4 * sqr(pi);
+      daysPerYear = 365.24;
+
+type
+  tbody = array[1..5] of Body;
+
+const b : tbody = (
+  { Sun }
+  ( x:0; y:0; z:0;  vx:0; vy:0; vz:0;  mass: solarMass ),
+  { Jupiter }
+  ( x:    4.84143144246472090e+00;
+    y:   -1.16032004402742839e+00;
+    z:   -1.03622044471123109e-01;
+    vx:   1.66007664274403694e-03 * daysPerYear;
+    vy:   7.69901118419740425e-03 * daysPerYear;
+    vz:  -6.90460016972063023e-05 * daysPerYear;
+    mass: 9.54791938424326609e-04 * solarMass ),
+  { Saturn }
+  ( x:    8.34336671824457987e+00;
+    y:    4.12479856412430479e+00;
+    z:   -4.03523417114321381e-01;
+    vx:  -2.76742510726862411e-03 * daysPerYear;
+    vy:   4.99852801234917238e-03 * daysPerYear;
+    vz:   2.30417297573763929e-05 * daysPerYear;
+    mass: 2.85885980666130812e-04 * solarMass ),
+  { Uranus }
+  ( x:    1.28943695621391310e+01;
+    y:   -1.51111514016986312e+01;
+    z:   -2.23307578892655734e-01;
+    vx:   2.96460137564761618e-03 * daysPerYear;
+    vy:   2.37847173959480950e-03 * daysPerYear;
+    vz:  -2.96589568540237556e-05 * daysPerYear;
+    mass: 4.36624404335156298e-05 * solarMass ),
+  { Neptune }
+  ( x:    1.53796971148509165e+01;
+    y:   -2.59193146099879641e+01;
+    z:    1.79258772950371181e-01;
+    vx:   2.68067772490389322e-03 * daysPerYear;
+    vy:   1.62824170038242295e-03 * daysPerYear;
+    vz:  -9.51592254519715870e-05 * daysPerYear;
+    mass: 5.15138902046611451e-05 * solarMass )
+);
+
+procedure offsetMomentum;
+var px,py,pz : double;
+    i : integer;
+begin
+  px:=0.0; py:=0.0; pz:=0.0;
+  for i := low(b)+1 to high(b) do
+    with b[i] do
+    begin
+      px := px - vx * mass;
+      py := py - vy * mass;
+      pz := pz - vz * mass;
+    end;
+  b[low(b)].vx := px / solarMass;
+  b[low(b)].vy := py / solarMass;
+  b[low(b)].vz := pz / solarMass;
+end;
+
+function distance(i,j : integer) : double;
+begin
+  distance := sqrt(sqr(b[i].x-b[j].x) + sqr(b[i].y-b[j].y) +
+sqr(b[i].z-b[j].z));
+end;
+
+function energy : double;
+var
+  i,j : integer;
+begin
+  result := 0.0;
+  for i := low(b) to high(b) do
+    with b[i] do
+    begin
+      result := result + mass * (sqr(vx) + sqr(vy) + sqr(vz)) / 2;
+      for j := i+1 to high(b) do
+        result := result - mass * b[j].mass / distance(i,j);
+    end;
+end;
+
+procedure advance(dt : double);
+var i,j : integer;
+    dx,dy,dz,mag : double;
+    bi,bj : PBody;
+begin
+  bi:=@b[low(b)];
+  for i := low(b) to high(b)-1 do begin
+    bj := bi;
+    for j := i+1 to high(b) do
+    begin
+      inc(bj);
+      dx := bi^.x - bj^.x;
+      dy := bi^.y - bj^.y;
+      dz := bi^.z - bj^.z;
+      mag := dt / (sqrt(sqr(dx)+sqr(dy)+sqr(dz))*(sqr(dx)+sqr(dy)+sqr(dz)));
+      bi^.vx := bi^.vx - dx * bj^.mass * mag;
+      bi^.vy := bi^.vy - dy * bj^.mass * mag;
+      bi^.vz := bi^.vz - dz * bj^.mass * mag;
+      bj^.vx := bj^.vx + dx * bi^.mass * mag;
+      bj^.vy := bj^.vy + dy * bi^.mass * mag;
+      bj^.vz := bj^.vz + dz * bi^.mass * mag;
+    end;
+    inc(bi);
+  end;
+  bi:=@b[low(b)];
+  for i := low(b) to high(b) do begin
+    with bi^ do
+    begin
+      x := x + dt * vx;
+      y := y + dt * vy;
+      z := z + dt * vz;
+    end;
+    inc(bi);
+  end;
+end;
+
+var i : integer;
+    n : Integer;
+begin
+  SetPrecisionMode(pmDouble);
+  offsetMomentum;
+  writeln(energy:0:9);
+  Val(ParamStr(1), n, i);
+  for i := 1 to n do advance(0.01);
+  writeln(energy:0:9);
+end.

tests/bench/shootout/src/nbody.pp

@@ -0,0 +1,149 @@
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org
+
+  contributed by Ian Osgood,
+  modified by Florian Klaempfl
+  modified by Ales Katona
+  modified by Vincent Snijders
+}
+{$mode objfpc}
+
+program n_body;
+
+uses Math;
+
+type
+  Body = record
+    x, y, z,
+    vx, vy, vz,
+    mass : double;
+  end;
+  PBody = ^Body;
+
+const pi = 3.141592653589793;
+      solarMass = 4 * sqr(pi);
+      daysPerYear = 365.24;
+
+type
+  tbody = array[1..5] of Body;
+
+const b : tbody = (
+  { Sun }
+  ( x:0; y:0; z:0;  vx:0; vy:0; vz:0;  mass: solarMass ),
+  { Jupiter }
+  ( x:    4.84143144246472090e+00;
+    y:   -1.16032004402742839e+00;
+    z:   -1.03622044471123109e-01;
+    vx:   1.66007664274403694e-03 * daysPerYear;
+    vy:   7.69901118419740425e-03 * daysPerYear;
+    vz:  -6.90460016972063023e-05 * daysPerYear;
+    mass: 9.54791938424326609e-04 * solarMass ),
+  { Saturn }
+  ( x:    8.34336671824457987e+00;
+    y:    4.12479856412430479e+00;
+    z:   -4.03523417114321381e-01;
+    vx:  -2.76742510726862411e-03 * daysPerYear;
+    vy:   4.99852801234917238e-03 * daysPerYear;
+    vz:   2.30417297573763929e-05 * daysPerYear;
+    mass: 2.85885980666130812e-04 * solarMass ),
+  { Uranus }
+  ( x:    1.28943695621391310e+01;
+    y:   -1.51111514016986312e+01;
+    z:   -2.23307578892655734e-01;
+    vx:   2.96460137564761618e-03 * daysPerYear;
+    vy:   2.37847173959480950e-03 * daysPerYear;
+    vz:  -2.96589568540237556e-05 * daysPerYear;
+    mass: 4.36624404335156298e-05 * solarMass ),
+  { Neptune }
+  ( x:    1.53796971148509165e+01;
+    y:   -2.59193146099879641e+01;
+    z:    1.79258772950371181e-01;
+    vx:   2.68067772490389322e-03 * daysPerYear;
+    vy:   1.62824170038242295e-03 * daysPerYear;
+    vz:  -9.51592254519715870e-05 * daysPerYear;
+    mass: 5.15138902046611451e-05 * solarMass )
+);
+
+procedure offsetMomentum;
+var px,py,pz : double;
+    i : integer;
+begin
+  px:=0.0; py:=0.0; pz:=0.0;
+  for i := low(b)+1 to high(b) do
+    with b[i] do
+    begin
+      px := px - vx * mass;
+      py := py - vy * mass;
+      pz := pz - vz * mass;
+    end;
+  b[low(b)].vx := px / solarMass;
+  b[low(b)].vy := py / solarMass;
+  b[low(b)].vz := pz / solarMass;
+end;
+
+function distance(i,j : integer) : double;
+begin
+  distance := sqrt(sqr(b[i].x-b[j].x) + sqr(b[i].y-b[j].y) +
+sqr(b[i].z-b[j].z));
+end;
+
+function energy : double;
+var
+  i,j : integer;
+begin
+  result := 0.0;
+  for i := low(b) to high(b) do
+    with b[i] do
+    begin
+      result := result + mass * (sqr(vx) + sqr(vy) + sqr(vz)) / 2;
+      for j := i+1 to high(b) do
+        result := result - mass * b[j].mass / distance(i,j);
+    end;
+end;
+
+procedure advance(dt : double);
+var i,j : integer;
+    dx,dy,dz,mag : double;
+    bi,bj : PBody;
+begin
+  bi:=@b[low(b)];
+  for i := low(b) to high(b)-1 do begin
+    bj := bi;
+    for j := i+1 to high(b) do
+    begin
+      inc(bj);
+      dx := bi^.x - bj^.x;
+      dy := bi^.y - bj^.y;
+      dz := bi^.z - bj^.z;
+      mag := dt / (sqrt(sqr(dx)+sqr(dy)+sqr(dz))*(sqr(dx)+sqr(dy)+sqr(dz)));
+      bi^.vx := bi^.vx - dx * bj^.mass * mag;
+      bi^.vy := bi^.vy - dy * bj^.mass * mag;
+      bi^.vz := bi^.vz - dz * bj^.mass * mag;
+      bj^.vx := bj^.vx + dx * bi^.mass * mag;
+      bj^.vy := bj^.vy + dy * bi^.mass * mag;
+      bj^.vz := bj^.vz + dz * bi^.mass * mag;
+    end;
+    inc(bi);
+  end;
+  bi:=@b[low(b)];
+  for i := low(b) to high(b) do begin
+    with bi^ do
+    begin
+      x := x + dt * vx;
+      y := y + dt * vy;
+      z := z + dt * vz;
+    end;
+    inc(bi);
+  end;
+end;
+
+var i : integer;
+    n : Integer;
+begin
+  SetPrecisionMode(pmDouble);
+  offsetMomentum;
+  writeln(energy:0:9);
+  Val(ParamStr(1), n, i);
+  for i := 1 to n do advance(0.01);
+  writeln(energy:0:9);
+end.

tests/bench/shootout/src/regexdna.pp

@@ -1,45 +1,141 @@
-{$mode objfpc}
-{$H-}
-uses
-  regexpr;
-var
-  buffer : PChar;
-  buffer2 : ansistring;
-  seqlen : longint;
-  TextBuf: array[0..$FFF] of byte;
+{ The Computer Language Benchmarks Game
+  http://shootout.alioth.debian.org
+
+  contributed by Steve Fisher
+  modified by Peter Vreman
+
+  compile with
+  fpc -O3 regex-dna.pp
+}
+
+uses regexpr,strutils;
 
-procedure Load;
+function replace_matches( const target: pchar;  const repl: ansistring;
+                const str: ansistring;  var dest: ansistring ): longint;
 var
-  len : longint;
-  buffersize, bufferptr: longint;
-  s : Shortstring;
+  engine : tRegexprEngine;
+  count, index, size : longint;
+  pstart : pchar;
+  starti : longint;
 begin
-  buffersize:=1024;
-  buffer:=getmem(buffersize);
-  bufferptr :=0;
-  while not eof do begin
-    readln(s);
-    len:=length(s);
-    if (bufferptr+len+1)>buffersize then begin
-      inc(buffersize,buffersize);
-      reallocmem(buffer,buffersize);
-    end;
-    move (s[1],buffer[bufferptr],len);
-    inc(bufferptr,len);
+  if not GenerateRegExprEngine( target, [], engine) then
+  begin
+    writeln( 'Failed to generate regex. engine for "',target,'".' );
+    halt(1)
+  end;
+  count := 0;
+  dest := '';
+  starti := 1;
+  pstart := pchar(str);
+  while starti <= length(str) do
+  begin
+    if RegExprPos(engine, pstart, index, size ) then
+    begin
+      inc(count);
+      dest := dest + Copy( str, starti, index) + repl;
+      inc(pstart,index+size);
+      inc(starti,index+size);
+    end
+    else
+      break
   end;
-  buffer[bufferptr] := #0;
-  seqlen:=bufferptr;
-  writeln(seqlen);
+  DestroyRegExprEngine( engine );
+  dest:=dest+Copy( str, starti, length(str)-starti+1);
+  exit(count);
 end;
 
-procedure ReplaceNewline;
+
+function count_matches( target: pchar; const str: ansistring ): longint;
+var
+  engine : tRegexprEngine;
+  pstart : pchar;
+  starti,
+  count, index, size : longint;
+begin
+  if not GenerateRegExprEngine( target, [ref_caseinsensitive], engine) then
   begin
-    GenerateRegExprEngine('>.*\n|\n',[],RegExprEngine);
-    writeln(RegExprReplace(RegExprEngine,buffer,'',buffer2));
-    DestroyRegExprEngine(RegExprEngine);
+    writeln( 'Failed to generate regex. engine for "',target,'".' );
+    halt(1)
   end;
+  count := 0;
+  pstart := pchar(str);
+  starti := 1;
+  while starti <= length(str) do
+  begin
+    if RegExprPos(engine, pstart, index, size ) then
+    begin
+      inc(count);
+      inc(pstart,index+size);
+      inc(starti,index+size);
+    end
+    else
+      break
+  end;
+  DestroyRegExprEngine( engine );
+  exit(count)
+end;
+
+const
+  patterns : array[1..9] of pchar =
+    (
+      '(agggtaaa)|(tttaccct)',
+      '([cgt]gggtaaa)|(tttaccc[acg])',
+      '(a[act]ggtaaa)|(tttacc[agt]t)',
+      '(ag[act]gtaaa)|(tttac[agt]ct)',
+      '(agg[act]taaa)|(ttta[agt]cct)',
+      '(aggg[acg]aaa)|(ttt[cgt]ccct)',
+      '(agggt[cgt]aa)|(tt[acg]accct)',
+      '(agggta[cgt]a)|(t[acg]taccct)',
+      '(agggtaa[cgt])|([acg]ttaccct)'
+    );
+  replacements : array[1..11,1..2] of pchar =
+  (
+    ('B', '(c|g|t)'), ('D', '(a|g|t)'), ('H', '(a|c|t)'), ('K', '(g|t)'),
+    ('M', '(a|c)'), ('N', '(a|c|g|t)'), ('R', '(a|g)'), ('S', '(c|t)'),
+    ('V', '(a|c|g)'), ('W', '(a|t)'), ('Y', '(c|t)')
+  );
 
+
+var
+  pattern : pchar;
+  sequence, new_seq : ansiString;
+  line, tmp: string[255];
+  letter, repl : pchar;
+  i, count, init_length, clean_length, reps : longint;
+  inbuf : array[0..64*1024] of char;
 begin
-  SetTextBuf(input, TextBuf, sizeof(TextBuf));
-  Load;
+  settextbuf(input,inbuf);
+  sequence := '';
+  init_length := 0;
+  while not eof do
+  begin
+    readln( line );
+    init_length += length( line ) + 1;
+    if line[1] <> '>' then
+      sequence := sequence + line;
+  end;
+  clean_length := length(sequence);
+
+  for i := low(patterns) to high(patterns) do
+  begin
+    pattern := patterns[i];
+    count := count_matches( pattern, sequence );
+    tmp := delChars( delChars(pattern,'('), ')' );
+    writeln( tmp, ' ', count);
+  end;
+
+
+  //  Replace.
+  for i := low(replacements) to high(replacements) do
+  begin
+    letter := replacements[i][1];  repl := replacements[i][2];
+    reps := replace_matches(letter,repl,sequence,new_seq);
+    sequence := new_seq;
+  end;
+
+
+  writeln;
+  writeln( init_length );
+  writeln( clean_length );
+  writeln( length(sequence) );
 end.

tests/bench/shootout/src/sumcol.pp

@@ -1,19 +1,30 @@
-{ The Great Computer Language Shootout
+{ The Computer Language Benchmarks Game
   http://shootout.alioth.debian.org
 
   contributed by Ales Katona
+  modified by Daniel Mantione
+  modified by Steve Fisher
+  modified by Vincent Snijders
 }
 
-program sumcol;
+{$iochecks off}
 
-{$mode objfpc}
-
-var num, tot: longint;
+var
+  num, tot: longint;
+  s: string[128];
+  textbuf: array[0..8191] of char;
+  infile: ^text;
 
 begin
-  while not Eof(input) do begin
-    ReadLn(input, num);
-    tot := tot + num;
-  end;
-  WriteLn(tot);
-end.
+  infile := @input;
+  settextbuf(infile^, textbuf);
+  tot := 0;
+  repeat
+    readLn(infile^, s);
+    val(s, num);
+    tot := tot + num
+  until eof(infile^);
+  writeLn(tot)
+end.
+
+

tests/bench/shootout/src/thread_ring.pp

@@ -0,0 +1,65 @@
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org
+
+  contributed by Marc Weustink
+}
+program thread_ring;
+{$mode objfpc}{$h-}{$i-}
+uses
+  PThreads;
+
+var
+  SemList: array[1..503] of TSemaphore;
+
+  ThreadAttr: TThreadAttr;
+  ThreadFuncAddr: TStartRoutine;
+  FinishedSem: TSemaphore;
+  Count: Integer;
+  
+function ThreadFunc(AIndex: PtrInt): Pointer; cdecl;
+var
+  MySem, NextSem: PSemaphore;
+  Id: TThreadID;
+begin
+  MySem := @SemList[AIndex];
+  if AIndex < High(SemList)
+  then begin
+    NextSem := MySem+1;
+    sem_init(NextSem, 0, 0);
+    pthread_create(@Id, @ThreadAttr, ThreadFuncAddr, Pointer(AIndex+1));
+  end
+  else NextSem := @SemList[Low(SemList)];
+
+  repeat
+    sem_wait(MySem);
+    if Count = 0 then begin
+      WriteLn(Aindex);
+      sem_post(FinishedSem);
+    end
+    else begin
+      Dec(Count);
+      sem_post(NextSem);
+    end;
+  until False;
+end;
+
+
+var
+  n: Integer;
+  Id: TThreadId;
+begin
+  Val(paramstr(1), count, n);
+  if n <> 0 then exit;
+
+  sem_init(SemList[Low(SemList)], 0, 1);
+  sem_init(FinishedSem, 0, 0);
+
+  pthread_attr_init(@ThreadAttr);
+  pthread_attr_setdetachstate(@ThreadAttr, 1);
+  pthread_attr_setstacksize(@ThreadAttr, 1024 * 16);
+
+  ThreadFuncAddr := TStartRoutine(@ThreadFunc);
+  pthread_create(@Id, @ThreadAttr, ThreadFuncAddr, Pointer(PtrUInt(Low(SemList))));
+
+  sem_wait(FinishedSem);
+end.