* new implementation

git-svn-id: trunk@7500 -

.gitattributes

@@ -5571,6 +5571,7 @@ 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/chameneos.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/chameneos.pp

@@ -0,0 +1,139 @@
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org
+  contributed by Marc Weustink
+}
+program chameneos;
+{$mode objfpc}{$h-}
+uses
+  PThreads;
+
+type
+  TColor = (Blue, Red, Yellow, Faded);
+
+var
+  waitfirst,
+  waitsecond   : TSemaphore;
+  first,second : TColor;
+  MeetingsLeft : Integer;
+  ThreadInfo   : array[0..3] of record
+    Id: TThreadId;
+    StartColor: TColor;
+    Count: Integer;
+  end;
+
+
+function Complement(c1,c2:TColor):TColor;
+begin
+  if c2=Faded then
+    begin
+      result:=Faded;
+      exit;
+    end;
+  if c1=c2 then
+    begin
+      result:=c1;
+      exit;
+    end;
+  case c1 of
+    Blue :
+      if c2=Red then
+        result:=Yellow
+      else
+        result:=Red;
+    Red :
+      if c2=Blue then
+        result:=Yellow
+      else
+        result:=Blue;
+    Yellow :
+      if c2=Blue then
+        result:=Red
+      else
+        result:=Blue;
+    else
+      result:=c1;
+  end;
+end;
+
+
+function OtherCreaturesColor(me:TColor):TColor;
+const
+  firstcall : boolean = true;
+begin
+  result:=Faded;
+  sem_wait(waitfirst);
+
+  if firstCall then
+    begin
+      if MeetingsLeft>0 then
+        begin
+          first:=me;
+          firstcall:=false;
+          sem_post(waitfirst);
+          sem_wait(waitsecond);
+          result:=second;
+          dec(MeetingsLeft);
+        end;
+      sem_post(waitfirst);
+    end
+  else
+    begin
+      firstcall:=true;
+      second:=me;
+      result:=first;
+      sem_post(waitsecond);
+    end;
+end;
+
+
+function ThreadFunc(AIndex: PtrInt): Pointer; cdecl;
+var
+  Meetings : Integer;
+  me,other : TColor;
+begin
+  me := ThreadInfo[AIndex].StartColor;
+  Meetings := 0;
+
+  while (me<>Faded) do
+    begin
+      other:=OtherCreaturesColor(me);
+      if other=Faded then
+        break;
+      inc(Meetings);
+      me:=Complement(me,other);
+    end;
+
+  ThreadInfo[AIndex].Count := Meetings;
+  result:=nil;
+end;
+
+
+const
+  COLOR: array[0..3] of TColor = (Blue, Red, Yellow, Blue);
+
+var
+  n: Integer;
+  Attr: TThreadAttr;
+  p: Pointer;
+begin
+  Val(paramstr(1), MeetingsLeft, n);
+  if n <> 0 then exit;
+
+  sem_init(waitfirst,0,1);
+  sem_init(waitsecond,0,0);
+
+  pthread_attr_init(Attr);
+  pthread_attr_setdetachstate(Attr, 0);
+  pthread_attr_setstacksize(Attr, 1024 * 16);
+
+  for n := 0 to 3 do begin
+    ThreadInfo[n].Count := 0;
+    ThreadInfo[n].StartColor := COLOR[n];
+    pthread_create(ThreadInfo[n].Id, Attr, TStartRoutine(@ThreadFunc), Pointer(n));
+  end;
+
+  for n := 0 to 3 do
+    pthread_join(ThreadInfo[n].Id, p);
+
+  WriteLN(ThreadInfo[0].Count + ThreadInfo[1].Count + ThreadInfo[2].Count + ThreadInfo[3].Count);
+end.