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

2006-09-22 23:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* 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 <classFunc1> [, <classFuncN> ]
      and/or:
         FRIEND FUNCTION <FuncName1> [, <FuncNameN> ]
      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
This commit is contained in:
Przemyslaw Czerpak
2006-09-22 21:02:17 +00:00
parent 4661d6885a
commit 1202be4471
10 changed files with 393 additions and 182 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
harbour/ChangeLog
View File

@@ -8,6 +8,49 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
or:
hb_execFromArray( <aExecArray> )
where <aExecArray> is in one of the following format:
{ <cFuncName> [, <params,...>] }
{ @<funcName>() [, <params,...>] }
{ <bCodeBlock> [, <params,...>] }
{ <oObject> , <cMethodName> [, <params,...>] }
{ <oObject> , @<msgName>() [, <params,...>] }
* 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 <classFunc1> [, <classFuncN> ]
and/or:
FRIEND FUNCTION <FuncName1> [, <FuncNameN> ]
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

14
harbour/include/hbclass.ch
View File

@@ -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 ( [ <SuperClass1>():class ] [ ,<SuperClassN>():class ] ) ) ;;
Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0 ( [ <SuperClass1>():class ] [ ,<SuperClassN>():class ] ) ) ;;
endif ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
@@ -229,6 +229,7 @@ DECLARE HBClass ;
#xcommand CLASS <ClassName> [METACLASS <metaClass>] ;
[ <frm: FROM, INHERIT> <SuperClass1> [,<SuperClassN>] ] ;
[ <modulfriend: MODULE FRIENDLY> ] ;
[ <static: STATIC> ] [ FUNCTION <FuncName> ] => ;
#undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME <ClassName> ;;
[ #undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME <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_ <ClassName> ;;
#undef _CLASS_MODE_ ;;
@@ -256,6 +257,7 @@ DECLARE HBClass ;
#xcommand CLASS <ClassName> [METACLASS <metaClass>] ;
[ <frm: FROM, INHERIT> <SuperClass1> [,<SuperClassN>] ] ;
[ <modulfriend: MODULE FRIENDLY> ] ;
[<static: STATIC>] [ FUNCTION <FuncName> ] => ;
#undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME <ClassName> ;;
[ #undef _HB_CLS_FUNCNAME ; #define _HB_CLS_FUNCNAME <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_ <ClassName> ;;
#undef _CLASS_MODE_ ;;
@@ -707,6 +709,12 @@ s_oClass:AddInline( <(op)>, {|Self, <cArg> | <Code> }, HBCLSCHOICE( <.export.>,
s_oClass:SetDestructor( CLSMETH _CLASS_NAME_ <MethodName>() )
#endif
#xcommand FRIEND CLASS <ClassName1> [, <ClassNameN> ] => ;
s_oClass:AddFriendClass( @<ClassName1>() [, @<ClassNameN>() ] )
#xcommand FRIEND FUNCTION <FuncName1> [, <FuncNameN> ] => ;
s_oClass:AddFriendFunc( @<FuncName1>() [, @<FuncNameN>() ] )
#xtranslate END CLASS => ENDCLASS
#ifdef HB_CLS_ALLOWCLASS

2
harbour/include/hbvm.h
View File

@@ -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

28
harbour/source/compiler/harbour.c
View File

@@ -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;
}

109
harbour/source/rtl/tclass.prg
View File

@@ -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()

208
harbour/source/vm/classes.c
View File

@@ -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 )
/*
* <hClass> := __clsNew( <cClassName>, <nDatas>, [ahSuper|aoSuper] )
* <hClass> := __clsNew( <cClassName>, <nDatas>, [<ahSuper>], [<pClassFunc>], [<lModuleFriendly>] )
*
* Create a new class
*
* <cClassName> Name of the class
* <nDatas> Number of DATAs in the class
* <ahSuper> Optional handle(s) of superclass(es)
* <ahSuper> Optional array with handle(s) of superclass(es)
* <pClassFunc> Class function symbol
* <lModuleFriendly> 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( <hClass>, <pFyncSym> )
*
* 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( <oObj>, <cMessage> )
*
@@ -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 );
}
/*

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

@@ -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;
}

76
harbour/source/vm/macro.c
View File

@@ -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

29
harbour/source/vm/proc.c
View File

@@ -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

2
harbour/source/vm/runner.c
View File

@@ -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;
}
}