From 88d4f41e4f85c180fdae23aa6c622a8269ee1a71 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Fri, 26 Sep 2008 19:28:54 +0000 Subject: [PATCH] 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 | 15 ++++++ harbour/common.mak | 1 + harbour/source/rdd/wacore.c | 6 ++- harbour/source/rtl/Makefile | 1 + harbour/source/rtl/tthreadx.prg | 81 +++++++++++++++++++++++++++++++++ harbour/source/vm/thread.c | 6 ++- harbour/tests/mt/mttest09.prg | 68 +++++++++++++++++++++++++++ 7 files changed, 176 insertions(+), 2 deletions(-) create mode 100644 harbour/source/rtl/tthreadx.prg create mode 100644 harbour/tests/mt/mttest09.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 539c2d0834..77d4521081 100644 --- a/harbour/ChangeLog +++ b/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 diff --git a/harbour/common.mak b/harbour/common.mak index 4d6904b28c..f9e79eeaed 100644 --- a/harbour/common.mak +++ b/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) \ diff --git a/harbour/source/rdd/wacore.c b/harbour/source/rdd/wacore.c index 9075a39631..e8df689293 100644 --- a/harbour/source/rdd/wacore.c +++ b/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; } diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 538de87747..f43df0526f 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -216,6 +216,7 @@ PRG_SOURCES=\ treport.prg \ tscalar.prg \ ttextlin.prg \ + tthreadx.prg \ ttopbar.prg \ typefile.prg \ typefilx.prg \ diff --git a/harbour/source/rtl/tthreadx.prg b/harbour/source/rtl/tthreadx.prg new file mode 100644 index 0000000000..e9b7a82121 --- /dev/null +++ b/harbour/source/rtl/tthreadx.prg @@ -0,0 +1,81 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * XPP compatible classes to manage threads + * + * Copyright 2008 Przemyslaw Czerpak + * 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 diff --git a/harbour/source/vm/thread.c b/harbour/source/vm/thread.c index 5c3ae5e97f..0347684032 100644 --- a/harbour/source/vm/thread.c +++ b/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 ); } diff --git a/harbour/tests/mt/mttest09.prg b/harbour/tests/mt/mttest09.prg new file mode 100644 index 0000000000..60dcd2de1d --- /dev/null +++ b/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 + * 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