* TCriticalSection.Tryenter support (Mantis 15928) + short test/demo

tested on FreeBSD (general Unix) and Windows. Note that Haiku seems 
    to have a native threadmgr rather than the Unix one. Will notify 
    maintainer (Olivier)

git-svn-id: trunk@15026 -
This commit is contained in:
marco 2010-03-21 11:34:05 +00:00
parent 0f9f3600c5
commit c477df5046
9 changed files with 91 additions and 1 deletions

1
.gitattributes vendored
View File

@ -1548,6 +1548,7 @@ packages/fcl-base/examples/b64test2.pp svneol=native#text/plain
packages/fcl-base/examples/base64decodingtestcase.pas svneol=native#text/plain
packages/fcl-base/examples/cachetest.pp svneol=native#text/plain
packages/fcl-base/examples/cfgtest.pp svneol=native#text/plain
packages/fcl-base/examples/crittest.pp svneol=native#text/plain
packages/fcl-base/examples/daemon.pp svneol=native#text/plain
packages/fcl-base/examples/daemon.txt svneol=native#text/plain
packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain

View File

@ -0,0 +1,47 @@
program crittest;
// originally a test to test .tryenter.
// A thread holds a lock for 5sec, while the main thread tries to lock
// it.
{$mode Delphi}
Uses {$ifdef unix}cthreads,{$endif} syncobjs,sysutils,classes;
type TTestthread = class(tthread)
procedure execute; override;
end;
var crit : TCriticalSection;
procedure TTestThread.Execute;
begin
crit.acquire;
sleep(5000);
crit.release;
end;
var thr : TTestthread;
I : integer;
begin
crit:=TCriticalsection.create;
thr :=TTestthread.Create(false);
sleep(500); // give thread time to start.
writeln('tryenter');
i:=0;
while not(crit.tryenter) do
begin
writeln('tryenter attempt ',i);
inc(i);
sleep(100);
end;
writeln('lock acquired in mainthread!');
writeln('no payload, so releasing');
crit.release;
thr.waitfor;
end.

View File

@ -42,6 +42,7 @@ type
procedure Acquire;override;
procedure Release;override;
procedure Enter;
function TryEnter:boolean;
procedure Leave;
constructor Create;
destructor Destroy;override;
@ -100,6 +101,10 @@ begin
Release;
end;
function TCriticalSection.TryEnter:boolean;
begin
result:=TryEnterCriticalSection(CriticalSection)<>0;
end;
procedure TCriticalSection.Acquire;

View File

@ -55,6 +55,7 @@ function pthread_self:pthread_t; cdecl;external;
function pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_lock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_trylock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_unlock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_cancel(_para1:pthread_t):cint;cdecl;external;
function pthread_detach(_para1:pthread_t):cint;cdecl;external;

View File

@ -55,6 +55,7 @@ function pthread_self:pthread_t; cdecl;external;
function pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_lock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_trylock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_mutex_unlock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_cancel(_para1:pthread_t):cint;cdecl;external;
function pthread_detach(_para1:pthread_t):cint;cdecl;external;

View File

@ -196,6 +196,12 @@ begin
CurrentTM.EnterCriticalSection(cs);
end;
function TryEnterCriticalsection(var cs : TRTLCriticalSection):longint;
begin
result:=CurrentTM.TryEnterCriticalSection(cs);
end;
procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
begin
@ -389,6 +395,15 @@ begin
ThreadingAlreadyUsed:=true;
end;
function NoTryEnterCriticalSection(var CS):longint;
begin
if IsMultiThread then
NoThreadError
else
ThreadingAlreadyUsed:=true;
end;
procedure NoInitThreadvar(var offset : dword;size : dword);
begin
@ -578,6 +593,7 @@ begin
InitCriticalSection :=@NoCriticalSection;
DoneCriticalSection :=@NoCriticalSection;
EnterCriticalSection :=@NoCriticalSection;
TryEnterCriticalSection:=@NoTryEnterCriticalSection;
LeaveCriticalSection :=@NoCriticalSection;
InitThreadVar :=@NoInitThreadVar;
RelocateThreadVar :=@NoRelocateThreadVar;

