You've already forked lazarus-ccr
semaphore: +new simple implementation based on a critical section(on non-Windows).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5994 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -16,42 +16,37 @@ unit semaphore;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, SyncObjs, wst_types
|
|
||||||
{$IFDEF WST_DELPHI}
|
|
||||||
,Windows
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF FPC}
|
|
||||||
{$IFDEF WINDOWS}
|
{$IFDEF WINDOWS}
|
||||||
,Windows
|
Windows,
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$ENDIF};
|
SysUtils,
|
||||||
|
SyncObjs;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
ESemaphoreException = class(Exception);
|
ESemaphoreException = class(Exception);
|
||||||
|
|
||||||
{$UNDEF FPC_TM}
|
|
||||||
{$IFDEF WST_DELPHI}
|
|
||||||
TSemaphoreHandle = THandle;
|
|
||||||
{$ENDIF}
|
|
||||||
{$IFDEF FPC}
|
|
||||||
{$IFDEF WINDOWS}
|
{$IFDEF WINDOWS}
|
||||||
TSemaphoreHandle = THandle;
|
TWindowsSemaphoreObject = class
|
||||||
{$ELSE}
|
|
||||||
{$DEFINE FPC_TM}
|
|
||||||
TSemaphoreHandle = Pointer;
|
|
||||||
{$ENDIF}
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
{ TSemaphoreObject }
|
|
||||||
|
|
||||||
TSemaphoreObject = class
|
|
||||||
private
|
private
|
||||||
FHandle : TSemaphoreHandle;
|
FHandle : THandle;
|
||||||
FLimit: Integer;
|
FLimit: Integer;
|
||||||
{$IFDEF FPC_TM}
|
public
|
||||||
FTM : TThreadManager;
|
constructor Create(const ALimit : Integer);
|
||||||
{$ENDIF}
|
destructor Destroy(); override;
|
||||||
|
function WaitFor(ATimeout : Cardinal) : TWaitResult;
|
||||||
|
procedure Release();
|
||||||
|
property Limit : Integer read FLimit;
|
||||||
|
end;
|
||||||
|
{$ENDIF WINDOWS}
|
||||||
|
|
||||||
|
{ TCsSemaphoreObject }
|
||||||
|
|
||||||
|
TCsSemaphoreObject = class
|
||||||
|
private
|
||||||
|
FCriticalSection : SyncObjs.TCriticalSection;
|
||||||
|
FLimit : Integer;
|
||||||
|
FCount : Integer;
|
||||||
public
|
public
|
||||||
constructor Create(const ALimit : Integer);
|
constructor Create(const ALimit : Integer);
|
||||||
destructor Destroy(); override;
|
destructor Destroy(); override;
|
||||||
@ -60,47 +55,80 @@ type
|
|||||||
property Limit : Integer read FLimit;
|
property Limit : Integer read FLimit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
TSemaphoreObject = TWindowsSemaphoreObject;
|
||||||
|
{$ELSE}
|
||||||
|
TSemaphoreObject = TCsSemaphoreObject;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
SERR_InvalidSemaphoreCount = 'Invalid semaphore maximum count : %d.';
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
{ TSemaphoreObject }
|
{ TCsSemaphoreObject }
|
||||||
|
|
||||||
constructor TSemaphoreObject.Create(const ALimit: Integer);
|
constructor TCsSemaphoreObject.Create(const ALimit : Integer);
|
||||||
{$IFDEF FPC_TM}
|
|
||||||
var
|
|
||||||
i : Integer;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
begin
|
||||||
if (ALimit < 1) then
|
if (ALimit < 1) then
|
||||||
raise ESemaphoreException.CreateFmt('Invalid semaphore maximum count : %d.',[ALimit]);
|
raise ESemaphoreException.CreateFmt(SERR_InvalidSemaphoreCount,[ALimit]);
|
||||||
|
FLimit := ALimit;
|
||||||
|
FCriticalSection := SyncObjs.TCriticalSection.Create();
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TCsSemaphoreObject.Destroy;
|
||||||
|
begin
|
||||||
|
FCriticalSection.Free();
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TCsSemaphoreObject.WaitFor(ATimeout : Cardinal) : TWaitResult;
|
||||||
|
begin
|
||||||
|
FCriticalSection.Acquire();
|
||||||
|
try
|
||||||
|
if (FCount < FLimit) then begin
|
||||||
|
FCount := FCount+1;
|
||||||
|
Result := wrSignaled;
|
||||||
|
end else begin
|
||||||
|
Result := wrAbandoned;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FCriticalSection.Release();
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCsSemaphoreObject.Release;
|
||||||
|
begin
|
||||||
|
FCriticalSection.Acquire();
|
||||||
|
try
|
||||||
|
if (FCount > 0) then
|
||||||
|
FCount := FCount-1;
|
||||||
|
finally
|
||||||
|
FCriticalSection.Release();
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
{ TWindowsSemaphoreObject }
|
||||||
|
|
||||||
|
constructor TWindowsSemaphoreObject.Create(const ALimit : Integer);
|
||||||
|
begin
|
||||||
|
if (ALimit < 1) then
|
||||||
|
raise ESemaphoreException.CreateFmt(SERR_InvalidSemaphoreCount,[ALimit]);
|
||||||
FLimit := ALimit;
|
FLimit := ALimit;
|
||||||
{$IFNDEF FPC_TM}
|
|
||||||
FHandle := CreateSemaphore(nil,ALimit,ALimit,'');
|
FHandle := CreateSemaphore(nil,ALimit,ALimit,'');
|
||||||
if (FHandle = THandle(0)) then
|
if (FHandle = THandle(0)) then
|
||||||
RaiseLastOSError();
|
RaiseLastOSError();
|
||||||
{$ELSE}
|
|
||||||
if not GetThreadManager(FTM) then
|
|
||||||
raise ESemaphoreException.Create('Unable to get the thread manager.');
|
|
||||||
FHandle := FTM.SemaphoreInit();
|
|
||||||
for i := 1 to FLimit do
|
|
||||||
FTM.SemaphorePost(FHandle);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TSemaphoreObject.Destroy();
|
destructor TWindowsSemaphoreObject.Destroy;
|
||||||
begin
|
begin
|
||||||
{$IFNDEF FPC_TM}
|
|
||||||
if ( FHandle <> THandle(0) ) then
|
if ( FHandle <> THandle(0) ) then
|
||||||
CloseHandle(FHandle);
|
CloseHandle(FHandle);
|
||||||
{$ELSE}
|
inherited Destroy;
|
||||||
if ( FHandle <> nil ) then
|
|
||||||
FTM.SemaphoreDestroy(FHandle);
|
|
||||||
FHandle := nil;
|
|
||||||
{$ENDIF}
|
|
||||||
inherited Destroy();
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSemaphoreObject.WaitFor(ATimeout: Cardinal): TWaitResult;
|
function TWindowsSemaphoreObject.WaitFor(ATimeout : Cardinal) : TWaitResult;
|
||||||
{$IFNDEF FPC_TM}
|
|
||||||
var
|
var
|
||||||
intRes : DWORD;
|
intRes : DWORD;
|
||||||
begin
|
begin
|
||||||
@ -113,21 +141,12 @@ begin
|
|||||||
Result := wrTimeout;
|
Result := wrTimeout;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{$ELSE}
|
|
||||||
begin
|
|
||||||
FTM.SemaphoreWait(FHandle);
|
|
||||||
Result := wrSignaled;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
procedure TSemaphoreObject.Release();
|
procedure TWindowsSemaphoreObject.Release;
|
||||||
begin
|
begin
|
||||||
{$IFNDEF FPC_TM}
|
|
||||||
ReleaseSemaphore(FHandle,1,nil);
|
ReleaseSemaphore(FHandle,1,nil);
|
||||||
{$ELSE}
|
|
||||||
FTM.SemaphorePost(FHandle);
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
|
{$ENDIF WINDOWS}
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user