Hi there,
A counting, or general, semaphore limits simultaneous access to a resource according to the number of permits you specify. On the other hand, a binary semaphore like a critical section limits the access to "one at a time".
FPC doesn't seem to have a general semaphore? I recently attempted to implement one, here is the code, plus a working Lazarus demo attached. It blocks on an event instead of a critical section. However, I didnt manage to have it block by just calling Wait, because then the code blocked without leaving the PermitLock and that meant deadlock for all threads. So thats why you see the "if Semaphore.Wait(aEvent) then RTLEventWaitFor(aEvent)" instead of just Semaphore.Wait(aEvent). It works just fine, but if anyone knows how to implement this by just calling Wait(aEvent), please tell. If you want to block on a critical section instead of an event, do that. Perhaps the result could be TFPSemaphore and go with FPC.
unit kbsemaphore;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, syncobjs, contnrs;
type
{ TKBSemaphore }
TKBSemaphore = class
private
FPermits: Cardinal;
FPermitLock: TCriticalSection;
FBlockQueue: TQueue;
function GetWaitCount: Cardinal;
public
function Wait(var AEvent: PRTLEvent): Boolean;
procedure Post;
constructor Create(MaxPermits: Cardinal);
destructor Destroy; override;
property WaitCount: Cardinal read GetWaitCount; //Approximate
precision!
property Permits: Cardinal read FPermits;
end;
implementation{ TKBSemaphore }
function TKBSemaphore.GetWaitCount: Cardinal;
begin
FPermitLock.Enter;
Result:= FBlockQueue.Count;
FPermitLock.Leave;
end;
function TKBSemaphore.Wait(var AEvent: PRTLEvent): Boolean;
begin
FPermitLock.Enter;
if (FPermits > 0) then
begin
Dec(FPermits);
Result:= False;
end
else
begin
AEvent:= RTLEventCreate;
FBlockQueue.Push(AEvent);
Result:= True;
end;
FPermitLock.Leave;
end;
procedure TKBSemaphore.Post;
begin
FPermitLock.Enter;
if FBlockQueue.Count > 0 then
begin
RTLeventSetEvent(PRTLEvent(FBlockQueue.Peek));
RTLeventdestroy(PRTLEvent(FBlockQueue.Pop));
end
else
Inc(FPermits);
FPermitLock.Leave;
end;
constructor TKBSemaphore.Create(MaxPermits: Cardinal);
begin
FPermits:= MaxPermits;
FPermitLock:= TCriticalSection.Create;
FBlockQueue:= TQueue.Create;
end;
destructor TKBSemaphore.Destroy;
begin
FPermitLock.Free;
FBlockQueue.Free;
inherited Destroy;
end;
end.