Семафор в Lazarus

Долго я искал как реализовать в Lazarus и вобщем то в Free Pascal такой объект синхронизации, как семафор.

Нашёл только критическую секцию и событие в модуле syncobjs. Спросил на форуме freepascal.ru, но ничего толком не сказали.

Реализовал семафор на основе событий. Данное решение работает на Windows (проверял на Windows 7 64)  и на Linux (Ubuntu 12.10).

Модуль semaphore.pas

unit semaphore;

interface

uses
  syncobjs,sysutils;

const INFINITE = (-1);

type
  TWait = (wSignaled, wTimeout, wAbandoned, wError);

  TSemaphore = class(TObject)
  private
    event: TEvent;
    counter:Cardinal;
    cs:TCriticalSection;
  public
    constructor Create(InitValue: Cardinal = 0);
    destructor Destroy; override;
    procedure Release(Value: Cardinal = 1);
    function Wait(TimeOut: Cardinal): TWait;
  end;


implementation

{
********************************** TSemaphore **********************************
}
constructor TSemaphore.Create(InitValue: Cardinal = 0);
begin
  counter:=InitValue;
  cs:=TCriticalSection.Create;
  event:=TEvent.Create(nil,False,(InitValue>0),'');
end;

destructor TSemaphore.Destroy;
begin
  FreeAndNil(cs);
  FreeAndNil(event);
end;

procedure TSemaphore.Release(Value: Cardinal = 1);
begin
  cs.Enter;
  Inc(counter,value);
  if counter>0 then event.SetEvent;
  cs.Leave;
end;

function TSemaphore.Wait(TimeOut: Cardinal): TWait;
begin
  result:=wError;
  case event.WaitFor(TimeOut) of
    wrSignaled: begin
      cs.Enter;
      Dec(counter,1);
      cs.Leave;
      result:=wSignaled;
    end;
    wrTimeout: result:=wTimeout;
    wrAbandoned: result:=wAbandoned;
    wrError: result:=wError;
  end;
  if counter>0 then event.SetEvent;
end;

end.

Пример работы с модулем:

На форме 4 кнопки, думаю будет понятно. В потоке идет сохранение строк в файле. По нажатию одной кнопки добавляются 3 строки, по нажатию другой 5.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, StdCtrls, Semaphore;

type

  { TT }

  TT=class(TThread)
  public
    sem:TSemaphore;
  protected
    procedure Execute; override;
  end;


  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { private declarations }
  public
    thread:TT;
  end;


var
  Form1: TForm1;

implementation

{ TT }

procedure TT.Execute;
var
  f:TextFile;
begin
  AssignFile(f,'log.iter');
  Rewrite(f);

  while not Terminated do begin
    if sem.Wait(500)<>wSignaled then continue;
    WriteLn(f,'iter');
    Flush(f);
  end;
  CloseFile(f);
end;

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  thread.Terminate;
  FreeAndNil(thread.sem);
  FreeAndNil(thread);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  thread.sem.Release(5);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  thread.sem.Release(3);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  thread:=TT.Create(True);
  thread.sem:=TSemaphore.Create;
  thread.Start;
end;

end.