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

2006-09-15 04:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
+ harbour/doc/destruct.txt
    + added description for object destructors in Harbour

  * harbour/include/error.ch
    + added new error code EG_DESTRUCTOR

  * harbour/source/lang/msgpl852.c
  * harbour/source/lang/msgpliso.c
  * harbour/source/lang/msgplmaz.c
  * harbour/source/lang/msgplwin.c
  * harbour/source/rtl/langapi.c
    + added desription for new error code - other language modules
      have to be updated

  * harbour/include/hbapi.h
    + added hb_gcRefCheck() and cover some hb_gc* functions by
      _HB_API_INTERNAL_ macro

  * harbour/source/vm/itemapi.c
    ! fixed possible RT error generation when some exception is active

  * harbour/include/hbapicls.h
  * harbour/include/hbclass.ch
  * harbour/include/hboo.ch
  * harbour/source/rtl/tclass.prg
  * harbour/source/vm/arrays.c
  * harbour/source/vm/classes.c
    + added support for object destructors

  * harbour/source/vm/garbage.c
    + added support for object destructors
    + added logic to detect buggu .prg code which uses destructors
      see doc/destruct.txt for more info.
      It's also possible that this code will exploit some bugs
      in other code which uses GC allocated memory blocks.
This commit is contained in:
Przemyslaw Czerpak
2006-09-15 03:10:38 +00:00
parent 27ccee95a1
commit a35053003b
18 changed files with 369 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
harbour/ChangeLog
View File

@@ -8,6 +8,43 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* removed some unused code and moved some scoping checking to
class creation code
2006-09-15 13:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbvm.h
* harbour/source/vm/classes.c
* harbour/source/vm/hvm.c
+ added hb_vmRequestReenter() and hb_vmRequestRestore()
+ added executing destructors when some exception is active
I forgot about it in previous commit.
+ harbour/tests/destruct.prg
+ added example/test code for object destructors
2006-09-15 04:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+ harbour/doc/destruct.txt
+ added description for object destructors in Harbour
* harbour/include/error.ch
+ added new error code EG_DESTRUCTOR
* harbour/source/lang/msgpl852.c
* harbour/source/lang/msgpliso.c
* harbour/source/lang/msgplmaz.c
* harbour/source/lang/msgplwin.c
* harbour/source/rtl/langapi.c
+ added desription for new error code - other language modules
have to be updated
* harbour/include/hbapi.h
+ added hb_gcRefCheck() and cover some hb_gc* functions by
_HB_API_INTERNAL_ macro
* harbour/source/vm/itemapi.c
! fixed possible RT error generation when some exception is active
* harbour/include/hbapicls.h
* harbour/include/hbclass.ch
* harbour/include/hboo.ch
* harbour/source/rtl/tclass.prg

128
harbour/doc/destruct.txt Normal file
View File

