From 6e54f3860ebf1155eb118a7bdd4d6dc452cd8126 Mon Sep 17 00:00:00 2001
From: Przemyslaw Czerpak <druzus@priv.onet.pl>
Date: Thu, 14 Apr 2011 13:38:58 +0000
Subject: [PATCH] 2011-04-14 15:38 UTC+0200 Przemyslaw Czerpak
 (druzus/at/priv.onet.pl)   * harbour/src/vm/thread.c     + added new
 function:          hb_criticalCode( <pMtx>, <bCode> | <@sFunc()> ) ->
 <xCodeResult>       it executes <bCode> or @sFunc() when <pMtx> is locked by
 this function.     ! fixed hb_mutexQueueInfo() to not overwrite RTE subst
 value.       This function may only return .T. or generate RTE so the logical
       return value is useless. I think that it should be removed and this    
   function should simply return NIL.     * updated syntax of PRG functions

---
 harbour/ChangeLog       | 11 +++++++++++
 harbour/src/vm/thread.c | 36 ++++++++++++++++++++++++++++++------
 2 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/harbour/ChangeLog b/harbour/ChangeLog
index 34cb4e146f..f359ce4532 100644
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -16,6 +16,17 @@
    The license applies to all entries newer than 2009-04-28.
 */
 
+2011-04-14 15:38 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+  * harbour/src/vm/thread.c
+    + added new function:
+         hb_criticalCode( <pMtx>, <bCode> | <@sFunc()> ) -> <xCodeResult>
+      it executes <bCode> or @sFunc() when <pMtx> is locked by this function.
+    ! fixed hb_mutexQueueInfo() to not overwrite RTE subst value.
+      This function may only return .T. or generate RTE so the logical
+      return value is useless. I think that it should be removed and this
+      function should simply return NIL.
+    * updated syntax of PRG functions
+
 2011-04-13 18:20 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com)
   * contrib/hbqt/qtcore/qth/HBQEvents.qth
   * contrib/hbqt/qtcore/qth/HBQSlots.qth
diff --git a/harbour/src/vm/thread.c b/harbour/src/vm/thread.c
index 7ef7c6930d..cddccbdeba 100644
--- a/harbour/src/vm/thread.c
+++ b/harbour/src/vm/thread.c
@@ -62,7 +62,7 @@
   hb_threadTerminateAll() -> NIL
   hb_threadWaitForAll() -> NIL
   hb_threadWait( <pThID> | <apThID>, [ <nTimeOut> ] [, <lAll> ] ) => <nThInd> | <nThCount> | 0
-  hb_threadOnce( @<onceControl> [, <bAction> ] ) -> <lFirstCall>
+  hb_threadOnce( @<onceControl> [, <bAction> | <@sAction()> ] ) -> <lFirstCall>
   hb_threadOnceInit( @<item> <value> ) -> <lInitialized>
   hb_mutexCreate() -> <pMtx>
   hb_mutexLock( <pMtx> [, <nTimeOut> ] ) -> <lLocked>
@@ -71,10 +71,16 @@
   hb_mutexNotifyAll( <pMtx> [, <xVal>] ) -> NIL
   hb_mutexSubscribe( <pMtx>, [ <nTimeOut> ] [, @<xSubscribed> ] ) -> <lSubscribed>
   hb_mutexSubscribeNow( <pMtx>, [ <nTimeOut> ] [, @<xSubscribed> ] ) -> <lSubscribed>
+** hb_mutexQueueInfo( <pMtx>, [ @<nWaitersCount> ], [ @<nQueueLength> ] ) -> .T.
+  hb_criticalCode( <pMtx>, <bCode> | <@sFunc()> ) -> <xCodeResult>
+  hb_mtVM() -> <lMultiThreadVM>
 
   * - this function call can be ignored by the destination thread in some
       cases. HVM does not guaranties that the QUIT signal will be always
       delivered.
+  ** - this is only information function and nWaitersCount or nQueueLength
+       can be changed simultaneously by other threads so they cannot be
+       used for MT synchronization
 */
 
 /* NOTE: Need to have these before Harbour headers,
@@ -2586,7 +2592,6 @@ HB_FUNC( HB_MUTEXSUBSCRIBENOW )
 
 HB_FUNC( HB_MUTEXQUEUEINFO )
 {
-   HB_STACK_TLS_PRELOAD
    PHB_ITEM pItem = hb_mutexParam( 1 );
 
    if( pItem )
@@ -2595,16 +2600,35 @@ HB_FUNC( HB_MUTEXQUEUEINFO )
 
       if( pMutex )
       {
+         HB_STACK_TLS_PRELOAD
          hb_storni( pMutex->waiters, 2 );
          hb_storns( pMutex->events ? hb_arrayLen( pMutex->events ) : 0, 3 );
          hb_retl( HB_TRUE );
-         return;
       }
    }
+}
 
-   hb_storni( 0, 2 );
-   hb_storns( 0, 3 );
-   hb_retl( HB_FALSE );
+HB_FUNC( HB_CRITICALCODE )
+{
+   PHB_ITEM pItem = hb_mutexParam( 1 );
+
+   if( pItem )
+   {
+      PHB_ITEM pEval = hb_param( 2, HB_IT_EVALITEM );
+
+      if( pEval )
+      {
+         if( hb_threadMutexLock( pItem ) )
+         {
+            hb_vmPushEvalSym();
+            hb_vmPush( pEval );
+            hb_vmSend( 0 );
+            hb_threadMutexUnlock( pItem );
+         }
+      }
+      else
+         hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
+   }
 }
 
 HB_FUNC( HB_MTVM )