View File

@ -35,6 +35,7 @@ type
TThreadGetPriorityHandler = Function (threadHandle : TThreadID): longint;
TGetCurrentThreadIdHandler = Function : TThreadID;
TCriticalSectionHandler = Procedure (var cs);
TCriticalSectionHandlerTryEnter = function (var cs):longint;
TInitThreadVarHandler = Procedure(var offset : dword;size : dword);
TRelocateThreadVarHandler = Function(offset : dword) : pointer;
TAllocateThreadVarsHandler = Procedure;
@ -69,6 +70,7 @@ type
InitCriticalSection : TCriticalSectionHandler;
DoneCriticalSection : TCriticalSectionHandler;
EnterCriticalSection : TCriticalSectionHandler;
TryEnterCriticalSection: TCriticalSectionHandlerTryEnter;
LeaveCriticalSection : TCriticalSectionHandler;
InitThreadVar : TInitThreadVarHandler;
RelocateThreadVar : TRelocateThreadVarHandler;
@ -146,7 +148,7 @@ procedure InitCriticalSection(var cs : TRTLCriticalSection);
procedure DoneCriticalsection(var cs : TRTLCriticalSection);
procedure EnterCriticalsection(var cs : TRTLCriticalSection);
procedure LeaveCriticalsection(var cs : TRTLCriticalSection);
function TryEnterCriticalsection(var cs : TRTLCriticalSection):longint;
function BasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
procedure basiceventdestroy(state:peventstate);
procedure basiceventResetEvent(state:peventstate);

View File

@ -431,6 +431,14 @@ Type PINTRTLEvent = ^TINTRTLEvent;
fpc_threaderror
end;
function CTryEnterCriticalSection(var CS):longint;
begin
if pthread_mutex_Trylock(@CS)=0 then
result:=1 // succes
else
result:=0; // failure
end;
procedure CLeaveCriticalSection(var CS);
begin
if pthread_mutex_unlock(@CS) <> 0 then
@ -943,6 +951,7 @@ begin
InitCriticalSection :=@CInitCriticalSection;
DoneCriticalSection :=@CDoneCriticalSection;
EnterCriticalSection :=@CEnterCriticalSection;
TryEnterCriticalSection:=@CTryEnterCriticalSection;
LeaveCriticalSection :=@CLeaveCriticalSection;
InitThreadVar :=@CInitThreadVar;
RelocateThreadVar :=@CRelocateThreadVar;

View File

@ -65,6 +65,9 @@ procedure WinDoneCriticalSection(var cs : TRTLCriticalSection);
procedure WinEnterCriticalSection(var cs : TRTLCriticalSection);
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'EnterCriticalSection';
function WinTryEnterCriticalSection(var cs : TRTLCriticalSection):longint;
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'TryEnterCriticalSection';
procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection);
{$ifdef wince}cdecl{$else}stdcall{$endif};external KernelDLL name 'LeaveCriticalSection';
@ -343,6 +346,10 @@ begin
WinEnterCriticalSection(PRTLCriticalSection(@cs)^);
end;
function SysTryEnterCriticalSection(var cs):longint;
begin
result:=WinTryEnterCriticalSection(PRTLCriticalSection(@cs)^);
end;
procedure SySLeaveCriticalSection(var cs);
begin
@ -461,6 +468,7 @@ begin
InitCriticalSection :=@SysInitCriticalSection;
DoneCriticalSection :=@SysDoneCriticalSection;
EnterCriticalSection :=@SysEnterCriticalSection;
TryEnterCriticalSection:=@SysTryEnterCriticalSection;
LeaveCriticalSection :=@SysLeaveCriticalSection;
InitThreadVar :=@SysInitThreadVar;
RelocateThreadVar :=@SysRelocateThreadVar;