+ added shootout thread-ring benchmark

git-svn-id: trunk@9246 -

.gitattributes

@@ -5822,6 +5822,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/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.