pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Update implementation to use fpc Thread manager semaphore routines

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@462 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-06-06 14:45:19 +00:00
parent 2a3c64a6e6
commit 675a16b787
1 changed files with 49 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
wst/trunk/semaphore.pas
View File

@ -16,21 +16,41 @@ unit semaphore;
interface interface
uses uses
Classes, SysUtils, syncobjs{$IFNDEF FPC},Windows{$ENDIF}; Classes, SysUtils, SyncObjs, wst_types
{$IFDEF WST_DELPHI}
,Windows
{$ENDIF}
{$IFDEF FPC}
{$IFDEF WINDOWS}
,Windows
{$ENDIF}
{$ENDIF};
type type
ESemaphoreException = class(Exception); ESemaphoreException = class(Exception);
{$UNDEF FPC_TM}
{$IFDEF WST_DELPHI}
TSemaphoreHandle = THandle;
{$ENDIF}
{$IFDEF FPC}
{$IFDEF WINDOWS}
TSemaphoreHandle = THandle;
{$ELSE}
{$DEFINE FPC_TM}
TSemaphoreHandle = Pointer;
{$ENDIF}
{$ENDIF}
{ TSemaphoreObject } { TSemaphoreObject }
TSemaphoreObject = class TSemaphoreObject = class
private private
FHandle : {$IFNDEF FPC}THandle{$ELSE}PRTLEvent{$ENDIF}; FHandle : TSemaphoreHandle;
FLimit: Integer; FLimit: Integer;
{$IFDEF FPC} {$IFDEF FPC_TM}
FCurrentState : Integer; FTM : TThreadManager;
FCriticalSection : TCriticalSection;
{$ENDIF} {$ENDIF}
public public
constructor Create(const ALimit : Integer); constructor Create(const ALimit : Integer);
@ -45,32 +65,40 @@ implementation
{ TSemaphoreObject } { TSemaphoreObject }
constructor TSemaphoreObject.Create(const ALimit: Integer); constructor TSemaphoreObject.Create(const ALimit: Integer);
var
i : PtrInt;
begin begin
Assert(ALimit>0); if ( ALimit < 1 ) then
raise ESemaphoreException.CreateFmt('Invalid semaphore maximum count : %d.',[ALimit]);
FLimit := ALimit; FLimit := ALimit;
{$IFNDEF FPC} {$IFNDEF FPC_TM}
FHandle := CreateSemaphore(nil,ALimit,ALimit,''); FHandle := CreateSemaphore(nil,ALimit,ALimit,'');
if ( FHandle = THandle(0) ) then
RaiseLastOSError();
{$ELSE} {$ELSE}
FHandle := RTLEventCreate(); if not GetThreadManager(FTM) then
FCriticalSection := TCriticalSection.Create(); raise ESemaphoreException.Create('Unable to get the thread manager.');
FCurrentState := FLimit; FHandle := FTM.SemaphoreInit();
RTLeventSetEvent(FHandle); for i := 1 to FLimit do
FTM.SemaphorePost(FHandle);
{$ENDIF} {$ENDIF}
end; end;
destructor TSemaphoreObject.Destroy(); destructor TSemaphoreObject.Destroy();
begin begin
{$IFNDEF FPC} {$IFNDEF FPC_TM}
if ( FHandle <> THandle(0) ) then
CloseHandle(FHandle); CloseHandle(FHandle);
{$ELSE} {$ELSE}
RTLeventdestroy(FHandle); if ( FHandle <> nil ) then
FreeAndNil(FCriticalSection); FTM.SemaphoreDestroy(FHandle);
FHandle := nil;
{$ENDIF} {$ENDIF}
inherited Destroy(); inherited Destroy();
end; end;
function TSemaphoreObject.WaitFor(ATimeout: Cardinal): TWaitResult; function TSemaphoreObject.WaitFor(ATimeout: Cardinal): TWaitResult;
{$IFNDEF FPC} {$IFNDEF FPC_TM}
var var
intRes : DWORD; intRes : DWORD;
begin begin
@ -84,55 +112,18 @@ begin
end; end;
end; end;
{$ELSE} {$ELSE}
var
ok : Boolean;
begin begin
Result := wrTimeout; FTM.SemaphoreWait(FHandle);
ok := False;
FCriticalSection.Acquire();
try
if ( FCurrentState > 0 ) then begin
Dec(FCurrentState);
ok := True;
if ( FCurrentState = 0 ) then
RTLeventResetEvent(FHandle);
end;
finally
FCriticalSection.Release();
end;
if not ok then begin
RTLeventWaitFor(FHandle,ATimeout);
FCriticalSection.Acquire();
try
if ( FCurrentState > 0 ) then begin
Dec(FCurrentState);
ok := True;
end;
finally
FCriticalSection.Release();
end;
end;
if ok then
Result := wrSignaled; Result := wrSignaled;
end; end;
{$ENDIF} {$ENDIF}
procedure TSemaphoreObject.Release(); procedure TSemaphoreObject.Release();
begin begin
{$IFNDEF FPC} {$IFNDEF FPC_TM}
ReleaseSemaphore(FHandle,1,nil); ReleaseSemaphore(FHandle,1,nil);
{$ELSE} {$ELSE}
FCriticalSection.Acquire(); FTM.SemaphorePost(FHandle);
try
if ( FCurrentState < Limit ) then begin
Inc(FCurrentState);
end else begin
raise ESemaphoreException.Create('Invalid semaphore operation.');
end;
finally
FCriticalSection.Release();
end;
RTLeventSetEvent(FHandle);
{$ENDIF} {$ENDIF}
end; end;