@@ -0,0 +1,128 @@
/*
* $Id$
*/
Destructors
===========
Destructors are special methods executed just before the object
will be destroyed. It means that a programmer _has_to_ pay a special
attention to the destructor's code and _NEVER_ store the reference
to SELF object in external items. The piece of memory where
the instance of class (object) is held, will be freed when
the destructor finishes, so any references to SELF object will
point to uninitialized memory or memory allocated for other
structures. Sooner or later (probably in a next GC pass) these
references will be accessed, causing GPFs or some other unpredictable
problems.
Harbour implementation
======================
General destructor activation
-----------------------------
Each object item has a reference counter. When it reaches 0 the object
is destroyed and if it has destructor message then this message will be
executed just before freeing the memory. After executing destructor HVM
checks if a programmer didn't store the reference to the object being
destroyed somewhere, and if he did then RT error is generated.
It's possible to detect such situation by simply checking the reference
counter. Such situation is not dangerous for HVM integrity because the
memory is not freed - instead the object is converted to an empty array.
Though it does not mean that the application is valid. A programmer stored
a reference to SELF object somewhere and when he will try to access it as
an object, some other RT errors will be generated.
For sure such programs have to be fixed.
It's the not the only one situation when destructors can be executed.
It's possible to create cyclic references between some complex items
so the reference counters will never reach 0 even if the items are not
longer accessible by application. To avoid memory leaks, such items are
destroyed by Garbage Collector in a special way. GC scans all items known
to HVM and marks them as used, then destroys all items which are not marked.
The reference counters in such items are greater then zero and cannot
be directly used to detect bugs in a user code. So GC collects all
unaccessible items and then executes cleanup functions for each of them,
and finally checks if reference counters reached zero before it will
free the memory blocks. If they didn't then RT error is generated for
the first memory block. All items which are still accessible, are not
freed and if GC can recognize a type of an item then it will also try to
convert it to some empty form (f.e. empty array).
The destructors are executed from cleanup functions so they all will be
executed and then, if there is sth wrong, RT error will be generated for
the first memory block which was copied to some external structures.
Please note that the order in which destructors are executed by GC
can be diffrent then some logical order defined by an application. HVM
does not know anything about programmer's ideas so a programmer has to
create a code which will be safe for such situations. HVM only guaranties
that destructors will be executed only once for each object.
This also cannot break HVM integrity for standard object items which are
represented as arrays. But if the problem is inside cleanup function of
a GC POINTER item, which has a structure unknown to HVM, then any further
behavior can be unpredictible if a programmer, who created such pointer
items, doesn't support such situation himslef in his C code. It's a good
practice to add some type of marker to body of memory allocated by
hb_gcAlloc() to detect bugs in .prg code destructors which may keep
pointers to freed POINTER item (these could be destructors of differ
object items).
In such case GC will not free the block so cleanup function (not object
destructor) will be executed second time when the buggy reference will be
cleared. Such marker can help to make clean-up function safe for such
situation. It's a programmer's implementation decision if such pointer item
should be still valid and work like before or drop its capacities after
first cleanup function execution. Anyhow the code should expect such
situation.
In summary, Harbour destructor implementation should be able to detect
bugs in destructor and keep HVM integrity. But we are not able to
guarantiee that nothing wrong will happen with 3-rd party code which
uses POINTER items scanned by GC, which are not safe for .prg code
bugs in destructors and repeated cleanup function execution.
Exiting the application and HVM closing
---------------------------------------
When HVM exits all items on HVM stack (local variables and parameters)
are cleaned. Then HVM clears all memvar items.
After these two steps HVM executes GC and all items which are not longer
accessible will be freed. Then HVM closes RDD system.
It's the last moment when object destructors can be executed, because
in next steps, the classy subsystem is closed and all static variables
cleared. So for all items which still exist as STATIC variables or in
some other structures, the object destructors will not be executed.
Clearing STATIC variables before closing classy subsystem will not help
because STATIC variables are integral part of this subsystem.
Anomalies and excpetions
------------------------
In some situations HVM may clear items when exception apear, f.e.
BREAK or QUIT request. In such case executing the exception type
is stored and destructors are executed and finally the exception
restored. But in destructors code new exception can appear. In such
case HVM will give higher priority to QUIT request. If both exception
are BREAK then the one from destructor is taken because it could
overwrite the error object created before destructor.
Inheritance
-----------
Destructors can be inherited from the first super class in the
same way as ON ERROR message. Defining destructor in class overwrites
the inherited ones so they will not be executed.
Maybe in some spare time I'll add support for executing all inherited
super destructors.
Defining destructors in CLASS definition code
---------------------------------------------
CREATE CLASS ...
...
DESTRUCTOR <MethodName>
...
ENDCLASS
Przemyslaw Czerpak (druzus/at/priv.onet.pl)

1
harbour/include/error.ch
View File

@@ -101,6 +101,7 @@
#define EG_APPENDLOCK 40
#define EG_LOCK 41
#define EG_DESTRUCTOR 45 /* Harbour special */
#define EG_ARRACCESS 46 /* Harbour special */
#define EG_ARRASSIGN 47 /* Harbour special */
#define EG_ARRDIMENSION 48 /* Harbour special */

12
harbour/include/hbapi.h
View File

