* code from shootout

git-svn-id: trunk@8621 -

.gitattributes

@@ -5640,6 +5640,7 @@ 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/nsieve.pp svneol=native#text/plain
 tests/bench/shootout/src/partialsums.pp svneol=native#text/plain

tests/bench/shootout/src/message.pp

@@ -0,0 +1,98 @@
+{ The Computer Language Shootout
+  http://shootout.alioth.debian.org
+  contributed by Marc Weustink
+}
+program message;
+{$mode objfpc}{$h-}
+uses
+  PThreads;
+
+var
+  PostOffice: array[0..499] of record
+    Queue: array[0..15] of Integer;  // queuelength must be power of 2
+    ReadIdx, WriteIdx: Integer;
+    ReadSem, WriteSem: TSemaphore;
+  end;
+  ThreadAttr: TThreadAttr;
+  ThreadFuncAddr: TStartRoutine;
+  Sum: Integer = 0;
+  FinishedSem: TSemaphore;
+
+procedure PostMessage(AIndex, AMessage: Integer);
+begin
+  with PostOffice[AIndex] do begin
+    sem_wait(WriteSem);
+    Queue[WriteIdx] := AMessage;
+    sem_post(ReadSem);
+    WriteIdx := (WriteIdx + 1) and (Length(Queue) - 1);
+  end;
+end;
+
+function ReadMessage(AIndex: Integer): Integer;
+begin
+  with PostOffice[AIndex] do begin
+    sem_wait(ReadSem);
+    Result := Queue[ReadIdx];
+    sem_post(WriteSem);
+    ReadIdx := (ReadIdx + 1) and (Length(Queue) - 1);
+  end;
+end;
+
+function ThreadFunc(ANum: PtrInt): Pointer; cdecl;
+var
+  Value: Integer;
+  Id: TThreadID;
+begin
+  if ANum <> 0
+  then pthread_create(@Id, @ThreadAttr, ThreadFuncAddr, Pointer(ANum-1));
+
+  repeat
+    Value := ReadMessage(ANum);
+    if Value <> -1
+    then begin
+      Inc(Value);
+      if ANum = 0
+      then Inc(Sum, Value)
+      else PostMessage(ANum-1, Value);
+    end
+    else begin
+      if ANum = 0
+      then sem_post(@FinishedSem)
+      else PostMessage(ANum-1, Value);
+      //Break;
+    end;
+  until False;
+end;
+
+
+var
+  n, count: Integer;
+  Id: TThreadId;
+begin
+  Val(paramstr(1), count, n);
+  if n <> 0 then exit;
+
+  for n := 0 to High(PostOffice) do with PostOffice[n] do begin
+    ReadIdx := 0;
+    WriteIdx := 0;
+    sem_init(@ReadSem, 0, 0);
+    sem_init(@WriteSem, 0, Length(Queue));
+  end;
+  
+  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(High(PostOffice)));
+
+  for n := 1 to count do
+    PostMessage(High(PostOffice), 0);
+
+  PostMessage(High(PostOffice), -1);
+  
+  sem_wait(FinishedSem);
+  WriteLn(Sum);
+end.