fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2010-02-25 08:40 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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( <nHSeconds> ) -> 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( [<xResult>] [,<nRestart>] )
    ! 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
This commit is contained in:
Przemyslaw Czerpak
2010-02-25 07:40:37 +00:00
parent 9a97d433ad
commit 835a921991
5 changed files with 178 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
harbour/ChangeLog
View File

@@ -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( <nHSeconds> ) -> 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( [<xResult>] [,<nRestart>] )
! 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

1
harbour/contrib/hbxpp/Makefile
View File

@@ -28,6 +28,7 @@ PRG_SOURCES := \
dbtotalx.prg \
dbupdatx.prg \
runshell.prg \
sleepx.prg \
tbcolumx.prg \
tbrowsex.prg \
tgetx.prg \

59
harbour/contrib/hbxpp/sleepx.prg Normal file
View File

@@ -0,0 +1,59 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* xBase++ SLEEP() function
*
* Copyright 2010 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 "common.ch"
FUNCTION Sleep( nTime )
hb_idleSleep( IIF( ISNUMBER( nTime ), nTime / 100, 0 ) )
RETURN NIL

110
harbour/contrib/hbxpp/tthreadx.prg
View File

@@ -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 ) )
*/

59
harbour/src/vm/hvm.c
View File

@@ -11486,22 +11486,6 @@ HB_FUNC( __SETPROFILER )
#endif
}
/* $Doc$
* $FuncName$ __TRACEPRGCALLS( <lOnOff> ) --> <lOldValue>
* $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( <lOnOff> ) --> <lOldValue>
* $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