@@ -564,6 +564,13 @@ extern void hb_gcFree( void *pAlloc ); /* deallocates a memory allocated b
extern void * hb_gcLock( void *pAlloc ); /* do not release passed memory block */
extern void * hb_gcUnlock( void *pAlloc ); /* passed block is allowed to be released */
#ifdef _HB_API_INTERNAL_
extern void hb_gcItemRef( HB_ITEM_PTR pItem ); /* checks if passed item refers passed memory block pointer */
extern void hb_vmIsLocalRef( void ); /* hvm.c - mark all local variables as used */
extern void hb_vmIsStaticRef( void ); /* hvm.c - mark all static variables as used */
extern void hb_memvarsIsMemvarRef( void ); /* memvars.c - mark all memvar variables as used */
extern void hb_gcReleaseAll( void ); /* release all memory blocks unconditionally */
extern void hb_gcRefCheck( void * pBlock ); /* Check if block still cannot be access after destructor execution */
extern void hb_gcRefInc( void * pAlloc ); /* increment reference counter */
extern BOOL hb_gcRefDec( void * pAlloc ); /* decrement reference counter, return TRUE when 0 reached */
extern void hb_gcRefFree( void * pAlloc ); /* decrement reference counter and free the block when 0 reached */
@@ -578,11 +585,6 @@ extern HB_COUNTER hb_gcRefCount( void * pAlloc ); /* return number of reference
#endif /* _HB_API_INTERNAL_ */
extern void hb_gcCollect( void ); /* checks if a single memory block can be released */
extern void hb_gcCollectAll( void ); /* checks if all memory blocks can be released */
extern void hb_gcReleaseAll( void ); /* release all memory blocks unconditionally */
extern void hb_gcItemRef( HB_ITEM_PTR pItem ); /* checks if passed item refers passed memory block pointer */
extern void hb_vmIsLocalRef( void ); /* hvm.c - mark all local variables as used */
extern void hb_vmIsStaticRef( void ); /* hvm.c - mark all static variables as used */
extern void hb_memvarsIsMemvarRef( void ); /* memvars.c - mark all memvar variables as used */
/* array management */
extern HB_EXPORT BOOL hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ); /* creates a new array */

2
harbour/include/hbapicls.h
View File

@@ -92,10 +92,12 @@ HB_EXTERN_BEGIN
extern void hb_clsInit( void ); /* initialize Classy/OO system at HVM startup */
extern void hb_clsReleaseAll( void ); /* releases all defined classes */
extern void hb_clsIsClassRef( void ); /* classes.c - mark all class internals as used */
extern BOOL hb_clsHasDestructor( USHORT uiClass );
extern PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pSymMsg, PHB_STACK_STATE pStack ); /* returns the method pointer of an object class */
extern BOOL hb_objHasOperator( PHB_ITEM pObject, USHORT uiOperator );
extern BOOL hb_objOperatorCall( USHORT uiOperator, HB_ITEM_PTR pResult, PHB_ITEM pObject, PHB_ITEM pMsgArg1, PHB_ITEM pMsgArg2 );
extern void hb_objDestructorCall( PHB_ITEM pObject );
#ifndef HB_NO_PROFILER
/* profiler for object management */

14
harbour/include/hbclass.ch
View File

