/* * $Id$ */ /* * Harbour Project source code: * Base-routines for OOPS system * * Copyright 1999 Antonio Linares * 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 of the License, or * (at your option) any later version, with one exception: * * The exception is that if you link the Harbour Runtime Library (HRL) * and/or the Harbour Virtual Machine (HVM) 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 HRL * and/or HVM code into it. * * 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 program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit * their web site at http://www.gnu.org/). * */ /* * The following parts are Copyright of the individual authors. * www - http://www.harbour-project.org * * Copyright 1999 Eddie Runia * :CLASSSEL() * __clsDelMsg() * __clsModMsg() * __clsInstSuper() * __cls_CntClsData() * __cls_CntData() * __cls_DecData() * __cls_IncData() * __objClone() * __objHasMsg() * __objSendMsg() * * Copyright 1999 Victor Szakats * hb___msgEval() * HB___CLASSNEW() * HB___CLASSINSTANCE() * HB___CLASSADD() * HB___CLASSNAME() * HB___CLASSSEL() (based on hb___msgClsSel()) * * Copyright 1999 Janica Lubos * hb_clsDictRealloc() * * Copyright 2000 JF. Lefebvre & RA. Cuylen * Now support of shared and not shared class data * Multiple inheritence fully implemented * Multiple datas declaration fully supported * Super msg correctly respond by a super object * Scoping : working for protected, hidden and readonly * Define of HB_MASKHIDDEN allow subclass to not inherit of hidden message * This implie a message not found error in place of protection error hidden * * hb___msgGetShrData() * hb___msgSetShrData() * hb___msgClsParent() * __Cls_Param() * __Cls_MsgToNum() // New Hashing method to allow a better use of buckets * __IsClsParent() * __Cls_Scope() * HBFUNC( SENDER ) // Work in progress * * See doc/license.txt for licensing terms. */ #include "hbapi.h" #include "hbapierr.h" #include "hbapiitm.h" #include "hbvm.h" #include "hboo.ch" #include #include //for debug... typedef struct { PHB_DYNS pMessage; // Method Symbolic name PHB_FUNC pFunction; // Function 'pointer' USHORT uiData; // Item position for data (Harbour like, begin from 1) USHORT uiDataShared; // Item position for datashared (C like, begin from 0) USHORT uiSprClass; // Originalclass'handel (super or current class'handel if not herited). USHORT uiScope; // Scoping value PHB_ITEM pInitValue; // Item Value and value for data (could be initiated by INIT KeyWord) BYTE bClsDataInitiated; // There is one value assigned at init time } METHOD, * PMETHOD; 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 USHORT uiHashKey; USHORT uiDatasShared; // Total shared Class data within Class data PHB_ITEM pClassDatas; /* Harbour Array for ClassDatas and shared */ PHB_ITEM * pSharedDatas; /* C Array for ClassDatas Shared Item pointer (hb_Alloc of pointer) */ //Added by RAC&JF /* This is _NOT_ a Harbour array*/ PHB_ITEM pInlines; /* Array for inline codeblocks */ PHB_FUNC pFunError; /* error handler for not defined messages */ } CLASS, * PCLASS; #define BASE_METHODS 255 //starting maximum number of message #define BUCKET 5 #define HASH_KEY ( BASE_METHODS / BUCKET ) //Idealy, here we want a "nombre premier" static PCLASS s_pClasses = NULL; static USHORT s_uiClasses = 0; static PMETHOD s_pMethod = NULL; /* TOFIX: The object engine is not thread safe because of this. [vszakats] */ static PHB_DYNS s_msgClassName = NULL; static PHB_DYNS s_msgClassH = NULL; static PHB_DYNS s_msgEval = NULL; static PHB_DYNS s_msgClassSel = NULL; static PHB_DYNS s_msgClsParent = NULL; /* All functions contained in classes.c */ static void hb_clsDictRealloc( PCLASS pClass ); static void hb_clsRelease( PCLASS ); void hb_clsReleaseAll( void ); char * hb_objGetClsName( PHB_ITEM pObject ); PHB_FUNC hb_objGetMethod( PHB_ITEM, PHB_SYMB ); ULONG hb_objHasMsg( PHB_ITEM pObject, char *szString ); void hb_clsScope( PHB_ITEM pObject, PMETHOD pMethod ); //Added by RAC&JF unsigned __Cls_MsgToNum( PHB_DYNS pMsg ); //Added by RAC&JF USHORT __IsClsParent( PCLASS pClass, char * szParentName ); //Added by RAC&JF static HARBOUR hb___msgClsH( void ); static HARBOUR hb___msgClsName( void ); static HARBOUR hb___msgClsSel( void ); static HARBOUR hb___msgSuper( void ); static HARBOUR hb___msgEvalInline( void ); static HARBOUR hb___msgClsParent( void ); //Added by RaC&JfL static HARBOUR hb___msgEval( void ); static HARBOUR hb___msgVirtual( void ); static HARBOUR hb___msgGetClsData( void ); static HARBOUR hb___msgSetClsData( void ); static HARBOUR hb___msgGetShrData( void ); //Added by RAC&JF static HARBOUR hb___msgSetShrData( void ); //Added by RAC&JF static HARBOUR hb___msgGetData( void ); static HARBOUR hb___msgSetData( void ); /* ================================================ */ /* Modified by RaC&JfL * hb_clsDictRealloc( PCLASS ) * * Realloc (widen) class */ static void hb_clsDictRealloc( PCLASS pClass ) { HB_TRACE(HB_TR_DEBUG, ("hb_clsDictRealloc(%p)", pClass)); if( pClass ) { PMETHOD pNewMethods; USHORT uiNewHashKey = pClass->uiHashKey; USHORT ui, uiLimit = pClass->uiHashKey * BUCKET; USHORT nOccurs = 1; while( nOccurs != 0 ) { uiNewHashKey += HASH_KEY ; pNewMethods = ( PMETHOD ) hb_xgrab( uiNewHashKey * BUCKET * sizeof( METHOD ) ); memset( pNewMethods, 0, uiNewHashKey * BUCKET * sizeof( METHOD ) ); for( ui = 0; ui < uiLimit; ui++ ) { PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ ui ].pMessage; if( pMessage ) { USHORT uiBucket; USHORT uiAt = ( __Cls_MsgToNum( pMessage ) % uiNewHashKey ) * BUCKET; for( uiBucket = 0; uiBucket < BUCKET ; uiBucket++ ) { if( pNewMethods[ uiAt+uiBucket ].pMessage == 0) //this message position is empty { memcpy(pNewMethods + ( uiAt+uiBucket ), pClass->pMethods + ui, sizeof( METHOD ) ); break; } } // Not enough go back to the beginning if( uiBucket >= BUCKET && nOccurs++ <= 5) { hb_xfree( pNewMethods ); break; } else if ( nOccurs <= 5 ) nOccurs = 0; else hb_errInternal( 9999, "Not able to realloc classmessage! __clsDictRealloc", NULL, NULL ); } } } pClass->uiHashKey = uiNewHashKey; hb_xfree( pClass->pMethods ); pClass->pMethods = pNewMethods; } } /* * hb_clsRelease( ) * * Release a class from memory */ static void hb_clsRelease( PCLASS pClass ) { USHORT uiAt; USHORT uiLimit = pClass->uiHashKey * BUCKET; PMETHOD pMeth = pClass->pMethods; HB_TRACE(HB_TR_DEBUG, ("hb_clsRelease(%p)", pClass)); for( uiAt = 0; uiAt < uiLimit; uiAt++, pMeth++ ) /* Release initializers */ { if( pMeth->pInitValue ) hb_itemRelease( pMeth->pInitValue ); } hb_xfree( pClass->szName ); hb_xfree( pClass->pMethods ); if( pClass->pSharedDatas ) //Added by RAC&JF hb_xfree( pClass->pSharedDatas ); // At least one shared data exist hb_itemRelease( pClass->pClassDatas ); hb_itemRelease( pClass->pInlines ); } /* * hb_clsReleaseAll() * * Release all classes */ void hb_clsReleaseAll( void ) { USHORT uiClass; HB_TRACE(HB_TR_DEBUG, ("hb_clsReleaseAll()")); for( uiClass = 0; uiClass < s_uiClasses; uiClass++ ) hb_clsRelease( s_pClasses + uiClass ); if( s_pClasses ) hb_xfree( s_pClasses ); } /* ================================================ */ /* * = ( pObject ) * * Get the class name of an object * */ char * hb_objGetClsName( PHB_ITEM pObject ) { char * szClassName; HB_TRACE(HB_TR_DEBUG, ("hb_objGetClsName(%p)", pObject)); if( HB_IS_ARRAY( pObject ) ) { if( ! pObject->item.asArray.value->uiClass ) szClassName = "ARRAY"; else szClassName = ( s_pClasses + pObject->item.asArray.value->uiClass - 1 )->szName; } else /* built in types */ { switch( pObject->type ) { case HB_IT_NIL: szClassName = "NIL"; break; case HB_IT_STRING: szClassName = "CHARACTER"; break; case HB_IT_BLOCK: szClassName = "BLOCK"; break; case HB_IT_SYMBOL: szClassName = "SYMBOL"; break; case HB_IT_DATE: szClassName = "DATE"; break; case HB_IT_INTEGER: case HB_IT_LONG: case HB_IT_DOUBLE: szClassName = "NUMERIC"; break; case HB_IT_LOGICAL: szClassName = "LOGICAL"; break; default: szClassName = "UNKNOWN"; break; } } return szClassName; } /* * = hb_objGetMethod( , ) * * Internal function to the function pointer of a message of an object */ PHB_FUNC hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage ) { USHORT uiClass; PHB_DYNS pMsg = pMessage->pDynSym; char Tmp[255]; HB_TRACE(HB_TR_DEBUG, ("hb_objGetMethod(%p, %p)", pObject, pMessage)); if( pObject->type == HB_IT_ARRAY ) uiClass = pObject->item.asArray.value->uiClass; else uiClass = 0; if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiAt = ( ( __Cls_MsgToNum( pMsg ) ) % pClass->uiHashKey ) * BUCKET; USHORT uiMask = pClass->uiHashKey * BUCKET; USHORT uiLimit = uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ); s_pMethod = NULL; /* Current method pointer */ while( uiAt != uiLimit ) { if( pClass->pMethods[ uiAt ].pMessage == pMsg ) { s_pMethod = pClass->pMethods + uiAt; hb_clsScope( pObject, s_pMethod ); //Added by RAC&JF return s_pMethod->pFunction; } uiAt++; if( uiAt == uiMask ) uiAt = 0; } } // JfL&RaC say : //bad method, we should always inherit by default from one generic superobject //wich then should know those methods ! TBD if( s_msgClassName == NULL ) { s_msgClassName = hb_dynsymGet( "CLASSNAME" ); /* Standard messages */ s_msgClassH = hb_dynsymGet( "CLASSH" ); /* Not present in classdef. */ s_msgClassSel = hb_dynsymGet( "CLASSSEL" ); s_msgEval = hb_dynsymGet( "EVAL" ); s_msgClsParent = hb_dynsymGet( "ISDERIVEDFROM" ); } if( pMsg == s_msgClassName ) return hb___msgClsName; else if( pMsg == s_msgClassH ) return hb___msgClsH; else if( pMsg == s_msgClassSel ) return hb___msgClsSel; else if( pMsg == s_msgEval ) return hb___msgEval; else if( pMsg == s_msgClsParent ) return hb___msgClsParent; if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); if( pClass->pFunError ) return pClass->pFunError; } return NULL; } /* * = hb_objHasMsg( , ) * * Check whether is an existing message for object. * * should be read as a boolean */ ULONG 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 ( ULONG ) hb_objGetMethod( pObject, pDynSym->pSymbol ); else return 0; } /* Get funcptr of message */ /* ================================================ */ /* * __clsAddMsg( , , , , [xInit], ) * * Add a message to the class. * * Class handle * Message * HB_OO_MSG_METHOD : Pointer to function * HB_OO_MSG_DATA : Index number in array * HB_OO_MSG_CLASSDATA : Index number in array * HB_OO_MSG_INLINE : Code block * HB_OO_MSG_SUPER : Handle of super class * see HB_OO_MSG_* * Optional initializer for DATA * Added by RAC&JF * HBCLSTP_EXPORTED 1 : default for data and method * HBCLSTP_PROTECTED 2 : method or data protected * HBCLSTP_HIDDEN 4 : method or data hidden * HBCLSTP_CTOR 8 : method constructor * HBCLSTP_READONLY 16 : data read only * HBCLSTP_SHARED 32 : (method or) data shared * HBCLSTP_CLASS 64 : message is the name of a superclass * HBCLSTP_SUPER 128 : message is herited */ HB_FUNC( __CLSADDMSG ) { USHORT uiClass = hb_parni( 1 ); USHORT uiScope = 1 ; // 1 = exported (default) ; Added by RAC&JF //Added by RAC&JF if( hb_pcount() == 6 && ISNUM( 6 ) ) uiScope = hb_parni( 6 ); if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); PHB_DYNS pMessage = hb_dynsymGet( hb_parc( 2 ) ); PHB_ITEM pSprObj ; USHORT wType = hb_parni( 4 ); USHORT uiAt = ( ( __Cls_MsgToNum( pMessage ) ) % pClass->uiHashKey ) * BUCKET; USHORT uiMask = pClass->uiHashKey * BUCKET; PMETHOD pNewMeth; if( wType == HB_OO_MSG_INLINE && hb_param( 3, HB_IT_BLOCK ) == NULL ) { hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSADDMSG" ); } if( pClass->uiMethods > ( pClass->uiHashKey * BUCKET * 2/3 ) ) hb_clsDictRealloc( pClass ); /* Find either the existing message or an open spot for a new message */ while( pClass->pMethods[ uiAt ].pMessage && ( pClass->pMethods[ uiAt ].pMessage != pMessage ) ) uiAt = ( uiAt == uiMask ) ? 0 : uiAt + 1; pNewMeth = pClass->pMethods + uiAt; if( !pNewMeth->pMessage ) { pNewMeth->pMessage = pMessage; pClass->uiMethods++; /* One more message */ } pNewMeth->uiSprClass = uiClass; //Added by RaC&JfL not yet used switch( wType ) { case HB_OO_MSG_METHOD: pNewMeth->pFunction = ( PHB_FUNC ) hb_parnl( 3 ); pNewMeth->uiScope = uiScope; break; case HB_OO_MSG_DATA: pNewMeth->uiData = ( USHORT ) hb_parnl( 3 ); pNewMeth->uiScope = uiScope; if( pMessage->pSymbol->szName[ 0 ] == '_' ) pNewMeth->pFunction = hb___msgSetData; else { PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); pNewMeth->pFunction = hb___msgGetData; if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ { if( HB_IS_ARRAY( pInit ) ) pNewMeth->pInitValue = hb_arrayClone( pInit ); else { pNewMeth->pInitValue = hb_itemNew( NULL ); hb_itemCopy( pNewMeth->pInitValue, pInit ); } } } break; case HB_OO_MSG_CLASSDATA: pNewMeth->uiData = ( USHORT ) hb_parnl( 3 ); pNewMeth->uiScope = uiScope; //Modified by RAC&JF if( ( pNewMeth->uiScope & HBCLSTP_SHARED ) != HBCLSTP_SHARED ) { if( ( USHORT ) hb_arrayLen( pClass->pClassDatas ) < pNewMeth->uiData ) { hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); } if( pMessage->pSymbol->szName[ 0 ] == '_' ) pNewMeth->pFunction = hb___msgSetClsData; else { PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); pNewMeth->pFunction = hb___msgGetClsData; if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ { if( HB_IS_ARRAY( pInit ) ) pNewMeth->pInitValue = hb_arrayClone( pInit ); else { pNewMeth->pInitValue = hb_itemNew( NULL ); hb_itemCopy( pNewMeth->pInitValue, pInit ); } } } } else { if( ( USHORT ) hb_arrayLen( pClass->pClassDatas ) < pNewMeth->uiData ) { PHB_ITEM pTmpItemPtr; hb_arraySize( pClass->pClassDatas, pNewMeth->uiData ); //Get a copy of the item pointer (not the value!) pTmpItemPtr = hb_arrayGetItemPtr( pClass->pClassDatas, pNewMeth->uiData ); pClass->uiDatasShared++; // Alloc or realloc PtrArray if( pClass->pSharedDatas ) pClass->pSharedDatas = ( PHB_ITEM * ) hb_xrealloc( pClass->pSharedDatas, pClass->uiDatasShared * sizeof( PHB_ITEM ) ); else pClass->pSharedDatas = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) ); // Store the C array offset pNewMeth->uiDataShared = pClass->uiDatasShared - 1; // Now store the Ptr itself pClass->pSharedDatas[ pNewMeth->uiDataShared ] = ( PHB_ITEM ) pTmpItemPtr ; } if( pMessage->pSymbol->szName[ 0 ] == '_' ) pNewMeth->pFunction = hb___msgSetShrData; else { PHB_ITEM pInit = hb_param( 5, HB_IT_ANY ); pNewMeth->pFunction = hb___msgGetShrData; if( pInit && ! HB_IS_NIL( pInit ) ) /* Initializer found */ { if( HB_IS_ARRAY( pInit ) ) pNewMeth->pInitValue = hb_arrayClone( pInit ); else { pNewMeth->pInitValue = hb_itemNew( NULL ); hb_itemCopy( pNewMeth->pInitValue, pInit ); } } } } break; case HB_OO_MSG_INLINE: 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 ) ); pNewMeth->pFunction = hb___msgEvalInline; break; case HB_OO_MSG_VIRTUAL: pNewMeth->pFunction = hb___msgVirtual; break; case HB_OO_MSG_SUPER: pSprObj = hb_itemParam( 5 ); pNewMeth->uiData = ( USHORT ) hb_parnl( 3 ); pNewMeth->pInitValue= pSprObj; // store the super object pNewMeth->uiScope = uiScope; pNewMeth->pFunction = hb___msgSuper; break; case HB_OO_MSG_ONERROR: pClass->pFunError = ( PHB_FUNC ) hb_parnl( 2 ); break; default: hb_errInternal( IE_CLSINVMETHOD, NULL, "__clsAddMsg", NULL ); break; } } } /* //Modified by RAC&JF * := __clsNew( , , [ahSuper] ) * * Create a new class * * Name of the class * Number of DATAs in the class * Optional handle(s) of superclass(es) */ HB_FUNC( __CLSNEW ) { PCLASS pNewCls; PMETHOD pMeth; USHORT uiSize; //Added by JF&RAC PHB_ITEM pSrc, pDst, pahSuper; USHORT i, uiSuper; pahSuper = hb_itemParam( 3 ); /* Replace the initial uiSuper */ uiSuper = hb_itemSize( pahSuper ); /* Number of Super class present */ if( s_pClasses ) s_pClasses = ( PCLASS ) hb_xrealloc( s_pClasses, sizeof( CLASS ) * ( s_uiClasses + 1 ) ); else s_pClasses = ( PCLASS ) hb_xgrab( sizeof( CLASS ) ); pNewCls = s_pClasses + s_uiClasses; pNewCls->szName = ( char * ) hb_xgrab( hb_parclen( 1 ) + 1 ); memset(pNewCls->szName,0,hb_parclen( 1 ) + 1); strcpy( pNewCls->szName, hb_parc( 1 ) ); pNewCls->uiDataFirst = 0; pNewCls->uiMethods = 0; pNewCls->uiDatasShared = 0; if( uiSuper ) { for( i = 1; i <= uiSuper; i++ ) { PHB_DYNS pMsg; PHB_ITEM pSuper; PHB_ITEM pClsAnyTmp, pClsNewTmp; USHORT nSuper; USHORT nLen, nLenShrDatas, nLenClsDatas, nLenInlines; USHORT ui, uiAt, uiLimit; PCLASS pSprCls; pSuper = hb_itemNew( NULL ); hb_arrayGet( pahSuper, i , pSuper); nSuper = hb_itemGetNL( pSuper ); pSprCls = s_pClasses + ( nSuper - 1 ); uiLimit = pSprCls->uiHashKey * BUCKET; hb_itemRelease( pSuper ); pNewCls->uiDataFirst += pSprCls->uiDatas; pNewCls->uiDatas = pNewCls->uiDataFirst + hb_parni( 2 ); if( i == 1 ) // This is the first superclass { pNewCls->uiHashKey = pSprCls->uiHashKey; // CLASS DATA Not Shared ( new array, new value ) pNewCls->pClassDatas = hb_arrayClone( pSprCls->pClassDatas ); pNewCls->pSharedDatas = 0; if( pSprCls->pSharedDatas ) { pNewCls->pSharedDatas = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) * pSprCls->uiDatasShared ); pNewCls->uiDatasShared = pSprCls->uiDatasShared; hb_xmemcpy( pNewCls->pSharedDatas, pSprCls->pSharedDatas, sizeof( PHB_ITEM ) * pSprCls->uiDatasShared ); } pNewCls->pInlines = hb_arrayClone( pSprCls->pInlines ); nLenShrDatas = 0 ; // In fact, this is really previous len nLenClsDatas = 0 ; // so we have to init it to 0 for the first nLenInlines = 0 ; // SuperClass, they will add an offset to the array pos } else { USHORT nLenNew, nLenSpr; PHB_ITEM pTmp; ULONG ulLen; ULONG ulPos; // Ok add now the previous len to the offset nLenShrDatas += pNewCls->uiDatasShared; nLenClsDatas += hb_itemSize( pNewCls->pClassDatas ) ; nLenInlines += hb_itemSize( pNewCls->pInlines ) ; //ClassDatas pClsAnyTmp = hb_arrayClone( pSprCls->pClassDatas ); nLen = hb_itemSize( pClsAnyTmp ); for( ui = 1; ui <= nLen; ui++ ) { PHB_ITEM pTmp = hb_itemNew(NULL); hb_arrayGet( pClsAnyTmp, ui, pTmp ); hb_arrayAdd( pNewCls->pClassDatas , pTmp ); hb_itemRelease( pTmp ); } hb_itemRelease( pClsAnyTmp ); //SharedDatas if( pSprCls->uiDatasShared ) if( pNewCls->pSharedDatas ) { pNewCls->pSharedDatas = ( PHB_ITEM * ) hb_xrealloc( pNewCls->pSharedDatas, pSprCls->uiDatasShared * sizeof( PHB_ITEM ) ); hb_xmemcpy(pNewCls->pSharedDatas + pNewCls->uiDatasShared , pSprCls->pSharedDatas , pSprCls->uiDatasShared * sizeof( PHB_ITEM ) ); pNewCls->uiDatasShared += pSprCls->uiDatasShared; } else { pNewCls->pSharedDatas = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) * pSprCls->uiDatasShared ); pNewCls->uiDatasShared = pSprCls->uiDatasShared; hb_xmemcpy( pNewCls->pSharedDatas, pSprCls->pSharedDatas, sizeof( PHB_ITEM ) * pSprCls->uiDatasShared ); } //Inlines pClsAnyTmp = hb_arrayClone( pSprCls->pInlines ); nLen = hb_itemSize( pClsAnyTmp ); for( ui = 1; ui <= nLen; ui++ ) { PHB_ITEM pTmp = hb_itemNew(NULL); hb_arrayGet( pClsAnyTmp, ui, pTmp ); hb_arrayAdd( pNewCls->pInlines , pTmp ); hb_itemRelease( pTmp ); } hb_itemRelease( pClsAnyTmp ); } if( ( pNewCls->uiMethods + 1 ) > ( pNewCls->uiHashKey * BUCKET * 2/3 ) ) hb_clsDictRealloc( pNewCls ); if( i == 1 ) { uiSize = pNewCls->uiHashKey * BUCKET * sizeof( METHOD ); pNewCls->pMethods = ( PMETHOD ) hb_xgrab( uiSize ); memset( pNewCls->pMethods, 0, uiSize ); pNewCls->pFunError = pSprCls->pFunError; } for( ui = 0; ui < uiLimit; ui++ ) { USHORT uiBucket; pMsg = ( PHB_DYNS ) pSprCls->pMethods[ ui ].pMessage; if( pMsg ) { uiAt = ( ( __Cls_MsgToNum( pMsg ) ) % pNewCls->uiHashKey ) * BUCKET; //here we are exactly the position for this message in the newcls for( uiBucket = 0; uiBucket < BUCKET ; uiBucket++ ) { if( ( pSprCls->pMethods[ ui ].uiScope & HBCLSTP_CLASS ) == HBCLSTP_CLASS ) break; #ifdef HB_MASKHIDDEN // no hidden methods allowed by the inheritence. if( ( pSprCls->pMethods[ ui ].uiScope & HBCLSTP_HIDDEN ) == HBCLSTP_HIDDEN ) break; #endif if( pNewCls->pMethods[ uiAt+uiBucket ].pMessage == 0) //this message position is empty { // Now, we can increment the msg count pNewCls->uiMethods++; memcpy(pNewCls->pMethods + ( uiAt+uiBucket ), pSprCls->pMethods + ui, sizeof( METHOD ) ); if( pNewCls->pMethods[ uiAt+uiBucket ].pFunction == hb___msgSetClsData || pNewCls->pMethods[ uiAt+uiBucket ].pFunction == hb___msgGetClsData ) pNewCls->pMethods[ uiAt+uiBucket ].uiData += nLenClsDatas; if( pNewCls->pMethods[ uiAt+uiBucket ].pFunction == hb___msgSetShrData || pNewCls->pMethods[ uiAt+uiBucket ].pFunction == hb___msgGetShrData ) { pNewCls->pMethods[ uiAt+uiBucket ].uiData += nLenClsDatas; // in all case will never used pNewCls->pMethods[ uiAt+uiBucket ].uiDataShared += nLenShrDatas; } if( pNewCls->pMethods[ uiAt+uiBucket ].pFunction == hb___msgEvalInline ) pNewCls->pMethods[ uiAt+uiBucket ].uiData += nLenInlines; if( ( pSprCls->pMethods[ ui ].uiScope & HBCLSTP_SUPER ) != HBCLSTP_SUPER ) pNewCls->pMethods[ uiAt+uiBucket ].uiScope = pSprCls->pMethods[ uiAt ].uiScope + HBCLSTP_SUPER; else pNewCls->pMethods[ uiAt+uiBucket ].uiScope = pSprCls->pMethods[ uiAt ].uiScope; if( pSprCls->pMethods[ ui ].pInitValue ) { PHB_ITEM pInitValue ; if( HB_IS_ARRAY( pSprCls->pMethods[ ui ].pInitValue ) ) pNewCls->pMethods[ uiAt+uiBucket ].pInitValue = hb_arrayClone( pSprCls->pMethods[ ui ].pInitValue ); else { pInitValue = hb_itemNew( NULL ); hb_itemCopy( pInitValue, pSprCls->pMethods[ ui ].pInitValue ); pNewCls->pMethods[ uiAt+uiBucket ].pInitValue = pInitValue; } } break; } else if( pNewCls->pMethods[ uiAt+uiBucket ].pMessage->pSymbol->szName == pMsg->pSymbol->szName ) break; } } } } } else { pNewCls->uiDatas = hb_parni( 2 ); pNewCls->uiDataFirst = 0; pNewCls->pMethods = ( PMETHOD ) hb_xgrab( BASE_METHODS * sizeof( METHOD ) ); memset( pNewCls->pMethods, 0, BASE_METHODS * sizeof( METHOD ) ); pNewCls->uiMethods = 0; pNewCls->uiHashKey = HASH_KEY; pNewCls->pClassDatas = hb_itemArrayNew( 0 ); pNewCls->pSharedDatas = 0; //Added by RAC&JF pNewCls->pInlines = hb_itemArrayNew( 0 ); pNewCls->pFunError = NULL; } hb_itemRelease( pahSuper ); hb_retni( ++s_uiClasses ); } /* * __clsDelMsg( , ) * * Delete message (only for INLINE and METHOD) * * Object * Message */ HB_FUNC( __CLSDELMSG ) { USHORT uiClass = hb_parni( 1 ); PHB_ITEM pString = hb_param( 2, HB_IT_STRING ); if( uiClass && uiClass <= s_uiClasses && pString ) { PHB_DYNS pMsg = hb_dynsymFindName( pString->item.asString.value ); if( pMsg ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiMask = pClass->uiHashKey * BUCKET; USHORT uiAt = ( ( __Cls_MsgToNum( pMsg ) ) % pClass->uiHashKey ) * BUCKET; USHORT uiLimit = uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ); while( ( uiAt != uiLimit ) && ( pClass->pMethods[ uiAt ].pMessage && ( pClass->pMethods[ uiAt ].pMessage != pMsg ) ) ) { uiAt++; if( uiAt == uiMask ) uiAt = 0; } if( uiAt != uiLimit ) { /* Requested method found */ PHB_FUNC pFunc = pClass->pMethods[ uiAt ].pFunction; if( pFunc == hb___msgEvalInline ) /* INLINE method deleted */ { hb_arrayDel( pClass->pInlines, pClass->pMethods[ uiAt ].uiData ); /* Delete INLINE block */ } /* Move messages */ while( pClass->pMethods[ uiAt ].pMessage && uiAt != uiLimit ) { memcpy( pClass->pMethods + uiAt, pClass->pMethods + ( ( uiAt == uiMask ) ? 0 : uiAt + 1 ), sizeof( METHOD ) ); uiAt++; if( uiAt == uiMask ) uiAt = 0; } memset( pClass->pMethods + uiAt, 0, sizeof( METHOD ) ); pClass->uiMethods--; /* Decrease number messages */ } } } } /* * := __clsInst( ) * * Create a new object from class definition */ HB_FUNC( __CLSINST ) { USHORT uiClass = hb_parni( 1 ); if( uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiAt; USHORT uiLimit = pClass->uiHashKey * BUCKET; PMETHOD pMeth = pClass->pMethods; /* Initialize DATA */ hb_arrayNew( &hb_stack.Return, pClass->uiDatas ); hb_stack.Return.item.asArray.value->uiClass = uiClass; hb_stack.Return.item.asArray.value->uiPrevCls = 0; //Modified By RAC&JF for( uiAt = 0; uiAt < uiLimit; uiAt++, pMeth++ ) { if( pMeth->pInitValue && !( pMeth->bClsDataInitiated ) ) { if( ( pMeth->pFunction != hb___msgGetClsData ) && ( pMeth->pFunction != hb___msgGetShrData ) ) /* is a DATA */ { if( HB_IS_ARRAY( pMeth->pInitValue ) ) { PHB_ITEM pInitValue = hb_arrayClone( pMeth->pInitValue ); hb_itemArrayPut( &hb_stack.Return, pMeth->uiData, pInitValue ); hb_itemRelease( pInitValue ); } else hb_itemArrayPut( &hb_stack.Return, pMeth->uiData, pMeth->pInitValue ); } else if( pMeth->pFunction == hb___msgGetClsData ) /* it is a ClassData */ { HB_ITEM init; hb_arrayGet( pClass->pClassDatas, pMeth->uiData, &init ); if( init.type == HB_IT_NIL ) { hb_arraySet( pClass->pClassDatas, pMeth->uiData, pMeth->pInitValue ); pMeth->bClsDataInitiated = 1; } hb_itemClear( &init ); } else if( pMeth->pFunction == hb___msgGetShrData ) /* it is a ClassData SHARED */ { HB_ITEM init; hb_itemCopy( &init , *(pClass->pSharedDatas + pMeth->uiDataShared) ) ; if( init.type == HB_IT_NIL ) { hb_itemCopy( *(pClass->pSharedDatas + pMeth->uiDataShared) , pMeth->pInitValue ); pMeth->bClsDataInitiated = 1; } hb_itemClear( &init ); } } } } } /* * __clsModMsg( , , ) * * Modify message (only for INLINE and METHOD) */ HB_FUNC( __CLSMODMSG ) { USHORT uiClass = hb_parni( 1 ); PHB_ITEM pString = hb_param( 2, HB_IT_STRING ); if( uiClass && uiClass <= s_uiClasses && pString ) { PHB_DYNS pMsg = hb_dynsymFindName( pString->item.asString.value ); if( pMsg ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiAt = ( ( __Cls_MsgToNum( pMsg ) ) % pClass->uiHashKey ) * BUCKET; USHORT uiMask = pClass->uiHashKey * BUCKET; USHORT uiLimit = uiAt ? ( uiAt - 1 ) : ( uiMask - 1 ); while( ( uiAt != uiLimit ) && ( pClass->pMethods[ uiAt ].pMessage && ( pClass->pMethods[ uiAt ].pMessage != pMsg ) ) ) { uiAt++; if( uiAt == uiMask ) uiAt = 0; } if( uiAt != uiLimit ) { /* Requested method found */ PHB_FUNC pFunc = pClass->pMethods[ uiAt ].pFunction; if( pFunc == hb___msgEvalInline ) /* INLINE method changed */ { PHB_ITEM pBlock = hb_param( 3, HB_IT_BLOCK ); if( pBlock == NULL ) hb_errRT_BASE( EG_ARG, 3000, NULL, "__CLSMODMSG" ); else hb_arraySet( pClass->pInlines, pClass->pMethods[ uiAt ].uiData, pBlock ); } else if( ( pFunc == hb___msgSetData ) || ( pFunc == hb___msgGetData ) ) { /* Not allowed for DATA */ hb_errRT_BASE( EG_ARG, 3004, "Cannot modify a DATA item", "__CLSMODMSG" ); } else /* Modify METHOD */ pClass->pMethods[ uiAt ].pFunction = ( PHB_FUNC ) hb_parnl( 3 ); } } } } /* * := ClassName( ) * * Returns class name of */ HB_FUNC( __OBJGETCLSNAME ) { PHB_ITEM pObject = hb_param( 0, HB_IT_OBJECT ); USHORT uiClass; if( pObject && pObject->item.asArray.value->uiClass ) { uiClass = pObject->item.asArray.value->uiClass; hb_retc( s_pClasses[ uiClass - 1 ].szName ); } else { uiClass = hb_parni( 1 ); if( uiClass <= s_uiClasses ) hb_retc( s_pClasses[ uiClass - 1 ].szName ); else hb_retc( "" ); } } /* * := __objHasMsg( , ) * * Is a valid message for the */ HB_FUNC( __OBJHASMSG ) { PHB_ITEM pObject = hb_param( 1, HB_IT_OBJECT ); PHB_ITEM pString = hb_param( 2, HB_IT_STRING ); if( pObject && pString ) hb_retl( hb_objHasMsg( pObject, pString->item.asString.value ) != 0 ); else hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJHASMSG" ); } /* * := __objClone( ) * * Clone an object. Note the similarity with aClone ;-) */ HB_FUNC( __OBJCLONE ) { PHB_ITEM pSrcObject = hb_param( 1, HB_IT_OBJECT ); if( pSrcObject ) { PHB_ITEM pDstObject = hb_arrayClone( pSrcObject ); hb_itemCopy( &hb_stack.Return, pDstObject ); hb_itemRelease( pDstObject ); } else hb_errRT_BASE( EG_ARG, 3001, NULL, "__OBJCLONE" ); } /* * = __objSendMsg( , , * * Send a message to an object */ HB_FUNC( __OBJSENDMSG ) { USHORT uiAt; PCLASS pClass; PHB_ITEM pObject = hb_param( 1, HB_IT_OBJECT ); PHB_ITEM pMessage = hb_param( 2, HB_IT_STRING ); if( pMessage && pObject ) /* Object & message passed */ { PHB_DYNS pMsg = hb_dynsymFindName( pMessage->item.asString.value ); if( pMsg ) { USHORT uiParam; hb_vmPush( pObject ); /* Push object */ hb_vmMessage( pMsg->pSymbol ); /* Push char symbol as message */ for( uiParam = 3; uiParam <= hb_pcount(); uiParam++ ) /* Push arguments on stack */ hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); hb_vmDo( hb_pcount() - 2 ); /* Execute message */ } } else hb_errRT_BASE( EG_ARG, 3000, NULL, "__OBJSENDMSG" ); } /* * := __clsInstSuper( ) * * Instance super class and return class handle */ HB_FUNC( __CLSINSTSUPER ) { PHB_ITEM pString = hb_param( 1, HB_IT_STRING ); BOOL bFound = FALSE; if( pString ) { PHB_DYNS pDynSym = hb_dynsymFind( pString->item.asString.value ); if( pDynSym ) /* Find function */ { USHORT uiClass; hb_vmPushSymbol( pDynSym->pSymbol ); /* Push function name */ hb_vmPushNil(); hb_vmFunction( 0 ); /* Execute super class */ if( HB_IS_OBJECT( &hb_stack.Return ) ) { for( uiClass = 0; ! bFound && uiClass < s_uiClasses; uiClass++ ) { /* Locate the entry */ if( hb_stricmp( pString->item.asString.value, s_pClasses[ uiClass ].szName ) == 0 ) { hb_retni( uiClass + 1 ); /* Entry + 1 = hb___msgClsH */ bFound = TRUE; } } } else hb_errRT_BASE( EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER" ); } else hb_errRT_BASE( EG_ARG, 3003, "Cannot find super class", "__CLSINSTSUPER" ); } if( ! bFound ) hb_retni( 0 ); } /* * = __cls_CntClsData( ) * * Return number of class datas */ HB_FUNC( __CLS_CNTCLSDATA ) { USHORT uiClass = hb_parni( 1 ); if( uiClass ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); hb_retni( hb_arrayLen( pClass->pClassDatas ) ); } else hb_retni( 0 ); } /* * = __cls_CntData( ) * * Return number of datas */ HB_FUNC( __CLS_CNTDATA ) { USHORT uiClass = hb_parni( 1 ); if( uiClass ) hb_retni( uiClass != 0 ? s_pClasses[ uiClass - 1 ].uiDatas : 0 ); } /* * = __cls_DecData( ) * * Return number of datas and decrease */ HB_FUNC( __CLS_DECDATA ) { USHORT uiClass = hb_parni( 1 ); if( uiClass ) hb_retni( s_pClasses[ uiClass - 1 ].uiDatas-- ); } /* * = __cls_IncData( ) * * Return number of datas and decrease */ HB_FUNC( __CLS_INCDATA ) { USHORT uiClass = hb_parni( 1 ); if( uiClass ) hb_retni( uiClass != 0 ? ++s_pClasses[ uiClass - 1 ].uiDatas : 0 ); } /* NOTE: Undocumented Clipper function */ HB_FUNC( __CLASSNEW ) { HB_FUNCNAME( __CLSNEW )(); } /* NOTE: Undocumented Clipper function */ HB_FUNC( __CLASSINSTANCE ) { HB_FUNCNAME( __CLSINST )(); } /* NOTE: Undocumented Clipper function */ HB_FUNC( __CLASSADD ) { HB_FUNCNAME( __CLSADDMSG )(); } /* NOTE: Undocumented Clipper function */ HB_FUNC( __CLASSNAME ) { HB_FUNCNAME( __OBJGETCLSNAME )(); } /* NOTE: Undocumented Clipper function */ /* NOTE: Based on hb___msgClsSel() */ HB_FUNC( __CLASSSEL ) { USHORT uiClass = hb_parni( 1 ); PHB_ITEM pReturn = hb_itemNew( NULL ); if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiLimit = pClass->uiHashKey * BUCKET; /* Number of Hash keys */ USHORT uiPos = 0; USHORT uiAt; hb_itemRelease( pReturn ); pReturn = hb_itemArrayNew( pClass->uiMethods ); /* Create a transfer array */ for( uiAt = 0; uiAt < uiLimit ; uiAt++ ) { PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage; if( pMessage ) /* Hash Entry used ? */ { PHB_ITEM pItem = hb_itemPutC( NULL, pMessage->pSymbol->szName ); /* Add to array */ hb_itemArrayPut( pReturn, ++uiPos, pItem ); hb_itemRelease( pItem ); } } } hb_itemReturn( pReturn ); hb_itemRelease( pReturn ); } /* ================================================ */ /* * := :ClassH() * * Returns class handle of */ static HARBOUR hb___msgClsH( void ) { if( HB_IS_ARRAY( hb_stack.pBase + 1 ) ) hb_retni( ( hb_stack.pBase + 1 )->item.asArray.value->uiClass ); else hb_retni( 0 ); } /* Added by JfL&RaC * <= :IsDerivedFrom( xParam ) * * Return true if is derived from xParam. * xParam can be either an obj or a classname */ static HARBOUR hb___msgClsParent( void ) { PHB_ITEM pItemRef; PHB_ITEM pItemParam; PCLASS pClass; char * szParentName; USHORT uiClass, lRetVal, i; if( HB_IS_BYREF( hb_stack.pBase + 1 ) ) /* Variables by reference */ pItemRef = hb_itemUnRef( hb_stack.pBase + 1 ); else pItemRef = hb_stack.pBase + 1; uiClass = pItemRef->item.asArray.value->uiClass; pClass = s_pClasses + ( uiClass - 1 ); pItemParam = hb_stack.pBase + 2; if( HB_IS_OBJECT( pItemParam ) ) szParentName = hb_objGetClsName( pItemParam ); else if( HB_IS_STRING( pItemParam ) ) szParentName = hb_itemGetC( pItemParam ); for( i = 0; szParentName[ i ] != '\0'; i++ ) szParentName[ i ] = toupper( szParentName[ i ] ); lRetVal = __IsClsParent( pClass, szParentName ); hb_itemFreeC( szParentName ); hb_retl( lRetVal ); } /* * := :ClassName() * * Return class name of . Can also be used for all types. */ static HARBOUR hb___msgClsName( void ) { PHB_ITEM pItemRef; if( HB_IS_BYREF( hb_stack.pBase + 1 ) ) /* Variables by reference */ pItemRef = hb_itemUnRef( hb_stack.pBase + 1 ); else pItemRef = hb_stack.pBase + 1; hb_retc( hb_objGetClsName( pItemRef ) ); } /* * := :ClassSel() * * Returns all the messages in */ static HARBOUR hb___msgClsSel( void ) { USHORT uiClass = HB_IS_ARRAY( hb_stack.pBase + 1 ) ? ( hb_stack.pBase + 1 )->item.asArray.value->uiClass : 0; /* Get class word */ PHB_ITEM pReturn = hb_itemNew( NULL ); if( ( ! uiClass ) && HB_IS_BYREF( hb_stack.pBase + 1 ) ) { /* Variables by reference */ PHB_ITEM pItemRef = hb_itemUnRef( hb_stack.pBase + 1 ); if( HB_IS_ARRAY( pItemRef ) ) uiClass = pItemRef->item.asArray.value->uiClass; } if( uiClass && uiClass <= s_uiClasses ) { PCLASS pClass = s_pClasses + ( uiClass - 1 ); USHORT uiLimit = pClass->uiHashKey * BUCKET; /* Number of Hash keys */ USHORT uiPos = 0; USHORT uiAt; hb_itemRelease( pReturn ); pReturn = hb_itemArrayNew( pClass->uiMethods ); /* Create a transfer array */ for( uiAt = 0; uiAt < uiLimit ; uiAt++ ) { PHB_DYNS pMessage = ( PHB_DYNS ) pClass->pMethods[ uiAt ].pMessage; if( pMessage ) /* Hash Entry used ? */ { PHB_ITEM pItem = hb_itemPutC( NULL, pMessage->pSymbol->szName ); /* Add to array */ hb_itemArrayPut( pReturn, ++uiPos, pItem ); hb_itemRelease( pItem ); } } } hb_itemReturn( pReturn ); hb_itemRelease( pReturn ); } /* * __msgEvalInline() * * Internal function executed for inline methods */ static HARBOUR hb___msgEvalInline( void ) { HB_ITEM block; USHORT uiClass = ( hb_stack.pBase + 1 )->item.asArray.value->uiClass; USHORT uiParam; hb_arrayGet( s_pClasses[ uiClass - 1 ].pInlines, s_pMethod->uiData, &block ); hb_vmPushSymbol( &hb_symEval ); hb_vmPush( &block ); hb_vmPush( hb_stack.pBase + 1 ); /* Push self */ for( uiParam = 1; uiParam <= hb_pcount(); uiParam++ ) hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); hb_vmDo( hb_pcount() + 1 ); /* Self is also an argument */ hb_itemClear( &block ); /* Release block */ } /* * __msgEval() * * Internal function for the internal EVAL method. */ static HARBOUR hb___msgEval( void ) { if( HB_IS_BLOCK( hb_stack.pBase + 1 ) ) { USHORT uiParam; hb_vmPushSymbol( &hb_symEval ); hb_vmPush( hb_stack.pBase + 1 ); /* Push block */ for( uiParam = 1; uiParam <= hb_pcount(); uiParam++ ) hb_vmPush( hb_param( uiParam, HB_IT_ANY ) ); hb_vmDo( hb_pcount() ); /* Self is also an argument */ } else { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" ); if( pResult ) { hb_itemReturn( pResult ); hb_itemRelease( pResult ); } } } /* * __msgGetClsData() * * Internal function to return a CLASSDATA */ static HARBOUR hb___msgGetClsData( void ) { USHORT uiClass = ( hb_stack.pBase + 1 )->item.asArray.value->uiClass; if( uiClass && uiClass <= s_uiClasses ) hb_arrayGet( s_pClasses[ uiClass - 1 ].pClassDatas, s_pMethod->uiData, &hb_stack.Return ); } //Added by RAC&JF /* * __msgGetShrData() * * Internal function to return a SHAREDDATA */ static HARBOUR hb___msgGetShrData( void ) { USHORT uiClass = ( hb_stack.pBase + 1 )->item.asArray.value->uiClass; if( uiClass && uiClass <= s_uiClasses ) hb_itemCopy( &hb_stack.Return , *(s_pClasses[ uiClass - 1 ].pSharedDatas + s_pMethod->uiDataShared) ) ; } /* * __msgGetData() * * Internal function to return a DATA */ static HARBOUR hb___msgGetData( void ) { PHB_ITEM pObject = hb_stack.pBase + 1; USHORT uiIndex = s_pMethod->uiData; if( uiIndex > ( USHORT ) hb_arrayLen( pObject ) ) /* Resize needed */ hb_arraySize( pObject, uiIndex ); /* Make large enough */ hb_arrayGet( pObject, uiIndex, &hb_stack.Return ); } /* * __msgSuper() * * Internal function to return a superobject */ static HARBOUR hb___msgSuper( void ) { PHB_ITEM pObject = s_pMethod->pInitValue ; hb_itemCopy( &hb_stack.Return, pObject ); } /* * __msgSetClsData() * * Internal function to set a CLASSDATA */ static HARBOUR hb___msgSetClsData( void ) { USHORT uiClass = ( hb_stack.pBase + 1 )->item.asArray.value->uiClass; PHB_ITEM pReturn = hb_stack.pBase + 2; if( uiClass && uiClass <= s_uiClasses ) { hb_arraySet( s_pClasses[ uiClass - 1 ].pClassDatas, s_pMethod->uiData, pReturn ); hb_itemCopy( &hb_stack.Return, pReturn ); } } //Added by RAC&JF /* * __msgSetShrData() * * Internal function to set a SHAREDDATA */ static HARBOUR hb___msgSetShrData( void ) { USHORT uiClass = ( hb_stack.pBase + 1 )->item.asArray.value->uiClass; PHB_ITEM pReturn = hb_stack.pBase + 2; if( uiClass && uiClass <= s_uiClasses ) { hb_itemCopy( *(s_pClasses[ uiClass - 1 ].pSharedDatas + s_pMethod->uiDataShared ), pReturn ) ; hb_itemCopy( &hb_stack.Return, pReturn ); } } /* * __msgSetData() * * Internal function to set a DATA */ static HARBOUR hb___msgSetData( void ) { PHB_ITEM pObject = hb_stack.pBase + 1; PHB_ITEM pReturn = hb_stack.pBase + 2; USHORT uiIndex = s_pMethod->uiData; /* Resize needed ? */ if( uiIndex > ( USHORT ) hb_arrayLen( pObject ) ) /* Make large enough */ hb_arraySize( pObject, uiIndex ); hb_arraySet( pObject, uiIndex, pReturn ); hb_itemCopy( &hb_stack.Return, pReturn ); } /* No comment :-) */ static HARBOUR hb___msgVirtual( void ) { /* hb_ret(); */ /* NOTE: It's safe to comment this out */ ; } /* to be used from Classes ERROR HANDLER method */ HB_FUNC( __GETMESSAGE ) { PHB_ITEM pBase = hb_stack.pBase; pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase; hb_retc( pBase->item.asSymbol.value->szName ); } //Added by RAC&JF // Used by the preprocessor to implement Classy compatibility to Harbour // Receive an variable number of param and return an array of it. // No param will return a NULL array HB_FUNC( __CLS_PARAM ) { PHB_ITEM array, iTmp ; USHORT uiParam = hb_pcount() ; USHORT n ; array = hb_itemArrayNew( uiParam ); for (n = 1; n <= uiParam ; n++) { iTmp = hb_itemParam(n); hb_itemArrayPut( array, n, iTmp ); hb_itemRelease(iTmp); } hb_itemReturn( array ); hb_itemRelease( array ); } //Added by RAC&JF void hb_clsScope( PHB_ITEM pObject, PMETHOD pMethod ) { PHB_ITEM pBase = hb_stack.pBase; LONG iLevel = 1; USHORT lRetVal = 0; USHORT uiScope = pMethod->uiScope; PHB_DYNS pMessage = pMethod->pMessage; char * szName; char * szNameBase; char * szNameObject; while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems ) pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase; szNameBase = hb_objGetClsName( pBase + 1 ); szNameObject = hb_objGetClsName( pObject ); if( ( iLevel == -1 ) ) { if( ( pBase + 1 )->type == HB_IT_ARRAY ) /* it is a message */ { if( ( uiScope & HBCLSTP_PROTECTED ) == HBCLSTP_PROTECTED ) { lRetVal = strcmp( szNameBase, szNameObject ) != 0; if( lRetVal ) { strcpy( szName, szNameObject ); strcat( szName, ":" ); strcat( szName, pMessage->pSymbol->szName ); hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (protected)", szName ); } } //if CLS_HIDDEN defined, a call to a hidden msg will result to a msg not found error. #ifndef HB_MASKHIDDEN if( ( uiScope & HBCLSTP_HIDDEN ) == HBCLSTP_HIDDEN ) { if( ( uiScope & HBCLSTP_SUPER ) == HBCLSTP_SUPER ) lRetVal = 1; else lRetVal = strcmp( szNameBase, szNameObject ) != 0; if( lRetVal ) { strcpy( szName, szNameObject ); strcat( szName, ":" ); strcat( szName, pMessage->pSymbol->szName ); hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (hidden)", szName ); } } #endif } else if( ( uiScope & HBCLSTP_PROTECTED ) == HBCLSTP_PROTECTED ) { strcpy( szName, szNameObject ); strcat( szName, ":" ); strcat( szName, pMessage->pSymbol->szName ); hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (protected)", szName ); } #ifndef CLS_HIDDEN else if( ( uiScope & HBCLSTP_HIDDEN ) == HBCLSTP_HIDDEN ) { strcpy( szName, szNameObject ); strcat( szName, ":" ); strcat( szName, pMessage->pSymbol->szName ); hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (hidden)", szName ); } #endif if( ( uiScope & HBCLSTP_READONLY ) == HBCLSTP_READONLY ) { printf("\nszMsgBase = %s", pMessage->pSymbol->szName); if( ( pMethod->pFunction == hb___msgSetData ) || ( pMethod->pFunction == hb___msgSetClsData ) || ( pMethod->pFunction == hb___msgSetShrData ) ) lRetVal = 1; if( lRetVal ) { strcpy( szName, szNameObject ); strcat( szName, ":" ); strcat( szName, pMessage->pSymbol->szName ); hb_errRT_BASE( EG_NOMETHOD, 1004, "Scope violation (readonly)", szName ); } } } } //Added by RAC&JF unsigned __Cls_MsgToNum( PHB_DYNS pMsg ) { USHORT i; ULONG nRetVal; nRetVal = 0; for( i = 0; pMsg->pSymbol->szName[ i ] != '\0'; i++) nRetVal = ( ( nRetVal << 1 ) + pMsg->pSymbol->szName[ i ] ); return( nRetVal ); } //Added by RAC&JF HB_FUNC( __CLSPARENT ) { USHORT lRetVal, uiAt, uiLimit; USHORT uiClass = hb_parni( 1 ); char * szParentName = hb_parc( 2 ); PCLASS pClass = s_pClasses + ( uiClass - 1 ); lRetVal = __IsClsParent( pClass, szParentName ); hb_retl( lRetVal ); } //Added by RAC&JF USHORT __IsClsParent( PCLASS pClass, char * szParentName ) { USHORT lRetVal, uiAt, uiLimit; PCLASS pSprCls ; uiLimit = pClass->uiHashKey * BUCKET; lRetVal = 0; for( uiAt = 0; uiAt < uiLimit ; uiAt++) if( ( pClass->pMethods[ uiAt ].uiScope & HBCLSTP_CLASS ) == HBCLSTP_CLASS ) { if( strcmp( pClass->pMethods[ uiAt ].pMessage->pSymbol->szName, szParentName ) == 0 ) { lRetVal = 1; } } if( !lRetVal ) for( uiAt = 0; uiAt < uiLimit ; uiAt++) { if( ( pClass->pMethods[ uiAt ].uiScope & HBCLSTP_CLASS ) == HBCLSTP_CLASS ) { pSprCls = s_pClasses + ( ( pClass->pMethods[ uiAt ].uiData ) - 1 ); lRetVal = __IsClsParent( pSprCls, szParentName ); } if( lRetVal ) break; } return( lRetVal ); } //Added by RāC&JfL HB_FUNC( SENDER ) { PHB_ITEM pBase = hb_stack.pBase; PHB_ITEM oReturn ; PHB_ITEM oSender; USHORT iLevel = 1; char * szNameSender; while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems ) pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase; oSender = pBase + 2; szNameSender = hb_objGetClsName( oSender ); printf("\nszNameSender : %s", szNameSender); if( ( oSender )->type == HB_IT_ARRAY ) hb_itemCopy( oReturn, oSender ); else oReturn = hb_itemNew( NULL ); hb_itemCopy(&hb_stack.Return, oReturn); hb_itemRelease( oReturn ); }