+ added shootout thread-ring benchmark

git-svn-id: trunk@9246 -
This commit is contained in:
Marc Weustink 2007-11-13 21:53:53 +00:00
parent dd25f17f96
commit 59f08ab878
2 changed files with 66 additions and 0 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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.