@@ -680,6 +680,20 @@ s_oClass:AddInline( <(op)>, {|Self, <cArg> | <Code> }, HBCLSCHOICE( <.export.>,
s_oClass:SetOnError( CLSMETH _CLASS_NAME_ <MethodName>() )
#endif
#ifdef STRICT_OO
#xcommand DESTRUCTOR <MethodName> => ;
_HB_MEMBER <MethodName>;;
#xcommand METHOD <MethodName> [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED METHOD _CLASS_NAME_ <MethodName>;;
#xcommand PROCEDURE <MethodName> [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED PROCEDURE _CLASS_NAME_ <MethodName>;;
s_oClass:SetDestructor( CLSMETH _CLASS_NAME_ <MethodName>() )
#else
#xcommand DESTRUCTOR <MethodName> => ;
_HB_MEMBER <MethodName>();;
#xcommand METHOD <MethodName> [([<anyParams,...>])] [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED METHOD _CLASS_NAME_ <MethodName>([<anyParams>]);;
#xcommand PROCEDURE <MethodName> [([<anyParams,...>])] [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED PROCEDURE _CLASS_NAME_ <MethodName>([<anyParams>]);;
s_oClass:SetDestructor( CLSMETH _CLASS_NAME_ <MethodName>() )
#endif
#xtranslate END CLASS => ENDCLASS
#ifdef HB_CLS_ALLOWCLASS

3
harbour/include/hboo.ch
View File

@@ -102,7 +102,8 @@
#define HB_OO_MSG_CLSASSIGN 10
#define HB_OO_MSG_CLSACCESS 11
#define HB_OO_MSG_REALCLASS 12
#define HB_OO_MSG_INITIALIZED 13
#define HB_OO_MSG_DESTRUCTOR 13
#define HB_OO_MSG_INITIALIZED 14
/* Data */
#define HB_OO_DATA_SYMBOL 1

2
harbour/source/lang/msgpl852.c
View File

@@ -156,7 +156,7 @@ static HB_LANG s_lang =
"",
"",
"",
"",
"Bˆ¥d w destruktorze obiektu",
"Nieprawidˆowa liczba argument¢w",
"pobranie elementu tablicy",
"zmiana warto˜ci elementu tablicy",

2
harbour/source/lang/msgpliso.c
View File

@@ -156,7 +156,7 @@ static HB_LANG s_lang =
"",
"",
"",
"",
"B³ad w destruktorze obiektu",
"Nieprawid³owa liczba argumentów",
"pobranie elementu tablicy",
"zmiana warto¶ci elementu tablicy",

2
harbour/source/lang/msgplmaz.c
View File

@@ -156,7 +156,7 @@ static HB_LANG s_lang =
"",
"",
"",
"",
"B’†d w destruktorze obiektu",
"Nieprawid’owa liczba argument¢w",
"pobranie elementu tablicy",
"zmiana wartožci elementu tablicy",

2
harbour/source/lang/msgplwin.c
View File

@@ -156,7 +156,7 @@ static HB_LANG s_lang =
"",
"",
"",
"",
"B³¹d w destruktorze obiektu",
"Nieprawid³owa liczba argumentów",
"pobranie elementu tablicy",
"zmiana wartoœci elementu tablicy",

2
harbour/source/rtl/langapi.c
View File

@@ -157,7 +157,7 @@ static HB_LANG s_lang_en =
"",
"",
"",
"",
"Object Destructor Failure",
"array access",
"array assign",
"array dimension",

23
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", 10)
/* s_hClass := __clsNew( "HBCLASS", 11) */
s_hClass := __clsNew( "HBCLASS", 11)
/* s_hClass := __clsNew( "HBCLASS", 12) */
__clsAddMsg( s_hClass, "New" , @New() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "Create" , @Create() , HB_OO_MSG_METHOD )
@@ -98,6 +98,7 @@ FUNCTION HBClass()
__clsAddMsg( s_hClass, "AddVirtual" , @AddVirtual() , 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 )
__clsAddMsg( s_hClass, "InitClass" , @InitClass() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "cSuper" , {| Self | iif( ::acSuper == NIL .OR. Len( ::acSuper ) == 0, NIL, ::acSuper[ 1 ] ) }, HB_OO_MSG_INLINE )
__clsAddMsg( s_hClass, "_cSuper" , {| Self, xVal | iif( ::acSuper == NIL .OR. Len( ::acSuper ) == 0, ( ::acSuper := { xVal } ), ::acSuper[ 1 ] := xVal ), xVal }, HB_OO_MSG_INLINE )
@@ -121,8 +122,10 @@ FUNCTION HBClass()
__clsAddMsg( s_hClass, "_acSuper" , 9, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "nOnError" , 10, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_nOnError" , 10, HB_OO_MSG_ASSIGN )
/* __clsAddMsg( s_hClass, "class" , 11, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_class" , 11, 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 ) */
ENDIF
@@ -250,6 +253,10 @@ STATIC PROCEDURE Create()
__clsAddMsg( hClass, "__OnError", ::nOnError, HB_OO_MSG_ONERROR )
ENDIF
IF ::nDestructor != NIL
__clsAddMsg( hClass, "__Destructor", ::nDestructor, HB_OO_MSG_DESTRUCTOR )
ENDIF
RETURN
//----------------------------------------------------------------------------//
@@ -420,6 +427,14 @@ STATIC PROCEDURE SetOnError( nFuncPtr )
RETURN
STATIC PROCEDURE SetDestructor( nFuncPtr )
LOCAL Self := QSelf()
::nDestructor := nFuncPtr
RETURN
//----------------------------------------------------------------------------//
STATIC FUNCTION InitClass()

49
harbour/source/vm/arrays.c
View File

@@ -71,23 +71,23 @@
#include "hbvmopt.h"
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapicls.h"
#include "hbapierr.h"
#include "hbapilng.h"
#include "hbvm.h"
#include "hbstack.h"
/* This releases array when called from the garbage collector */
static HB_GARBAGE_FUNC( hb_arrayReleaseGarbage )
static void hb_arrayReleaseItems( PHB_BASEARRAY pBaseArray )
{
PHB_BASEARRAY pBaseArray = ( PHB_BASEARRAY ) Cargo;
if( pBaseArray->pItems )
if( pBaseArray->ulLen )
{
HB_ITEM_PTR pItems = pBaseArray->pItems;
ULONG ulLen = pBaseArray->ulLen;
/* clear the pBaseArray->pItems to avoid infinit loop in cross
* referenced items
/*
* clear the pBaseArray->pItems to avoid infinite loop in cross
* referenced items when pBaseArray is not freed due to buggy
* object destructor [druzus]
*/
pBaseArray->pItems = NULL;
pBaseArray->ulLen = 0;
@@ -101,6 +101,41 @@ static HB_GARBAGE_FUNC( hb_arrayReleaseGarbage )
}
}
/* This releases array when called from the garbage collector */
static HB_GARBAGE_FUNC( hb_arrayReleaseGarbage )
{
PHB_BASEARRAY pBaseArray = ( PHB_BASEARRAY ) Cargo;
if( pBaseArray->uiClass )
{
if( hb_clsHasDestructor( pBaseArray->uiClass ) )
{
PHB_ITEM pItem = hb_stackAllocItem();
pItem->type = HB_IT_ARRAY;
pItem->item.asArray.value = pBaseArray;
hb_gcRefInc( pBaseArray );
hb_objDestructorCall( pItem );
/* Clear object properities before hb_stackPop(), [druzus] */
pBaseArray->uiClass = 0;
hb_stackPop();
/*
* release array items before hb_gcRefCheck() to avoid double
* pBaseArray freeing when it will have cross references to
* self after executing buggy destructor [druzus]
*/
hb_arrayReleaseItems( pBaseArray );
hb_gcRefCheck( pBaseArray );
return;
}
}
hb_arrayReleaseItems( pBaseArray );
}
HB_EXPORT BOOL hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */
{
PHB_BASEARRAY pBaseArray;

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

@@ -186,6 +186,7 @@ typedef struct
PHB_ITEM pSharedDatas; /* Harbour Array for Class Shared Datas */
PHB_ITEM pInlines; /* Array for inline codeblocks */
PHB_SYMB pFunError; /* error handler for not defined messages */
PHB_SYMB pDestructor; /* destructor for not this class objects */
ULONG ulOpFlags; /* Flags for overloaded operators */
USHORT uiMethods; /* Total Method initialised Counter */
USHORT uiInitDatas; /* Total Method initialised Counter */
@@ -257,6 +258,8 @@ static HB_SYMB s_opSymbols[ HB_OO_MAX_OPERATOR + 1 ] = {
{ "__ENUMSTOP", {HB_FS_MESSAGE}, {NULL}, NULL } /* 26 */
};
static HB_SYMB s___msgDestructor = { "__msgDestructor", {HB_FS_MESSAGE}, {NULL}, NULL };
static HB_SYMB s___msgSetData = { "__msgSetData", {HB_FS_MESSAGE}, {hb___msgSetData}, NULL };
static HB_SYMB s___msgGetData = { "__msgGetData", {HB_FS_MESSAGE}, {hb___msgGetData}, NULL };
static HB_SYMB s___msgSetClsData = { "__msgSetClsData", {HB_FS_MESSAGE}, {hb___msgSetClsData}, NULL };
@@ -430,6 +433,7 @@ static void hb_clsCopyClass( PCLASS pClsDst, PCLASS pClsSrc )
hb_clsDictInit( pClsDst, pClsSrc->uiHashKey );
pClsDst->pFunError = pClsSrc->pFunError;
pClsDst->pDestructor = pClsSrc->pDestructor;
/* CLASS DATA Not Shared ( new array, new value ) */
pClsDst->pClassDatas = hb_arrayClone( pClsSrc->pClassDatas );
@@ -599,19 +603,21 @@ void hb_clsInit( void )
pOpSym->pDynSym = hb_dynsymGetCase( pOpSym->szName );
}
s___msgClassName.pDynSym = hb_dynsymGetCase( s___msgClassName.szName ); /* Standard messages */
s___msgClassH.pDynSym = hb_dynsymGetCase( s___msgClassH.szName ); /* Not present in classdef. */
s___msgClassSel.pDynSym = hb_dynsymGetCase( s___msgClassSel.szName );
s___msgEval.pDynSym = hb_dynsymGetCase( s___msgEval.szName );
s___msgExec.pDynSym = hb_dynsymGetCase( s___msgExec.szName );
s___msgName.pDynSym = hb_dynsymGetCase( s___msgName.szName );
s___msgDestructor.pDynSym = hb_dynsymGetCase( s___msgDestructor.szName );
s___msgClassName.pDynSym = hb_dynsymGetCase( s___msgClassName.szName ); /* Standard messages */
s___msgClassH.pDynSym = hb_dynsymGetCase( s___msgClassH.szName ); /* Not present in classdef. */
s___msgClassSel.pDynSym = hb_dynsymGetCase( s___msgClassSel.szName );
s___msgEval.pDynSym = hb_dynsymGetCase( s___msgEval.szName );
s___msgExec.pDynSym = hb_dynsymGetCase( s___msgExec.szName );
s___msgName.pDynSym = hb_dynsymGetCase( s___msgName.szName );
/*
s___msgClsParent.pDynSym = hb_dynsymGetCase( s___msgClsParent.szName );
s___msgClass.pDynSym = hb_dynsymGetCase( s___msgClass.szName );
s___msgClsParent.pDynSym = hb_dynsymGetCase( s___msgClsParent.szName );
s___msgClass.pDynSym = hb_dynsymGetCase( s___msgClass.szName );
*/
s___msgEnumIndex.pDynSym = hb_dynsymGetCase( s___msgEnumIndex.szName );
s___msgEnumBase.pDynSym = hb_dynsymGetCase( s___msgEnumBase.szName );
s___msgEnumValue.pDynSym = hb_dynsymGetCase( s___msgEnumValue.szName );
s___msgEnumIndex.pDynSym = hb_dynsymGetCase( s___msgEnumIndex.szName );
s___msgEnumBase.pDynSym = hb_dynsymGetCase( s___msgEnumBase.szName );
s___msgEnumValue.pDynSym = hb_dynsymGetCase( s___msgEnumValue.szName );
s___msgWithObjectPush.pDynSym = hb_dynsymGetCase( s___msgWithObjectPush.szName );
s___msgWithObjectPop.pDynSym = hb_dynsymGetCase( s___msgWithObjectPop.szName );
@@ -1199,6 +1205,9 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage,
{
PHB_ITEM pRealObj;
/* clear the class handle to avoid destructor call */
pObject->item.asArray.value->uiClass = 0;
pRealObj = hb_itemNew( pObject->item.asArray.value->pItems );
/* Now I should exchnage it with the current stacked value */
hb_itemMove( pObject, pRealObj );
@@ -1222,6 +1231,10 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage,
}
return pMethod->pFuncSym;
}
else if( pMsg == s___msgDestructor.pDynSym && pClass->pDestructor )
{
return pClass->pDestructor;
}
}
}
else if( HB_IS_BLOCK( pObject ) )
@@ -1350,6 +1363,38 @@ PHB_SYMB hb_objGetMethod( PHB_ITEM pObject, PHB_SYMB pMessage,
return NULL;
}
/*
* Check if class has object destructors
*/
BOOL hb_clsHasDestructor( USHORT uiClass )
{
if( uiClass && uiClass <= s_uiClasses )
return ( s_pClasses + ( uiClass - 1 ) )->pDestructor != NULL;
else
return FALSE;
}
/*
* Call object destructor
*/
void hb_objDestructorCall( PHB_ITEM pObject )
{
if( pObject->type == HB_IT_ARRAY &&
pObject->item.asArray.value->uiClass != 0 )
{
PCLASS pClass = s_pClasses + pObject->item.asArray.value->uiClass - 1;
if( pClass->pDestructor )
{
hb_stackPushReturn();
hb_vmPushSymbol( &s___msgDestructor );
hb_vmPush( pObject );
hb_vmSend( 0 );
hb_stackPopReturn();
}
}
}
/*
* Check if object has a given operator
*/
@@ -1720,6 +1765,7 @@ HB_FUNC( __CLSADDMSG )
{
case HB_OO_MSG_METHOD:
case HB_OO_MSG_ONERROR:
case HB_OO_MSG_DESTRUCTOR:
pFuncSym = hb_objFuncParam( 3 );
fOK = pFuncSym != NULL;
break;
@@ -1913,6 +1959,11 @@ HB_FUNC( __CLSADDMSG )
pClass->pFunError = pFuncSym;
break;
case HB_OO_MSG_DESTRUCTOR:
pClass->pDestructor = pFuncSym;
break;
default:
hb_errInternal( HB_EI_CLSINVMETHOD, NULL, "__clsAddMsg", NULL );

59
harbour/source/vm/garbage.c
View File

@@ -98,9 +98,10 @@ typedef struct HB_GARBAGE_
#define HB_GC_LOCKED 1 /* do not collect a memory block */
/* flags stored in 'used' slot */
#define HB_GC_USED_FLAG 2 /* the bit for used/unused flag */
#define HB_GC_DELETE 4 /* item will be deleted during finalization */
#define HB_GC_DELETE 4 /* item marked to delete */
#define HB_GC_DELETELST 8 /* item will be deleted during finalization */
/* flags stored in 'flags' slot */
#define HB_GC_USERSWEEP 8 /* memory block with user defined sweep function */
#define HB_GC_USERSWEEP 16 /* memory block with user defined sweep function */
/* pointer to memory block that will be checked in next step */
static HB_GARBAGE_PTR s_pCurrBlock = NULL;
@@ -240,21 +241,14 @@ void hb_gcRefFree( void * pBlock )
else
hb_gcUnlink( &s_pCurrBlock, pAlloc );
pAlloc->used |= HB_GC_DELETE;
/* execute clean-up function */
if( pAlloc->pFunc )
{
/*
* we do not have to set HB_GC_DELETE flag here. If upper level
* code is not broken then the reference counter to this block
* now reach 0 so is nowhere accessible. I set this flag only
* as workaround for some wrong code which may want to execute
* hb_gcFree() for this block from clean-up function. [druzus]
*/
pAlloc->used |= HB_GC_DELETE;
( pAlloc->pFunc )( pBlock );
}
HB_GARBAGE_FREE( pAlloc );
if( pAlloc->used & HB_GC_DELETE )
HB_GARBAGE_FREE( pAlloc );
}
}
}
@@ -264,6 +258,7 @@ void hb_gcRefFree( void * pBlock )
}
}
/* return number of references */
#undef hb_gcRefCount
HB_COUNTER hb_gcRefCount( void * pBlock )
@@ -272,6 +267,27 @@ HB_COUNTER hb_gcRefCount( void * pBlock )
}
/*
* Check if block still cannot be access after destructor execution
*/
void hb_gcRefCheck( void * pBlock )
{
HB_GARBAGE_PTR pAlloc = HB_GC_PTR( pBlock );
if( !( pAlloc->used & HB_GC_DELETELST ) )
{
if( hb_xRefCount( pAlloc ) != 0 )
{
if( hb_vmRequestQuery() == 0 )
hb_errRT_BASE( EG_DESTRUCTOR, 1301, NULL, "Reference to freed block", 0 );
hb_gcLink( &s_pCurrBlock, pAlloc );
pAlloc->used = s_uUsedFlag;
}
}
}
static HB_GARBAGE_FUNC( hb_gcGripRelease )
{
/* Item was already released in hb_gcGripDrop() - then we have nothing
@@ -342,7 +358,7 @@ void * hb_gcLock( void * pBlock )
/* Unlock a memory pointer so it can be released if there is no
references inside of harbour variables
*/
void *hb_gcUnlock( void * pBlock )
void * hb_gcUnlock( void * pBlock )
{
if( pBlock )
{
@@ -578,7 +594,7 @@ void hb_gcCollectAll( void )
if( s_pCurrBlock->used == s_uUsedFlag )
{
pDelete = s_pCurrBlock;
s_pCurrBlock->used |= HB_GC_DELETE;
s_pCurrBlock->used |= HB_GC_DELETE | HB_GC_DELETELST;
hb_gcUnlink( &s_pCurrBlock, s_pCurrBlock );
hb_gcLink( &s_pDeletedBlock, pDelete );
}
@@ -611,7 +627,16 @@ void hb_gcCollectAll( void )
{
pDelete = s_pDeletedBlock;
hb_gcUnlink( &s_pDeletedBlock, s_pDeletedBlock );
HB_GARBAGE_FREE( pDelete );
if( hb_xRefCount( pDelete ) != 0 )
{
if( hb_vmRequestQuery() == 0 )
hb_errRT_BASE( EG_DESTRUCTOR, 1301, NULL, "Reference to freed block", 0 );
hb_gcLink( &s_pCurrBlock, pAlloc );
pAlloc->used = s_uUsedFlag;
}
else
HB_GARBAGE_FREE( pDelete );
} while( s_pDeletedBlock );
}
@@ -642,7 +667,7 @@ void hb_gcReleaseAll( void )
{
HB_TRACE( HB_TR_INFO, ( "Cleanup, %p", s_pCurrBlock ) );
s_pCurrBlock->used |= HB_GC_DELETE;
s_pCurrBlock->used |= HB_GC_DELETE | HB_GC_DELETELST;
( s_pCurrBlock->pFunc )( HB_MEM_PTR( s_pCurrBlock ) );
}

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

@@ -549,6 +549,7 @@ HB_EXPORT int hb_vmQuit( void )
hb_rddShutDown();
hb_idleShutDown();
hb_errExit();
hb_clsReleaseAll();
hb_itemClear( &s_aStatics );

10
harbour/source/vm/itemapi.c
View File

@@ -1437,10 +1437,14 @@ PHB_ITEM hb_itemUnRefOnce( PHB_ITEM pItem )
/* put it here to avoid recursive RT error generation */
pItem->item.asEnum.valuePtr = hb_itemNew( NULL );
hb_itemPutNInt( hb_stackAllocItem(), pItem->item.asEnum.offset );
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
2, pItem->item.asEnum.basePtr, hb_stackItemFromTop( -1 ) );
if( hb_vmRequestQuery() == 0 )
{
hb_itemPutNInt( hb_stackAllocItem(), pItem->item.asEnum.offset );
hb_errRT_BASE( EG_BOUND, 1132, NULL, hb_langDGetErrorDesc( EG_ARRACCESS ),
2, pItem->item.asEnum.basePtr, hb_stackItemFromTop( -1 ) );
hb_stackPop();
}
return pItem->item.asEnum.valuePtr;
}