From a35053003bb424e088056fe312763f663f5a509b Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Fri, 15 Sep 2006 03:10:38 +0000 Subject: [PATCH] 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 * 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. --- harbour/ChangeLog | 37 ++++++++++ harbour/doc/destruct.txt | 128 +++++++++++++++++++++++++++++++++ harbour/include/error.ch | 1 + harbour/include/hbapi.h | 12 ++-- harbour/include/hbapicls.h | 2 + harbour/include/hbclass.ch | 14 ++++ harbour/include/hboo.ch | 3 +- harbour/source/lang/msgpl852.c | 2 +- harbour/source/lang/msgpliso.c | 2 +- harbour/source/lang/msgplmaz.c | 2 +- harbour/source/lang/msgplwin.c | 2 +- harbour/source/rtl/langapi.c | 2 +- harbour/source/rtl/tclass.prg | 23 ++++-- harbour/source/vm/arrays.c | 49 +++++++++++-- harbour/source/vm/classes.c | 73 ++++++++++++++++--- harbour/source/vm/garbage.c | 59 ++++++++++----- harbour/source/vm/hvm.c | 1 + harbour/source/vm/itemapi.c | 10 ++- 18 files changed, 369 insertions(+), 53 deletions(-) create mode 100644 harbour/doc/destruct.txt diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 91f176f248..b4e8cfa6a3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,43 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + * 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 diff --git a/harbour/doc/destruct.txt b/harbour/doc/destruct.txt new file mode 100644 index 0000000000..0eacd0f4d8 --- /dev/null +++ b/harbour/doc/destruct.txt @@ -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 + ... +ENDCLASS + + + +Przemyslaw Czerpak (druzus/at/priv.onet.pl) diff --git a/harbour/include/error.ch b/harbour/include/error.ch index 10165621f4..3a8aa30ab9 100644 --- a/harbour/include/error.ch +++ b/harbour/include/error.ch @@ -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 */ diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index f6ef5e85b5..41b47118ee 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -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 */ diff --git a/harbour/include/hbapicls.h b/harbour/include/hbapicls.h index 079fa0e457..c5b4e7fdf5 100644 --- a/harbour/include/hbapicls.h +++ b/harbour/include/hbapicls.h @@ -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 */ diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index a7832780e9..d6788c9fc7 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -680,6 +680,20 @@ s_oClass:AddInline( <(op)>, {|Self, | }, HBCLSCHOICE( <.export.>, s_oClass:SetOnError( CLSMETH _CLASS_NAME_ () ) #endif +#ifdef STRICT_OO + #xcommand DESTRUCTOR => ; + _HB_MEMBER ;; + #xcommand METHOD [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED METHOD _CLASS_NAME_ ;; + #xcommand PROCEDURE [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED PROCEDURE _CLASS_NAME_ ;; + s_oClass:SetDestructor( CLSMETH _CLASS_NAME_ () ) +#else + #xcommand DESTRUCTOR => ; + _HB_MEMBER ();; + #xcommand METHOD [([])] [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED METHOD _CLASS_NAME_ ([]);; + #xcommand PROCEDURE [([])] [DECLCLASS _CLASS_NAME_] _CLASS_IMPLEMENTATION_ => DECLARED PROCEDURE _CLASS_NAME_ ([]);; + s_oClass:SetDestructor( CLSMETH _CLASS_NAME_ () ) +#endif + #xtranslate END CLASS => ENDCLASS #ifdef HB_CLS_ALLOWCLASS diff --git a/harbour/include/hboo.ch b/harbour/include/hboo.ch index c0da068e61..42a5249d05 100644 --- a/harbour/include/hboo.ch +++ b/harbour/include/hboo.ch @@ -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 diff --git a/harbour/source/lang/msgpl852.c b/harbour/source/lang/msgpl852.c index e4e32ed811..ac50e678d4 100644 --- a/harbour/source/lang/msgpl852.c +++ b/harbour/source/lang/msgpl852.c @@ -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", diff --git a/harbour/source/lang/msgpliso.c b/harbour/source/lang/msgpliso.c index a20d1fcd0f..300346996d 100644 --- a/harbour/source/lang/msgpliso.c +++ b/harbour/source/lang/msgpliso.c @@ -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", diff --git a/harbour/source/lang/msgplmaz.c b/harbour/source/lang/msgplmaz.c index 5afd4929e6..7532b137fe 100644 --- a/harbour/source/lang/msgplmaz.c +++ b/harbour/source/lang/msgplmaz.c @@ -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", diff --git a/harbour/source/lang/msgplwin.c b/harbour/source/lang/msgplwin.c index e05af3aef8..fb222fe634 100644 --- a/harbour/source/lang/msgplwin.c +++ b/harbour/source/lang/msgplwin.c @@ -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", diff --git a/harbour/source/rtl/langapi.c b/harbour/source/rtl/langapi.c index 3d390e57ed..e979c3840b 100644 --- a/harbour/source/rtl/langapi.c +++ b/harbour/source/rtl/langapi.c @@ -157,7 +157,7 @@ static HB_LANG s_lang_en = "", "", "", - "", + "Object Destructor Failure", "array access", "array assign", "array dimension", diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 7a10ad7b88..ec5be29acc 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", 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() diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 5dd96808d3..6a216f44ba 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -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; diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index a750e18f2d..c090e16adf 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -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 ); diff --git a/harbour/source/vm/garbage.c b/harbour/source/vm/garbage.c index e04729a73e..0dfeb36012 100644 --- a/harbour/source/vm/garbage.c +++ b/harbour/source/vm/garbage.c @@ -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 ) ); } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 9fde7b27a7..0cbee22874 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -549,6 +549,7 @@ HB_EXPORT int hb_vmQuit( void ) hb_rddShutDown(); hb_idleShutDown(); + hb_errExit(); hb_clsReleaseAll(); hb_itemClear( &s_aStatics ); diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 467c76c484..1b0772f3e8 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -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; }