From 50c2ad2dd25382a1534ce3666f7ff99653aa512d Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 1 Mar 2011 15:07:56 +0000 Subject: Reorganization of call context reference count management so that code is (mostly) simpler. --- ChangeLog | 9 +++++++++ generic/tclOO.c | 21 +++++---------------- generic/tclOOBasic.c | 19 +++++++------------ generic/tclOOCall.c | 10 ++++++---- generic/tclOOInt.h | 6 ++---- 5 files changed, 29 insertions(+), 36 deletions(-) diff --git a/ChangeLog b/ChangeLog index 02af7dd..176e594 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2011-03-01 Donal K. Fellows + + * generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance) + (TclOOObjectCmdCore, FinalizeObjectCall): + * generic/tclOOBasic.c (TclOO_Object_Destroy, AfterNRDestructor): + * generic/tclOOCall.c (TclOODeleteContext, TclOOGetCallContext): + Reorganization of call context reference count management so that code + is (mostly) simpler. + 2011-01-26 Donal K. Fellows * doc/RegExp.3: [Bug 3165108]: Corrected documentation of description diff --git a/generic/tclOO.c b/generic/tclOO.c index 820fee0..4397d8a 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -3,12 +3,10 @@ * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * - * Copyright (c) 2005-2008 by Donal K. Fellows + * Copyright (c) 2005-2011 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclOO.c,v 1.36 2010/03/05 15:32:16 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -1452,7 +1450,6 @@ Tcl_NewObjectInstance( int result, flags; Tcl_InterpState state; - AddRef(oPtr); state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; @@ -1472,7 +1469,6 @@ Tcl_NewObjectInstance( result = TCL_ERROR; } TclOODeleteContext(contextPtr); - DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); @@ -1569,7 +1565,6 @@ TclNRNewObjectInstance( return TCL_OK; } - AddRef(oPtr); state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; @@ -1607,7 +1602,6 @@ FinalizeAlloc( result = TCL_ERROR; } TclOODeleteContext(contextPtr); - DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); @@ -2316,7 +2310,6 @@ TclOOObjectCmdCore( } } if (contextPtr->index >= contextPtr->callPtr->numChain) { - result = TCL_ERROR; Tcl_SetResult(interp, "no valid method implementation", TCL_STATIC); TclOODeleteContext(contextPtr); @@ -2329,8 +2322,7 @@ TclOOObjectCmdCore( * for the duration. */ - AddRef(oPtr); - TclNRAddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL); + TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } @@ -2340,15 +2332,12 @@ FinalizeObjectCall( Tcl_Interp *interp, int result) { - register CallContext *contextPtr = data[0]; - register Object *oPtr = data[1]; - /* - * Dispose of the call chain and drop the lock on the object's structure. + * Dispose of the call chain, which drops the lock on the object's + * structure. */ - TclOODeleteContext(contextPtr); - DelRef(oPtr); + TclOODeleteContext(data[0]); return result; } diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b26061e..7e9dc29 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -4,12 +4,10 @@ * This file contains implementations of the "simple" commands and * methods from the object-system core. * - * Copyright (c) 2005-2008 by Donal K. Fellows + * Copyright (c) 2005-2011 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclOOBasic.c,v 1.24 2010/02/05 13:41:33 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -278,9 +276,8 @@ TclOO_Object_Destroy( if (contextPtr != NULL) { contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; - AddRef(oPtr); - TclNRAddCallback(interp, AfterNRDestructor, oPtr, contextPtr, - NULL, NULL); + TclNRAddCallback(interp, AfterNRDestructor, contextPtr, + NULL, NULL, NULL); return TclOOInvokeContext(contextPtr, interp, 0, NULL); } } @@ -296,14 +293,12 @@ AfterNRDestructor( Tcl_Interp *interp, int result) { - Object *oPtr = data[0]; - CallContext *contextPtr = data[1]; + CallContext *contextPtr = data[0]; - TclOODeleteContext(contextPtr); - if (oPtr->command) { - Tcl_DeleteCommandFromToken(interp, oPtr->command); + if (contextPtr->oPtr->command) { + Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command); } - DelRef(oPtr); + TclOODeleteContext(contextPtr); return result; } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index e8f9757..292e9e0 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -4,12 +4,10 @@ * This file contains the method call chain management code for the * object-system core. * - * Copyright (c) 2005-2008 by Donal K. Fellows + * Copyright (c) 2005-2011 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclOOCall.c,v 1.15 2009/09/30 03:11:26 dgp Exp $ */ #ifdef HAVE_CONFIG_H @@ -103,8 +101,11 @@ void TclOODeleteContext( CallContext *contextPtr) { + register Object oPtr = contextPtr->oPtr; + TclOODeleteChain(contextPtr->callPtr); - TclStackFree(contextPtr->oPtr->fPtr->interp, contextPtr); + TclStackFree(oPtr->fPtr->interp, contextPtr); + DelRef(oPtr); } /* @@ -1089,6 +1090,7 @@ TclOOGetCallContext( returnContext: contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); contextPtr->oPtr = oPtr; + AddRef(oPtr); contextPtr->callPtr = callPtr; contextPtr->skip = 2; contextPtr->index = 0; diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 56da45d..bd32f22 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -4,12 +4,10 @@ * This file contains the structure definitions and some of the function * declarations for the object-system (NB: not Tcl_Obj, but ::oo). * - * Copyright (c) 2006 by Donal K. Fellows + * Copyright (c) 2006-2011 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclOOInt.h,v 1.18 2010/04/27 12:36:21 nijtmans Exp $ */ #ifndef TCL_OO_INTERNAL_H @@ -368,7 +366,7 @@ typedef struct CallContext { } CallContext; /* - * Bits for the 'flags' field of the call context. + * Bits for the 'flags' field of the call chain. */ #define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */ -- cgit v0.12