From 69503c8a2b1c1ec5fb69781039a9bd9109e0e050 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sun, 3 Sep 2006 14:30:26 +0000 Subject: [PATCH] 2006-09-03 16:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hboo.ch + added HB_OO_CLSTP_PERSIST and HB_OO_MSG_INITIALIZED * harbour/include/hbapi.h * harbour/include/hbvmpub.h * harbour/source/vm/dynsym.c % changed HB_HANDLE hArea to USHORT uiArea to reduce HB_DYNS size. RDD code internally uses USHORT as area number so it's not necessary to keep it as HB_HANDLE value. * harbour/source/vm/arrays.c * modified internal static function name * harbour/source/vm/itemapi.c + added missing HB_TRACE in hb_itemClone() * harbour/source/vm/classes.c ! moved initialization values to separate structure not bound with methods. We can inherit the same method names from more then one object so we will store only the first one but we are inheriting whole instance area which is accessible with super casting (last fixes) so we have to properly initialize it even if methods does not exist. This modification also fixes some possible memory leaks. % replaced bIsPersistent by HB_OO_CLSTP_PERSIST in uiScope in method definition ! added basic parameter validation to __CLSADDMSG() to avoid some possible strange behavior at runtime when broken messages are defined. * updated __OBJHASMSG() and __OBJSENDMSG() to accept SYMBOL items too (@funcName()). Using symbol items it faster then strings. Also added support to use non array parametes. F.e. now __OBJHASMSG( {||NIL}, "EVAL" ) returns TRUE * some other fixes, reduced memory consumption and speed optimizations --- harbour/ChangeLog | 71 +++ harbour/include/hbapi.h | 2 +- harbour/include/hboo.ch | 3 +- harbour/include/hbvmpub.h | 2 +- harbour/source/vm/arrays.c | 8 +- harbour/source/vm/classes.c | 866 ++++++++++++++++++------------------ harbour/source/vm/dynsym.c | 8 +- harbour/source/vm/itemapi.c | 2 + 8 files changed, 522 insertions(+), 440 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index c1dcfb5a15..bb06b96098 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,77 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2006-09-03 16:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hboo.ch + + added HB_OO_CLSTP_PERSIST and HB_OO_MSG_INITIALIZED + + * harbour/include/hbapi.h + * harbour/include/hbvmpub.h + * harbour/source/vm/dynsym.c + % changed HB_HANDLE hArea to USHORT uiArea to reduce HB_DYNS size. + RDD code internally uses USHORT as area number so it's not + necessary to keep it as HB_HANDLE value. + + * harbour/source/vm/arrays.c + * modified internal static function name + + * harbour/source/vm/itemapi.c + + added missing HB_TRACE in hb_itemClone() + + * harbour/source/vm/classes.c + ! moved initialization values to separate structure not bound with + methods. We can inherit the same method names from more then one + object so we will store only the first one but we are inheriting + whole instance area which is accessible with super casting (last + fixes) so we have to properly initialize it even if methods does + not exist. This modification also fixes some possible memory leaks. + % replaced bIsPersistent by HB_OO_CLSTP_PERSIST in uiScope in method + definition + ! added basic parameter validation to __CLSADDMSG() to avoid some + possible strange behavior at runtime when broken messages are + defined. + * updated __OBJHASMSG() and __OBJSENDMSG() to accept SYMBOL items + too (@funcName()). Using symbol items it faster then strings. + Also added support to use non array parametes. F.e. now + __OBJHASMSG( {||NIL}, "EVAL" ) + returns TRUE + * some other fixes, reduced memory consumption and speed optimizations + +2006-09-03 16:15 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hboo.ch + + added HB_OO_CLSTP_PERSIST and HB_OO_MSG_INITIALIZED + + * harbour/include/hbvmpub.h + * harbour/source/vm/dynsym.c + % changed HB_HANDLE hArea to USHORT uiArea to reduce HB_DYNS size. + RDD code internally uses USHORT as area number so it's not + necessary to keep it as HB_HANDLE value. + + * harbour/source/vm/arrays.c + * modified internal static function name + + * harbour/source/vm/itemapi.c + + added missing HB_TRACE in hb_itemClone() + + * harbour/source/vm/classes.c + ! moved initialization values to separate structure not bound with + methods. We can inherit the same method names from more then one + object so we will store only the first one but we are inheriting + whole instance area which is accessible with super casting (last + fixes) so we have to properly initialize it even if methods does + not exist. This modification also fixes some possible memory leaks. + % replaced bIsPersistent by HB_OO_CLSTP_PERSIST in uiScope in method + definition + ! added basic parameter validation to __CLSADDMSG() to avoid some + possible strange behavior at runtime when broken messages are + defined. + * updated __OBJHASMSG() and __OBJSENDMSG() to accept SYMBOL items + too (@funcName()). Using symbol items it faster then strings. + Also added support to use non array parametes. F.e. now + __OBJHASMSG( {||NIL}, "EVAL" ) + returns TRUE + * some other fixes, reduced memory consumption and speed optimizations + 2006-09-03 16:37 UTC+0300 Chen Kedem * doc/en/lang.txt + Update supported codepage list for HB_SETCODEPAGE() diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 61415982c1..9acf39033d 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -699,7 +699,7 @@ extern HB_EXPORT PHB_SYMB hb_dynsymFindSymbol( char * szName ); /* finds a dyna extern HB_EXPORT PHB_SYMB hb_dynsymSymbol( PHB_DYNS pDynSym ); extern HB_EXPORT char * hb_dynsymName( PHB_DYNS pDynSym ); /* return dynamic symbol name */ extern HB_EXPORT HB_HANDLE hb_dynsymMemvarHandle( PHB_DYNS pDynSym ); /* return memvar handle number bound with given dynamic symbol */ -extern HB_EXPORT HB_HANDLE hb_dynsymAreaHandle( PHB_DYNS pDynSym ); /* return work area number bound with given dynamic symbol */ +extern HB_EXPORT int hb_dynsymAreaHandle( PHB_DYNS pDynSym ); /* return work area number bound with given dynamic symbol */ extern HB_EXPORT void hb_dynsymSetAreaHandle( PHB_DYNS pDynSym, int iArea ); /* set work area number for a given dynamic symbol */ /* Symbol management */ diff --git a/harbour/include/hboo.ch b/harbour/include/hboo.ch index 2ba9581140..2a4ca12e0d 100644 --- a/harbour/include/hboo.ch +++ b/harbour/include/hboo.ch @@ -82,6 +82,7 @@ #define HB_OO_CLSTP_CLASS 64 /* The related message is a superobject call, uidata is the superclass handle pInitValue contain one superclass object instance (absolutely needed for Inline msg and class data) */ #define HB_OO_CLSTP_SUPER 128 /* The related message is inherited from a superclass */ +#define HB_OO_CLSTP_PERSIST 256 /* Message is persistent (PROPERTY) */ /* Message types */ #define HB_OO_MSG_METHOD 0 @@ -92,7 +93,7 @@ #define HB_OO_MSG_SUPER 5 #define HB_OO_MSG_ONERROR 6 #define HB_OO_MSG_CLSMTHD 7 /* for the future */ - +#define HB_OO_MSG_INITIALIZED 8 /* Data */ #define HB_OO_DATA_SYMBOL 1 #define HB_OO_DATA_VALUE 2 diff --git a/harbour/include/hbvmpub.h b/harbour/include/hbvmpub.h index c3f2942b6e..53bd21baab 100644 --- a/harbour/include/hbvmpub.h +++ b/harbour/include/hbvmpub.h @@ -95,8 +95,8 @@ struct _HB_SYMB; typedef struct _HB_DYNS { struct _HB_SYMB * pSymbol; /* pointer to its relative local symbol */ - HB_HANDLE hArea; /* Workarea number */ HB_HANDLE hMemvar; /* Index number into memvars ( publics & privates ) array */ + USHORT uiArea; /* Workarea number */ USHORT uiSymNum; /* dynamic symbol number */ #ifndef HB_NO_PROFILER ULONG ulCalls; /* profiler support */ diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 24ebed3faf..8360d94276 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -801,12 +801,12 @@ BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG * pulStart, return FALSE; } -static void hb_arrayCloneTo( PHB_BASEARRAY pSrcBaseArray, PHB_BASEARRAY pDstBaseArray, PHB_NESTED_CLONED pClonedList ) +static void hb_arrayCloneBody( PHB_BASEARRAY pSrcBaseArray, PHB_BASEARRAY pDstBaseArray, PHB_NESTED_CLONED pClonedList ) { PHB_ITEM pSrcItem, pDstItem; ULONG ulLen; - HB_TRACE(HB_TR_DEBUG, ("hb_arrayCloneTo(%p, %p, %p)", pSrcBaseArray, pDstBaseArray, pClonedList)); + HB_TRACE(HB_TR_DEBUG, ("hb_arrayCloneBody(%p, %p, %p)", pSrcBaseArray, pDstBaseArray, pClonedList)); pSrcItem = pSrcBaseArray->pItems; pDstItem = pDstBaseArray->pItems; @@ -843,7 +843,7 @@ static void hb_arrayCloneTo( PHB_BASEARRAY pSrcBaseArray, PHB_BASEARRAY pDstBase pCloned->pNext = pClonedList->pNext; pClonedList->pNext = pCloned; - hb_arrayCloneTo( pBaseArray, pDstItem->item.asArray.value, pClonedList ); + hb_arrayCloneBody( pBaseArray, pDstItem->item.asArray.value, pClonedList ); } } else @@ -871,7 +871,7 @@ HB_EXPORT PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) pClonedList->pDest = pDstArray; pClonedList->pNext = NULL; - hb_arrayCloneTo( pSrcBaseArray, pDstArray->item.asArray.value, pClonedList ); + hb_arrayCloneBody( pSrcBaseArray, pDstArray->item.asArray.value, pClonedList ); do { diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index fd7dd61a5d..da919a33d0 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -152,17 +152,21 @@ /* DEBUG only*/ /* #include */ +typedef struct +{ + PHB_ITEM pInitValue; /* Init Value for data */ + USHORT uiType; /* HB_OO_MSG_DATA or HB_OO_MSG_CLASSDATA */ + USHORT uiData; /* Item position in instance area or in class data */ +} INITDATA, * PINITDATA; + typedef struct { PHB_DYNS pMessage; /* Method Symbolic name */ PHB_SYMB pFuncSym; /* Function symbol */ - USHORT uiData; /* Item position for data (Harbour like, begin from 1) */ - USHORT uiDataShared; /* Item position for datashared (original pos within Shared Class) */ + USHORT uiData; /* Item position for instance data or shared data (Harbour like, begin from 1) or supercast offset (from 0) */ USHORT uiSprClass; /* Originalclass'handel (super or current class'handel if not herited). */ /*Added by RAC&JF*/ USHORT uiScope; /* Scoping value */ - PHB_ITEM pInitValue; /* Init Value for data */ USHORT bClsDataInitiated; /* There is one value assigned at init time */ - USHORT bIsPersistent; /* persistence support */ #ifndef HB_NO_PROFILER ULONG ulCalls; /* profiler support */ ULONG ulTime; /* profiler support */ @@ -172,17 +176,18 @@ typedef struct typedef struct { - char * szName; /* Class name */ - USHORT uiDatas; /* Total Data Counter */ - USHORT uiDataFirst; /* First uiData from this class */ - PMETHOD pMethods; - USHORT uiMethods; /* Total Method initialised Counter */ + char * szName; /* Class name */ + PMETHOD pMethods; /* Class methods */ + PINITDATA pInitData; /* Class/instance Initialization data */ + PHB_ITEM pClassDatas; /* Harbour Array for ClassDatas and shared */ + PHB_ITEM pInlines; /* Array for inline codeblocks */ + PHB_SYMB pFunError; /* error handler for not defined messages */ + ULONG ulOpFlags; /* Flags for overloaded operators */ + USHORT uiMethods; /* Total Method initialised Counter */ + USHORT uiInitDatas; /* Total Method initialised Counter */ + USHORT uiDatas; /* Total Data Counter */ + USHORT uiDataFirst; /* First uiData from this class */ USHORT uiHashKey; - USHORT uiDatasShared; /* Total shared Class data within Class data */ - PHB_ITEM pClassDatas; /* Harbour Array for ClassDatas and shared */ - PHB_ITEM pInlines; /* Array for inline codeblocks */ - PHB_SYMB pFunError; /* error handler for not defined messages */ - ULONG ulOpFlags; /* Flags for overloaded operators */ } CLASS, * PCLASS; #define BUCKETBITS 2 @@ -191,6 +196,7 @@ typedef struct #define HASHBITS 3 #define HASH_KEY ( 1 << HASHBITS ) #define HASH_KEYMAX ( 1 << ( 16 - BUCKETBITS ) ) +#define hb_clsMthNum(p) ( ( ULONG ) (p)->uiHashKey << BUCKETBITS ) static HARBOUR hb___msgGetData( void ); static HARBOUR hb___msgSetData( void ); @@ -373,6 +379,18 @@ static BOOL hb_clsDictRealloc( PCLASS pClass ) return TRUE; } +static void hb_clsDictInit( PCLASS pClass, USHORT uiHashKey ) +{ + ULONG ulSize; + + HB_TRACE(HB_TR_DEBUG, ("hb_clsDictInit(%p,%hu)", pClass, uiHashKey)); + + ulSize = ( ( ULONG ) uiHashKey << BUCKETBITS ) * sizeof( METHOD ); + pClass->uiHashKey = uiHashKey; + pClass->pMethods = ( PMETHOD ) hb_xgrab( ulSize ); + memset( pClass->pMethods, 0, ulSize ); +} + static PMETHOD hb_clsFindMsg( PCLASS pClass, PHB_DYNS pMsg ) { PMETHOD pMethod = pClass->pMethods + hb_clsMsgBucket( pMsg, pClass->uiHashKey - 1 ); @@ -409,6 +427,23 @@ static PMETHOD hb_clsAllocMsg( PCLASS pClass, PHB_DYNS pMsg ) return NULL; } +static void hb_clsAddInitValue( PCLASS pClass, PHB_ITEM pItem, + USHORT uiType, USHORT uiData ) +{ + PINITDATA pInitData; + + if( ! pClass->uiInitDatas ) + pClass->pInitData = ( PINITDATA ) hb_xgrab( sizeof( INITDATA ) ); + else + pClass->pInitData = ( PINITDATA ) hb_xrealloc( pClass->pInitData, + ( pClass->uiInitDatas + 1 ) * sizeof( INITDATA ) ); + + pInitData = pClass->pInitData + pClass->uiInitDatas++; + + pInitData->pInitValue = hb_itemClone( pItem ); + pInitData->uiType = uiType; + pInitData->uiData = uiData; +} /* * initialize Classy/OO system at HVM startup @@ -449,22 +484,24 @@ void hb_clsInit( void ) */ static void hb_clsRelease( PCLASS pClass ) { - ULONG ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS; - PMETHOD pMeth = pClass->pMethods; - HB_TRACE(HB_TR_DEBUG, ("hb_clsRelease(%p)", pClass)); - do + if( pClass->uiInitDatas ) { - if( pMeth->pInitValue ) - hb_itemRelease( pMeth->pInitValue ); - pMeth++; + USHORT ui = pClass->uiInitDatas; + PINITDATA pInitData = pClass->pInitData; + + do + { + hb_itemRelease( pInitData->pInitValue ); + ++pInitData; + } + while( --ui ); + hb_xfree( pClass->pInitData ); } - while( --ulLimit ); hb_xfree( pClass->szName ); hb_xfree( pClass->pMethods ); - hb_itemRelease( pClass->pClassDatas ); hb_itemRelease( pClass->pInlines ); } @@ -509,8 +546,6 @@ void hb_clsIsClassRef( void ) #if 0 USHORT uiClass = s_uiClasses; PCLASS pClass = s_pClasses; - ULONG ulLimit; - PMETHOD pMeth; HB_TRACE(HB_TR_DEBUG, ("hb_clsIsClassRef()")); @@ -528,20 +563,19 @@ void hb_clsIsClassRef( void ) hb_gcItemRef( pClass->pClassDatas ); } - pMeth = pClass->pMethods; - ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS; - - do + if( pClass->uiInitDatas ) { - if( pMeth->pInitValue ) - { - if( HB_IS_GCITEM( pMeth->pInitValue ) ) - hb_gcItemRef( pMeth->pInitValue ); - } - pMeth++; - } - while( --ulLimit ); + USHORT ui = pClass->uiInitDatas; + PINITDATA pInitData = pClass->pInitData; + do + { + if( HB_IS_GCITEM( pInitData->pInitValue ) ) + hb_gcItemRef( pInitData->pInitValue ); + ++pInitData; + } + while( --ui ); + } ++pClass; } #endif @@ -1081,6 +1115,56 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage, PHB_STACK_STATE p return NULL; } +/* + * Check if object has a given operator + */ +BOOL hb_objHasOperator( PHB_ITEM pObject, USHORT uiOperator ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_objHasOperator(%p,%hu)", pObject, uiOperator)); + + if( pObject->type == HB_IT_ARRAY && + pObject->item.asArray.value->uiClass != 0 ) + { + PCLASS pClass = s_pClasses + pObject->item.asArray.value->uiClass - 1; + return ( pClass->ulOpFlags & ( 1UL << uiOperator ) ) != 0; + } + + return FALSE; +} + +/* + * Call object operator. If pMsgArg is NULL then operator is unary. + * Function return TRUE when object class overloads given operator + * and FALSE otherwise. [druzus] + */ +BOOL hb_objOperatorCall( USHORT uiOperator, HB_ITEM_PTR pResult, + PHB_ITEM pObject, PHB_ITEM pMsgArg ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_objOperatorCall(%hu,%p,%p,%p)", uiOperator, pResult, pObject, pMsgArg)); + + if( hb_objHasOperator( pObject, uiOperator ) ) + { + hb_vmPushSymbol( s_opSymbols + uiOperator ); + hb_vmPush( pObject ); + if( HB_IS_COMPLEX( hb_stackReturnItem() ) ) + hb_itemClear( hb_stackReturnItem() ); + else + hb_stackReturnItem()->type = HB_IT_NIL; + if( pMsgArg ) + { + hb_vmPush( pMsgArg ); + hb_vmSend( 1 ); + } + else + hb_vmSend( 0 ); + + /* store the return value */ + hb_itemCopy( pResult, hb_stackReturnItem() ); + return TRUE; + } + return FALSE; +} + /* * return TRUE if object has a given message */ @@ -1089,6 +1173,76 @@ BOOL hb_objHasMessage( PHB_ITEM pObject, PHB_DYNS pMessage ) return hb_objGetMethod( pObject, pMessage->pSymbol, NULL ) != NULL; } +/* + * = hb_objHasMsg( , ) + * + * Check whether is an existing message for object. + * + * should be read as a boolean + */ +BOOL hb_objHasMsg( PHB_ITEM pObject, char *szString ) +{ + PHB_DYNS pDynSym; + + HB_TRACE(HB_TR_DEBUG, ("hb_objHasMsg(%p, %s)", pObject, szString)); + + pDynSym = hb_dynsymFindName( szString ); + if( pDynSym ) + { + return hb_objGetMethod( pObject, pDynSym->pSymbol, NULL ) != NULL; + } + else + { + return FALSE; + } +} + +void hb_objSendMessage( PHB_ITEM pObject, PHB_DYNS pMsgSym, ULONG ulArg, ... ) +{ + if( pObject && pMsgSym ) + { + hb_vmPushSymbol( pMsgSym->pSymbol ); + hb_vmPush( pObject ); + + if( ulArg ) + { + unsigned long i; + va_list ap; + + va_start( ap, ulArg ); + for( i = 0; i < ulArg; i++ ) + { + hb_vmPush( va_arg( ap, PHB_ITEM ) ); + } + va_end( ap ); + } + hb_vmSend( (USHORT) ulArg ); + } + else + { + hb_errRT_BASE( EG_ARG, 3000, NULL, "__ObjSendMessage()", 0 ); + } +} + +void hb_objSendMsg( PHB_ITEM pObject, char *sMsg, ULONG ulArg, ... ) +{ + hb_vmPushSymbol( hb_dynsymGet( sMsg )->pSymbol ); + hb_vmPush( pObject ); + if( ulArg ) + { + unsigned long i; + va_list ap; + + va_start( ap, ulArg ); + for( i = 0; i < ulArg; i++ ) + { + hb_vmPush( va_arg( ap, PHB_ITEM ) ); + } + va_end( ap ); + } + hb_vmSend( (USHORT) ulArg ); +} + #ifndef HB_CLS_ENFORCERO /* * This function is only for backward binary compatibility @@ -1146,77 +1300,29 @@ static PHB_SYMB hb_objFuncParam( int iParam ) return NULL; } -/* - * Check if object has a given operator - */ -BOOL hb_objHasOperator( PHB_ITEM pObject, USHORT uiOperator ) +static PHB_DYNS hb_objMsgParam( int iParam ) { - HB_TRACE(HB_TR_DEBUG, ("hb_objHasOperator(%p,%hu)", pObject, uiOperator)); + PHB_ITEM pMessage = hb_param( iParam, HB_IT_STRING | HB_IT_SYMBOL ); + PHB_DYNS pDynSym = NULL; - if( pObject->type == HB_IT_ARRAY && - pObject->item.asArray.value->uiClass != 0 ) + if( pMessage ) { - PCLASS pClass = s_pClasses + pObject->item.asArray.value->uiClass - 1; - return ( pClass->ulOpFlags & ( 1UL << uiOperator ) ) != 0; - } + char * szMsg = NULL; - return FALSE; -} - -/* - * Call object operator. If pMsgArg is NULL then operator is unary. - * Function return TRUE when object class overloads given operator - * and FALSE otherwise. [druzus] - */ -BOOL hb_objOperatorCall( USHORT uiOperator, HB_ITEM_PTR pResult, - PHB_ITEM pObject, PHB_ITEM pMsgArg ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_objOperatorCall(%hu,%p,%p,%p)", uiOperator, pResult, pObject, pMsgArg)); - - if( hb_objHasOperator( pObject, uiOperator ) ) - { - hb_vmPushSymbol( s_opSymbols + uiOperator ); - hb_vmPush( pObject ); - if( HB_IS_COMPLEX( hb_stackReturnItem() ) ) - hb_itemClear( hb_stackReturnItem() ); + if( HB_IS_STRING( pMessage ) ) + szMsg = pMessage->item.asString.value; else - hb_stackReturnItem()->type = HB_IT_NIL; - if( pMsgArg ) { - hb_vmPush( pMsgArg ); - hb_vmSend( 1 ); + pDynSym = pMessage->item.asSymbol.value->pDynSym; + if( !pDynSym ) + szMsg = pMessage->item.asSymbol.value->szName; } - else - hb_vmSend( 0 ); - /* store the return value */ - hb_itemCopy( pResult, hb_stackReturnItem() ); - return TRUE; + if( szMsg && *szMsg ) + pDynSym = hb_dynsymGet( szMsg ); } - return FALSE; -} -/* - * = hb_objHasMsg( , ) - * - * Check whether is an existing message for object. - * - * should be read as a boolean - */ -BOOL hb_objHasMsg( PHB_ITEM pObject, char *szString ) -{ - PHB_DYNS pDynSym = hb_dynsymFindName( szString ); - - HB_TRACE(HB_TR_DEBUG, ("hb_objHasMsg(%p, %s)", pObject, szString)); - - if( pDynSym ) - { - return hb_objGetMethod( pObject, pDynSym->pSymbol, NULL ) != NULL; - } - else - { - return FALSE; - } + return pDynSym; } static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign ) @@ -1254,7 +1360,7 @@ static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign ) * * HB_OO_MSG_DATA : Optional initializer for DATA * HB_OO_MSG_CLASSDATA : Optional initializer for DATA - * HB_OO_MSG_SUPER : Index number in array (for instance SuperObject) + * HB_OO_MSG_SUPER : Superclass handle * * HB_OO_CLSTP_EXPORTED 1 : default for data and method * HB_OO_CLSTP_PROTECTED 2 : method or data protected @@ -1264,29 +1370,34 @@ static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign ) * HB_OO_CLSTP_SHARED 32 : (method or) data shared * HB_OO_CLSTP_CLASS 64 : message is the name of a superclass * HB_OO_CLSTP_SUPER 128 : message is herited - * HB_OO_CLSTP_CLASSCTOR 256 : Class method constructor - * HB_OO_CLSTP_CLASSMETH 512 : Class method + * HB_OO_CLSTP_PERSIST 256 : message is persistent (PROPERTY) + * + * HB_OO_CLSTP_CLASSCTOR 512 : Class method constructor + * HB_OO_CLSTP_CLASSMETH 1024 : Class method */ HB_FUNC( __CLSADDMSG ) { USHORT uiClass = ( USHORT ) hb_parni( 1 ); - USHORT uiScope = ( USHORT ) ( ISNUM( 6 ) ? hb_parni( 6 ) : HB_OO_CLSTP_EXPORTED ); - BOOL bPersistent = hb_parl( 7 ); if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); PHB_DYNS pMessage; + PMETHOD pNewMeth; + USHORT uiOperator, uiSprClass = 0, uiIndex = 0; + PHB_SYMB pOpSym, pFuncSym = NULL; + PHB_ITEM pBlock = NULL; + BOOL fOK, fAssign; + ULONG ulOpFlags = 0; char * szMessage = hb_parc( 2 ); USHORT nType = ( USHORT ) hb_parni( 4 ); - PMETHOD pNewMeth; + USHORT uiScope = ( USHORT ) ( ISNUM( 6 ) ? hb_parni( 6 ) : HB_OO_CLSTP_EXPORTED ); - USHORT uiOperator; - PHB_SYMB pOpSym; - ULONG ulOpFlags = 0; + if( hb_parl( 7 ) ) + uiScope |= HB_OO_CLSTP_PERSIST; /* translate names of operator overloading messages */ if (strcmp("+", szMessage) == 0) @@ -1352,7 +1463,39 @@ HB_FUNC( __CLSADDMSG ) } } - if( nType == HB_OO_MSG_INLINE && hb_param( 3, HB_IT_BLOCK ) == NULL ) + /* basic parameter validation */ + switch( nType ) + { + case HB_OO_MSG_METHOD: + case HB_OO_MSG_ONERROR: + pFuncSym = hb_objFuncParam( 3 ); + fOK = pFuncSym != NULL; + break; + + case HB_OO_MSG_INLINE: + pBlock = hb_param( 3, HB_IT_BLOCK ); + fOK = pBlock != NULL; + break; + + case HB_OO_MSG_SUPER: + uiSprClass = ( USHORT ) hb_parni( 5 ); + fOK = uiSprClass && uiSprClass <= s_uiClasses; + break; + + case HB_OO_MSG_DATA: + /* This validation can break buggy .prg code which wrongly + * sets data offsets but IMHO it will help to clean the code. + * [druzus] + */ + uiIndex = ( USHORT ) hb_parni( 3 ); + fOK = uiIndex && uiIndex <= pClass->uiDatas; + break; + + default: + fOK = TRUE; + } + + if( !fOK ) { hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSADDMSG", 0 ); return; @@ -1369,87 +1512,84 @@ HB_FUNC( __CLSADDMSG ) } pNewMeth->uiSprClass = uiClass ; /* now used !! */ - pNewMeth->bClsDataInitiated = 0 ; /* reset state */ - pNewMeth->bIsPersistent = bPersistent ? 1 : 0; #ifndef HB_NO_PROFILER pNewMeth->ulCalls = 0; pNewMeth->ulTime = 0; pNewMeth->ulRecurse = 0; #endif - /* in case of re-used message */ - if( pNewMeth->pInitValue ) - { - hb_itemRelease(pNewMeth->pInitValue); - pNewMeth->pInitValue = NULL; - } + fAssign = pMessage->pSymbol->szName[ 0 ] == '_'; switch( nType ) { case HB_OO_MSG_METHOD: - pNewMeth->pFuncSym = hb_objFuncParam( 3 ); + pNewMeth->pFuncSym = pFuncSym; pNewMeth->uiScope = uiScope; pNewMeth->uiData = 0; break; case HB_OO_MSG_DATA: - pNewMeth->uiData = ( USHORT ) hb_parni( 3 ); - pNewMeth->uiScope = hb_clsUpdateScope( uiScope, - pMessage->pSymbol->szName[ 0 ] == '_' ); - - if( pMessage->pSymbol->szName[ 0 ] == '_' ) + pNewMeth->uiData = uiIndex; + pNewMeth->uiScope = hb_clsUpdateScope( uiScope, fAssign ); + if( fAssign ) pNewMeth->pFuncSym = &s___msgSetData; else { PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); - pNewMeth->pFuncSym = &s___msgGetData; - if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ - { - pNewMeth->pInitValue = hb_itemClone( pInit ); - } + hb_clsAddInitValue( pClass, pInit, HB_OO_MSG_DATA, + pNewMeth->uiData ); + pNewMeth->pFuncSym = &s___msgGetData; } break; case HB_OO_MSG_CLASSDATA: pNewMeth->uiData = ( USHORT ) hb_parni( 3 ); - pNewMeth->uiDataShared = pNewMeth->uiData ; - pNewMeth->uiScope = hb_clsUpdateScope( uiScope, - pMessage->pSymbol->szName[ 0 ] == '_' ); - + pNewMeth->uiScope = hb_clsUpdateScope( uiScope, fAssign ); if( hb_arrayLen( pClass->pClassDatas ) < ( ULONG ) pNewMeth->uiData ) hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); - if( pMessage->pSymbol->szName[ 0 ] != '_' ) - { - PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); - - if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ - { - pNewMeth->pInitValue = hb_itemClone( pInit ); - } - } - if( pNewMeth->uiScope & HB_OO_CLSTP_SHARED ) { - if( pMessage->pSymbol->szName[ 0 ] == '_' ) - { + if( fAssign ) pNewMeth->pFuncSym = &s___msgSetShrData; - pClass->uiDatasShared++; - } else + { + PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); + pNewMeth->pFuncSym = &s___msgGetShrData; + if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ + { + /* Shared Classdata need to be initialized only once + * ACCESS/ASSIGN methods will be inherited by subclasses + * and will operate on this value so it's not necessary + * to keep the init value. [druzus] + */ + pInit = hb_itemClone( pInit ); + hb_arraySet( pClass->pClassDatas, pNewMeth->uiData, pInit ); + hb_itemRelease( pInit ); + } + } } else { - if( pMessage->pSymbol->szName[ 0 ] == '_' ) + if( fAssign ) + { pNewMeth->pFuncSym = &s___msgSetClsData; + } else + { + PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); + + if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ + hb_clsAddInitValue( pClass, pInit, HB_OO_MSG_CLASSDATA, + pNewMeth->uiData ); pNewMeth->pFuncSym = &s___msgGetClsData; + } } break; @@ -1458,26 +1598,27 @@ HB_FUNC( __CLSADDMSG ) pNewMeth->uiData = ( USHORT ) ( hb_arrayLen( pClass->pInlines ) + 1 ); pNewMeth->uiScope = uiScope; hb_arraySize( pClass->pInlines, pNewMeth->uiData ); - hb_arraySet( pClass->pInlines, pNewMeth->uiData, hb_param( 3, HB_IT_BLOCK ) ); + hb_arraySet( pClass->pInlines, pNewMeth->uiData, pBlock ); pNewMeth->pFuncSym = &s___msgEvalInline; break; case HB_OO_MSG_VIRTUAL: + pNewMeth->uiScope = uiScope; pNewMeth->pFuncSym = &s___msgVirtual; break; case HB_OO_MSG_SUPER: - pNewMeth->uiData = ( USHORT ) hb_parni( 3 ); - pNewMeth->uiSprClass = ( USHORT ) hb_parni( 5 ); /* store the super handel */ + pNewMeth->uiData = ( USHORT ) hb_parni( 3 ); /* offset to instance area */ + pNewMeth->uiSprClass = uiSprClass; /* store the super handel */ pNewMeth->uiScope = uiScope; pNewMeth->pFuncSym = &s___msgSuper; break; case HB_OO_MSG_ONERROR: - pClass->pFunError = hb_objFuncParam( 3 ); + pClass->pFunError = pFuncSym; break; default: @@ -1506,9 +1647,8 @@ HB_FUNC( __CLSNEW ) { PCLASS pNewCls; PHB_ITEM pahSuper; - USHORT i, uiSuper; - USHORT nLenClsDatas = 0; - USHORT nLenInlines = 0; + USHORT ui, uiSuper, uiSuperCls; + USHORT nLenClsDatas = 0, nLenInlines = 0; pahSuper = hb_param( 3, HB_IT_ARRAY ); uiSuper = ( USHORT ) ( pahSuper ? hb_arrayLen( pahSuper ) : 0 ); @@ -1518,41 +1658,30 @@ HB_FUNC( __CLSNEW ) else s_pClasses = ( PCLASS ) hb_xgrab( sizeof( CLASS ) ); - pNewCls = s_pClasses + s_uiClasses; + pNewCls = s_pClasses + s_uiClasses++; + memset( pNewCls, 0, sizeof( CLASS ) ); pNewCls->szName = hb_strdup( hb_parc( 1 ) ); - pNewCls->uiDataFirst = 0; - pNewCls->uiDatas = 0; - pNewCls->uiMethods = 0; - pNewCls->uiDatasShared = 0; - pNewCls->ulOpFlags = 0; - if( uiSuper ) + for( ui = 1; ui <= uiSuper; ++ui ) { - for( i = 1; i <= uiSuper; i++ ) + uiSuperCls = ( USHORT ) hb_arrayGetNI( pahSuper, ui ); + if( uiSuperCls && uiSuperCls <= s_uiClasses ) { PHB_DYNS pMsg; PHB_ITEM pClsAnyTmp; - USHORT nSuper; PCLASS pSprCls; ULONG ul, ulLimit, ulLen; - nSuper = ( USHORT ) hb_arrayGetNI( pahSuper, i ); - pSprCls = s_pClasses + ( nSuper - 1 ); - ulLimit = ( ULONG ) pSprCls->uiHashKey << BUCKETBITS; - - if( i == 1 ) /* This is the first superclass */ + pSprCls = s_pClasses + ( uiSuperCls - 1 ); + ulLimit = hb_clsMthNum( pSprCls ); + if( !pNewCls->pMethods ) /* This is the first superclass */ { - ULONG ulSize; - pNewCls->uiHashKey = pSprCls->uiHashKey; - ulSize = ( ULONG ) ( pNewCls->uiHashKey << BUCKETBITS ) * sizeof( METHOD ); - pNewCls->pMethods = ( PMETHOD ) hb_xgrab( ulSize ); - memset( pNewCls->pMethods, 0, ulSize ); + hb_clsDictInit( pNewCls, pSprCls->uiHashKey ); pNewCls->pFunError = pSprCls->pFunError; /* CLASS DATA Not Shared ( new array, new value ) */ pNewCls->pClassDatas = hb_arrayClone( pSprCls->pClassDatas ); pNewCls->pInlines = hb_arrayClone( pSprCls->pInlines ); - pNewCls->uiDatasShared = pSprCls->uiDatasShared; } else { @@ -1561,27 +1690,60 @@ HB_FUNC( __CLSNEW ) nLenInlines = ( USHORT ) hb_itemSize( pNewCls->pInlines ); /* ClassDatas */ - pClsAnyTmp = hb_arrayClone( pSprCls->pClassDatas ); - ulLen = hb_itemSize( pClsAnyTmp ); - for( ul = 1; ul <= ulLen; ul++ ) + ulLen = hb_itemSize( pSprCls->pClassDatas ); + if( ulLen ) { - hb_arrayAdd( pNewCls->pClassDatas, - hb_arrayGetItemPtr( pClsAnyTmp, ul ) ); + pClsAnyTmp = hb_arrayClone( pSprCls->pClassDatas ); + hb_arraySize( pNewCls->pClassDatas, nLenClsDatas + ulLen ); + for( ul = 1; ul <= ulLen; ul++ ) + { + hb_itemCopy( hb_arrayGetItemPtr( pNewCls->pClassDatas, + nLenClsDatas + ul ), + hb_arrayGetItemPtr( pClsAnyTmp, ul ) ); + } + hb_itemRelease( pClsAnyTmp ); } - hb_itemRelease( pClsAnyTmp ); - /* SharedDatas */ - pNewCls->uiDatasShared += pSprCls->uiDatasShared; - - /* Inlines */ - pClsAnyTmp = hb_arrayClone( pSprCls->pInlines ); - ulLen = ( USHORT ) hb_itemSize( pClsAnyTmp ); - for( ul = 1; ul <= ulLen; ul++ ) + /* Copy Inline codeblocks */ + ulLen = hb_arrayLen( pSprCls->pInlines ); + if( ulLen ) { - hb_arrayAdd( pNewCls->pInlines, - hb_arrayGetItemPtr( pClsAnyTmp, ul ) ); + hb_arraySize( pNewCls->pInlines, nLenInlines + ulLen ); + for( ul = 1; ul <= ulLen; ul++ ) + { + hb_itemCopy( hb_arrayGetItemPtr( pNewCls->pInlines, + nLenInlines + ul ), + hb_arrayGetItemPtr( pSprCls->pInlines, ul ) ); + } + } + } + + if( pSprCls->uiInitDatas ) + { + USHORT uiData, uiStart = pNewCls->uiInitDatas, uiType; + + pNewCls->uiInitDatas += pSprCls->uiInitDatas; + if( ! uiStart ) + pNewCls->pInitData = ( PINITDATA ) + hb_xgrab( pNewCls->uiInitDatas * sizeof( INITDATA ) ); + else + pNewCls->pInitData = ( PINITDATA ) hb_xrealloc( pNewCls->pInitData, + pNewCls->uiInitDatas * sizeof( INITDATA ) ); + + for( uiData = 0; uiData < pSprCls->uiInitDatas; ++uiData ) + { + uiType = pSprCls->pInitData[ uiData ].uiType; + if( uiType == HB_OO_MSG_INITIALIZED ) + uiType = HB_OO_MSG_CLASSDATA; + + pNewCls->pInitData[ uiData + uiStart ].pInitValue = + hb_itemNew( pSprCls->pInitData[ uiData ].pInitValue ); + pNewCls->pInitData[ uiData + uiStart ].uiType = uiType; + pNewCls->pInitData[ uiData + uiStart ].uiData = + pSprCls->pInitData[ uiData ].uiData + + ( uiType == HB_OO_MSG_CLASSDATA ? nLenClsDatas : + ( uiType == HB_OO_MSG_DATA ? pNewCls->uiDatas : 0 ) ); } - hb_itemRelease( pClsAnyTmp ); } /* Now working on pMethods */ @@ -1621,11 +1783,6 @@ HB_FUNC( __CLSNEW ) } pMethod->uiScope = pSprCls->pMethods[ ul ].uiScope | HB_OO_CLSTP_SUPER; - if( pSprCls->pMethods[ ul ].pInitValue ) - { - pMethod->pInitValue = - hb_itemClone( pSprCls->pMethods[ ul ].pInitValue ); - } } } } @@ -1634,22 +1791,17 @@ HB_FUNC( __CLSNEW ) pNewCls->ulOpFlags |= pSprCls->ulOpFlags; } } - else - { - pNewCls->pMethods = ( PMETHOD ) hb_xgrab( ( HASH_KEY << BUCKETBITS ) * sizeof( METHOD ) ); - memset( pNewCls->pMethods, 0, ( HASH_KEY << BUCKETBITS ) * sizeof( METHOD ) ); - - pNewCls->uiHashKey = HASH_KEY; - pNewCls->uiMethods = 0; - pNewCls->uiDatasShared= 0; - pNewCls->pClassDatas = hb_itemArrayNew( 0 ); - pNewCls->pInlines = hb_itemArrayNew( 0 ); - pNewCls->pFunError = NULL; - } pNewCls->uiDataFirst = pNewCls->uiDatas; pNewCls->uiDatas += ( USHORT ) hb_parni( 2 ); - hb_retni( ++s_uiClasses ); + if( !pNewCls->pMethods ) + { + hb_clsDictInit( pNewCls, HASH_KEY ); + pNewCls->pClassDatas = hb_itemArrayNew( 0 ); + pNewCls->pInlines = hb_itemArrayNew( 0 ); + } + + hb_retni( s_uiClasses ); } @@ -1682,9 +1834,9 @@ HB_FUNC( __CLSDELMSG ) if( pFuncSym == &s___msgEvalInline ) { /* INLINE method deleted, delete INLINE block */ - hb_arrayDel( pClass->pInlines, pMethod->uiData ); + hb_itemClear( hb_arrayGetItemPtr( pClass->pInlines, + pMethod->uiData ) ); } - /* Move messages */ uiPos = ( USHORT ) ( pMethod - pClass->pMethods ) & BUCKETMASK; @@ -1713,60 +1865,41 @@ static PHB_ITEM hb_clsInst( USHORT uiClass ) if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); - PMETHOD pMeth = pClass->pMethods; - ULONG ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS; pSelf = hb_itemNew( NULL ); hb_arrayNew( pSelf, pClass->uiDatas ); - pSelf->item.asArray.value->uiClass = uiClass; /* Initialise value if initialisation was requested */ - do + if( pClass->uiInitDatas ) { - /* Init Classdata (inherited and not) if needed */ - if( pMeth->pInitValue ) + PINITDATA pInitData = pClass->pInitData; + USHORT ui = pClass->uiInitDatas; + PHB_ITEM pDestItm; + + do { - if( pMeth->pFuncSym == &s___msgGetClsData && !( pMeth->bClsDataInitiated ) ) + if( pInitData->uiType == HB_OO_MSG_DATA ) + pDestItm = hb_arrayGetItemPtr( pSelf, pInitData->uiData ); + else if( pInitData->uiType == HB_OO_MSG_CLASSDATA ) { - PHB_ITEM pInit; - - pInit = hb_arrayGetItemPtr( pClass->pClassDatas, pMeth->uiData ); - if( HB_IS_NIL( pInit ) ) - { - pInit = hb_itemClone( pMeth->pInitValue ); - - hb_arraySet( pClass->pClassDatas, pMeth->uiData, pInit ); - hb_itemRelease( pInit ); - pMeth->bClsDataInitiated = 1; - } + pDestItm = hb_arrayGetItemPtr( pClass->pClassDatas, pInitData->uiData ); + /* do not initialize it again */ + pInitData->uiType = HB_OO_MSG_INITIALIZED; } - else if( pMeth->pFuncSym == &s___msgGetData ) /* is a DATA but not herited */ - { - PHB_ITEM pInit = hb_itemClone( pMeth->pInitValue ); + else + pDestItm = NULL; - hb_arraySet( pSelf, pMeth->uiData, pInit ); + if( pDestItm ) + { + PHB_ITEM pInit = hb_itemClone( pInitData->pInitValue ); + hb_itemCopy( pDestItm, pInit ); hb_itemRelease( pInit ); } - else if( pMeth->pFuncSym == &s___msgGetShrData && !( pMeth->bClsDataInitiated ) ) - { - /* Init Shared Classdata as needed, we only need to init the first */ - /* not inherited classdata array where all shared will point to */ - PHB_ITEM pInit; - - pInit = hb_arrayGetItemPtr( pClass->pClassDatas, pMeth->uiData ); - if( HB_IS_NIL( pInit ) ) - { - pInit = hb_itemClone( pMeth->pInitValue ); - hb_arraySet( pClass->pClassDatas, pMeth->uiData, pInit ); - hb_itemRelease( pInit ); - pMeth->bClsDataInitiated = 1; - } - } + ++pInitData; } - ++pMeth; + while( --ui ); } - while( --ulLimit ); } return pSelf; @@ -1828,7 +1961,12 @@ HB_FUNC( __CLSMODMSG ) } else /* Modify METHOD */ { - pMethod->pFuncSym = hb_objFuncParam( 3 ); + PHB_SYMB pFuncSym = hb_objFuncParam( 3 ); + + if( pFuncSym == NULL ) + hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSADDMSG", 0 ); + else + pMethod->pFuncSym = pFuncSym; } } } @@ -1862,86 +2000,12 @@ HB_FUNC( __OBJGETCLSNAME ) */ HB_FUNC( __OBJHASMSG ) { - PHB_ITEM pObject = hb_param( 1, HB_IT_OBJECT ); - PHB_ITEM pString = hb_param( 2, HB_IT_STRING ); + PHB_DYNS pMessage = hb_objMsgParam( 2 ); - if( pObject && pString ) - { - hb_retl( hb_objHasMsg( pObject, pString->item.asString.value ) ); - } + if( pMessage ) + hb_retl( hb_objHasMessage( hb_param( 1, HB_IT_ANY ), pMessage ) ); else - { - /*hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJHASMSG", 0 );*/ - hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "__ObjHasMsg", HB_ERR_ARGS_BASEPARAMS ); - } -} - - -/* - * := __objClone( ) - * - * Clone an object. Note the similarity with aClone ;-) - */ -HB_FUNC( __OBJCLONE ) -{ - PHB_ITEM pSrcObject = hb_param( 1, HB_IT_OBJECT ); - PHB_ITEM pDstObject ; - - if( pSrcObject ) - { - pDstObject = hb_arrayClone( pSrcObject ); - hb_itemRelease( hb_itemReturn( pDstObject ) ); - } - else - { - hb_errRT_BASE( EG_ARG, 3001, NULL, "__OBJCLONE", 0 ); - } -} - -void hb_objSendMsg( PHB_ITEM pObject, char *sMsg, ULONG ulArg, ... ) -{ - hb_vmPushSymbol( hb_dynsymGet( sMsg )->pSymbol ); - hb_vmPush( pObject ); - if( ulArg ) - { - unsigned long i; - va_list ap; - - va_start( ap, ulArg ); - for( i = 0; i < ulArg; i++ ) - { - hb_vmPush( va_arg( ap, PHB_ITEM ) ); - } - va_end( ap ); - } - hb_vmSend( (USHORT) ulArg ); -} - -void hb_objSendMessage( PHB_ITEM pObject, PHB_DYNS pMsgSym, ULONG ulArg, ... ) -{ - if( pObject && pMsgSym ) - { - hb_vmPushSymbol( pMsgSym->pSymbol ); - hb_vmPush( pObject ); - - if( ulArg ) - { - unsigned long i; - va_list ap; - - va_start( ap, ulArg ); - for( i = 0; i < ulArg; i++ ) - { - hb_vmPush( va_arg( ap, PHB_ITEM ) ); - } - va_end( ap ); - } - hb_vmSend( (USHORT) ulArg ); - } - else - { - hb_errRT_BASE( EG_ARG, 3000, NULL, "__ObjSendMessage()", 0 ); - } + hb_errRT_BASE_SubstR( EG_ARG, 1099, NULL, "__OBJHASMSG", HB_ERR_ARGS_BASEPARAMS ); } /* @@ -1951,27 +2015,46 @@ void hb_objSendMessage( PHB_ITEM pObject, PHB_DYNS pMsgSym, ULONG ulArg, ... ) */ HB_FUNC( __OBJSENDMSG ) { - PHB_ITEM pObject = hb_param( 1, HB_IT_OBJECT ); - char * szMsg = hb_parc( 2 ); + PHB_DYNS pMessage = hb_objMsgParam( 2 ); - if( pObject && szMsg && *szMsg ) /* Object & message passed */ + if( pMessage ) { USHORT uiPCount = hb_pcount(); USHORT uiParam; - hb_vmPushSymbol( hb_dynsymGet( szMsg )->pSymbol ); /* Push message symbol */ - hb_vmPush( pObject ); /* Push object */ + hb_vmPushSymbol( pMessage->pSymbol ); /* Push message symbol */ + hb_vmPush( hb_param( 1, HB_IT_ANY ) ); /* Push object */ for( uiParam = 3; uiParam <= uiPCount; ++uiParam ) /* Push arguments on stack */ { - hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); + hb_vmPush( hb_stackItemFromBase( uiParam ) ); } - hb_vmSend( ( USHORT ) ( uiPCount - 2 ) ); /* Execute message */ } else { - hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJSENDMSG", 0 ); + hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJSENDMSG", HB_ERR_ARGS_BASEPARAMS ); + } +} + +/* + * := __objClone( ) + * + * Clone an object. Note the similarity with aClone ;-) + */ +HB_FUNC( __OBJCLONE ) +{ + PHB_ITEM pSrcObject = hb_param( 1, HB_IT_OBJECT ); + PHB_ITEM pDstObject; + + if( pSrcObject ) + { + pDstObject = hb_arrayClone( pSrcObject ); + hb_itemRelease( hb_itemReturn( pDstObject ) ); + } + else + { + hb_errRT_BASE( EG_ARG, 3001, NULL, "__OBJCLONE", 0 ); } } @@ -1997,6 +2080,7 @@ HB_FUNC( __CLSINSTSUPER ) hb_vmPushNil(); hb_vmFunction( 0 ); /* Execute super class */ + /* TODO: optimize this function */ if( HB_IS_OBJECT( hb_stackReturnItem() ) ) { for( uiClass = 0; ! bFound && uiClass < s_uiClasses; uiClass++ ) @@ -2129,7 +2213,7 @@ HB_FUNC( __CLASSSEL ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); PMETHOD pMethod = pClass->pMethods; - ULONG ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS, ulPos = 0; + ULONG ulLimit = hb_clsMthNum( pClass ), ulPos = 0; hb_arrayNew( pReturn, pClass->uiMethods ); /* Create a transfer array */ @@ -2266,7 +2350,7 @@ static HARBOUR hb___msgClsSel( void ) PHB_ITEM pReturn = hb_itemNew( NULL ); PCLASS pClass = s_pClasses + ( uiClass - 1 ); PMETHOD pMethod = pClass->pMethods; - ULONG ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS, ulPos = 0; + ULONG ulLimit = hb_clsMthNum( pClass ), ulPos = 0; USHORT nParam; nParam = hb_pcount() > 0 ? ( USHORT ) hb_parni( 1 ) : HB_MSGLISTALL; @@ -2303,7 +2387,7 @@ static HARBOUR hb___msgClsSel( void ) } while( --ulLimit && ulPos < ( ULONG ) pClass->uiMethods ); - if( ulPos < pClass->uiMethods ) + if( ulPos < ( ULONG ) pClass->uiMethods ) hb_arraySize( pReturn, ulPos ); hb_itemRelease( hb_itemReturn( pReturn ) ); } @@ -2329,36 +2413,22 @@ static HARBOUR hb___msgClass( void ) */ static HARBOUR hb___msgClsParent( void ) { - PHB_ITEM pItemRef; - PHB_ITEM pItemParam; - char * szParentName = 0; - USHORT uiClass, i; - BOOL lClass=FALSE; + char * szParentName = NULL; + PHB_ITEM pItem; + USHORT uiClass; - if( HB_IS_BYREF( hb_stackSelfItem() ) ) /* Variables by reference */ - pItemRef = hb_itemUnRef( hb_stackSelfItem() ); - else - pItemRef = hb_stackSelfItem(); + uiClass = hb_stackBaseItem()->item.asSymbol.stackstate->uiClass; + pItemParam = hb_param( 1, HB_IT_ANY ); - uiClass = pItemRef->item.asArray.value->uiClass; - - pItemParam = hb_stackItemFromBase( 1 ); - - if( HB_IS_OBJECT( pItemParam ) ) - szParentName = hb_objGetClsName( pItemParam ); - else if( HB_IS_STRING( pItemParam ) ) + if( pItemParam ) { - szParentName = hb_itemGetC( pItemParam ); - lClass=TRUE; + if( HB_IS_OBJECT( pItemParam ) ) + szParentName = hb_objGetClsName( pItemParam ); + else if( HB_IS_STRING( pItemParam ) ) + szParentName = hb_parc( pItemParam ); } - for( i = 0; szParentName[ i ] != '\0'; i++ ) - szParentName[ i ] = ( char ) toupper( szParentName[ i ] ); - - hb_retl( hb_clsIsParent( uiClass , szParentName ) ); - - if (lClass) - hb_itemFreeC( szParentName ); + hb_retl( szParentName && hb_clsIsParent( uiClass , szParentName ) ); } #endif @@ -2520,7 +2590,7 @@ static HARBOUR hb___msgGetShrData( void ) if( uiSprCls && uiSprCls <= s_uiClasses ) { hb_arrayGet( s_pClasses[ uiSprCls - 1 ].pClassDatas, - pMethod->uiDataShared, hb_stackReturnItem() ); + pMethod->uiData, hb_stackReturnItem() ); } } @@ -2542,7 +2612,7 @@ static HARBOUR hb___msgSetShrData( void ) if( uiSprCls && uiSprCls <= s_uiClasses ) { hb_arraySet( s_pClasses[ uiSprCls - 1 ].pClassDatas, - pMethod->uiDataShared, pReturn ); + pMethod->uiData, pReturn ); } hb_itemReturn( pReturn ); @@ -2562,10 +2632,6 @@ static HARBOUR hb___msgGetData( void ) hb_stackBaseItem()->item.asSymbol.stackstate->uiMethod; ULONG ulIndex = pMethod->uiData + pObject->item.asArray.superoffset; - /* TOFIX: this code does not work correctly when super casting is used - for classes with multiinheritance - to ulIndex we should add additional - variable uiSuperInstantOffset, [druzus] */ - /* will arise only if the class has been modified after first instance */ if( ulIndex > hb_arrayLen( pObject ) ) /* Resize needed */ hb_arraySize( pObject, ulIndex ); /* Make large enough */ @@ -2588,10 +2654,6 @@ static HARBOUR hb___msgSetData( void ) hb_stackBaseItem()->item.asSymbol.stackstate->uiMethod; ULONG ulIndex = pMethod->uiData + pObject->item.asArray.superoffset; - /* TOFIX: this code does not work correctly when super casting is used - for classes with multiinheritance - to ulIndex we should add additional - variable uiSuperInstantOffset, [druzus] */ - /* will arise only if the class has been modified after first instance */ if( ulIndex > hb_arrayLen( pObject ) ) /* Resize needed ? */ hb_arraySize( pObject, ulIndex ); /* Make large enough */ @@ -2716,14 +2778,14 @@ HB_FUNC( __CLSGETPROPERTIES ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); PMETHOD pMethod = pClass->pMethods; - ULONG ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS; + ULONG ulLimit = hb_clsMthNum( pClass ); PHB_ITEM pItem = NULL; hb_arrayNew( pReturn, 0 ); do { - if( pMethod->pMessage && pMethod->bIsPersistent ) /* Hash Entry used ? */ + if( pMethod->pMessage && ( pMethod->uiScope & HB_OO_CLSTP_PERSIST ) ) { pItem = hb_itemPutC( pItem, pMethod->pMessage->pSymbol->szName ); hb_arrayAdd( pReturn, pItem ); @@ -2795,57 +2857,3 @@ void hb_clsAssociate( USHORT usClassH ) hb_vmPushLong( usClassH ); hb_vmFunction( 1 ); } - -HB_FUNC( HB_CLSSTAT ) -{ - PCLASS pClass; - PMETHOD pMethod; - USHORT uiClass, ui, uiCnt, uiCntMax; - ULONG ulLimit; - PHB_ITEM pArray, pClsItm, pStat; - int piStat[ BUCKETSIZE ]; - - pArray = hb_itemArrayNew( s_uiClasses ); - for( uiClass = 0; uiClass < s_uiClasses; ++uiClass ) - { - pClass = s_pClasses + uiClass; - pMethod = pClass->pMethods; - ulLimit = ( ULONG ) pClass->uiHashKey << BUCKETBITS; - - pClsItm = hb_arrayGetItemPtr( pArray, uiClass + 1 ); - hb_arrayNew( pClsItm, 6 ); - hb_itemPutC( hb_arrayGetItemPtr( pClsItm, 1 ), pClass->szName ); - hb_itemPutNI( hb_arrayGetItemPtr( pClsItm, 2 ), pClass->uiMethods ); - hb_itemPutNI( hb_arrayGetItemPtr( pClsItm, 3 ), ulLimit ); - hb_itemPutNI( hb_arrayGetItemPtr( pClsItm, 4 ), sizeof( METHOD ) ); - pStat = hb_arrayGetItemPtr( pClsItm, 6 ); - hb_arrayNew( pStat, BUCKETSIZE + 1 ); - for( ui = 0; ui <= BUCKETSIZE; ++ui ) - piStat[ ui ] = 0; - uiCntMax = 0; - do - { - uiCnt = 0; - ui = BUCKETSIZE; - - do - { - if( pMethod->pMessage ) - ++uiCnt; - ++pMethod; - --ulLimit; - } - while( --ui ); - - piStat[ uiCnt ]++; - if( uiCnt > uiCntMax ) - uiCntMax = uiCnt; - } - while( ulLimit ); - - hb_itemPutNI( hb_arrayGetItemPtr( pClsItm, 5 ), uiCntMax ); - for( ui = 0; ui <= BUCKETSIZE; ++ui ) - hb_itemPutNI( hb_arrayGetItemPtr( pStat, ui + 1 ), piStat[ ui ] ); - } - hb_itemRelease( hb_itemReturn( pArray ) ); -} diff --git a/harbour/source/vm/dynsym.c b/harbour/source/vm/dynsym.c index d74f8c13f3..32cd66b3f3 100644 --- a/harbour/source/vm/dynsym.c +++ b/harbour/source/vm/dynsym.c @@ -156,7 +156,7 @@ HB_EXPORT PHB_DYNS hb_dynsymNew( PHB_SYMB pSymbol ) /* creates a new dynamic s_uiDynSymbols++; /* Got one more symbol */ pDynSym->pSymbol = pSymbol; pDynSym->hMemvar = 0; - pDynSym->hArea = 0; + pDynSym->uiArea = 0; pDynSym->uiSymNum = s_uiDynSymbols; #ifndef HB_NO_PROFILER pDynSym->ulCalls = 0; /* profiler support */ @@ -369,18 +369,18 @@ HB_EXPORT HB_HANDLE hb_dynsymMemvarHandle( PHB_DYNS pDynSym ) return pDynSym->hMemvar; } -HB_EXPORT HB_HANDLE hb_dynsymAreaHandle( PHB_DYNS pDynSym ) +HB_EXPORT int hb_dynsymAreaHandle( PHB_DYNS pDynSym ) { HB_TRACE(HB_TR_DEBUG, ("hb_dynsymAreaHandle(%p)", pDynSym)); - return pDynSym->hArea; + return pDynSym->uiArea; } HB_EXPORT void hb_dynsymSetAreaHandle( PHB_DYNS pDynSym, int iArea ) { HB_TRACE(HB_TR_DEBUG, ("hb_dynsymSetAreaHandle(%p,%d)", pDynSym, iArea)); - pDynSym->hArea = iArea; + pDynSym->uiArea = ( USHORT ) iArea; } void hb_dynsymEval( PHB_DYNS_FUNC pFunction, void * Cargo ) diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 7549bf28d0..eb0c3c66e6 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -1570,6 +1570,8 @@ PHB_ITEM hb_itemUnShare( PHB_ITEM pItem ) /* clone the given item */ HB_EXPORT PHB_ITEM hb_itemClone( PHB_ITEM pItem ) { + HB_TRACE_STEALTH(HB_TR_DEBUG, ("hb_itemClone(%p)", pItem)); + if( HB_IS_ARRAY( pItem ) ) { return hb_arrayClone( pItem );