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

Andi Jahja <harbour@cbn.net.id>

Browse Source
This commit is contained in:
Andi Jahja
2002-01-18 21:50:18 +00:00
parent fc22b231b1
commit 77092c956a
4 changed files with 177 additions and 143 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
harbour/ChangeLog
View File

@@ -7,6 +7,16 @@
For example:
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* contrib/libct/Makefile
* contrib/libct/makefile.bc
* contrib/libct/makefile.vc
* contrib/libct/ctflist.txt
* changes according to the above
2002-01-19 17:55 UTC-0300 Horacio Roldan <harbour_ar@yahoo.com.ar>
* source/rdd/dbfcdx1.c
! speed boost for ordKeyNo() and ordKeyCount()
2002-01-19 13:39 UTC-0300 Horacio Roldan <harbour_ar@yahoo.com.ar>
* source/rdd/dbfcdx1.c
! fixed a bug in descending skipping

5
harbour/include/hbexpra.c
View File

@@ -328,6 +328,11 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms )
HB_EXPR_PCODE1( hb_compExprDelete, pName );
}
}
else if( ( strcmp( "EVAL", pName->value.asSymbol ) == 0 ) && iCount )
{
/* Optimize Eval( bBlock, [ArgList] ) to: bBlock:Eval( [ArgList] ) */
return hb_compExprNewMethodCall( hb_compExprNewSend( pParms->value.asList.pExprList, "EVAL" ), hb_compExprNewArgList( pParms->value.asList.pExprList->pNext ) );
}
else if( HB_COMP_ISSUPPORTED( HB_COMPFLAG_XBASE ) &&
(( strcmp( "__DBLIST", pName->value.asSymbol ) == 0 ) && iCount >= 10) )
{

284
harbour/source/vm/hvm.c
View File

@@ -2919,7 +2919,14 @@ void hb_vmDo( USHORT uiParams )
PHB_BASEARRAY pSelfBase = NULL;
if( pSym == &( hb_symEval ) && HB_IS_BLOCK( pSelf ) )
pFunc = pSym->pFunPtr; /* __EVAL method = function */
if( strncmp( pSym->szName, "EVAL", 4 ) == 0 )
{
printf("%s\n",pSym->szName);
pSym = &hb_symEval;
pFunc = pSym->pFunPtr; /* __EVAL method = function */
}
else
pFunc = pSym->pFunPtr; /* __EVAL method = function */
else
{
pFunc = hb_objGetMethod( pSelf, pSym );
@@ -3062,10 +3069,10 @@ void hb_vmSend( USHORT uiParams )
PHB_SYMB pSym;
HB_STACK_STATE sStackState;
PHB_ITEM pSelf;
PHB_FUNC pFunc;
PHB_FUNC pFunc = NULL;
BOOL bDebugPrevState;
ULONG ulClock = 0;
void * pMethod = NULL;
void *pMethod;
BOOL bProfiler = hb_bProfiler; /* because profiler state may change */
HB_TRACE(HB_TR_DEBUG, ("hb_vmSend(%hu)", uiParams));
@@ -3080,7 +3087,9 @@ void hb_vmSend( USHORT uiParams )
}
if( bProfiler )
{
ulClock = ( ULONG ) clock();
}
pItem = hb_stackNewFrame( &sStackState, uiParams ); /* procedure name */
pSym = pItem->item.asSymbol.value;
@@ -3088,147 +3097,9 @@ void hb_vmSend( USHORT uiParams )
bDebugPrevState = s_bDebugging;
s_bDebugging = FALSE;
if( ! HB_IS_NIL( pSelf ) ) /* are we sending a message ? */
{
if( ! ( pSym == &( hb_symEval ) && HB_IS_BLOCK( pSelf ) ) )
{
if( HB_IS_OBJECT( pSelf ) ) /* Object passed */
{
PHB_BASEARRAY pSelfBase;
BOOL lPopSuper = FALSE;
//printf( "Symbol: '%s'\n", pSym->szName );
pFunc = hb_objGetMethod( pSelf, pSym );
pSelfBase = pSelf->item.asArray.value;
if( pSelfBase->uiPrevCls ) /* Is is a Super cast ? */
{
PHB_ITEM pRealSelf;
USHORT nPos;
USHORT uiClass;
/*
printf( "\n VmSend Method: %s \n", pSym->szName );
*/
uiClass = pSelfBase->uiClass;
pRealSelf = hb_itemNew( NULL ) ;
hb_itemCopy(pRealSelf ,pSelf->item.asArray.value->pItems) ; // hb_arrayGetItemPtr(pSelf,1) ;
/* and take back the good pSelfBase */
pSelfBase = pRealSelf->item.asArray.value;
/* Now I should exchnage it with the current stacked value */
hb_itemSwap( pSelf, pRealSelf );
hb_itemRelease(pRealSelf) ; /* and release the fake one */
/* Push current SuperClass handle */
lPopSuper = TRUE ;
if ( ! pSelf->item.asArray.value->puiClsTree)
{
pSelf->item.asArray.value->puiClsTree = ( USHORT * ) hb_xgrab( sizeof( USHORT ) );
pSelf->item.asArray.value->puiClsTree[0]=0;
}
nPos=pSelfBase->puiClsTree[0]+1;
pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * (nPos+1) ) ;
pSelfBase->puiClsTree[0] = nPos ;
pSelfBase->puiClsTree[ nPos ] = uiClass;
}
if( pFunc )
{
if( bProfiler )
pMethod = hb_mthRequested();
if ( hb_bTracePrgCalls )
HB_TRACE(HB_TR_ALWAYS, ("Calling: %s", pSym->szName));
pFunc();
if (lPopSuper && pSelfBase->puiClsTree)
{
USHORT nPos=pSelfBase->puiClsTree[0]-1;
/* POP SuperClass handle */
if (nPos)
{
pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * (nPos + 1) );
pSelfBase->puiClsTree[0]=nPos;
}
else
{
hb_xfree(pSelfBase->puiClsTree);
pSelfBase->puiClsTree = NULL ;
}
}
if( bProfiler )
hb_mthAddTime( pMethod, clock() - ulClock );
}
else if( pSym->szName[ 0 ] == '_' )
{
PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams );
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
else
{
PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, NULL, pSym->szName, 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
}
else
{
char *sClass, sDesc[64];
if( HB_IS_POINTER( pSelf ) )
sClass = "POINTER";
else if( HB_IS_DATE( pSelf ) )
sClass = "DATE";
else if( HB_IS_LOGICAL( pSelf ) )
sClass = "LOGICAL";
else if( HB_IS_SYMBOL( pSelf ) )
sClass = "SYMBOL";
else if( HB_IS_STRING( pSelf ) )
sClass = "CHARACTER";
else if( HB_IS_MEMO( pSelf ) )
sClass = "MEMO";
else if( HB_IS_BLOCK( pSelf ) )
sClass = "BLOCK";
else if( HB_IS_BYREF( pSelf ) )
sClass = "BYREF";
else if( HB_IS_MEMVAR( pSelf ) )
sClass = "MEMVAR";
else if( HB_IS_ARRAY( pSelf ) )
sClass = "ARRAY";
else if( HB_IS_NUMERIC( pSelf ) )
sClass = "NUMERIC";
else
sClass = "UNKNOWN";
if( strncmp( pSym->szName, "CLASSNAME", strlen( pSym->szName ) < 4 ? 4 : strlen( pSym->szName ) ) == 0 )
{
hb_itemPutC( &hb_stack.Return, sClass );
}
else if( pSym->szName[ 0 ] == '_' )
{
PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams );
sprintf( (char *) sDesc, "Class: %s has no property", sClass );
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, (char *) sDesc, pSym->szName + 1, 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
else
{
PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams );
sprintf( (char *) sDesc, "Class: %s has no exported method", sClass );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, (char *) sDesc, pSym->szName, 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
}
}
}
else /* it is a function */
if( HB_IS_NIL( pSelf ) ) /* are we sending a message ? */
{
pFunc = pSym->pFunPtr;
@@ -3280,11 +3151,138 @@ void hb_vmSend( USHORT uiParams )
}
}
}
else
{
PHB_BASEARRAY pSelfBase;
BOOL lPopSuper;
if( HB_IS_BLOCK( pSelf ) )
{
if( strncmp( pSym->szName, "EVAL", 4 ) == 0 )
{
pSym = &hb_symEval;
pFunc = pSym->pFunPtr; /* __EVAL method = function */
}
}
else if( HB_IS_OBJECT( pSelf ) ) /* Object passed */
{
lPopSuper = FALSE;
pFunc = hb_objGetMethod( pSelf, pSym );
pSelfBase = pSelf->item.asArray.value;
if( pSelfBase->uiPrevCls ) /* Is is a Super cast ? */
{
PHB_ITEM pRealSelf;
USHORT nPos;
USHORT uiClass;
/*
printf( "\n VmSend Method: %s \n", pSym->szName );
*/
uiClass = pSelfBase->uiClass;
pRealSelf = hb_itemNew( NULL ) ;
hb_itemCopy( pRealSelf, pSelf->item.asArray.value->pItems ) ; // hb_arrayGetItemPtr(pSelf,1) ;
/* and take back the good pSelfBase */
pSelfBase = pRealSelf->item.asArray.value;
/* Now I should exchnage it with the current stacked value */
hb_itemSwap( pSelf, pRealSelf );
hb_itemRelease( pRealSelf ) ; /* and release the fake one */
/* Push current SuperClass handle */
lPopSuper = TRUE ;
if ( ! pSelf->item.asArray.value->puiClsTree )
{
pSelf->item.asArray.value->puiClsTree = ( USHORT * ) hb_xgrab( sizeof( USHORT ) );
pSelf->item.asArray.value->puiClsTree[0]=0;
}
nPos=pSelfBase->puiClsTree[0]+1;
pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * (nPos+1) ) ;
pSelfBase->puiClsTree[0] = nPos ;
pSelfBase->puiClsTree[ nPos ] = uiClass;
}
}
if( pFunc )
{
if( bProfiler )
{
pMethod = hb_mthRequested();
}
if ( hb_bTracePrgCalls )
{
HB_TRACE(HB_TR_ALWAYS, ("Calling: %s", pSym->szName));
}
pFunc();
if ( pSym != &hb_symEval && lPopSuper && pSelfBase->puiClsTree )
{
USHORT nPos=pSelfBase->puiClsTree[0] - 1;
/* POP SuperClass handle */
if (nPos)
{
pSelfBase->puiClsTree = ( USHORT * ) hb_xrealloc( pSelfBase->puiClsTree, sizeof( USHORT ) * (nPos + 1) );
pSelfBase->puiClsTree[0]=nPos;
}
else
{
hb_xfree(pSelfBase->puiClsTree);
pSelfBase->puiClsTree = NULL ;
}
}
if( bProfiler )
{
hb_mthAddTime( pMethod, clock() - ulClock );
}
}
else
{
char *sClass = hb_objGetClsName( pSelf );
if( strncmp( pSym->szName, "CLASSNAME", strlen( pSym->szName ) < 4 ? 4 : strlen( pSym->szName ) ) == 0 )
{
hb_itemPutC( &hb_stack.Return, sClass );
}
else if( strncmp( pSym->szName, "CLASSH", 6 ) == 0 )
{
hb_itemPutNI( &hb_stack.Return, 0 );
}
else
{
char sDesc[128];
if( pSym->szName[ 0 ] == '_' )
{
PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams );
sprintf( (char *) sDesc, "Class: '%s' has no property", sClass );
hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, (char *) sDesc, pSym->szName + 1, 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
else
{
PHB_ITEM pArgsArray = hb_arrayFromStack( uiParams );
sprintf( (char *) sDesc, "Class: '%s' has no exported method", sClass );
hb_errRT_BASE_SubstR( EG_NOMETHOD, 1004, (char *) sDesc, pSym->szName, 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
}
}
}
hb_stackOldFrame( &sStackState );
if( s_bDebugging )
{
hb_vmDebuggerEndProc();
}
s_bDebugging = bDebugPrevState;
}

21
harbour/tests/speed.prg Normal file
View File

@@ -0,0 +1,21 @@
Function Main()
Local Program := { , }, Condition := 1, body := 2, Counter := 1, TheEnd := 1000000, stop, start
Program[ condition] := { || Counter == TheEnd}
Program[ body] := { || Counter++}
? start := Second()
// in Clipper :
// While !Program[ condition]:Eval() ; Program[ body]:Eval()
// why Harbour CodeBlocks don't have Eval() method ?!
// Now It is supported.
While !Eval( Program[ condition]) ; Eval( Program[ body])
End
? stop := Second()
? '==============='
? stop - start
Return NIL