* 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 -

.gitattributes

@@ -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

packages/fcl-base/examples/crittest.pp

@@ -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.

packages/fcl-base/src/syncobjs.pp

@@ -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;
 

rtl/freebsd/pthread.inc

@@ -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;

rtl/haiku/pthread.inc

@@ -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;

rtl/inc/thread.inc

@@ -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;

rtl/inc/threadh.inc

@@ -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);

rtl/unix/cthreads.pp

@@ -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;

rtl/win/systhrd.inc

@@ -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;