From 1202be447175f42bfae97c121d173b976f176954 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Fri, 22 Sep 2006 21:02:17 +0000 Subject: [PATCH] 2006-09-22 23:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbclass.ch * harbour/include/hbvm.h * harbour/source/rtl/tclass.prg * harbour/source/vm/classes.c * harbour/source/vm/hvm.c ! fixed bug in real codeblock scoping which was exploited by dictionary resizing * changed ACCESS messages to ASSIGN ones when object item reference is created for proper READONLY scope checking. The reference to object variable can be created only when caller has sufficient ASSIGN privileges. + added FRIEND CLASS and FRIEND FUNCTION support. It's enough to add class definition: FRIEND CLASS [, ] and/or: FRIEND FUNCTION [, ] and all methods of given class or given function will be able to access private variables. Warning!!! Friends cannot access overloaded non virtual methods. This feature is available _ONLY_ for real class members. + added MODULE FRIENDLY to class definition. It causes that all other functions and classes defined in the same .prg module will have friend privileges. In such way works xHarbour and there is now way to disable this "feature" what is IMHO bug. In Harbour programmer has to explicitly enable it (until he will not change / add new preprocessor rule and set it as default ;-)). Syntax: CREATE CLASS .... MODULE FRIENDLY ... END CLASS * harbour/source/vm/proc.c * harbour/source/vm/runner.c * updated function symbols processing * harbour/source/compiler/harbour.c * added note in hb_compOptimizeFrames() about exceeding maximum number of local variables (255). We should add new pcode(s) HB_P_LARGE[V]FRAME or generate compile time error. * harbour/source/vm/macro.c % minor optimizations --- harbour/ChangeLog | 43 ++++++ harbour/include/hbclass.ch | 14 +- harbour/include/hbvm.h | 2 + harbour/source/compiler/harbour.c | 28 ++-- harbour/source/rtl/tclass.prg | 109 ++++++++++++---- harbour/source/vm/classes.c | 208 ++++++++++++++++++++++-------- harbour/source/vm/hvm.c | 64 +++++++-- harbour/source/vm/macro.c | 76 ++++------- harbour/source/vm/proc.c | 29 +---- harbour/source/vm/runner.c | 2 +- 10 files changed, 393 insertions(+), 182 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 6024c74bb1..9cf4af1dfc 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,49 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + or: + hb_execFromArray( ) + where is in one of the following format: + { [, ] } + { @() [, ] } + { [, ] } + { , [, ] } + { , @() [, ] } + + * harbour/source/rtl/symbol.prg + * removed C code inside #pragma BEGINDUMP/ENDDUMP + now it's only .prg code which uses variable parameters function + and hb_execFromArray() + +2006-09-22 23:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbclass.ch + * harbour/include/hbvm.h + * harbour/source/rtl/tclass.prg + * harbour/source/vm/classes.c + * harbour/source/vm/hvm.c + ! fixed bug in real codeblock scoping which was exploited by + dictionary resizing + * changed ACCESS messages to ASSIGN ones when object item + reference is created for proper READONLY scope checking. + The reference to object variable can be created only when + caller has sufficient ASSIGN privileges. + + added FRIEND CLASS and FRIEND FUNCTION support. + It's enough to add class definition: + FRIEND CLASS [, ] + and/or: + FRIEND FUNCTION [, ] + and all methods of given class or given function will be able + to access private variables. + Warning!!! Friends cannot access overloaded non virtual methods. + This feature is available _ONLY_ for real class members. + + added MODULE FRIENDLY to class definition. It causes that all other + functions and classes defined in the same .prg module will have + friend privileges. In such way works xHarbour and there is now way + or generate compile time error. + has to explicitly enable it (until he will not change / add new + preprocessor rule and set it as default ;-)). Syntax: + CREATE CLASS .... MODULE FRIENDLY + ... END CLASS * harbour/source/vm/proc.c diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index 87c52159d4..af9525be79 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -175,7 +175,7 @@ DECLARE HBClass ; if s_oClass == NIL ;; s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;; if ! <.metaClass.> ;; - Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0 ( [ ():class ] [ ,():class ] ) ) ;; + Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0 ( [ ():class ] [ ,():class ] ) ) ;; endif ;; #undef _CLASS_NAME_ ;; #define _CLASS_NAME_ ;; @@ -229,6 +229,7 @@ DECLARE HBClass ; #xcommand CLASS [METACLASS ] ; [ [,] ] ; + [ ] ; [ ] [ FUNCTION ] => ; #undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME ;; [ #undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME ] ;; @@ -238,7 +239,7 @@ DECLARE HBClass ; local nScope ;; nScope := HB_OO_CLSTP_EXPORTED ;; if s_oClass == NIL ;; - s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;; + s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;; #undef _CLASS_NAME_ ;; #define _CLASS_NAME_ ;; #undef _CLASS_MODE_ ;; @@ -256,6 +257,7 @@ DECLARE HBClass ; #xcommand CLASS [METACLASS ] ; [ [,] ] ; + [ ] ; [] [ FUNCTION ] => ; #undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME ;; [ #undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME ] ;; @@ -265,7 +267,7 @@ DECLARE HBClass ; local nScope ;; nScope := HB_OO_CLSTP_EXPORTED ;; if s_oClass == NIL ;; - s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;; + s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;; #undef _CLASS_NAME_ ;; #define _CLASS_NAME_ ;; #undef _CLASS_MODE_ ;; @@ -707,6 +709,12 @@ s_oClass:AddInline( <(op)>, {|Self, | }, HBCLSCHOICE( <.export.>, s_oClass:SetDestructor( CLSMETH _CLASS_NAME_ () ) #endif +#xcommand FRIEND CLASS [, ] => ; + s_oClass:AddFriendClass( @() [, @() ] ) + +#xcommand FRIEND FUNCTION [, ] => ; + s_oClass:AddFriendFunc( @() [, @() ] ) + #xtranslate END CLASS => ENDCLASS #ifdef HB_CLS_ALLOWCLASS diff --git a/harbour/include/hbvm.h b/harbour/include/hbvm.h index e4dcd3b598..180cf2867f 100644 --- a/harbour/include/hbvm.h +++ b/harbour/include/hbvm.h @@ -93,6 +93,8 @@ extern HB_EXPORT PHB_SYMB hb_vmProcessSymbolsEx( PHB_SYMB pSymbols, USHORT uiSym extern void hb_vmInitSymbolGroup( void * hNewDynLib, int argc, char * argv[] ); extern void hb_vmExitSymbolGroup( void * hDynLib ); extern char * hb_vmFindModuleSymbolName( PHB_SYMB pSym ); + extern BOOL hb_vmFindModuleSymbols( PHB_SYMB pSym, PHB_SYMB * pSymbols, USHORT * puiSymbols ); + extern PHB_SYMB hb_vmGetRealFuncSym( PHB_SYMB pSym ); extern void hb_vmEnumRelease( PHB_ITEM pBase, PHB_ITEM pValue ); #endif diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index 6a29d5e2bd..1049d7003b 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -3686,30 +3686,32 @@ static void hb_compOptimizeFrames( PFUNCTION pFunc ) pFunc->pCode[ 3 ] == HB_P_SFRAME ) { PVAR pLocal; - int bLocals = 0; + int iLocals = 0; BOOL bSkipFRAME; BOOL bSkipSFRAME; pLocal = pFunc->pLocals; + while( pLocal ) { pLocal = pLocal->pNext; - bLocals++; + iLocals++; } - if( bLocals || pFunc->wParamCount ) + if( iLocals || pFunc->wParamCount ) { + /* Parameters declared with PARAMETERS statement are not + * placed in the local variable list. + */ if( pFunc->bFlags & FUN_USES_LOCAL_PARAMS ) - { - pFunc->pCode[ 1 ] = ( BYTE )( bLocals ) - ( BYTE )( pFunc->wParamCount ); - } - else - { - /* Parameters declared with PARAMETERS statement are not - * placed in the local variable list. - */ - pFunc->pCode[ 1 ] = ( BYTE )( bLocals ); - } + iLocals -= pFunc->wParamCount; + + /* TODO: generate error when iLocals > 255 or add new + * HB_P_LARGE[V]FRAME pcode(s) and replace current + * pcode frame with the new one moving the pcode. + */ + + pFunc->pCode[ 1 ] = ( BYTE )( iLocals ); pFunc->pCode[ 2 ] = ( BYTE )( pFunc->wParamCount ); bSkipFRAME = FALSE; } diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index ec5be29acc..2098ec0c14 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -83,8 +83,8 @@ FUNCTION HBClass() STATIC s_hClass /* NOTE: Automatically default to NIL */ IF s_hClass == NIL - s_hClass := __clsNew( "HBCLASS", 11) -/* s_hClass := __clsNew( "HBCLASS", 12) */ + s_hClass := __clsNew( "HBCLASS", 15) +/* s_hClass := __clsNew( "HBCLASS", 16) */ __clsAddMsg( s_hClass, "New" , @New() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "Create" , @Create() , HB_OO_MSG_METHOD ) @@ -96,6 +96,8 @@ FUNCTION HBClass() __clsAddMsg( s_hClass, "AddMethod" , @AddMethod() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "AddClsMethod" , @AddClsMethod() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "AddVirtual" , @AddVirtual() , HB_OO_MSG_METHOD ) + __clsAddMsg( s_hClass, "AddFriendFunc" , @AddFriendFunc() , HB_OO_MSG_METHOD ) + __clsAddMsg( s_hClass, "AddFriendClass" , @AddFriendClass() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "Instance" , @Instance() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "SetOnError" , @SetOnError() , HB_OO_MSG_METHOD ) __clsAddMsg( s_hClass, "SetDestructor" , @SetDestructor() , HB_OO_MSG_METHOD ) @@ -124,8 +126,16 @@ FUNCTION HBClass() __clsAddMsg( s_hClass, "_nOnError" , 10, HB_OO_MSG_ASSIGN ) __clsAddMsg( s_hClass, "nDestructor" , 11, HB_OO_MSG_ACCESS ) __clsAddMsg( s_hClass, "_nDestructor" , 11, HB_OO_MSG_ASSIGN ) - /* __clsAddMsg( s_hClass, "class" , 12, HB_OO_MSG_ACCESS ) - __clsAddMsg( s_hClass, "_class" , 12, HB_OO_MSG_ASSIGN ) */ + __clsAddMsg( s_hClass, "lModFriendly" , 12, HB_OO_MSG_ACCESS ) + __clsAddMsg( s_hClass, "_lModFriendly" , 12, HB_OO_MSG_ASSIGN ) + __clsAddMsg( s_hClass, "asFriendClass" , 13, HB_OO_MSG_ACCESS ) + __clsAddMsg( s_hClass, "_asFriendClass" , 13, HB_OO_MSG_ASSIGN ) + __clsAddMsg( s_hClass, "asFriendFunc" , 14, HB_OO_MSG_ACCESS ) + __clsAddMsg( s_hClass, "_asFriendFunc" , 14, HB_OO_MSG_ASSIGN ) + __clsAddMsg( s_hClass, "sClassFunc" , 15, HB_OO_MSG_ACCESS ) + __clsAddMsg( s_hClass, "_sClassFunc" , 15, HB_OO_MSG_ASSIGN ) + /* __clsAddMsg( s_hClass, "class" , 16, HB_OO_MSG_ACCESS ) + __clsAddMsg( s_hClass, "_class" , 16, HB_OO_MSG_ASSIGN ) */ ENDIF @@ -138,7 +148,7 @@ FUNCTION HBClass() // In case of direct class creation (without the help of preprocessor) xSuper can be // either NIL or contain the name of the superclass. -STATIC FUNCTION New( cClassName, xSuper ) +STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly ) LOCAL Self := QSelf() LOCAL nSuper, i @@ -154,21 +164,30 @@ STATIC FUNCTION New( cClassName, xSuper ) nSuper := 0 ENDIF - ::cName := Upper( cClassName ) + ::cName := Upper( cClassName ) + ::sClassFunc := sClassFunc - ::aDatas := {} - ::aMethods := {} - ::aClsDatas := {} - ::aClsMethods := {} - ::aInlines := {} - ::aVirtuals := {} + ::aDatas := {} + ::aMethods := {} + ::aClsDatas := {} + ::aClsMethods := {} + ::aInlines := {} + ::aVirtuals := {} + ::asFriendClass := {} + ::asFriendFunc := {} + + IF ISLOGICAL( lModuleFriendly ) + ::lModFriendly := lModuleFriendly + ELSE + ::lModFriendly := .F. + ENDIF FOR i := 1 TO nSuper IF ! ISCHARACTER( ::acSuper[ i ] ) EXIT ENDIF NEXT - IF i < nSuper + IF i <= nSuper nSuper := i - 1 ASize( ::acSuper, nSuper) ENDIF @@ -182,28 +201,33 @@ STATIC PROCEDURE Create() LOCAL Self := QSelf() LOCAL n - LOCAL nLen := Len( ::acSuper ) + LOCAL nLen LOCAL nLenDatas := Len( ::aDatas ) //Datas local to the class !! LOCAL nClassBegin LOCAL hClass - LOCAL ahSuper := Array( nLen ) + LOCAL ahSuper := {} /* Self:Class := MetaClass */ - IF nLen == 0 - hClass := __clsNew( ::cName, nLenDatas ) - ELSE // Multi inheritance - FOR n := 1 TO nLen - ahSuper[ n ] := __clsInstSuper( Upper( ::acSuper[ n ] ) ) // Super handle available - NEXT - hClass := __clsNew( ::cName, nLenDatas, ahSuper ) - __clsAddMsg( hClass, "SUPER" , 0, HB_OO_MSG_SUPER, ahSuper[ 1 ], HB_OO_CLSTP_EXPORTED ) - __clsAddMsg( hClass, "__SUPER", 0, HB_OO_MSG_SUPER, ahSuper[ 1 ], HB_OO_CLSTP_EXPORTED ) + nLen := Len( ::acSuper ) + FOR n := 1 TO nLen + hClass := __clsInstSuper( Upper( ::acSuper[ n ] ) ) // Super handle available + IF hClass != 0 + AAdd( ahSuper, hClass ) + ENDIF + NEXT + + hClass := __clsNew( ::cName, nLenDatas, ahSuper, ::sClassFunc, ::lModFriendly ) + ::hClass := hClass + + IF !EMPTY( ahSuper ) + IF ahSuper[ 1 ] != 0 + __clsAddMsg( hClass, "SUPER" , 0, HB_OO_MSG_SUPER, ahSuper[ 1 ], HB_OO_CLSTP_EXPORTED ) + __clsAddMsg( hClass, "__SUPER", 0, HB_OO_MSG_SUPER, ahSuper[ 1 ], HB_OO_CLSTP_EXPORTED ) + ENDIF ENDIF __clsAddMsg( hClass, "REALCLASS" , 0, HB_OO_MSG_REALCLASS, 0 , HB_OO_CLSTP_EXPORTED ) - ::hClass := hClass - // We will work here on the MetaClass object to add the Class Method // as needed //nLen := Len( ::aClsMethods ) @@ -257,6 +281,18 @@ STATIC PROCEDURE Create() __clsAddMsg( hClass, "__Destructor", ::nDestructor, HB_OO_MSG_DESTRUCTOR ) ENDIF + //Friend Classes + nLen := Len( ::asFriendClass ) + FOR n := 1 TO nLen + __clsAddFriend( ::hClass, ::asFriendClass[ n ] ) + NEXT + + //Friend Functions + nLen := Len( ::asFriendFunc ) + FOR n := 1 TO nLen + __clsAddFriend( ::hClass, ::asFriendFunc[ n ] ) + NEXT + RETURN //----------------------------------------------------------------------------// @@ -404,6 +440,7 @@ STATIC PROCEDURE AddClsMethod( cMethod, nFuncPtr, nScope ) RETURN //----------------------------------------------------------------------------// + STATIC PROCEDURE AddVirtual( cMethod ) LOCAL Self := QSelf(), nAt @@ -419,6 +456,26 @@ STATIC PROCEDURE AddVirtual( cMethod ) //----------------------------------------------------------------------------// +STATIC PROCEDURE AddFriendClass( ... ) + + LOCAL Self := QSelf() + + AEval( HB_AParams(), { | sClass | AAdd( ::asFriendClass, sClass ) } ) + + RETURN + +//----------------------------------------------------------------------------// + +STATIC PROCEDURE AddFriendFunc( ... ) + + LOCAL Self := QSelf() + + AEval( HB_AParams(), { | sFunc | AAdd( ::asFriendFunc, sFunc ) } ) + + RETURN + +//----------------------------------------------------------------------------// + STATIC PROCEDURE SetOnError( nFuncPtr ) LOCAL Self := QSelf() diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index eee3a73c31..f6462336cb 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -181,10 +181,13 @@ typedef struct char * szName; /* Class name */ PHB_DYNS pClassSym; /* Class symbolic name */ PMETHOD pMethods; /* Class methods */ + PHB_SYMB pClassFuncSym; /* Class function symbol */ + PHB_SYMB pFriendModule; /* Class friend symbols */ PINITDATA pInitData; /* Class/instance Initialization data */ PHB_ITEM pClassDatas; /* Harbour Array for Class Datas */ PHB_ITEM pSharedDatas; /* Harbour Array for Class Shared Datas */ PHB_ITEM pInlines; /* Array for inline codeblocks */ + PHB_SYMB * pFriendSyms; /* Friend functions' symbols */ ULONG ulOpFlags; /* Flags for overloaded operators */ BOOL fHasDestructor; /* has the class destructor message? */ BOOL fHasOnError; /* has the class OnError message? */ @@ -192,6 +195,8 @@ typedef struct USHORT uiInitDatas; /* Total Method initialised Counter */ USHORT uiDatas; /* Total Data Counter */ USHORT uiDataFirst; /* First instance item from this class */ + USHORT uiFriendSyms; /* Number of friend function's symbols */ + USHORT uiFriendModule; /* Number of friend symbols in pFriendModule */ USHORT uiHashKey; } CLASS, * PCLASS; @@ -209,10 +214,11 @@ typedef struct # define HB_REAL_BLOCK_SCOPE #endif -#if defined( HB_REAL_BLOCK_SCOPE ) +#if !defined( HB_CLASSY_BLOCK_SCOPE ) # define hb_clsSenderOffset() hb_stackBaseProcOffset( 1 ) #endif + static HARBOUR hb___msgGetData( void ); static HARBOUR hb___msgSetData( void ); static HARBOUR hb___msgGetClsData( void ); @@ -449,6 +455,15 @@ static void hb_clsCopyClass( PCLASS pClsDst, PCLASS pClsSrc ) } } + if( pClsSrc->uiFriendSyms ) + { + pClsDst->uiFriendSyms = pClsSrc->uiFriendSyms; + pClsDst->pFriendSyms = ( PHB_SYMB * ) hb_xgrab( pClsSrc->uiFriendSyms * + sizeof( PHB_SYMB ) ); + memcpy( pClsDst->pFriendSyms, pClsSrc->pFriendSyms, + pClsSrc->uiFriendSyms * sizeof( PHB_SYMB ) ); + } + ulLimit = hb_clsMthNum( pClsDst ); memcpy( pClsDst->pMethods, pClsSrc->pMethods, ulLimit * sizeof( METHOD ) ); pClsDst->uiMethods = pClsSrc->uiMethods; @@ -599,6 +614,46 @@ static USHORT hb_clsAddInitValue( PCLASS pClass, PHB_ITEM pItem, return pClass->uiInitDatas; } +static BOOL hb_clsIsFriendSymbol( PCLASS pClass, PHB_SYMB pSym ) +{ + USHORT uiCount; + + HB_TRACE(HB_TR_DEBUG, ("hb_clsIsFriendSymbol(%p,%p)", pClass, pSym)); + + if( pSym >= pClass->pFriendModule && + pSym < pClass->pFriendModule + pClass->uiFriendModule ) + return TRUE; + + for( uiCount = 0; uiCount < pClass->uiFriendSyms; ++uiCount ) + { + if( pClass->pFriendSyms[ uiCount ] == pSym ) + return TRUE; + } + + return FALSE; +} + +static void hb_clsAddFriendSymbol( PCLASS pClass, PHB_SYMB pSym ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_clsAddFriendSymbol(%p,%p)", pClass, pSym)); + + if( ! hb_clsIsFriendSymbol( pClass, pSym ) ) + { + if( pClass->uiFriendSyms == 0 ) + { + pClass->pFriendSyms = ( PHB_SYMB * ) hb_xgrab( sizeof( PHB_SYMB ) ); + pClass->pFriendSyms[ 0 ] = pSym; + pClass->uiFriendSyms++; + } + else + { + pClass->pFriendSyms = ( PHB_SYMB * ) hb_xrealloc( pClass->pFriendSyms, + ( pClass->uiFriendSyms + 1 ) * sizeof( PHB_SYMB ) ); + pClass->pFriendSyms[ pClass->uiFriendSyms++ ] = pSym; + } + } +} + /* * initialize Classy/OO system at HVM startup */ @@ -607,6 +662,8 @@ void hb_clsInit( void ) PHB_SYMB pOpSym; USHORT uiOperator; + HB_TRACE(HB_TR_DEBUG, ("hb_clsInit()")); + for( uiOperator = 0, pOpSym = s_opSymbols; uiOperator <= HB_OO_MAX_OPERATOR; ++uiOperator, ++pOpSym ) { @@ -662,6 +719,8 @@ static void hb_clsRelease( PCLASS pClass ) hb_xfree( pClass->szName ); if( pClass->pMethods ) hb_xfree( pClass->pMethods ); + if( pClass->uiFriendSyms ) + hb_xfree( pClass->pFriendSyms ); if( pClass->pClassDatas ) hb_itemRelease( pClass->pClassDatas ); if( pClass->pSharedDatas ) @@ -921,7 +980,7 @@ char * hb_clsRealMethodName( void ) return szName; } -#if !defined( HB_REAL_BLOCK_SCOPE ) +#if defined( HB_CLASSY_BLOCK_SCOPE ) static LONG hb_clsSenderOffset( void ) { LONG lOffset = hb_stackBaseProcOffset( 1 ); @@ -974,6 +1033,27 @@ static USHORT hb_clsSenderMethodClasss( void ) return 0; } +static PHB_SYMB hb_clsSenderSymbol( void ) +{ + PHB_SYMB pSym = NULL; + LONG lOffset = hb_clsSenderOffset(); + + if( lOffset >=0 ) + { + pSym = hb_stackItem( lOffset )->item.asSymbol.value; + + if( pSym == &hb_symEval || pSym->pDynSym == s___msgEval.pDynSym ) + { + PHB_ITEM pBlock = hb_stackItem( lOffset + 1 ); + + if( HB_IS_BLOCK( pBlock ) ) + pSym = pBlock->item.asBlock.value->pDefSymb; + } + } + + return hb_vmGetRealFuncSym( pSym ); +} + static USHORT hb_clsSenderObjectClasss( void ) { LONG lOffset = hb_clsSenderOffset(); @@ -1000,6 +1080,10 @@ static PHB_SYMB hb_clsValidScope( PMETHOD pMethod, PHB_STACK_STATE pStack ) if( uiSenderClass == pMethod->uiSprClass ) return pMethod->pFuncSym; + /* + * Warning!!! Friends cannot access overloaded non virtual methods. + * This feature is available _ONLY_ for real class members, [druzus] + */ if( pMethod->uiScope & HB_OO_CLSTP_OVERLOADED ) { PCLASS pClass = s_pClasses + ( uiSenderClass - 1 ); @@ -1015,22 +1099,26 @@ static PHB_SYMB hb_clsValidScope( PMETHOD pMethod, PHB_STACK_STATE pStack ) } if( pMethod->uiScope & HB_OO_CLSTP_HIDDEN ) - return &s___msgScopeErr; - - if( pMethod->uiScope & HB_OO_CLSTP_PROTECTED && + { + if( ! hb_clsIsFriendSymbol( s_pClasses + ( pStack->uiClass - 1 ), + ( s_pClasses + ( uiSenderClass - 1 ) )->pClassFuncSym ) ) + return &s___msgScopeErr; + } + else if( pMethod->uiScope & HB_OO_CLSTP_PROTECTED && ! hb_clsHasParent( s_pClasses + ( pStack->uiClass - 1 ), ( s_pClasses + ( uiSenderClass - 1 ) )->pClassSym ) && ! hb_clsHasParent( s_pClasses + ( uiSenderClass - 1 ), - ( s_pClasses + ( pStack->uiClass - 1 ) )->pClassSym ) ) -#if 0 - if( pMethod->uiScope & HB_OO_CLSTP_PROTECTED && - ! hb_clsHasParent( s_pClasses + ( pObject->item.asArray.value->uiClass - 1 ), - ( s_pClasses + ( uiSenderClass - 1 ) )->pClassSym ) ) -#endif + ( s_pClasses + ( pStack->uiClass - 1 ) )->pClassSym ) && + ! hb_clsIsFriendSymbol( s_pClasses + ( pStack->uiClass - 1 ), + ( s_pClasses + ( uiSenderClass - 1 ) )->pClassFuncSym ) ) return &s___msgScopeErr; } else if( pMethod->uiScope & ( HB_OO_CLSTP_HIDDEN | HB_OO_CLSTP_PROTECTED ) ) - return &s___msgScopeErr; + { + if( ! hb_clsIsFriendSymbol( s_pClasses + ( pStack->uiClass - 1 ), + hb_clsSenderSymbol() ) ) + return &s___msgScopeErr; + } } return pMethod->pFuncSym; @@ -1230,7 +1318,7 @@ BOOL hb_objGetVarRef( PHB_ITEM pObject, PHB_SYMB pMessage, if( pExecSym ) { - if( pExecSym->value.pFunPtr == hb___msgGetData ) + if( pExecSym->value.pFunPtr == hb___msgSetData ) { USHORT uiObjClass = pObject->item.asArray.value->uiClass; PCLASS pClass = s_pClasses + ( pStack->uiClass - 1 ); @@ -1249,7 +1337,7 @@ BOOL hb_objGetVarRef( PHB_ITEM pObject, PHB_SYMB pMessage, return hb_arrayGetItemRef( pObject, ulIndex, hb_stackReturnItem() ); } - else if( pExecSym->value.pFunPtr == hb___msgGetClsData ) + else if( pExecSym->value.pFunPtr == hb___msgSetClsData ) { PCLASS pClass = s_pClasses + ( pStack->uiClass - 1 ); PMETHOD pMethod = pClass->pMethods + pStack->uiMethod; @@ -1257,7 +1345,7 @@ BOOL hb_objGetVarRef( PHB_ITEM pObject, PHB_SYMB pMessage, return hb_arrayGetItemRef( pClass->pClassDatas, pMethod->uiData, hb_stackReturnItem() ); } - else if( pExecSym->value.pFunPtr == hb___msgGetShrData ) + else if( pExecSym->value.pFunPtr == hb___msgSetShrData ) { PCLASS pClass = s_pClasses + ( pStack->uiClass - 1 ); PMETHOD pMethod = pClass->pMethods + pStack->uiMethod; @@ -1265,6 +1353,8 @@ BOOL hb_objGetVarRef( PHB_ITEM pObject, PHB_SYMB pMessage, return hb_arrayGetItemRef( s_pClasses[ pMethod->uiSprClass - 1 ].pSharedDatas, pMethod->uiData, hb_stackReturnItem() ); } + else if( pExecSym->value.pFunPtr == hb___msgScopeErr ) + hb___msgScopeErr(); } return FALSE; @@ -1483,15 +1573,6 @@ static PHB_DYNS hb_objMsgParam( int iParam ) return pDynSym; } -static void hb_clsSetInlineClass( PCLASS pClass, USHORT uiIndex, - USHORT uiClass, USHORT uiMethod ) -{ - PHB_ITEM pBlock = hb_arrayGetItemPtr( pClass->pInlines, uiIndex ); - - pBlock->item.asBlock.hclass = uiClass; - pBlock->item.asBlock.method = uiMethod; -} - static USHORT hb_clsUpdateScope( USHORT uiScope, BOOL fAssign ) { if( !fAssign ) @@ -1827,8 +1908,6 @@ HB_FUNC( __CLSADDMSG ) pNewMeth->uiData = ( USHORT ) ( hb_arrayLen( pClass->pInlines ) + 1 ); hb_arraySize( pClass->pInlines, pNewMeth->uiData ); hb_arraySet( pClass->pInlines, pNewMeth->uiData, pBlock ); - hb_clsSetInlineClass( pClass, pNewMeth->uiData, uiClass, - ( USHORT ) ( pNewMeth - pClass->pMethods ) ); break; case HB_OO_MSG_VIRTUAL: @@ -1874,13 +1953,16 @@ HB_FUNC( __CLSADDMSG ) /* - * := __clsNew( , , [ahSuper|aoSuper] ) + * := __clsNew( , , [], [], [] ) * * Create a new class * * Name of the class * Number of DATAs in the class - * Optional handle(s) of superclass(es) + * Optional array with handle(s) of superclass(es) + * Class function symbol + * when true all functions and classes from the same + * module as pClassFunc are defined as friends */ HB_FUNC( __CLSNEW ) { @@ -1888,11 +1970,16 @@ HB_FUNC( __CLSNEW ) PMETHOD pMethod; PHB_ITEM pahSuper; USHORT ui, uiSuper, uiSuperCls; + BOOL fModuleFriendly; + PHB_SYMB pClassFunc; USHORT * puiClassData = NULL, uiClassDataSize = 0; pahSuper = hb_param( 3, HB_IT_ARRAY ); uiSuper = ( USHORT ) ( pahSuper ? hb_arrayLen( pahSuper ) : 0 ); + pClassFunc = hb_vmGetRealFuncSym( hb_itemGetSymbol( hb_param( 4, HB_IT_SYMBOL ) ) ); + fModuleFriendly = hb_parl( 5 ); + if( s_pClasses ) s_pClasses = ( PCLASS ) hb_xrealloc( s_pClasses, sizeof( CLASS ) * ( s_uiClasses + 1 ) ); else @@ -1902,11 +1989,17 @@ HB_FUNC( __CLSNEW ) memset( pNewCls, 0, sizeof( CLASS ) ); pNewCls->szName = hb_strdup( hb_parc( 1 ) ); pNewCls->pClassSym = hb_dynsymGet( pNewCls->szName ); + if( !pClassFunc ) + pClassFunc = hb_vmGetRealFuncSym( pNewCls->pClassSym->pSymbol ); + pNewCls->pClassFuncSym = pClassFunc; + if( fModuleFriendly ) + hb_vmFindModuleSymbols( pClassFunc, &pNewCls->pFriendModule, + &pNewCls->uiFriendModule ); for( ui = 1; ui <= uiSuper; ++ui ) { uiSuperCls = ( USHORT ) hb_arrayGetNI( pahSuper, ui ); - if( uiSuperCls && uiSuperCls <= s_uiClasses ) + if( uiSuperCls && uiSuperCls < s_uiClasses ) { PCLASS pSprCls; @@ -1995,6 +2088,14 @@ HB_FUNC( __CLSNEW ) } } + /* Copy friend functions */ + if( pSprCls->uiFriendSyms ) + { + USHORT ui; + for( ui = 0; ui < pSprCls->uiFriendSyms; ++ui ) + hb_clsAddFriendSymbol( pNewCls, pSprCls->pFriendSyms[ ui ] ); + } + /* Now working on other methods */ ulLimit = hb_clsMthNum( pSprCls ); for( ul = 0; ul < ulLimit; ++ul ) @@ -2091,24 +2192,23 @@ HB_FUNC( __CLSNEW ) hb_retni( s_uiClasses ); } -HB_FUNC( __CLSSOFFSET ) +/* + * __clsAddFriend( , ) + * + * Add friend function + */ +HB_FUNC( __CLSADDFRIEND ) { - USHORT uiClass = ( USHORT ) hb_parni( 1 ); - char * szSuper = hb_parc( 2 ); + USHORT uiClass; + PHB_SYMB pSym; - if( uiClass && uiClass <= s_uiClasses && szSuper ) - { - PHB_DYNS pDynSym = hb_dynsymFindName( szSuper ); + uiClass = ( USHORT ) hb_parni( 1 ); + pSym = hb_vmGetRealFuncSym ( hb_itemGetSymbol( hb_param( 2, HB_IT_SYMBOL ) ) ); - if( pDynSym ) - { - hb_retni( hb_clsParentInstanceOffset( s_pClasses + ( uiClass - 1 ), - pDynSym ) ); - } - } + if( pSym && uiClass && uiClass <= s_uiClasses ) + hb_clsAddFriendSymbol( s_pClasses + ( uiClass - 1 ), pSym ); } - /* * __clsDelMsg( , ) * @@ -2237,11 +2337,7 @@ HB_FUNC( __CLSMODMSG ) if( pBlock == NULL ) hb_errRT_BASE( EG_ARG, 3000, "Cannot modify INLINE method", "__CLSMODMSG", 0 ); else - { hb_arraySet( pClass->pInlines, pMethod->uiData, pBlock ); - hb_clsSetInlineClass( pClass, pMethod->uiData, uiClass, - ( USHORT ) ( pMethod - pClass->pMethods ) ); - } } else /* Modify METHOD */ { @@ -2780,23 +2876,27 @@ static HARBOUR hb___msgClsParent( void ) */ static HARBOUR hb___msgEvalInline( void ) { - PCLASS pClass = s_pClasses + - hb_stackBaseItem()->item.asSymbol.stackstate->uiClass - 1; - PMETHOD pMethod = pClass->pMethods + - hb_stackBaseItem()->item.asSymbol.stackstate->uiMethod; - USHORT uiPCount = hb_pcount(); - USHORT uiParam; + PHB_STACK_STATE pStack = hb_stackBaseItem()->item.asSymbol.stackstate; + PCLASS pClass = s_pClasses + pStack->uiClass - 1; + PMETHOD pMethod = pClass->pMethods + pStack->uiMethod; + USHORT uiPCount = hb_pcount(), uiParam; + PHB_ITEM pBlock; hb_vmPushSymbol( &hb_symEval ); + hb_vmPush( hb_arrayGetItemPtr( pClass->pInlines, pMethod->uiData ) ); - hb_vmPush( hb_stackSelfItem() ); /* Push self */ + pBlock = hb_stackItemFromTop( -1 ); /* Push block */ + pBlock->item.asBlock.hclass = pStack->uiClass; + pBlock->item.asBlock.method = pStack->uiMethod; + + hb_vmPush( hb_stackSelfItem() ); /* Push self as first argument */ for( uiParam = 1; uiParam <= uiPCount; uiParam++ ) { hb_vmPush( hb_stackItemFromBase( uiParam ) ); } - hb_vmDo( uiPCount + 1 ); /* Self is also an argument */ + hb_vmDo( uiPCount + 1 ); } /* diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index b2bf3d98ae..7774ca94af 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -4241,8 +4241,9 @@ static void hb_vmPushObjectVarRef( void ) pItem = hb_stackNewFrame( &sStackState, 0 ); /* procedure name */ pSym = pItem->item.asSymbol.value; - if( !hb_objGetVarRef( hb_stackSelfItem(), pSym, &sStackState ) ) - hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName, 1, hb_stackSelfItem() ); + if( !hb_objGetVarRef( hb_stackSelfItem(), pSym, &sStackState ) && + hb_vmRequestQuery() == 0 ) + hb_errRT_BASE_SubstR( EG_NOVARMETHOD, 1005, NULL, pSym->szName + 1, 1, hb_stackSelfItem() ); hb_stackOldFrame( &sStackState ); @@ -4971,7 +4972,7 @@ static void hb_vmPushAliasedVar( PHB_SYMB pSym ) if( szAlias[ 0 ] == 'M' || szAlias[ 0 ] == 'm' ) { - if( szAlias[ 1 ] == '\0' || /* M->variable */ + if( pAlias->item.asString.length == 1 || /* M->variable */ ( pAlias->item.asString.length >= 4 && hb_strnicmp( szAlias, "MEMVAR", /* MEMVAR-> or MEMVA-> or MEMV-> */ pAlias->item.asString.length ) == 0 ) ) @@ -5325,7 +5326,7 @@ static void hb_vmPopAliasedVar( PHB_SYMB pSym ) if( szAlias[ 0 ] == 'M' || szAlias[ 0 ] == 'm' ) { - if( szAlias[ 1 ] == '\0' || /* M->variable */ + if( pAlias->item.asString.length == 1 || /* M->variable */ ( pAlias->item.asString.length >= 4 && hb_strnicmp( szAlias, "MEMVAR", /* MEMVAR-> or MEMVA-> or MEMV-> */ pAlias->item.asString.length ) == 0 ) ) @@ -5452,6 +5453,19 @@ static double hb_vmTopNumber( void ) /* * Functions to mange module symbols */ + +PHB_SYMB hb_vmGetRealFuncSym( PHB_SYMB pSym ) +{ + if( pSym && !( pSym->scope.value & HB_FS_LOCAL ) ) + { + pSym = pSym->pDynSym && + ( pSym->pDynSym->pSymbol->scope.value & HB_FS_LOCAL ) ? + pSym->pDynSym->pSymbol : NULL; + } + + return pSym; +} + char * hb_vmFindModuleSymbolName( PHB_SYMB pSym ) { if( pSym ) @@ -5472,15 +5486,46 @@ char * hb_vmFindModuleSymbolName( PHB_SYMB pSym ) return NULL; } +BOOL hb_vmFindModuleSymbols( PHB_SYMB pSym, PHB_SYMB * pSymbols, + USHORT * puiSymbols ) +{ + if( pSym ) + { + PHB_SYMBOLS pLastSymbols = s_pSymbols; + +/* + if( pSym->scope.value & HB_FS_PCODEFUNC ) + * pSymbols = pSym->value.pCodeFunc->pSymbols; +*/ + + while( pLastSymbols ) + { + if( pLastSymbols->fActive && + pSym >= pLastSymbols->pModuleSymbols && + pSym < pLastSymbols->pModuleSymbols + pLastSymbols->uiModuleSymbols ) + { + * pSymbols = pLastSymbols->pModuleSymbols; + * puiSymbols = pLastSymbols->uiModuleSymbols; + return TRUE; + } + pLastSymbols = pLastSymbols->pNext; + } + } + + * pSymbols = NULL; + * puiSymbols = 0; + return FALSE; +} + static PHB_SYMBOLS hb_vmFindFreeModule( PHB_SYMB pSymbols, USHORT uiSymbols, char * szModuleName, ULONG ulID ) { - PHB_SYMBOLS pLastSymbols = s_pSymbols; - HB_TRACE(HB_TR_DEBUG, ("hb_vmFindFreeModule(%p,%hu,%s,%lu)", pSymbols, uiSymbols, szModuleName, ulID)); if( s_ulFreeSymbols ) { + PHB_SYMBOLS pLastSymbols = s_pSymbols; + while( pLastSymbols ) { if( !pLastSymbols->fActive && @@ -5721,13 +5766,10 @@ hb_vmRegisterSymbols( PHB_SYMB pModuleSymbols, USHORT uiSymbols, char * szModule } else { - PHB_SYMBOLS pLastSymbols; + PHB_SYMBOLS pLastSymbols = s_pSymbols; - pLastSymbols = s_pSymbols; while( pLastSymbols->pNext ) /* locates the latest processed group of symbols */ - { pLastSymbols = pLastSymbols->pNext; - } pLastSymbols->pNext = pNewSymbols; } } @@ -5793,7 +5835,7 @@ hb_vmRegisterSymbols( PHB_SYMB pModuleSymbols, USHORT uiSymbols, char * szModule if( pDynSym->pSymbol->value.pFunPtr ) { pSymbol->scope.value = - ( pSymbol->scope.value & ~HB_FS_PCODEFUNC ) | + ( pSymbol->scope.value & ~( HB_FS_PCODEFUNC | HB_FS_LOCAL ) ) | ( pDynSym->pSymbol->scope.value & HB_FS_PCODEFUNC ); pSymbol->value.pFunPtr = pDynSym->pSymbol->value.pFunPtr; } diff --git a/harbour/source/vm/macro.c b/harbour/source/vm/macro.c index e92fd59ab0..398c5ed5cc 100644 --- a/harbour/source/vm/macro.c +++ b/harbour/source/vm/macro.c @@ -1342,36 +1342,22 @@ void hb_compGenPopAliasedVar( char * szVarName, { if( szAlias ) { - if( szAlias[ 0 ] == 'M' && szAlias[ 1 ] == '\0' ) - { /* M->variable */ + int iLen = strlen( szAlias ); + + if( szAlias[ 0 ] == 'M' && ( iLen == 1 || + ( iLen >= 4 && iLen <= 6 && strncmp( szAlias, "MEMVAR", iLen ) == 0 ) ) ) + { /* M-> or MEMV-> or MEMVA-> or MEMVAR-> variable */ hb_compMemvarGenPCode( HB_P_MPOPMEMVAR, szVarName, HB_MACRO_PARAM ); hb_compMemvarCheck( szVarName, HB_MACRO_PARAM ); } + else if( iLen >= 4 && iLen <= 5 && strncmp( szAlias, "FIELD", iLen ) == 0 ) + { /* FIELD-> */ + hb_compMemvarGenPCode( HB_P_MPOPFIELD, szVarName, HB_MACRO_PARAM ); + } else - { - int iCmp = strncmp( szAlias, "MEMVAR", 4 ); - if( iCmp == 0 ) - iCmp = strncmp( szAlias, "MEMVAR", strlen( szAlias ) ); - if( iCmp == 0 ) - { /* MEMVAR-> or MEMVA-> or MEMV-> */ - hb_compMemvarGenPCode( HB_P_MPOPMEMVAR, szVarName, HB_MACRO_PARAM ); - hb_compMemvarCheck( szVarName, HB_MACRO_PARAM ); - } - else - { /* field variable */ - iCmp = strncmp( szAlias, "FIELD", 4 ); - if( iCmp == 0 ) - iCmp = strncmp( szAlias, "FIELD", strlen( szAlias ) ); - if( iCmp == 0 ) - { /* FIELD-> */ - hb_compMemvarGenPCode( HB_P_MPOPFIELD, szVarName, HB_MACRO_PARAM ); - } - else - { /* database alias */ - hb_compGenPushSymbol( szAlias, FALSE, TRUE, HB_MACRO_PARAM ); - hb_compMemvarGenPCode( HB_P_MPOPALIASEDFIELD, szVarName, HB_MACRO_PARAM ); - } - } + { /* database alias */ + hb_compGenPushSymbol( szAlias, FALSE, TRUE, HB_MACRO_PARAM ); + hb_compMemvarGenPCode( HB_P_MPOPALIASEDFIELD, szVarName, HB_MACRO_PARAM ); } } else @@ -1446,36 +1432,22 @@ void hb_compGenPushAliasedVar( char * szVarName, * FIELD->var * MEMVAR->var */ - if( szAlias[ 0 ] == 'M' && szAlias[ 1 ] == '\0' ) - { /* M->variable */ + int iLen = strlen( szAlias ); + + if( szAlias[ 0 ] == 'M' && ( iLen == 1 || + ( iLen >= 4 && iLen <= 6 && strncmp( szAlias, "MEMVAR", iLen ) == 0 ) ) ) + { /* M-> or MEMV-> or MEMVA-> or MEMVAR-> variable */ hb_compMemvarGenPCode( HB_P_MPUSHMEMVAR, szVarName, HB_MACRO_PARAM ); hb_compMemvarCheck( szVarName, HB_MACRO_PARAM ); } + else if( iLen >= 4 && iLen <= 5 && strncmp( szAlias, "FIELD", iLen ) == 0 ) + { /* FIELD-> */ + hb_compMemvarGenPCode( HB_P_MPUSHFIELD, szVarName, HB_MACRO_PARAM ); + } else - { - int iCmp = strncmp( szAlias, "MEMVAR", 4 ); - if( iCmp == 0 ) - iCmp = strncmp( szAlias, "MEMVAR", strlen( szAlias ) ); - if( iCmp == 0 ) - { /* MEMVAR-> or MEMVA-> or MEMV-> */ - hb_compMemvarGenPCode( HB_P_MPUSHMEMVAR, szVarName, HB_MACRO_PARAM ); - hb_compMemvarCheck( szVarName, HB_MACRO_PARAM ); - } - else - { /* field variable */ - iCmp = strncmp( szAlias, "FIELD", 4 ); - if( iCmp == 0 ) - iCmp = strncmp( szAlias, "FIELD", strlen( szAlias ) ); - if( iCmp == 0 ) - { /* FIELD-> */ - hb_compMemvarGenPCode( HB_P_MPUSHFIELD, szVarName, HB_MACRO_PARAM ); - } - else - { /* database alias */ - hb_compGenPushSymbol( szAlias, FALSE, TRUE, HB_MACRO_PARAM ); - hb_compMemvarGenPCode( HB_P_MPUSHALIASEDFIELD, szVarName, HB_MACRO_PARAM ); - } - } + { /* database alias */ + hb_compGenPushSymbol( szAlias, FALSE, TRUE, HB_MACRO_PARAM ); + hb_compMemvarGenPCode( HB_P_MPUSHALIASEDFIELD, szVarName, HB_MACRO_PARAM ); } } else diff --git a/harbour/source/vm/proc.c b/harbour/source/vm/proc.c index b1a3687e82..3790953c35 100644 --- a/harbour/source/vm/proc.c +++ b/harbour/source/vm/proc.c @@ -108,7 +108,6 @@ HB_FUNC( PROCLINE ) HB_FUNC( PROCFILE ) { - PHB_SYMB pLocalSym = NULL; PHB_SYMB pSym = NULL; if( ISSYMBOL( 1 ) ) @@ -128,21 +127,12 @@ HB_FUNC( PROCFILE ) PHB_ITEM pSelf = hb_stackItem( lOffset + 1 ); if( HB_IS_BLOCK( pSelf ) ) - pLocalSym = pSelf->item.asBlock.value->pDefSymb; + pSym = pSelf->item.asBlock.value->pDefSymb; } } } - if( !pLocalSym && pSym ) - { - if( ( pSym->scope.value & HB_FS_LOCAL ) != 0 ) - pLocalSym = pSym; - else if( pSym->pDynSym && - ( pSym->pDynSym->pSymbol->scope.value & HB_FS_LOCAL ) != 0 ) - pLocalSym = pSym->pDynSym->pSymbol; - } - - hb_retc( hb_vmFindModuleSymbolName( pLocalSym ) ); + hb_retc( hb_vmFindModuleSymbolName( hb_vmGetRealFuncSym( pSym ) ) ); } #endif @@ -254,17 +244,12 @@ BOOL hb_procinfo( int iLevel, char * szName, USHORT * puiLine, char * szFile ) { char * szModule; - if( ( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 ) && - HB_IS_BLOCK( pSelf ) && pSelf->item.asBlock.value->pDefSymb ) + if( HB_IS_BLOCK( pSelf ) && + ( pSym == &hb_symEval || strcmp( pSym->szName, "EVAL" ) == 0 ) ) pSym = pSelf->item.asBlock.value->pDefSymb; - else if( ( pSym->scope.value & HB_FS_LOCAL ) == 0 ) - { - if( ( pSym->pDynSym->pSymbol->scope.value & HB_FS_LOCAL ) != 0 ) - pSym = pSym->pDynSym->pSymbol; - else - pSym = NULL; - } - szModule = hb_vmFindModuleSymbolName( pSym ); + + szModule = hb_vmFindModuleSymbolName( hb_vmGetRealFuncSym( pSym ) ); + if( szModule ) strcpy( szFile, szModule ); else diff --git a/harbour/source/vm/runner.c b/harbour/source/vm/runner.c index dc76adc3ab..9badcf8269 100644 --- a/harbour/source/vm/runner.c +++ b/harbour/source/vm/runner.c @@ -422,7 +422,7 @@ static PHRB_BODY hb_hrbLoad( char* szHrbBody, ULONG ulBodySize ) else { pSymRead[ ul ].value.pCodeFunc = ( PHB_PCODEFUNC ) pHrbBody->pDynFunc[ ulPos ].pCodeFunc; - pSymRead[ ul ].scope.value |= HB_FS_PCODEFUNC; /* | HB_FS_LOCAL; */ + pSymRead[ ul ].scope.value |= HB_FS_PCODEFUNC | HB_FS_LOCAL; } }