From 6b88ee5facf821dbc877447a5ef18b47090313f7 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sat, 6 Jun 2009 12:21:43 +0000 Subject: [PATCH] 2009-06-06 14:31 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbvm.h * harbour/source/vm/hvm.c + added hb_vmProc() function - it's hb_vmDo() but without hack to send messages. TODO: remove from hb_vmDo() support for messages so it can replace new hb_vmProc() function or if we really need such mixed common execution function then replace in HVM calls to hb_vmDo() with hb_vmProc() * harbour/source/vm/classes.c * replaced hb_vmFunction() call by hb_vmDo() * harbour/source/vm/arrays.c * harbour/source/vm/thread.c ! cleaned hb_vmDo()/hb_vmSend() usage * harbour/source/vm/eval.c ! replaced hb_vmFunction() calls by hb_vmSend() + added .prg function hb_execMsg( , , [] ) which executes with set as QSELF() value. Mindaugas, you can use it in your HashObject to execute functions like pseudo messages. --- harbour/ChangeLog | 24 +++++++++++++++ harbour/include/hbvm.h | 1 + harbour/source/vm/arrays.c | 6 ++-- harbour/source/vm/classes.c | 10 +++---- harbour/source/vm/eval.c | 23 +++++++++++---- harbour/source/vm/hvm.c | 59 +++++++++++++++++++++++++++++++++++++ harbour/source/vm/thread.c | 7 ++++- 7 files changed, 116 insertions(+), 14 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 738a8e8b6e..e97320bbb1 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,30 @@ past entries belonging to author(s): Viktor Szakats. */ +2009-06-06 14:31 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbvm.h + * harbour/source/vm/hvm.c + + added hb_vmProc() function - it's hb_vmDo() but without hack to send + messages. + TODO: remove from hb_vmDo() support for messages so it can replace + new hb_vmProc() function or if we really need such mixed common + execution function then replace in HVM calls to hb_vmDo() with + hb_vmProc() + + * harbour/source/vm/classes.c + * replaced hb_vmFunction() call by hb_vmDo() + + * harbour/source/vm/arrays.c + * harbour/source/vm/thread.c + ! cleaned hb_vmDo()/hb_vmSend() usage + + * harbour/source/vm/eval.c + ! replaced hb_vmFunction() calls by hb_vmSend() + + added .prg function hb_execMsg( , , [] ) + which executes with set as QSELF() value. + Mindaugas, you can use it in your HashObject to execute functions + like pseudo messages. + 2009-06-06 11:38 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * utils/hbmk2/hbmk2.prg * Changed directory name for embedded mingwarm tools to diff --git a/harbour/include/hbvm.h b/harbour/include/hbvm.h index 1c3c36b8ca..81dc0201ff 100644 --- a/harbour/include/hbvm.h +++ b/harbour/include/hbvm.h @@ -133,6 +133,7 @@ extern HB_EXPORT void hb_vmRequestRestore( void ); /* Execution */ extern HB_EXPORT void hb_vmDo( USHORT uiParams ); /* invoke the virtual machine */ +extern HB_EXPORT void hb_vmProc( USHORT uiParams ); /* executes a function or procedure */ extern HB_EXPORT void hb_vmFunction( USHORT uiParams ); /* executes a function */ extern HB_EXPORT void hb_vmSend( USHORT uiParams ); /* sends a message to an object */ extern HB_EXPORT PHB_ITEM hb_vmEvalBlock( PHB_ITEM pBlockItem ); /* executes passed codeblock with no arguments */ diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index ef7f4fcec5..3b1e9c9730 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -977,7 +977,7 @@ ULONG hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG * hb_vmPush( pValue ); hb_vmPush( pBaseArray->pItems + ulStart ); hb_vmPushLong( ++ulStart ); - hb_vmDo( 2 ); + hb_vmSend( 2 ); if( HB_IS_LOGICAL( hb_stackReturnItem() ) && hb_stackReturnItem()->item.asLogical.value ) return ulStart; @@ -1144,7 +1144,7 @@ ULONG hb_arrayRevScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG * pulStart, ULONG else hb_vmPushNil(); hb_vmPushLong( ulStart + 1 ); - hb_vmDo( 2 ); + hb_vmSend( 2 ); if( HB_IS_LOGICAL( hb_stackReturnItem() ) && hb_stackReturnItem()->item.asLogical.value ) return ulStart + 1; @@ -1302,7 +1302,7 @@ BOOL hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG * pulStart, ULONG * p hb_vmPush( bBlock ); hb_vmPush( pBaseArray->pItems + ulStart ); hb_vmPushLong( ulStart + 1 ); - hb_vmDo( 2 ); + hb_vmSend( 2 ); } while( --ulCount > 0 && ++ulStart < pBaseArray->ulLen ); /* diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 4d0333f511..7e1ff94844 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -1086,13 +1086,13 @@ void hb_clsDoInit( void ) PHB_DYNS pFuncSym = hb_dynsymFindName( s_pszFuncNames[i] ); if( pFuncSym && hb_dynsymIsFunction( pFuncSym ) ) { - PHB_ITEM pObject; + PHB_ITEM pReturn = hb_stackReturnItem(); + hb_itemSetNil( pReturn ); hb_vmPushDynSym( pFuncSym ); hb_vmPushNil(); hb_vmDo( 0 ); - pObject = hb_stackReturnItem(); - if( HB_IS_OBJECT( pObject ) ) - *( s_puiHandles[i] ) = pObject->item.asArray.value->uiClass; + if( HB_IS_OBJECT( pReturn ) ) + *( s_puiHandles[i] ) = pReturn->item.asArray.value->uiClass; } } } @@ -3788,7 +3788,7 @@ HB_FUNC( __CLSINSTSUPER ) { hb_vmPushSymbol( pClassFuncSym ); hb_vmPushNil(); - hb_vmFunction( 0 ); /* Execute super class */ + hb_vmDo( 0 ); /* Execute super class */ if( hb_vmRequestQuery() == 0 ) { diff --git a/harbour/source/vm/eval.c b/harbour/source/vm/eval.c index e2bf34128c..99033cda06 100644 --- a/harbour/source/vm/eval.c +++ b/harbour/source/vm/eval.c @@ -315,7 +315,7 @@ void hb_evalBlock0( PHB_ITEM pCodeBlock ) { hb_vmPushSymbol( &hb_symEval ); hb_vmPush( pCodeBlock ); - hb_vmFunction( 0 ); + hb_vmSend( 0 ); } /* undocumented Clipper _cEval1() */ @@ -324,7 +324,7 @@ void hb_evalBlock1( PHB_ITEM pCodeBlock, PHB_ITEM pParam ) hb_vmPushSymbol( &hb_symEval ); hb_vmPush( pCodeBlock ); hb_vmPush( pParam ); - hb_vmFunction( 1 ); + hb_vmSend( 1 ); } /* same functionality but with a NULL terminated list of parameters */ @@ -345,7 +345,7 @@ void hb_evalBlock( PHB_ITEM pCodeBlock, ... ) } va_end( args ); - hb_vmFunction( uiParams ); + hb_vmSend( uiParams ); } HB_FUNC( HB_FORNEXT ) /* nStart, nEnd | bEnd, bCode, nStep */ @@ -367,7 +367,7 @@ HB_FUNC( HB_FORNEXT ) /* nStart, nEnd | bEnd, bCode, nStep */ hb_vmPushSymbol( &hb_symEval ); hb_vmPush( pCodeBlock ); hb_vmPushLong( lStart ); - hb_vmFunction( 1 ); + hb_vmSend( 1 ); lStart += lStep; @@ -383,7 +383,7 @@ HB_FUNC( HB_FORNEXT ) /* nStart, nEnd | bEnd, bCode, nStep */ hb_vmPushSymbol( &hb_symEval ); hb_vmPush( pCodeBlock ); hb_vmPushLong( lStart ); - hb_vmFunction( 1 ); + hb_vmSend( 1 ); lStart += lStep; } @@ -568,3 +568,16 @@ BOOL hb_execFromArray( PHB_ITEM pParam ) return FALSE; } + +/* hb_execMsg( , , [] ) -> + * Execute with set as QSELF() value + */ +HB_FUNC( HB_EXECMSG ) +{ + int iParams = hb_pcount(); + + if( iParams >= 2 && ISSYMBOL( 1 ) ) + hb_vmProc( ( USHORT ) ( iParams - 2 ) ); + else + hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); +} diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 6e63e84071..453d908b0b 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -5438,6 +5438,7 @@ static void hb_vmMacroFunc( USHORT uiArgSets ) lArgs = hb_vmArgsJoin( -1, uiArgSets ); hb_stackDecrease( uiArgSets ); + hb_itemSetNil( hb_stackReturnItem() ); hb_vmDo( ( USHORT ) lArgs ); hb_stackPushReturn(); } @@ -5451,6 +5452,7 @@ static void hb_vmMacroSend( USHORT uiArgSets ) lArgs = hb_vmArgsJoin( -1, uiArgSets ); hb_stackDecrease( uiArgSets ); + hb_itemSetNil( hb_stackReturnItem() ); hb_vmSend( ( USHORT ) lArgs ); hb_stackPushReturn(); } @@ -5620,6 +5622,63 @@ static void hb_vmSwapAlias( void ) /* Execution */ /* ------------------------------- */ +void hb_vmProc( USHORT uiParams ) +{ + HB_STACK_TLS_PRELOAD + HB_STACK_STATE sStackState; + PHB_SYMB pSym; +#ifndef HB_NO_PROFILER + ULONG ulClock = 0; + BOOL bProfiler = hb_bProfiler; /* because profiler state may change */ +#endif + + HB_TRACE(HB_TR_DEBUG, ("hb_vmProc(%hu)", uiParams)); + +#ifndef HB_NO_PROFILER + if( bProfiler ) + ulClock = ( ULONG ) clock(); +#endif + + /* Poll the console keyboard + #if !defined( HB_GUI ) + hb_inkeyPoll(); + #endif + */ + + pSym = hb_stackNewFrame( &sStackState, uiParams )->item.asSymbol.value; + HB_VM_FUNCUNREF( pSym ); + if( HB_VM_ISFUNC( pSym ) ) + { + HB_TRACE_PRG(("Calling: %s", pSym->szName)); + +#ifndef HB_NO_PROFILER + if( bProfiler && pSym->pDynSym ) + pSym->pDynSym->ulRecurse++; +#endif + + HB_VM_EXECUTE( pSym ); + +#ifndef HB_NO_PROFILER + if( bProfiler && pSym->pDynSym ) + { + pSym->pDynSym->ulCalls++; /* profiler support */ + /* Time spent has to be added only inside topmost call of a recursive function */ + if( --pSym->pDynSym->ulRecurse == 0 ) + pSym->pDynSym->ulTime += clock() - ulClock; /* profiler support */ + } +#endif + } + else + hb_errRT_BASE_SubstR( EG_NOFUNC, 1001, NULL, pSym->szName, HB_ERR_ARGS_BASEPARAMS ); + +#ifndef HB_NO_DEBUG + if( sStackState.fDebugging ) + hb_vmDebuggerEndProc(); +#endif + + hb_stackOldFrame( &sStackState ); +} + void hb_vmDo( USHORT uiParams ) { HB_STACK_TLS_PRELOAD diff --git a/harbour/source/vm/thread.c b/harbour/source/vm/thread.c index ffb6c3e92a..84d844949d 100644 --- a/harbour/source/vm/thread.c +++ b/harbour/source/vm/thread.c @@ -780,6 +780,7 @@ static HB_THREAD_STARTFUNC( hb_threadStartVM ) PHB_ITEM pThItm = ( PHB_ITEM ) Cargo; ULONG ulPCount, ulParam; PHB_THREADSTATE pThread; + BOOL fSend = FALSE; pThread = ( PHB_THREADSTATE ) hb_itemGetPtrGC( pThItm, hb_threadDestructor ); @@ -794,6 +795,7 @@ static HB_THREAD_STARTFUNC( hb_threadStartVM ) { hb_vmPushSymbol( &hb_symEval ); hb_vmPush( pStart ); + fSend = TRUE; } else if( HB_IS_SYMBOL( pStart ) ) { @@ -817,7 +819,10 @@ static HB_THREAD_STARTFUNC( hb_threadStartVM ) hb_itemRelease( pThread->pParams ); pThread->pParams = NULL; - hb_vmDo( ( USHORT ) ( ulPCount - 1 ) ); + if( fSend ) + hb_vmSend( ( USHORT ) ( ulPCount - 1 ) ); + else + hb_vmDo( ( USHORT ) ( ulPCount - 1 ) ); } else {