diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ba479323f1..12cd031246 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,31 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-02-25 08:40 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/src/vm/hvm.c + + added internal PRG function __QUITCANCEL() + + * harbour/contrib/hbxpp/Makefile + + harbour/contrib/hbxpp/sleepx.prg + + added xbase++ compatible prg function SLEEP( ) -> NIL + + * harbour/contrib/hbxpp/tthreadx.prg + ! renamed TTHREAD class to THREAD and TSIGNAL to SIGNAL - I had to + wrongly understood xbase++ documentation sent to the least. + ! made THREAD:threadSelf() method exported + + added full support for THREAD:QUIT( [] [,] ) + ! initialize THREAD:startCount and ThreadObject() value before executing + THREAD:atStart[()] method and codeblock + % simplified emulation of xbase++ like behavior of THREAD:atStart[()] + and THREAD:atEnd[()], in such context it's not necessary to use + __ClsMsgType() + % simplified THREAD:execute() method calling + + added proper THREAD:deltaTime setting + ! do not use THREAD:startTime to store thread start time + ! fixed thread restarting when THREAD:interval is set to use + calculated THREAD:deltaTime instead of fixed delay defined + by THREAD:interval + 2010-02-24 17:40 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com) * contrib/hbqt/qtgui/QWidget.cpp * contrib/hbqt/qtgui/TQWidget.prg diff --git a/harbour/contrib/hbxpp/Makefile b/harbour/contrib/hbxpp/Makefile index 2f90943452..bb9f65dde0 100644 --- a/harbour/contrib/hbxpp/Makefile +++ b/harbour/contrib/hbxpp/Makefile @@ -28,6 +28,7 @@ PRG_SOURCES := \ dbtotalx.prg \ dbupdatx.prg \ runshell.prg \ + sleepx.prg \ tbcolumx.prg \ tbrowsex.prg \ tgetx.prg \ diff --git a/harbour/contrib/hbxpp/sleepx.prg b/harbour/contrib/hbxpp/sleepx.prg new file mode 100644 index 0000000000..33b6191d8f --- /dev/null +++ b/harbour/contrib/hbxpp/sleepx.prg @@ -0,0 +1,59 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * xBase++ SLEEP() function + * + * Copyright 2010 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 "common.ch" + +FUNCTION Sleep( nTime ) + + hb_idleSleep( IIF( ISNUMBER( nTime ), nTime / 100, 0 ) ) + + RETURN NIL diff --git a/harbour/contrib/hbxpp/tthreadx.prg b/harbour/contrib/hbxpp/tthreadx.prg index e74ad271e1..74b6a8e504 100644 --- a/harbour/contrib/hbxpp/tthreadx.prg +++ b/harbour/contrib/hbxpp/tthreadx.prg @@ -65,7 +65,7 @@ /* * SIGNAL class */ -CREATE CLASS TSignal FUNCTION Signal +CREATE CLASS Signal VAR cargo AS USUAL EXPORTED VAR mutex AS USUAL PROTECTED @@ -78,15 +78,15 @@ EXPORTED: ENDCLASS -METHOD new( ... ) CLASS TSIGNAL +METHOD new( ... ) CLASS SIGNAL ::mutex := hb_mutexCreate() ::Init( ... ) RETURN Self -METHOD wait( nTimeOut ) CLASS TSIGNAL +METHOD wait( nTimeOut ) CLASS SIGNAL RETURN __ClsSyncWait( ::mutex, nTimeOut ) -METHOD signal() CLASS TSIGNAL +METHOD signal() CLASS SIGNAL __ClsSyncSignal( ::mutex ) RETURN Self @@ -95,7 +95,7 @@ METHOD signal() CLASS TSIGNAL * THREAD class */ -CREATE CLASS TThread FUNCTION Thread +CREATE CLASS Thread EXPORTED: VAR active AS LOGICAL READONLY INIT .F. @@ -132,14 +132,11 @@ EXPORTED: METHOD start( xAction, ... ) METHOD synchronize( nTimeOut ) - METHOD thread INLINE ::TThread() - -HIDDEN: METHOD threadSelf() ENDCLASS -METHOD new( ... ) CLASS TTHREAD +METHOD new( ... ) CLASS THREAD LOCAL nMaxStackSize IF PCount() == 1 @@ -151,43 +148,37 @@ METHOD new( ... ) CLASS TTHREAD ::Init( ... ) RETURN Self -METHOD execute() CLASS TTHREAD +METHOD execute() CLASS THREAD HB_SYMBOL_UNUSED( Self ) RETURN NIL -METHOD quit( xResult, nRestart ) CLASS TTHREAD +METHOD quit( xResult, nRestart ) CLASS THREAD IF hb_threadSelf() == ::pThreadID - IF ISNUMBER( nRestart ) - IF nRestart == QUIT_NORESTART - ::interval := NIL - ELSEIF nRestart == QUIT_RESTART - IF ISNUMBER( ::interval ) - /* TODO: do not interrupt by QUIT but restart execution */ - ENDIF - ENDIF - ENDIF IF PCOUNT() > 0 ::result := xResult ENDIF + IF !ISNUMBER( nRestart ) .OR. nRestart != QUIT_RESTART + ::interval := NIL + ENDIF QUIT ENDIF RETURN NIL -METHOD setInterval( nHSeconds ) CLASS TTHREAD +METHOD setInterval( nHSeconds ) CLASS THREAD IF nHSeconds == NIL .OR. ISNUMBER( nHSeconds ) ::interval := nHSeconds ENDIF RETURN .F. -METHOD setPriority( nPriority ) CLASS TTHREAD +METHOD setPriority( nPriority ) CLASS THREAD /* TODO: add thread priority setting */ IF ISNUMBER( nPriority ) ::priority := nPriority ENDIF RETURN .F. -METHOD setStartTime( nSeconds ) CLASS TTHREAD - /* TODO: add such functionality, probably by special thread */ +METHOD setStartTime( nSeconds ) CLASS THREAD + /* TODO: add such functionality */ IF ISNUMBER( nSeconds ) ::startTime := nSeconds ELSEIF nSeconds == NIL @@ -195,56 +186,58 @@ METHOD setStartTime( nSeconds ) CLASS TTHREAD ENDIF RETURN .F. -METHOD start( xAction, ... ) CLASS TTHREAD +METHOD start( xAction, ... ) CLASS THREAD /* TODO: thread stack size set by user ::maxStackSize */ IF ::active RETURN .F. - ELSEIF ! Empty( xAction ) .OR. __ClsMsgType( Self:ClassH(), "EXECUTE" ) == HB_OO_MSG_METHOD + ELSE ::pThreadID := hb_threadStart( HB_THREAD_INHERIT_PUBLIC, ; { |...| + LOCAL nTime + + ThreadObject( Self ) ::active := .T. + ::startCount++ - IF __ClsMsgType( Self:ClassH(), "ATSTART" ) == HB_OO_MSG_METHOD - ::atStart( ... ) - ENDIF - - IF __ClsMsgType( Self:ClassH(), "_ATSTART" ) == HB_OO_MSG_DATA .AND.; - ValType( ::_atStart ) == "B" - + ::atStart( ... ) + IF ValType( ::_atStart ) == "B" EVAL( ::_atStart, ... ) ENDIF - WHILE ::active + WHILE .T. - ::startTime := Seconds() - ::startCount++ - ThreadObject( Self ) + nTime := hb_milliSeconds() - IF ! Empty( xAction ) .AND. ValType( xAction ) $ "CBS" - ::result := DO( xAction, ... ) - ELSE - ::result := ::execute( ... ) - ENDIF + BEGIN SEQUENCE + IF ! Empty( xAction ) .AND. ValType( xAction ) $ "CBS" + ::result := DO( xAction, ... ) + ELSE + ::result := ::execute( ... ) + ENDIF + ALWAYS + __QUITCANCEL() + ENDSEQUENCE - IF ISNUMBER( ::interval ) - hb_idleSleep( ::interval / 100 ) - LOOP - ENDIF - ::startTime := NIL + nTime := Int( ( hb_milliSeconds() - nTime ) / 10 ) + ::deltaTime := nTime - IF __ClsMsgType( Self:ClassH(), "ATEND" ) == HB_OO_MSG_METHOD + IF !ISNUMBER( ::interval ) + ::startTime := NIL ::atEnd( ... ) + IF ValType( ::_atEnd ) == "B" + EVAL( ::_atEnd, ... ) + ENDIF + ::active := .F. + EXIT ENDIF - IF __ClsMsgType( Self:ClassH(), "_ATEND" ) == HB_OO_MSG_DATA .AND.; - ValType( ::_atEnd ) == "B" - - EVAL( ::_atEnd, ... ) + nTime := ::interval - ::deltaTime + IF nTime > 0 + hb_idleSleep( nTime / 100 ) ENDIF - - ::active := .F. + ::startCount++ ENDDO @@ -253,14 +246,11 @@ METHOD start( xAction, ... ) CLASS TTHREAD ::threadID := IIF( ::pThreadID == NIL, 0, hb_threadID( ::pThreadID ) ) - ELSE - RETURN .F. - ENDIF RETURN .T. -METHOD synchronize( nTimeOut ) CLASS TTHREAD +METHOD synchronize( nTimeOut ) CLASS THREAD LOCAL pThreadID := ::pThreadID IF hb_threadSelf() != pThreadID @@ -270,11 +260,11 @@ METHOD synchronize( nTimeOut ) CLASS TTHREAD ENDIF RETURN .F. -METHOD threadSelf() CLASS TTHREAD +METHOD threadSelf() CLASS THREAD RETURN ::pThreadID /* -METHOD threadID() CLASS TTHREAD +METHOD threadID() CLASS THREAD LOCAL pThreadID := ::pThreadID RETURN IIF( pThreadID == NIL, 0, hb_threadID( pThreadID ) ) */ diff --git a/harbour/src/vm/hvm.c b/harbour/src/vm/hvm.c index 3de736c7ea..5876b56229 100644 --- a/harbour/src/vm/hvm.c +++ b/harbour/src/vm/hvm.c @@ -11486,22 +11486,6 @@ HB_FUNC( __SETPROFILER ) #endif } -/* $Doc$ - * $FuncName$ __TRACEPRGCALLS( ) --> - * $Description$ Turns on | off tracing of PRG-level function and method calls - * $End$ */ -HB_FUNC( __TRACEPRGCALLS ) -{ - HB_STACK_TLS_PRELOAD -#if defined( HB_PRG_TRACE ) - hb_retl( hb_bTracePrgCalls ); - if( HB_ISLOG( 1 ) ) - hb_bTracePrgCalls = hb_parl( 1 ); -#else - hb_retl( HB_FALSE ); -#endif -} - HB_FUNC( __OPCOUNT ) /* it returns the total amount of opcodes */ { HB_STACK_TLS_PRELOAD @@ -11532,6 +11516,49 @@ HB_FUNC( __OPGETPRF ) /* profiler: It returns an array with an opcode called and } } +/* $Doc$ + * $FuncName$ __TRACEPRGCALLS( ) --> + * $Description$ Turns on | off tracing of PRG-level function and method calls + * $End$ */ +HB_FUNC( __TRACEPRGCALLS ) +{ + HB_STACK_TLS_PRELOAD +#if defined( HB_PRG_TRACE ) + hb_retl( hb_bTracePrgCalls ); + if( HB_ISLOG( 1 ) ) + hb_bTracePrgCalls = hb_parl( 1 ); +#else + hb_retl( HB_FALSE ); +#endif +} + +HB_FUNC( __QUITCANCEL ) +{ + HB_STACK_TLS_PRELOAD + +#if defined( HB_MT_VM ) + if( !hb_stackQuitState() ) +#endif + { + long lRecoverBase = hb_stackGetRecoverBase(); + + if( lRecoverBase ) + { + PHB_ITEM pRecover = hb_stackItem( lRecoverBase + HB_RECOVER_STATE ); + +#if defined( _HB_RECOVER_DEBUG ) + if( pRecover->type != HB_IT_RECOVER ) + hb_errInternal( HB_EI_ERRUNRECOV, "hb_vmRequestBreak", NULL, NULL ); +#endif + if( pRecover->item.asRecover.flags & HB_SEQ_DOALWAYS ) + { + pRecover->item.asRecover.flags &= ~HB_QUIT_REQUESTED; + pRecover->item.asRecover.request &= ~HB_QUIT_REQUESTED; + } + } + } +} + HB_FUNC( ERRORLEVEL ) { HB_STACK_TLS_PRELOAD