2008-09-26 21:28 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

* harbour/source/vm/thread.c
    * release thread return value when is retrieve

  * harbour/common.mak
  * harbour/source/rtl/Makefile
  + harbour/source/rtl/tthreadx.prg
    + added xBase++ compatible signal class

  * harbour/source/rdd/wacore.c
    ! added missing alias setting after attaching work area

  + harbour/tests/mt/mttest09.prg
    + added test code for using the same work area in different threads

harbour/ChangeLog

@@ -8,6 +8,21 @@
    2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
 */
 
+2008-09-26 21:28 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+  * harbour/source/vm/thread.c
+    * release thread return value when is retrieve
+
+  * harbour/common.mak
+  * harbour/source/rtl/Makefile
+  + harbour/source/rtl/tthreadx.prg
+    + added xBase++ compatible signal class
+
+  * harbour/source/rdd/wacore.c
+    ! added missing alias setting after attaching work area
+
+  + harbour/tests/mt/mttest09.prg
+    + added test code for using the same work area in different threads
+
 2008-09-26 19:34 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
   * harbour/include/hbstack.h
   * harbour/source/vm/estack.c

harbour/common.mak

@@ -655,6 +655,7 @@ RTL_LIB_OBJS = \
     $(OBJ_DIR)\treport$(OBJEXT)  \
     $(OBJ_DIR)\tscalar$(OBJEXT)  \
     $(OBJ_DIR)\ttextlin$(OBJEXT) \
+    $(OBJ_DIR)\tthreadx$(OBJEXT) \
     $(OBJ_DIR)\ttopbar$(OBJEXT)  \
     $(OBJ_DIR)\typefile$(OBJEXT) \
     $(OBJ_DIR)\typefilx$(OBJEXT) \

harbour/source/rdd/wacore.c

@@ -547,7 +547,7 @@ HB_EXPORT ERRCODE hb_rddDetachArea( AREAP pArea, PHB_ITEM pCargo )
       hb_arraySet( pDetachedArea, 2, pCargo );
    pHolder = ( AREAP * ) hb_gcAlloc( sizeof( AREAP ), hb_waHolderDestructor );
    *pHolder = pArea;
-   hb_itemPutPtrGC( hb_arrayGetItemPtr( pDetachedArea, 1 ), pHolder );
+   hb_arraySetPtrGC( pDetachedArea, 1, pHolder );
    /* siagnal waiting processes that new area is available */
    hb_threadCondBroadcast( &s_waCond );
    /* leave critical section */
@@ -640,7 +640,11 @@ HB_EXPORT AREAP hb_rddRequestArea( char * szAlias, PHB_ITEM pCargo,
 
    /* atach WA and set alias */
    if( pArea )
+   {
       hb_waNodeInsert( hb_stackRDD(), pArea );
+      if( pArea->atomAlias )
+         hb_dynsymSetAreaHandle( ( PHB_DYNS ) pArea->atomAlias, pArea->uiArea );
+   }
 
    return pArea;
 }

harbour/source/rtl/Makefile

@@ -216,6 +216,7 @@ PRG_SOURCES=\
 	treport.prg  \
 	tscalar.prg  \
 	ttextlin.prg \
+	tthreadx.prg \
 	ttopbar.prg  \
 	typefile.prg \
 	typefilx.prg \

harbour/source/rtl/tthreadx.prg

@@ -0,0 +1,81 @@
+/*
+ * $Id$
+ */
+
+/*
+ * Harbour Project source code:
+ * XPP compatible classes to manage threads
+ *
+ * Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
+ * www - http://www.harbour-project.org
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
+ *
+ * As a special exception, the Harbour Project gives permission for
+ * additional uses of the text contained in its release of Harbour.
+ *
+ * The exception is that, if you link the Harbour libraries with other
+ * files to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the Harbour library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the Harbour
+ * Project under the name Harbour.  If you copy code from other
+ * Harbour Project or Free Software Foundation releases into a copy of
+ * Harbour, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for Harbour, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ *
+ */
+
+#include "hbclass.ch"
+
+#ifdef HB_COMPAT_XPP
+
+CREATE CLASS TSignal FUNCTION Signal
+   VAR cargo      AS USUAL EXPORTED
+   VAR mutex      AS USUAL PROTECTED
+EXPORTED:
+   METHOD new()
+   METHOD wait( nTimeOut )
+   METHOD signal()
+ENDCLASS
+
+METHOD new() CLASS TSIGNAL
+   ::mutex := hb_mutexCreate()
+RETURN Self
+
+METHOD wait( nTimeOut ) CLASS TSIGNAL
+/* TOCHECK: I do not know if strict xbase++ compatibility needs
+ *          hb_mutexSubscribe() or hb_mutexSubscribeNow()
+ *          Please change it if necessary
+ */
+RETURN hb_mutexSubscribe( ::mutex, nTimeOut )
+
+METHOD signal() CLASS TSIGNAL
+   hb_mutexNotify( ::mutex )
+RETURN Self
+
+#endif

harbour/source/vm/thread.c

@@ -669,7 +669,11 @@ HB_FUNC( HB_THREADJOIN )
       if( fResult )
       {
          if( pThread->pResult )
-            hb_itemParamStore( 2, pThread->pResult );
+         {
+            hb_itemParamStoreForward( 2, pThread->pResult );
+            hb_itemRelease( pThread->pResult );
+            pThread->pResult = NULL;
+         }
       }
       hb_retl( fResult );
    }

harbour/tests/mt/mttest09.prg

@@ -0,0 +1,68 @@
+/*
+ * $Id$
+ */
+
+/*
+ * Harbour Project source code:
+ *    demonstration/test code for using common for using the same
+ *    work area in different threads. Please note that this program
+ *    also works when compiled without thread support.
+ *
+ * Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
+ * www - http://www.harbour-project.org
+ *
+ */
+
+STATIC s_mainThreadID
+
+proc main()
+   field F1
+   local thID, bResult
+
+   s_mainThreadID := hb_threadSelf()
+   /* create table */
+   dbCreate("_tst",{{"F1","C",1,0}})
+   use _tst
+   while lastRec() < 10000
+      dbAppend()
+      F1 := chr( recno() )
+   enddo
+
+   thID := hb_threadStart( @thFunc() )
+   ? "thread ID:", thID
+   ? "current work area detached, used() =>", used(), alias()
+   WAIT "Press a key to detach work area"
+   hb_dbDetach( , {|| countRecords( {|| F1 == "A" } ) } )
+   ? "work area detached, used() =>", used(), alias()
+   ? "we will make some other things now..."
+   hb_idleSleep( 1 )
+   ? "let's check the result"
+   ? "request for work area"
+   hb_dbRequest( , , @bResult, .T. )
+   ? "work area atached, used() =>", used(), alias()
+   ? "query result:", eval( bResult )
+   close
+   dbDrop("_tst")
+   return
+
+proc thFunc()
+   local bQuery, xResult
+
+   if hb_dbRequest( , , @bQuery, .T. )
+      xResult := Eval( bQuery )
+      dbRelease( , {|| xResult } )
+   endif
+   return
+
+static func countRecords( bFor )
+   local nCount := 0
+   dbGoTop()
+   while ! eof()
+      if eval( bFor )
+         nCount ++
+      endif
+      dbSkip()
+   enddo
+   ? "!!! JOB DONE !!!" + iif( hb_threadSelf() == s_mainThreadID, ;
+                               " (by main thread)", " (by child thread)" )
+   return nCount