fpc/tests/bench/shootout/src/thread_ring.pp

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