Reorganization of call context reference count management so that code

	is (mostly) simpler.

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  <dkf@users.sf.net>
+
+	* 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  <dkf@users.sf.net>
 
 	* 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. */