Implementation of TIP #257. Incomplete due to missing Win build support.

31 files changed, 13866 insertions, 22 deletions

diff --git a/ChangeLog b/ChangeLog
index aadcf78..1255ad6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2008-05-31  Donal K. Fellows  <dkf@users.sf.net>
+
+	TIP#257 IMPLEMENTATION
+
+	* generic/tclOO*, doc/*, tests/oo.test: Port of implementation of
+	TclOO to sit directly inside Tcl. Note that this is incomplete (e.g.
+	no build support yet for Windows).
+
 2008-05-26  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* tests/io.test (io-53.9): need to close chan before removing file.
diff --git a/doc/Class.3 b/doc/Class.3
new file mode 100644
index 0000000..8954ab7
--- /dev/null
+++ b/doc/Class.3
@@ -0,0 +1,231 @@
+'\"
+'\" Copyright (c) 2007 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: Class.3,v 1.1 2008/05/31 11:42:06 dkf Exp $
+'\"
+.so man.macros
+.TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_CopyObjectInstance, Tcl_GetClassAsObject, Tcl_GetObjectAsClass, Tcl_GetObjectCommand, Tcl_GetObjectNamespace, Tcl_NewObjectInstance, Tcl_ObjectDeleted, Tcl_ObjectGetMetadata, Tcl_ObjectGetMethodNameMapper, Tcl_ObjectSetMetadata, Tcl_ObjectSetMethodNameMapper \- manipulate objects and classes
+.SH SYNOPSIS
+.nf
+\fB#include <tclOO.h>\fR
+.sp
+Tcl_Object
+\fBTcl_GetObjectFromObj\fR(\fIinterp, objPtr\fR)
+.sp
+Tcl_Object
+\fBTcl_GetClassAsObject\fR(\fIclass\fR)
+.sp
+Tcl_Class
+\fBTcl_GetObjectAsClass\fR(\fIobject\fR)
+.sp
+Tcl_Command
+\fBTcl_GetObjectCommand\fR(\fIobject\fR)
+.sp
+Tcl_Namespace *
+\fBTcl_GetObjectNamespace\fR(\fIobject\fR)
+.sp
+Tcl_Object
+\fBTcl_NewObjectInstance\fR(\fIinterp, class, name, nsName, objc, objv, skip\fR)
+.sp
+Tcl_Object
+\fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR)
+.sp
+int
+\fBTcl_ObjectDeleted\fR(\fIobject\fR)
+.sp
+ClientData
+\fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR)
+.sp
+\fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR)
+.sp
+ClientData
+\fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR)
+.sp
+\fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR)
+.sp
+Tcl_ObjectMapMethodNameProc
+\fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR)
+.sp
+\fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR)
+.SH ARGUMENTS
+.AS ClientData metadata in/out
+.AP Tcl_Interp *interp in/out
+Interpreter providing the context for looking up or creating an object, and
+into whose result error messages will be written on failure.
+.AP Tcl_Obj *objPtr in
+The name of the object to look up.
+.AP Tcl_Object object in
+Reference to the object to operate upon.
+.AP Tcl_Class class in
+Reference to the class to operate upon.
+.AP "const char" *name in
+The name of the object to create, or NULL if a new unused name is to be
+automatically selected.
+.AP "const char" *nsName in
+The name of the namespace to create for the object's private use, or NULL if a
+new unused name is to be automatically selected.
+.AP int objc in
+The number of elements in the \fIobjv\fR array.
+.AP "Tcl_Obj *const" *objv in
+The arguments to the command to create the instance of the class.
+.AP int skip in
+The number of arguments at the start of the argument array, \fIobjv\fR, that
+are not arguments to any constructors.
+.AP Tcl_ObjectMetadataType *metaTypePtr in
+The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
+retrieved with \fBTcl_ClassGetMetadata\fR.
+.AP ClientData metadata in
+An item of metadata to attach to the class, or NULL to remove the metadata
+associated with a particular \fImetaTypePtr\fR.
+.AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in
+A pointer to a function to call to adjust the mapping of objects and method
+names to implementations, or NULL when no such mapping is required.
+.BE
+.SH DESCRIPTION
+.PP
+Objects are typed entities that have a set of operations ("methods")
+associated with them. Classes are objects that can manufacture objects. Each
+class can be viewed as an object itself; the object view can be retrieved
+using \fBTcl_GetClassAsObject\fR which always returns the object when applied
+to a non-destroyed class, and an object can be viewed as a class with the aid
+of the \fBTcl_GetObjectAsClass\fR (which either returns the class, or NULL if
+the object is not a class). An object may be looked up using the
+\fBTcl_GetObjectFromObj\fR function, which either returns an object or NULL
+(with an error message in the interpreter result) if the object cannot be
+found. The correct way to look up a class by name is to look up the object
+with that name, and then to use \fBTcl_GetObjectAsClass\fR.
+.PP
+Every object has its own command and namespace associated with it. The command
+may be retrieved using the \fBTcl_GetObjectCommand\fR function, and the
+namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR function.
+.PP
+Instances of classes are created using \fBTcl_NewObjectInstance\fR, which
+takes creates an object from any class (and which is internally called by both
+the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes
+parameters that optionally give the name of the object and namespace to
+create, and which describe the arguments to pass to to the class's constructor
+(if any). The result of the function will be either a reference to the newly
+created object, or NULL if the creation failed (when an error message will be
+left in the interpreter result). In addition, objects may be copied by using
+\fBTcl_CopyObjectInstance\fR which creates a copy of an object without running
+any constructors.
+.SH "OBJECT AND CLASS METADATA"
+.PP
+Every object and every class may have arbitrary amounts of metadata attached
+to it, which the object or class attaches no meaning to beyond what is
+described in a Tcl_ObjectMetadataType structure instance. Metadata to be
+attached is described by the the type of the metadata (given in the
+\fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR
+argument) that are given to \fBTcl_ObjectSetMetadata\fR and
+\fBTcl_ClassSetMetadata\fR, and a particular piece of metadata can be
+retrieved given its type using \fBTcl_ObjectGetMetadata\fR and
+\fBTcl_ClassGetMetadata\fR. If the \fImetadata\fR parameter to either
+\fBTcl_ObjectSetMetadata\fR or \fBTcl_ClassSetMetadata\fR is NULL, the
+metadata is removed if it was attached, and the results of
+\fBTcl_ObjectGetMetadata\fR and \fBTcl_ClassGetMetadata\fR are NULL if the
+given type of metadata was not attached. It is not an error to request or
+remove a piece of metadata that was not attached.
+.SS "TCL_OBJECTMETADATATYPE STRUCTURE"
+.PP
+The contents of the Tcl_ObjectMetadataType structure are as follows:
+.PP
+.CS
+ typedef const struct {
+     int \fIversion\fR;
+     const char *\fIname\fR;
+     Tcl_ObjectMetadataDeleteProc \fIdeleteProc\fR;
+     Tcl_CloneProc \fIcloneProc\fR;
+ } \fBTcl_ObjectMetadataType\fR;
+.CE
+.PP
+The \fIversion\fR field allows for future expansion of the structure, and
+should always be declared equal to TCL_OO_METADATA_VERSION_CURRENT. The
+\fIname\fR field provides a human-readable name for the type, and is reserved
+for debugging.
+.PP
+The \fIdeleteProc\fR field gives a function of type
+Tcl_ObjectMetadataDeleteProc that is used to delete a particular piece of
+metadata, and is called when the attached metadata is replaced or removed; the
+field must not be NULL.
+.PP
+The \fIcloneProc\fR field gives a function that is used to copy a piece of
+metadata (used when a copy of an object is created using
+\fBTcl_CopyObjectInstance\fR); if NULL, the metadata will be just directly
+copied.
+.SS "TCL_OBJECTMETADATADELETEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used to delete metadata associated with
+a class or object.
+.PP
+.CS
+ typedef void (*\fBTcl_ObjectMetadataDeleteProc\fR) (
+         ClientData \fImetadata\fR);
+.CE
+.PP
+The \fImetadata\fR argument gives the address of the metadata to be
+deleted.
+.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used to create copies of metadata
+associated with a class or object.
+.PP
+.CS
+ typedef int (*\fBTcl_CloneProc\fR) (
+         Tcl_Interp *\fIinterp\fR,
+         ClientData \fIsrcMetadata\fR,
+         ClientData *\fIdstMetadataPtr\fR);
+.CE
+.PP
+The \fIinterp\fR argument gives a place to write an error message when the
+attempt to clone the object is to fail, in which case the clone procedure must
+also return TCL_ERROR; it should return TCL_OK otherwise.
+The \fIsrcMetadata\fR argument gives the address of the metadata to be cloned,
+and the cloned metadata should be written into the variable pointed to by
+\fIdstMetadataPtr\fR; a NULL should be written if the metadata is to not be
+cloned but the overall object copy operation is still to succeed.
+.SH "OBJECT METHOD NAME MAPPING"
+It is possible to control, on a per-object basis, what methods are invoked
+when a particular method is invoked. Normally this is done by looking up the
+method name in the object and then in the class hierarchy, but fine control of
+exactly what the value used to perform the look up is afforded through the
+ability to set a method name mapper callback via
+\fBTcl_ObjectSetMethodNameMapper\fR (and its introspection counterpart,
+\fBTcl_ObjectGetMethodNameMapper\fR, which returns the current mapper). The
+current mapper (if any) is invoked immediately before looking up what chain of
+method implementations is to be used.
+.SS "TCL_OBJECTMAPMETHODNAMEPROC FUNCTION SIGNATURE"
+The \fITcl_ObjectMapMethodNameProc\fR callback is defined as follows:
+.PP
+.CS
+ typedef int (*\fBTcl_ObjectMapMethodNameProc\fR)(
+         Tcl_Interp *\fIinterp\fR,
+         Tcl_Object \fIobject\fR,
+         Tcl_Class *\fIstartClsPtr\fR,
+         Tcl_Obj *\fImethodNameObj\fR);
+.CE
+.PP
+The \fIinterp\fR parameter (and the integer result) follow normal Tcl result
+rules for error reporting. The \fIobject\fR parameter says which object is
+being processed. The \fIstartClsPtr\fR parameter points to a variable that
+contains the first class to provide a definition in the method chain to
+process, or NULL if the whole chain is to be processed (the argument itself is
+never NULL); this variable may be updated by the callback. The
+\fImethodNameObj\fR parameter gives an unshared object containing the name of
+the method being invoked, as provided by the user; this object may be updated
+by the callback.
+.SH "SEE ALSO"
+Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n)
+.SH KEYWORDS
+class, constructor, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/Method.3 b/doc/Method.3
new file mode 100644
index 0000000..341dcac
--- /dev/null
+++ b/doc/Method.3
@@ -0,0 +1,249 @@
+'\"
+'\" Copyright (c) 2007 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: Method.3,v 1.1 2008/05/31 11:42:06 dkf Exp $
+'\"
+.so man.macros
+.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
+.SH SYNOPSIS
+.nf
+\fB#include <tclOO.h>\fR
+.sp
+Tcl_Method
+\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
+              methodTypePtr, clientData\fR)
+.sp
+Tcl_Method
+\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
+                      methodTypePtr, clientData\fR)
+.sp
+\fBTcl_ClassSetConstructor\fR(\fIclass, method\fR)
+.sp
+\fBTcl_ClassSetDestructor\fR(\fIclass, method\fR)
+.sp
+Tcl_Class
+\fBTcl_MethodDeclarerClass\fR(\fImethod\fR)
+.sp
+Tcl_Object
+\fBTcl_MethodDeclarerObject\fR(\fImethod\fR)
+.sp
+Tcl_Obj *
+\fBTcl_MethodName\fR(\fImethod\fR)
+.sp
+int
+\fBTcl_MethodIsPublic\fR(\fImethod\fR)
+.sp
+int
+\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
+.sp
+int
+\fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR)
+.sp
+int
+\fBTcl_ObjectContextIsFiltering\fR(\fIcontext\fR)
+.sp
+Tcl_Method
+\fBTcl_ObjectContextMethod\fR(\fIcontext\fR)
+.sp
+Tcl_Object
+\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
+.sp
+int
+\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
+.SH ARGUMENTS
+.AS ClientData clientData in
+.AP Tcl_Interp *interp in/out
+The interpreter holding the object or class to create or update a method in.
+.AP Tcl_Object object in
+The object to create the method in.
+.AP Tcl_Class class in
+The class to create the method in.
+.AP Tcl_Obj *nameObj in
+The name of the method to create. Should not be NULL unless creating
+constructors or destructors.
+.AP int isPublic in
+A boolean flag saying whether the method is to be exported.
+.AP Tcl_MethodType *methodTypePtr in
+A description of the type of the method to create, or the type of method to
+compare against.
+.AP ClientData clientData in
+A piece of data that is passed to the implementation of the method without
+interpretation.
+.AP ClientData *clientDataPtr out
+A pointer to a variable in which to write the \fIclientData\fR value supplied
+when the method was created. If NULL, the \fIclientData\fR value will not be
+retrieved.
+.AP Tcl_Method method in
+A reference to a method to query.
+.AP Tcl_ObjectContext context in
+A reference to a method-call context. Note that client code \fImust not\fR
+retain a reference to a context.
+.AP int objc in
+The number of arguments to pass to the method implementation.
+.AP "Tcl_Obj *const" *objv in
+An array of arguments to pass to the method implementation.
+.AP int skip in
+The number of arguments passed to the method implementation that do not
+represent "real" arguments.
+.BE
+.SH DESCRIPTION
+.PP
+A method is an operation carried out on an object that is associated with the
+object. Every method must be attached to either an object or a class; methods
+attached to a class are associated with all instances (direct and indirect) of
+that class.
+.PP
+Given a method, the entity that declared it can be found using
+\fBTcl_MethodDeclarerClass\fR which returns the class that the method is
+attached to (or NULL if the method is not attached to any class) and
+\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
+attached to (or NULL if the method is not attached to an object). The name of
+the method can be retrieved with \fBTcl_MethodName\fR and whether the method
+is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
+can also be introspected upon to a limited degree; the function
+\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
+assigning the per-method \fIclientData\fR to the variable pointed to by
+\fIclientDataPtr\fR if (that is non-NULL) if the type is matched.
+.SS "METHOD CREATION"
+.PP
+Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewClassMethod\fR, which
+create a method attached to an object or a class respectively. In both cases,
+the \fInameObj\fR argument gives the name of the method to create, the
+\fIisPublic\fR argument states whether the method should be exported
+initially, the \fImethodTypePtr\fR argument describes the implementation of
+the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
+argument gives some implementation-specific data that is passed on to the
+implementation of the method when it is called.
+.PP
+When the \fInameObj\fR argument to \fBTcl_NewClassMethod\fR is NULL, an
+unnamed method is created, which is used for constructors and destructors.
+Constructors should be installed into their class using the
+\fBTcl_ClassSetConstructor\fR function, and destructors (which must not
+require any arguments) should be installed into their class using the
+\fBTcl_ClassSetDestructor\fR function. Unnamed methods should not be used for
+any other purpose, and named methods should not be used as either constructors
+or destructors. Also note that a NULL \fImethodTypePtr\fR is used to provide
+internal signalling, and should not be used in client code.
+.SS "METHOD CALL CONTEXTS"
+.PP
+When a method is called, a method-call context reference is passed in as one
+of the arguments to the implementation function. This context can be inspected
+to provide information about the caller, but should not be retained beyond the
+moment when the method call terminates.
+.PP
+The method that is being called can be retrieved from the context by using
+\fBTcl_ObjectContextMethod\fR, and the object that caused the method to be
+invoked can be retrieved with \fBTcl_ObjectContextObject\fR. The number of
+arguments that are to be skipped (e.g. the object name and method name in a
+normal method call) is read with \fBTcl_ObjectContextSkippedArgs\fR, and the
+context can also report whether it is working as a filter for another method
+through \fBTcl_ObjectContextIsFiltering\fR.
+.PP
+During the execution of a method, the method implementation may choose to
+invoke the stages of the method call chain that come after the current method
+implementation. This (the core of the \fBnext\fR command) is done using
+\fBTcl_ObjectContextInvokeNext\fR. Note that this function does not manipulate
+the call-frame stack, unlike the \fBnext\fR command; if the method
+implementation has pushed one or more extra frames on the stack as part of its
+implementation, it is also responsible for temporarily popping those frames
+from the stack while the \fBTcl_ObjectContextInvokeNext\fR function is
+executing. Note also that the method-call context is \fInever\fR deleted
+during the execution of this function.
+.SH "METHOD TYPES"
+.PP
+The types of methods are described by a pointer to a Tcl_MethodType structure,
+which is defined as:
+.PP
+.CS
+ typedef const struct {
+     int \fIversion\fR;
+     const char *\fIname\fR;
+     Tcl_MethodCallProc \fIcallProc\fR;
+     Tcl_MethodDeleteProc \fIdeleteProc\fR;
+     Tcl_CloneProc \fIcloneProc\fR;
+ } \fBTcl_MethodType\fR;
+.CE
+.PP
+The \fIversion\fR field allows for future expansion of the structure, and
+should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The
+\fIname\fR field provides a human-readable name for the type, and is reserved
+for debugging.
+.PP
+The \fIcallProc\fR field gives a function that is called when the method is
+invoked; it must never be NULL.
+.PP
+The \fIdeleteProc\fR field gives a function that is used to delete a
+particular method, and is called when the method is replaced or removed; if
+the field is NULL, it is assumed that the method's \fIclientData\fR needs no
+special action to delete.
+.PP
+The \fIcloneProc\fR field is either a function that is used to copy a method's
+\fIclientData\fR (as part of \fBTcl_CopyObjectInstance\fR) or NULL to indicate
+that the \fIclientData\fR can just be copied directly.
+.SS "TCL_METHODCALLPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are called when the method is invoked.
+.PP
+.CS
+ typedef int (*\fBTcl_MethodCallProc\fR) (
+         ClientData \fIclientData\fR,
+         Tcl_Interp *\fIinterp\fR,
+         Tcl_ObjectContext \fIobjectContext\fR,
+         int \fIobjc\fR,
+         Tcl_Obj *const *\fIobjv\fR);
+.CE
+.PP
+The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was
+given when the method was created, the \fIinterp\fR is a place in which to
+execute scripts and access variables as well as being where to put the result
+of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter
+objects to the method. The calling context of the method can be discovered
+through the \fIobjectContext\fR argument, and the return value from a
+Tcl_MethodCallProc is any Tcl return code (e.g. TCL_OK, TCL_ERROR).
+.SS "TCL_METHODDELETEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used when a method is deleted, whether
+through a new method being created or because the object or class is deleted.
+.PP
+.CS
+ typedef void (*\fBTcl_MethodDeleteProc\fR) (
+         ClientData \fIclientData\fR);
+.CE
+.PP
+The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as
+the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or
+\fBTcl_NewClassMethod\fR when the method was created.
+.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
+.PP
+Functions matching this signature are used to copy a method when the object or
+class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR).
+.PP
+.CS
+ typedef int (*\fBTcl_CloneProc\fR) (
+         Tcl_Interp *\fIinterp\fR,
+         ClientData \fIoldClientData\fR,
+         ClientData *\fInewClientDataPtr\fR);
+.CE
+.PP
+The \fIinterp\fR argument gives a place to write an error message when the
+attempt to clone the object is to fail, in which case the clone procedure must
+also return TCL_ERROR; it should return TCL_OK otherwise.
+The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the
+method being copied from, and the \fInewClientDataPtr\fR field will point to
+a variable in which to write the value for the method being copied to.
+.SH "SEE ALSO"
+Class(3), oo::class(n), oo::define(n), oo::object(n)
+.SH KEYWORDS
+constructor, method, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/class.n b/doc/class.n
new file mode 100644
index 0000000..02dfc46
--- /dev/null
+++ b/doc/class.n
@@ -0,0 +1,126 @@
+'\"
+'\" Copyright (c) 2007 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: class.n,v 1.1 2008/05/31 11:42:06 dkf Exp $
+'\"
+.so man.macros
+.TH class n 0.1 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::class \- class of all classes
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::class\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+   \(-> \fBoo::class\fR
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBoo::class\fR class is the class of all classes; every class is an
+instance of this class, which is consequently an instance of itself. This
+class is a subclass of \fBoo::object\fR, so every class is also an object.
+Additional metaclasses (i.e. classes of classes) can be defined if necessary
+by subclassing \fBoo::class\fR. Note that the \fBoo::class\fR object hides the
+\fBnew\fR method on itself, so new classes should always be made using the
+\fBcreate\fR method.
+.SS CONSTRUCTOR
+The constructor of the \fBoo::class\fR class takes an optional argument which,
+if present, is sent to the \fBoo::define\fR command (along with the name of
+the newly-created class) to allow the class to be conveniently configured at
+creation time.
+.SS DESTRUCTOR
+The \fBoo::class\fR class does not define an explicit destructor. However,
+when a class is destroyed, all its subclasses and instances are also
+destroyed, along with all objects that it has been mixed into.
+.SS "EXPORTED METHODS"
+.TP
+\fIcls \fBcreate \fIname \fR?\fIarg ...\fR?
+.
+This creates a new instance of the class \fIcls\fR called \fIname\fR (which is
+resolved within the calling context's namespace if not fully qualified),
+passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
+a successful result) returning the fully qualified name of the created object
+(the result of the constructor is ignored). If the constructor fails (i.e.
+returns a non-OK result) then the object is destroyed and the error message is
+the result of this method call.
+.TP
+\fIcls \fBnew \fR?\fIarg ...\fR?
+.
+This creates a new instance of the class \fIcls\fR with a new unique name,
+passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
+a successful result) returning the fully qualified name of the created object
+(the result of the constructor is ignored). If the constructor fails (i.e.
+returns a non-OK result) then the object is destroyed and the error message is
+the result of this method call. Note that this method is not exported by the
+\fBoo::class\fR object itself, so classes should not be created using this
+method.
+.SS "NON-EXPORTED METHODS"
+The \fBoo::class\fR class supports the following non-exported methods:
+.TP
+\fIobj \fBcreateWithNamespace\fI name nsName\fR ?\fIarg ...\fR?
+.
+This creates a new instance of the class \fIcls\fR called \fIname\fR (which is
+resolved within the calling context's namespace if not fully qualified),
+passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
+a successful result) returning the fully qualified name of the created object
+(the result of the constructor is ignored). The name of the instance's
+internal namespace will be \fInsName\fR unless that namespace already exists
+(when an arbitrary name will be chosen instead). If the constructor fails
+(i.e. returns a non-OK result) then the object is destroyed and the error
+message is the result of this method call.
+.SH EXAMPLES
+This example defines a simple class hierarchy and creates a new instance of
+it. It then invokes a method of the object before destroying the hierarchy and
+showing that the destruction is transitive.
+.CS
+\fBoo::class create\fR fruit {
+    method eat {} {
+        puts "yummy!"
+    }
+}
+\fBoo::class create\fR banana {
+    superclass fruit
+    constructor {} {
+        my variable peeled
+        set peeled 0
+    }
+    method peel {} {
+        my variable peeled
+        set peeled 1
+        puts "skin now off"
+    }
+    method edible? {} {
+        my variable peeled
+        return $peeled
+    }
+    method eat {} {
+        if {![my edible?]} {
+            my peel
+        }
+        next
+    }
+}
+set b [banana \fBnew\fR]
+$b eat               \fI\(-> prints "skin now off" and "yummy!"\fR
+fruit destroy
+$b eat               \fI\(-> error "unknown command"\fR
+.CE
+.SH "SEE ALSO"
+oo::define(n), oo::object(n)
+.SH KEYWORDS
+class, metaclass, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/copy.n b/doc/copy.n
new file mode 100644
index 0000000..291d2fc
--- /dev/null
+++ b/doc/copy.n
@@ -0,0 +1,54 @@
+'\"
+'\" Copyright (c) 2007 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: copy.n,v 1.1 2008/05/31 11:42:12 dkf Exp $
+'\"
+.so man.macros
+.TH copy n 0.1 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::copy \- create copies of objects and classes
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBoo::copy\fR command creates a copy of an object or class. It takes the
+name of the object or class to be copied, \fIsourceObject\fR, and optionally
+the name of the object or class to create, \fItargetObject\fR, which will be
+resolved relative to the current namespace if not an absolute qualified name.
+If \fItargetObject\fR is omitted, a new name is chosen. The copied object will
+be of the same class as the source object, and will have all its per-object
+methods copied. If it is a class, it will also have all the class methods in
+the class copied, but it will not have any of its instances copied. The
+contents of the source object's private namespace \fIwill not\fR be copied; it
+is up to the caller to do this. The result of this command will be the
+fully-qualified name of the new object or class.
+.SH EXAMPLES
+This example creates an object, copies it, modifies the source object, and
+then demonstrates that the copied object is indeed a copy.
+.CS
+oo::object create src
+oo::define src method msg {} {puts foo}
+\fBoo::copy\fR src dst
+oo::define src method msg {} {puts bar}
+src msg              \fI\(-> prints "bar"\fR
+dst msg              \fI\(-> prints "foo"\fR
+.CE
+.SH "SEE ALSO"
+oo::class(n), oo::define(n), oo::object(n)
+.SH KEYWORDS
+clone, copy, duplication, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/define.n b/doc/define.n
new file mode 100644
index 0000000..a1a92bf
--- /dev/null
+++ b/doc/define.n
@@ -0,0 +1,269 @@
+'\"
+'\" Copyright (c) 2007 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: define.n,v 1.1 2008/05/31 11:42:12 dkf Exp $
+'\"
+.so man.macros
+.TH define n 0.3 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::define, oo::objdefine \- define and configure classes and objects
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::define\fI class defScript\fR
+\fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR?
+\fBoo::objdefine\fI object defScript\fR
+\fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBoo::define\fR command is used to control the configuration of classes,
+and the \fBoo::objdefine\fR command is used to control the configuration of
+objects (including classes as instance objects), with the configuration being
+applied to the entity named in the \fIclass\fR or the \fIobject\fR argument.
+Configuring a class also updates the
+configuration of all subclasses of the class and all objects that are
+instances of that class or which mix it in (as modified by any per-instance
+configuration). The way in which the configuration is done is controlled by
+either the \fIdefScript\fR argument or by the \fIsubcommand\fR and following
+\fIarg\fR arguments; when the second is present, it is exactly as if all the
+arguments from \fIsubcommand\fR onwards are made into a list and that list is
+used as the \fIdefScript\fR argument.
+.SS "CONFIGURING CLASSES"
+.PP
+The following commands are supported in the \fIdefScript\fR for
+\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
+.TP
+\fBconstructor\fI argList bodyScript\fR
+.
+This creates or updates the constructor for a class. The formal arguments to
+the constructor (defined using the same format as for the Tcl \fBproc\fR
+command) will be \fIargList\fR, and the body of the constructor will be
+\fIbodyScript\fR. When the body of the constructor is evaluated, the current
+namespace of the constructor will be a namespace that is unique to the object
+being constructed. Within the constructor, the \fBnext\fR command should be
+used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
+string, the constructor will be deleted.
+.TP
+\fBdeletemethod\fI name\fR ?\fIname ...\fR
+.
+This deletes each of the methods called \fIname\fR from a class. The methods
+must have previously existed in that class. Does not affect the superclasses
+of the class, nor does it affect the subclasses or instances of the class
+(except when they have a call chain through the class being modified).
+.TP
+\fBdestructor\fI bodyScript\fR
+.
+This creates or updates the destructor for a class. Destructors take no
+arguments, and the body of the destructor will be \fIbodyScript\fR. The
+destructor is called when objects of the class are deleted, and when called
+will have the object's unique namespace as the current namespace. Destructors
+should use the \fBnext\fR command to call the superclasses' destructors. Note
+that destructors are not called in all situations (e.g. if the interpreter is
+destroyed). If \fIbodyScript\fR is the empty string, the destructor will be
+deleted.
+.RS
+Note that errors during the evaluation of a destructor \fIare not returned\fR
+to the code that causes the destruction of an object. Instead, they are passed
+to the currently-defined \fBbgerror\fR handler.
+.RE
+.TP
+\fBexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be exported
+(i.e. usable outside an instance through the instance object's command) by the
+class being defined. Note that the methods themselves may be actually defined
+by a superclass; subclass exports override superclass visibility, and may in
+turn be overridden by instances.
+.TP
+\fBfilter\fR ?\fImethodName ...\fR?
+.
+This sets or updates the list of method names that are used to guard whether a
+method call to instances of the class may be called and what the method's
+results are. Each \fImethodName\fR names a single filtering method (which may
+be exposed or not exposed); it is not an error for a non-existent method to be
+named since they may be defined by subclasses. If no \fImethodName\fR
+arguments are present, the list of filter names is set to empty.
+.TP
+\fBforward\fI name cmdName \fR?\fIarg ...\fR?
+.
+This creates or updates a forwarded method called \fIname\fR. The method
+is defined be forwarded to the command called \fIcmdName\fR, with additional
+arguments, \fIarg\fR etc., added before those arguments specified by the
+caller of the method. Forwarded methods should be deleted using the
+\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
+a lower-case letter, and non-exported otherwise.
+.TP
+\fBmethod\fI name argList bodyScript\fR
+.
+This creates, updates or deletes a method. The name of the method is
+\fIname\fR, the formal arguments to the method (defined using the same format
+as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
+method will be \fIbodyScript\fR. When the body of the method is evaluated, the
+current namespace of the method will be a namespace that is unique to the
+current object. The method will be exported if \fIname\fR starts with a
+lower-case letter, and non-exported otherwise; this behavior can be overridden
+via \fBexport\fR and \fBunexport\fR.
+.TP
+\fBmixin\fR ?\fIclassName ...\fR?
+.
+This sets or updates the list of additional classes that are to be mixed into
+all the instances of the class being defined. Each \fIclassName\fR argument
+names a single class that is to be mixed in; if no classes are present, the
+list of mixed-in classes is set to be empty.
+.TP
+\fBrenamemethod\fI fromName toName\fR
+.
+This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
+method must have previously existed in the class, and \fItoName\fR must not
+previously refer to a method in that class. Does not affect the superclasses
+of the class, nor does it affect the subclasses or instances of the class
+(except when they have a call chain through the class being modified). Does
+not change the export status of the method; if it was exported before, it will
+be afterwards.
+.TP
+\fBself\fI subcommand arg ...\fR
+.TP
+\fBself\fI script\fR
+.
+This command is equivalent to calling \fBoo::objdefine\fR on the class being
+defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
+supported values of \fIsubcommand\fR). It follows the same general pattern of
+argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands,
+and
+.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
+operates identically to
+.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
+.TP
+\fBsuperclass\fI className \fR?\fIclassName ...\fR?
+.
+This allows the alteration of the superclasses of the class being defined.
+Each \fIclassName\fR argument names one class that is to be a superclass of
+the defined class. Note that objects must not be changed from being classes to
+being non-classes or vice-versa.
+.TP
+\fBunexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be not exported
+(i.e. not usable outside the instance through the instance object's command,
+but instead just through the \fBmy\fR command visible in each object's
+context) by the class being defined. Note that the methods themselves may be
+actually defined by a superclass; subclass unexports override superclass
+visibility, and may be overridden by instance unexports.
+.SS "CONFIGURING OBJECTS"
+.PP
+The following commands are supported in the \fIdefScript\fR for
+\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
+form:
+.TP
+\fBclass\fI className\fR
+.
+This allows the class of an object to be changed after creation. Note that the
+class's constructors are not called when this is done, and so the object may
+well be in an inconsistent state unless additional configuration work is done.
+.TP
+\fBdeletemethod\fI name\fR ?\fIname ...\fR
+.
+This deletes each of the methods called \fIname\fR from an object. The methods
+must have previously existed in that object. Does not affect the classes that
+the object is an instance of.
+.TP
+\fBexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be exported
+(i.e. usable outside the object through the object's command) by the object
+being defined. Note that the methods themselves may be actually defined by a
+class or superclass; object exports override class visibility.
+.TP
+\fBfilter\fR ?\fImethodName ...\fR?
+.
+This sets or updates the list of method names that are used to guard whether a
+method call to the object may be called and what the method's results are.
+Each \fImethodName\fR names a single filtering method (which may be exposed or
+not exposed); it is not an error for a non-existent method to be named. If no
+\fImethodName\fR arguments are present, the list of filter names is set to
+empty. Note that the actual list of filters also depends on the filters set
+upon any classes that the object is an instance of.
+.TP
+\fBforward\fI name cmdName \fR?\fIarg ...\fR?
+.
+This creates or updates a forwarded object method called \fIname\fR. The
+method is defined be forwarded to the command called \fIcmdName\fR, with
+additional arguments, \fIarg\fR etc., added before those arguments specified
+by the caller of the method. Forwarded methods should be deleted using the
+\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
+a lower-case letter, and non-exported otherwise.
+.TP
+\fBmethod\fI name argList bodyScript\fR
+.
+This creates, updates or deletes an object method. The name of the method is
+\fIname\fR, the formal arguments to the method (defined using the same format
+as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
+method will be \fIbodyScript\fR. When the body of the method is evaluated, the
+current namespace of the method will be a namespace that is unique to the
+object. The method will be exported if \fIname\fR starts with a lower-case
+letter, and non-exported otherwise.
+.TP
+\fBmixin\fR ?\fIclassName ...\fR?
+.
+This sets or updates a per-object list of additional classes that are to be
+mixed into the object. Each argument, \fIclassName\fR, names a single class
+that is to be mixed in; if no classes are present, the list of mixed-in
+classes is set to be empty.
+.TP
+\fBrenamemethod\fI fromName toName\fR
+.
+This renames the method called \fIfromName\fR in an object to \fItoName\fR.
+The method must have previously existed in the object, and \fItoName\fR must
+not previously refer to a method in that object. Does not affect the classes
+that the object is an instance of. Does not change the export status of the
+method; if it was exported before, it will be afterwards.
+.TP
+\fBunexport\fI name \fR?\fIname ...\fR?
+.
+This arranges for each of the named methods, \fIname\fR, to be not exported
+(i.e. not usable outside the object through the object's command, but instead
+just through the \fBmy\fR command visible in the object's context) by the
+object being defined. Note that the methods themselves may be actually defined
+by a class; instance unexports override class visibility.
+.SH EXAMPLES
+This example demonstrates how to use both forms of the \fBoo::define\fR and
+\fBoo::objdefine\fR commands (they work in the same way), as well as
+illustrating four of the subcommands of them.
+.PP
+.CS
+oo::class create c
+c create o
+\fBoo::define\fR c \fBmethod\fR foo {} {
+    puts "world"
+}
+\fBoo::objdefine\fR o {
+    \fBmethod\fR bar {} {
+        my Foo "hello "
+        my foo
+    }
+    \fBforward\fR Foo ::puts -nonewline
+    \fBunexport\fR foo
+}
+o bar                \fI\(-> prints "hello world"\fR
+o foo                \fI\(-> error "unknown method foo"\fR
+o Foo Bar            \fI\(-> error "unknown method Foo"\fR
+\fBoo::objdefine\fR o \fBrenamemethod\fR bar lollipop
+o lollipop           \fI\(-> prints "hello world"\fR
+.CE
+.SH "SEE ALSO"
+next(n), oo::class(n), oo::object(n)
+.SH KEYWORDS
+class, definition, method, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/info.n b/doc/info.n
index 2fb697f..3072d13 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -3,11 +3,12 @@
 '\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
 '\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
 '\" Copyright (c) 1998-2000 Ajuba Solutions
+'\" Copyright (c) 2007-2008 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: info.n,v 1.25 2008/03/12 20:16:13 andreas_kupries Exp $
+'\" RCS: @(#) $Id: info.n,v 1.26 2008/05/31 11:42:12 dkf Exp $
 '\" 
 .so man.macros
 .TH info n 8.4 Tcl "Tcl Built-In Commands"
@@ -34,6 +35,11 @@ Tcl command procedure.
 Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
 the name of a Tcl command procedure.
 .TP
+\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
+.
+Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
+described in \fBCLASS INTROSPECTION\fR below.
+.TP
 \fBinfo cmdcount\fR
 Returns a count of the total number of commands that have been invoked
 in this interpreter.
@@ -263,6 +269,11 @@ Returns the full path name of the binary file from which the application
 was invoked.  If Tcl was unable to identify the file, then an empty
 string is returned.
 .TP
+\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
+.
+Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
+described in \fBOBJECT INTROSPECTION\fR below.
+.TP
 \fBinfo patchlevel\fR
 Returns the value of the global variable \fBtcl_patchLevel\fR; see
 the \fBtclvars\fR manual entry for more information.
@@ -321,7 +332,174 @@ Note that a currently-visible variable may not yet
 .QW exist
 if it has not
 been set (e.g. a variable declared but not set by \fBvariable\fR).
-.SH EXAMPLE
+.SS "CLASS INTROSPECTION"
+.PP
+The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
+.TP
+\fBinfo class constructor\fI class\fR
+.
+This subcommand returns a description of the definition of the constructor of
+class \fIclass\fR. The defintion is described as a two element list; the first
+element is the list of arguments to the constructor in a form suitable for
+passing to another call to \fBproc\fR or a method defintion, and the second
+element is the body of the constructor. If no constructor is present, this
+returns the empty list.
+.TP
+\fBinfo class definition\fI class method\fR
+.
+This subcommand returns a description of the definition of the method named
+\fImethod\fR of class \fIclass\fR. The defintion is described as a two element
+list; the first element is the list of arguments to the method in a form
+suitable for passing to another call to \fBproc\fR or a method defintion, and
+the second element is the body of the method.
+.TP
+\fBinfo class destructor\fI class\fR
+.
+This subcommand returns the body of the destructor of class \fIclass\fR. If no
+destructor is present, this returns the empty string.
+.TP
+\fBinfo class filters\fI class\fR
+.
+This subcommand returns the list of filter methods set on the class.
+.TP
+\fBinfo class forward\fI class method\fR
+.
+This subcommand returns the argument list for the method forwarding called
+\fImethod\fR that is set on the class called \fIclass\fR.
+.TP
+\fBinfo class instances\fI class\fR ?\fIpattern\fR?
+.
+This subcommand returns a list of instances of class \fIclass\fR. If the
+optional \fIpattern\fR argument is present, it constrains the list of returned
+instances to those that match it according to the rules of \fBstring match\fR.
+.TP
+\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
+.
+This subcommand returns a list of all public (i.e. exported) methods of the
+class called \fIclass\fR. Any of the following \fIoption\fRs may be
+specified, controlling exactly which method names are returned:
+.RS
+.TP
+\fB\-all\fR
+.
+If the \fB\-all\fR flag is given, the list of methods will include those
+methods defined not just by the class, but also by the class's superclasses
+and mixins.
+.TP
+\fB\-private\fR
+.
+If the \fB\-private\fR flag is given, the list of methods will also include
+the private (i.e. non-exported) methods of the class (and superclasses and
+mixins, if \fB\-all\fR is also given).
+.RE
+.TP
+\fBinfo class mixins\fI class\fR
+.
+This subcommand returns a list of all classes that have been mixed into the
+class named \fIclass\fR.
+.TP
+\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
+.
+This subcommand returns a list of direct subclasses of class \fIclass\fR. If
+the optional \fIpattern\fR argument is present, it constrains the list of
+returned classes to those that match it according to the rules of \fBstring
+match\fR.
+.TP
+\fBinfo class superclasses\fI class\fR
+.
+This subcommand returns a list of direct superclasses of class \fIclass\fR in
+inheritance precedence order.
+.SS "OBJECT INTROSPECTION"
+.PP
+The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
+.TP
+\fBinfo object class\fI object\fR ?\fIclassName\fR?
+.
+If \fIclassName\fR is unspecified, this subcommand returns class of the
+\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
+boolean value indicating whether the \fIobject\fR is of that class.
+.TP
+\fBinfo object definition\fI object method\fR
+.
+This subcommand returns a description of the definition of the method named
+\fImethod\fR of object \fIobject\fR. The defintion is described as a two
+element list; the first element is the list of arguments to the method in a
+form suitable for passing to another call to \fBproc\fR or a method defintion,
+and the second element is the body of the method.
+.TP
+\fBinfo object filters\fI object\fR
+.
+This subcommand returns the list of filter methods set on the object.
+.TP
+\fBinfo object forward\fI object method\fR
+.
+This subcommand returns the argument list for the method forwarding called
+\fImethod\fR that is set on the object called \fIobject\fR.
+.TP
+\fBinfo object isa\fI category object\fR ?\fIarg\fR?
+.
+This subcommand tests whether an object belongs to a particular category,
+returning a boolean value that indicates whether the \fIobject\fR argument
+meets the criteria for the category. The supported categories are:
+.RS
+.TP
+\fBinfo object isa class\fI object\fR
+.
+This returns whether \fIobject\fR is a class (i.e. an instance of
+\fBoo::class\fR or one of its subclasses).
+.TP
+\fBinfo object isa metaclass\fI object\fR
+.
+This returns whether \fIobject\fR is a class that can manufacture classes
+(i.e. is \fBoo::class\fR or a subclass of it).
+.TP
+\fBinfo object isa mixin\fI object class\fR
+.
+This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
+.TP
+\fBinfo object isa object\fI object\fR
+.
+This returns whether \fIobject\fR really is an object.
+.TP
+\fBinfo object isa typeof\fI object class\fR
+.
+This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
+\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
+direct or indirect).
+.RE
+.TP
+\fBinfo object methods\fI object\fR ?\fIoption...\fR?
+.
+This subcommand returns a list of all public (i.e. exported) methods of the
+object called \fIobject\fR. Any of the following \fIoption\fRs may be
+specified, controlling exactly which method names are returned:
+.RS
+.TP
+\fB\-all\fR
+.
+If the \fB\-all\fR flag is given, the list of methods will include those
+methods defined not just by the object, but also by the object's class and
+mixins, plus the superclasses of those classes.
+.TP
+\fB\-private\fR
+.
+If the \fB\-private\fR flag is given, the list of methods will also include
+the private (i.e. non-exported) methods of the object (and classes, if
+\fB\-all\fR is also given).
+.RE
+.TP
+\fBinfo object mixins\fI object\fR
+.
+This subcommand returns a list of all classes that have been mixed into the
+object named \fIobject\fR.
+.TP
+\fBinfo object vars\fI object\fR ?\fIpattern\fR?
+.
+This subcommand returns a list of all variables in the private namespace of
+the object named \fIobject\fR. If the optional \fIpattern\fR argument is
+given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
+that constrains the list of variables returned.
+.SH EXAMPLES
 This command prints out a procedure suitable for saving in a Tcl
 script:
 .PP
@@ -341,10 +519,44 @@ proc printProc {procName} {
     puts [lappend result $formals [\fBinfo body\fR $procName]]
 }
 .CE
+.SS "EXAMPLES WITH OBJECTS"
+.PP
+Every object necessarily knows what its class is; this information is
+trivially extractable through introspection:
+.CS
+oo::class create c
+c create o
+puts [\fBinfo object class\fR o]
+                     \fI\(-> prints "::c"\fR
+puts [\fBinfo object class\fR c]
+                     \fI\(-> prints "::oo::class"\fR
+.CE
+.PP
+The introspection capabilities can be used to discover what class implements a
+method and get how it is defined. This procedure illustrates how:
+.CS
+proc getDef {obj method} {
+    if {$method in [\fBinfo object methods\fR $obj]} {
+        # Assume no forwards
+        return [\fBinfo object definition\fR $obj $method]
+    }
+    set cls [\fBinfo object class\fR $obj]
+    while {$method ni [\fBinfo class methods\fR $cls]} {
+        # Assume the simple case
+        set cls [lindex [\fBinfo class superclass\fR $cls] 0]
+        if {$cls eq {}} {
+            error "no definition for $method"
+        }
+    }
+    # Assume no forwards
+    return [\fBinfo class definition\fR $cls $method]
+}
+.CE
 .SH "SEE ALSO"
-global(n), proc(n)
+global(n), oo::class(n), oo::object(n), proc(n), self(n)
 .SH KEYWORDS
-command, information, interpreter, level, namespace, procedure, variable
+command, information, interpreter, introspection, level, namespace, object,
+procedure, variable
 .\" Local Variables:
 .\" mode: nroff
 .\" End:
diff --git a/doc/my.n b/doc/my.n
new file mode 100644
index 0000000..75d7bac
--- /dev/null
+++ b/doc/my.n
@@ -0,0 +1,56 @@
+'\"
+'\" Copyright (c) 2007 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: my.n,v 1.1 2008/05/31 11:42:13 dkf Exp $
+'\"
+.so man.macros
+.TH my n 0.1 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+my \- invoke any method of current object
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBmy\fI methodName\fR ?\fIarg ...\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBmy\fR command is used to allow methods of objects to invoke any method
+of the object (or its class). In particular, the set of valid values for
+\fImethodName\fR is the set of all methods supported by an object and its
+superclasses, including those that are not exported. The object upon which the
+method is invoked is always the one that is the current context of the method
+(i.e. the object that is returned by \fBself object\fR) from which the
+\fBmy\fR command is invoked.
+.PP
+Each object has its own \fBmy\fR command, contained in its unique namespace.
+.SH EXAMPLES
+This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
+the \fBoo::object\fR class, which is not publically visible by default:
+.CS
+oo::class create c {
+    method count {} {
+        \fBmy\fR variable counter
+        print [incr counter]
+    }
+}
+c create o
+o count              \fI\(-> prints "1"\fR
+o count              \fI\(-> prints "2"\fR
+o count              \fI\(-> prints "3"\fR
+.CE
+.SH "SEE ALSO"
+next(n), oo::object(n), self(n)
+.SH KEYWORDS
+method, method visibility, object, private method, public method
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/next.n b/doc/next.n
new file mode 100644
index 0000000..a312764
--- /dev/null
+++ b/doc/next.n
@@ -0,0 +1,195 @@
+'\"
+'\" Copyright (c) 2007 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: next.n,v 1.1 2008/05/31 11:42:13 dkf Exp $
+'\"
+.so man.macros
+.TH next n 0.1 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+next \- invoke superclass method implementations
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBnext\fR ?\fIarg ...\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBnext\fR command is used to call implementations of a method by a class,
+superclass or mixin that are overridden by the current method. It can only be
+used from within a method. It is also used within filters to indicate the
+point where a filter calls the actual implementation (the filter may decide to
+not go along the chain, and may process the results of going along the chain
+of methods as it chooses). The result of the \fBnext\fR command is the result
+of the next method in the method chain; if there are no further methods in the
+method chain, the result of \fBnext\fR is the empty string. The arguments,
+\fIarg\fR, to \fBnext\fR are the arguments to pass to the next method in the
+chain.
+.SH "THE METHOD CHAIN"
+.PP
+When a method of an object is invoked, things happen in several stages:
+.IP [1]
+The structure of the object, its class, superclasses, filters, and mixins, are
+examined to build a \fImethod chain\fR, which contains a list of method
+implementations to invoke.
+.IP [2]
+The first method implementation on the chain is invoked.
+.IP [3]
+If that method implementation invokes the \fBnext\fR command, the next method
+implementation is invoked (with its arguments being those that were passed to
+\fBnext\fR).
+.IP [4]
+The result from the overall method call is the result from the outermost
+method implementation; inner method implementations return their results
+through \fBnext\fR.
+.IP [5]
+The method chain is cached for future use.
+.SS "METHOD SEARCH ORDER"
+.PP
+When constructing the method chain, method implementations are searched for in
+the following order:
+.IP [1]
+In the object.
+.IP [2]
+In the classes mixed into the object, in class traversal order. The list of
+mixins is checked in natural order.
+.IP [3]
+In the classes mixed into the classes of the object, with sources of mixing in
+being searched in class traversal order. Within each class, the list of mixins
+is processed in natural order.
+.IP [4]
+In the object's class.
+.IP [5]
+In the superclasses of the class, following each superclass in a depth-first
+fashion in the natural order of the superclass list.
+.PP
+Any particular method implementation always comes as \fIlate\fR in the
+resulting list of implementations as possible.
+.SS FILTERS
+.PP
+When an object has a list of filter names set upon it, or is an instance of a
+class (or has mixed in a class) that has a list of filter names set upon it,
+before every invokation of any method the filters are processed. Filter
+implementations are found in class traversal order, as are the lists of filter
+names (each of which is traversed in natural list order). Explicitly invoking
+a method used as a filter will cause that method to be invoked twice, once as
+a filter and once as a normal method.
+.PP
+Each filter should decide for itself whether to permit the execution to go
+forward to the proper implementation of the method (which it does by invoking
+the \fBnext\fR command as filters are inserted into the front of the method
+call chain) and is responsible for returning the result of \fBnext\fR.
+.PP
+Filters are not invoked when processing an invokation of the \fBunknown\fR
+method because of a failure to locate a method implementation, or when
+invoking either constructors or destructors.
+.SH EXAMPLES
+.PP
+This example demonstrates how to use the \fBnext\fR command to call the
+(super)class's implementation of a method. The script:
+.CS
+oo::class create theSuperclass {
+    method example {args} {
+        puts "in the superclass, args = $args"
+    }
+}
+oo::class create theSubclass {
+    superclass theSuperclass
+    method example {args} {
+        puts "before chaining from subclass, args = $args"
+        \fBnext\fR a {*}$args b
+        \fBnext\fR pureSynthesis
+        puts "after chaining from subclass"
+    }
+}
+theSubclass create obj
+oo::define obj method example args {
+    puts "per-object method, args = $args"
+    \fBnext\fR x {*}$args y
+    \fBnext\fR
+}
+obj example 1 2 3
+.CE
+prints the following:
+.CS
+per-object method, args = 1 2 3
+before chaining from subclass, args = x 1 2 3 y
+in the superclass, args = a x 1 2 3 y b
+in the superclass, args = pureSynthesis
+after chaining from subclass
+before chaining from subclass, args = 
+in the superclass, args = a b
+in the superclassm args = pureSynthesis
+after chaining from subclass
+.CE
+.PP
+This example demonstrates how to build a simple cache class that applies
+memoization to all the method calls of the objects it is mixed into, and shows
+how it can make a difference to computation times:
+.PP
+.CS
+oo::class create cache {
+    filter Memoize
+    method Memoize args {
+        \fI# Do not filter the core method implementations\fR
+        if {[lindex [self target] 0] eq "::oo::object"} {
+            return [\fBnext\fR {*}$args]
+        }
+
+        \fI# Check if the value is already in the cache\fR
+        my variable ValueCache
+        set key [self target],$args
+        if {[info exist ValueCache($key)]} {
+            return $ValueCache($key)
+        }
+
+        \fI# Compute value, insert into cache, and return it\fR
+        return [set ValueCache($key) [\fBnext\fR {*}$args]]
+    }
+    method flushCache {} {
+        my variable ValueCache
+        unset ValueCache
+        \fI# Skip the cacheing\fR
+        return -level 2 ""
+    }
+}
+
+oo::object create demo
+oo::define demo {
+    mixin cache
+    method compute {a b c} {
+        after 3000 \fI;# Simulate deep thought\fR
+        return [expr {$a + $b * $c}]
+    }
+    method compute2 {a b c} {
+        after 3000 \fI;# Simulate deep thought\fR
+        return [expr {$a * $b + $c}]
+    }
+}
+
+puts [demo compute  1 2 3]      \fI\(-> prints "7" after delay\fR
+puts [demo compute2 4 5 6]      \fI\(-> prints "26" after delay\fR
+puts [demo compute  1 2 3]      \fI\(-> prints "7" instantly\fR
+puts [demo compute2 4 5 6]      \fI\(-> prints "26" instantly\fR
+puts [demo compute  4 5 6]      \fI\(-> prints "34" after delay\fR
+puts [demo compute  4 5 6]      \fI\(-> prints "34" instantly\fR
+puts [demo compute  1 2 3]      \fI\(-> prints "7" instantly\fR
+demo flushCache
+puts [demo compute  1 2 3]      \fI\(-> prints "7" after delay\fR
+.CE
+.SH "SEE ALSO"
+oo::class(n), oo::define(n), oo::object(n), self(n)
+.SH KEYWORDS
+call, method, method chain
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/object.n b/doc/object.n
new file mode 100644
index 0000000..79038db
--- /dev/null
+++ b/doc/object.n
@@ -0,0 +1,101 @@
+'\"
+'\" Copyright (c) 2007 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: object.n,v 1.1 2008/05/31 11:42:13 dkf Exp $
+'\"
+.so man.macros
+.TH object n 0.1 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::object \- root class of the class hierarchy
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::object\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBoo::object\fR class is the root class of the object hierarchy; every
+object (and hence every class) is an instance of this class. Objects are
+always referred to by their name, and may be \fBrename\fRd while maintaining
+their identity. Each object has a unique namespace associated with it.
+Instances of objects may be made with either the \fBcreate\fR or \fBnew\fR
+methods of the \fBoo::object\fR object itself, or by invoking those methods on
+any of the subclass objects; see \fBoo::class\fR for more details.
+.SS CONSTRUCTOR
+The \fBoo::object\fR class does not define an explicit constructor.
+.SS DESTRUCTOR
+The \fBoo::object\fR class does not define an explicit destructor.
+.SS "EXPORTED METHODS"
+The \fBoo::object\fR class supports the following exported methods:
+.TP
+\fIobj \fBdestroy\fR
+.
+This method destroys the object, \fIobj\fR, that it is invoked upon, invoking
+any destructors on the object's class in the process. It is equivalent to
+using \fBrename\fR to delete the object command. The result of this method is
+always the empty string.
+.SS "NON-EXPORTED METHODS"
+The \fBoo::object\fR class supports the following non-exported methods:
+.TP
+\fIobj \fBeval\fR ?\fIarg ...\fR?
+.
+This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR,
+and then evaluates the resulting script in the namespace that is uniquely
+associated with \fIobj\fR, returning the result of the evaluation.
+.TP
+\fIobj \fBunknown \fImethodName\fR ?\fIarg ...\fR?
+.
+This method is called when an attempt to invoke the method \fImethodName\fR on
+object \fIobj\fR fails. The arguments that the user supplied to the method are
+given as \fIarg\fR argments. The default implementation (i.e. the one defined
+by the \fBoo::object\fR class) generates a suitable error, detailing what
+methods the object supports given whether the object was invoked by its public
+name or through the \fBmy\fR command.
+.TP
+\fIobj \fBvariable \fIvarName \fR?\fIvarName ...\fR?
+.
+This method arranges for each variable called \fIvarName\fR to be linked from
+the object \fIobj\fR's unique namespace into the caller's context. Thus, if it
+is invoked from inside a procedure then the namespace variable in the object
+is linked to the local variable in the procedure. Each \fIvarName\fR argument
+must not have any namespace separators in it. The result is the empty string.
+.TP
+\fIobj \fBvarname \fIvarName\fR
+.
+This method returns the globally qualified name of the variable \fIvarName\fR
+in the unique namespace for the object \fIobj\fR.
+.SH EXAMPLES
+This example demonstrates basic use of an object.
+.CS
+set obj [\fBoo::object\fR new]
+$obj foo             \fI\(-> error "unknown method foo"\fR
+oo::define $obj method foo {} {
+    my \fBvariable\fR count
+    puts "bar[incr count]"
+}
+$obj foo             \fI\(-> prints "bar1"\fR
+$obj foo             \fI\(-> prints "bar2"\fR
+$obj variable count  \fI\(-> error "unknown method variable"\fR
+$obj \fBdestroy\fR
+$obj foo             \fI\(-> error "unknown command obj"\fR
+.CE
+.SH "SEE ALSO"
+my(n), oo::class(n)
+.SH KEYWORDS
+base class, class, object, root class
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/self.n b/doc/self.n
new file mode 100644
index 0000000..2c66edb
--- /dev/null
+++ b/doc/self.n
@@ -0,0 +1,111 @@
+'\"
+'\" Copyright (c) 2007 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: self.n,v 1.1 2008/05/31 11:42:13 dkf Exp $
+'\"
+.so man.macros
+.TH self n 0.1 TclOO "TclOO Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+self \- method call internal introspection
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBself\fR ?\fIsubcommand\fR?
+.fi
+.BE
+
+.SH DESCRIPTION
+The \fBself\fR command, which should only be used from within the context of a
+call to a method (i.e. inside a method, constructor or destructor body) is
+used to allow the method to discover information about how it was called. It
+takes an argument, \fIsubcommand\fR, that tells it what sort of information is
+actually desired; if omitted the result will be the same as if \fBself
+object\fR was invoked. The supported subcommands are:
+.TP
+\fBself caller\fR
+.
+When the method was invoked from inside another object method, this subcommand
+returns a three element list describing the containing object and method. The
+first element describes the declaring object or class of the method, the
+second element is the name of the object on which the containing method was
+invoked, and the third element is the name of the method (with the strings
+\fB<constructor>\fR and \fB<destructor>\fR indicating constructors and
+destructors respectively).
+.TP
+\fBself class\fR
+.
+This returns the name of the class or object that the current method was
+defined within. Note that this will change as the chain of method
+implementations is traversed with \fBnext\fR.
+.TP
+\fBself filter\fR
+.
+When invoked inside a filter, this subcommand returns a three element list
+describing the filter. The first element gives the name of the object or class
+that declared the filter (note that this may be different from the object or
+class that provided the implementation of the filter), the second element is
+either \fBobject\fR or \fBclass\fR depending on whether the declaring entity
+was an object or class, and the third element is the name of the filter.
+.TP
+\fBself method\fR
+.
+This returns the name of the current method (with the strings
+\fB<constructor>\fR and \fB<destructor>\fR indicating constructors and
+destructors respectively).
+.TP
+\fBself namespace\fR
+.
+This returns the name of the unique namespace of the object that the method
+was invoked upon.
+.TP
+\fBself next\fR
+.
+When invoked from a method that is not at the end of a call chain (i.e. where
+the \fBnext\fR command will invoke an actual method implementation), this
+subcommand returns a two element list describing the next element in the
+method call chain; the first element is the name of the class or object that
+declares the next part of the call chain, and the second element is the name
+of the method (with the strings \fB<constructor>\fR and \fB<destructor>\fR
+indicating constructors and destructors respectively). If invoked from a
+method that is at the end of a call chain, this subcommand returns the emtpy
+string.
+.TP
+\fBself object\fR
+.
+This returns the name of the object that the method was invoked upon.
+.TP
+\fBself target\fR
+.
+When invoked inside a filter implementation, this subcommand returns a two
+element list describing the method being filtered. The first element will be
+the name of the declarer of the method, and the second element will be the
+actual name of the method.
+.SH EXAMPLES
+This example shows basic use of \fBself\fR to provide information about the
+current object:
+.CS
+oo::class create c {
+    method foo {} {
+        puts "this is the [\fBself\fR] object"
+    }
+}
+c create a
+c create b
+a foo                \fI\(-> prints "this is the ::a object"\fR
+b foo                \fI\(-> prints "this is the ::b object"\fR
+.CE
+.SH "SEE ALSO"
+info(n), next(n)
+.SH KEYWORDS
+call, introspection, object
+
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4b7593a..0a45567 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.298 2008/05/02 20:08:51 patthoyts Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.299 2008/05/31 11:42:13 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -815,6 +815,10 @@ Tcl_CreateInterp(void)
 	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
     }
 
+    if (TclOOInit(interp) != TCL_OK) {
+	Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+    }
+
     return interp;
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index eab070c..3ec57b4 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.368 2008/05/09 04:58:54 georgeps Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.369 2008/05/31 11:42:14 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -1058,6 +1058,14 @@ typedef struct CallFrame {
 
 #define FRAME_IS_PROC   0x1
 #define FRAME_IS_LAMBDA 0x2
+#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
+				 * clientData field contains a CallContext
+				 * reference. Part of TIP#257. */
+#define FRAME_IS_OO_DEFINE 0x8	/* The frame is part of the inside workings of
+				 * the [oo::define] command; the clientData
+				 * field contains an Object reference that has
+				 * been confirmed to refer to a class. Part of
+				 * TIP#257. */
 
 /*
  * TIP #280
@@ -1878,6 +1886,15 @@ typedef struct Interp {
 				 * TclpCheckStackSpace in the platform's
 				 * directory. */
 
+    /*
+     * The pointer to the object system root ekeko. c.f. TIP #257.
+     */
+
+    void *objectFoundation;	/* Pointer to the Foundation structure of the
+				 * object system, which contains things like
+				 * references to key namespaces. See
+				 * tclOOInt.h and tclOO.c for real definition
+				 * and setup. */
 
 #ifdef TCL_COMPILE_STATS
     /*
diff --git a/generic/tclOO.c b/generic/tclOO.c
new file mode 100644
index 0000000..de0b36b
--- /dev/null
+++ b/generic/tclOO.c
@@ -0,0 +1,2179 @@
+/*
+ * tclOO.c --
+ *
+ *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
+ *
+ * Copyright (c) 2005-2008 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.4 2008/05/31 11:42:16 dkf Exp $
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Commands in oo::define.
+ */
+
+static const struct {
+    const char *name;
+    Tcl_ObjCmdProc *objProc;
+    int flag;
+} defineCmds[] = {
+    {"constructor", TclOODefineConstructorObjCmd, 0},
+    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
+    {"destructor", TclOODefineDestructorObjCmd, 0},
+    {"export", TclOODefineExportObjCmd, 0},
+    {"filter", TclOODefineFilterObjCmd, 0},
+    {"forward", TclOODefineForwardObjCmd, 0},
+    {"method", TclOODefineMethodObjCmd, 0},
+    {"mixin", TclOODefineMixinObjCmd, 0},
+    {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
+    {"self", TclOODefineSelfObjCmd, 0},
+    {"superclass", TclOODefineSuperclassObjCmd, 0},
+    {"unexport", TclOODefineUnexportObjCmd, 0},
+    {NULL, NULL, 0}
+}, objdefCmds[] = {
+    {"class", TclOODefineClassObjCmd, 1},
+    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
+    {"export", TclOODefineExportObjCmd, 1},
+    {"filter", TclOODefineFilterObjCmd, 1},
+    {"forward", TclOODefineForwardObjCmd, 1},
+    {"method", TclOODefineMethodObjCmd, 1},
+    {"mixin", TclOODefineMixinObjCmd, 1},
+    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
+    {"unexport", TclOODefineUnexportObjCmd, 1},
+    {NULL, NULL, 0}
+};
+
+/*
+ * What sort of size of things we like to allocate.
+ */
+
+#define ALLOC_CHUNK 8
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
+static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
+			    const char *nsNameStr);
+static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
+			    Method *mPtr, Tcl_Obj *namePtr,
+			    Method **newMPtrPtr);
+static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
+			    Method *mPtr, Tcl_Obj *namePtr);
+static void		InitFoundation(Tcl_Interp *interp);
+static void		KillFoundation(ClientData clientData,
+			    Tcl_Interp *interp);
+static void		ObjectNamespaceDeleted(ClientData clientData);
+static void		ObjectRenamedTrace(ClientData clientData,
+			    Tcl_Interp *interp, const char *oldName,
+			    const char *newName, int flags);
+static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
+
+static int		PublicObjectCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+static int		PrivateObjectCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+
+/*
+ * Methods in the oo::object and oo::class classes. First, we define a helper
+ * macro that makes building the method type declaration structure a lot
+ * easier. No point in making life harder than it has to be!
+ *
+ * Note that the core methods don't need clone or free proc callbacks.
+ */
+
+#define DCM(name,visibility,proc) \
+    {name,visibility,\
+	{TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}}
+
+static const DeclaredClassMethod objMethods[] = {
+    DCM("destroy", 1,	TclOO_Object_Destroy),
+    DCM("eval", 0,	TclOO_Object_Eval),
+    DCM("unknown", 0,	TclOO_Object_Unknown),
+    DCM("variable", 0,	TclOO_Object_LinkVar),
+    DCM("varname", 0,	TclOO_Object_VarName),
+    {NULL}
+}, clsMethods[] = {
+    DCM("create", 1,	TclOO_Class_Create),
+    DCM("new", 1,	TclOO_Class_New),
+    DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
+    {NULL}
+};
+
+static char initScript[] =
+    "namespace eval ::oo { variable version " TCLOO_VERSION " };"
+    "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
+/*     "tcl_findLibrary tcloo $oo::version $oo::version" */
+/*     " tcloo.tcl OO_LIBRARY oo::library;"; */
+
+extern struct TclOOStubAPI tclOOStubAPI;
+
+/*
+ * Convenience macro for getting the foundation from an interpreter.
+ */
+
+#define GetFoundation(interp) \
+	((Foundation *)((Interp *)(interp))->objectFoundation)
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOInit --
+ *
+ *	Called to initialise the OO system within an interpreter.
+ *
+ * Result:
+ *	TCL_OK if the setup succeeded. Currently assumed to always work.
+ *
+ * Side effects:
+ *	Creates namespaces, commands, several classes and a number of
+ *	callbacks. Upon return, the OO system is ready for use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOInit(
+    Tcl_Interp *interp)		/* The interpreter to install into. */
+{
+    /*
+     * Build the core of the OO system.
+     */
+
+    InitFoundation(interp);
+
+    /*
+     * Run our initialization script and, if that works, declare the package
+     * to be fully provided.
+     */
+
+    if (Tcl_Eval(interp, initScript) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION, &tclOOStubAPI);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetFoundation --
+ *
+ *	Get a reference to the OO core class system.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Foundation *
+TclOOGetFoundation(
+    Tcl_Interp *interp)
+{
+    return GetFoundation(interp);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitFoundation --
+ *
+ *	Set up the core of the OO core class system. This is a structure
+ *	holding references to the magical bits that need to be known about in
+ *	other places, plus the oo::object and oo::class classes.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InitFoundation(
+    Tcl_Interp *interp)
+{
+    static Tcl_ThreadDataKey tsdKey;
+    ThreadLocalData *tsdPtr =
+	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
+    Foundation *fPtr = (Foundation *) ckalloc(sizeof(Foundation));
+    Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
+    Tcl_DString buffer;
+    int i;
+
+    /*
+     * Initialize the structure that holds the OO system core. This is
+     * attached to the interpreter via an assocData entry; not very efficient,
+     * but the best we can do without hacking the core more.
+     */
+
+    memset(fPtr, 0, sizeof(Foundation));
+    ((Interp *) interp)->objectFoundation = fPtr;
+    fPtr->interp = interp;
+    fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL);
+    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
+    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", NULL, NULL);
+    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", NULL,
+	    NULL);
+    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", NULL,
+	    NULL);
+    fPtr->epoch = 0;
+    fPtr->tsdPtr = tsdPtr;
+    fPtr->unknownMethodNameObj = Tcl_NewStringObj("unknown", -1);
+    fPtr->constructorName = Tcl_NewStringObj("<constructor>", -1);
+    fPtr->destructorName = Tcl_NewStringObj("<destructor>", -1);
+    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
+    Tcl_IncrRefCount(fPtr->constructorName);
+    Tcl_IncrRefCount(fPtr->destructorName);
+    Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
+	    TclOOUnknownDefinition, NULL, NULL);
+    namePtr = Tcl_NewStringObj("::oo::UnknownDefinition", -1);
+    Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
+    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);
+
+    /*
+     * Create the subcommands in the oo::define and oo::objdefine spaces.
+     */
+
+    Tcl_DStringInit(&buffer);
+    for (i=0 ; defineCmds[i].name ; i++) {
+	Tcl_DStringAppend(&buffer, "::oo::define::", 14);
+	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
+	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
+		defineCmds[i].objProc, (void *) defineCmds[i].flag, NULL);
+	Tcl_DStringFree(&buffer);
+    }
+    for (i=0 ; objdefCmds[i].name ; i++) {
+	Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17);
+	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
+	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
+		objdefCmds[i].objProc, (void *) objdefCmds[i].flag, NULL);
+	Tcl_DStringFree(&buffer);
+    }
+
+    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
+
+    /*
+     * Create the objects at the core of the object system. These need to be
+     * spliced manually.
+     */
+
+    fPtr->objectCls = AllocClass(interp,
+	    AllocObject(interp, "::oo::object", NULL));
+    fPtr->classCls = AllocClass(interp,
+	    AllocObject(interp, "::oo::class", NULL));
+    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
+    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
+    fPtr->objectCls->superclasses.num = 0;
+    ckfree((char *) fPtr->objectCls->superclasses.list);
+    fPtr->objectCls->superclasses.list = NULL;
+    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
+    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
+    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+
+    /*
+     * Basic method declarations for the core classes.
+     */
+
+    for (i=0 ; objMethods[i].name ; i++) {
+	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
+    }
+    for (i=0 ; clsMethods[i].name ; i++) {
+	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
+    }
+
+    /*
+     * Finish setting up the class of classes by marking the 'new' method as
+     * private; classes, unlike general objects, must have explicit names. We
+     * also need to create the constructor for classes.
+     */
+
+    namePtr = Tcl_NewStringObj("new", -1);
+    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
+	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
+
+    argsPtr = Tcl_NewStringObj("{definitionScript {}}", -1);
+    bodyPtr = Tcl_NewStringObj(
+	    "if {[catch {define [self] $definitionScript} msg opt]} {\n"
+	    "set ei [split [dict get $opt -errorinfo] \\n]\n"
+	    "dict set opt -errorinfo [join [lrange $ei 0 end-2] \\n]\n"
+	    "dict set opt -errorline 0xdeadbeef\n"
+	    "}\n"
+	    "return -options $opt $msg", -1);
+    fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
+	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
+
+    /*
+     * Create non-object commands and plug ourselves into the Tcl [info]
+     * ensemble.
+     */
+
+    Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
+	    NULL);
+    Tcl_CreateObjCommand(interp, "::oo::Helpers::self", TclOOSelfObjCmd, NULL,
+	    NULL);
+    Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL,
+	    NULL);
+    Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL,
+	    NULL);
+    Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL);
+    TclOOInitInfo(interp);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * KillFoundation --
+ *
+ *	Delete those parts of the OO core that are not deleted automatically
+ *	when the objects and classes themselves are destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+KillFoundation(
+    ClientData clientData,	/* Pointer to the OO system foundation
+				 * structure. */
+    Tcl_Interp *interp)		/* The interpreter containing the OO system
+				 * foundation. */
+{
+    Foundation *fPtr = GetFoundation(interp);
+
+    Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
+    Tcl_DecrRefCount(fPtr->constructorName);
+    Tcl_DecrRefCount(fPtr->destructorName);
+    ckfree((char *) fPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AllocObject --
+ *
+ *	Allocate an object of basic type. Does not splice the object into its
+ *	class's instance list.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Object *
+AllocObject(
+    Tcl_Interp *interp,		/* Interpreter within which to create the
+				 * object. */
+    const char *nameStr,	/* The name of the object to create, or NULL
+				 * if the OO system should pick the object
+				 * name itself (equal to the namespace
+				 * name). */
+    const char *nsNameStr)	/* The name of the namespace to create, or
+				 * NULL if the OO system should pick a unique
+				 * name itself. If this is non-NULL but names
+				 * a namespace that already exists, the effect
+				 * will be the same as if this was NULL. */
+{
+    Foundation *fPtr = GetFoundation(interp);
+    Tcl_DString buffer;
+    Object *oPtr;
+    int creationEpoch;
+
+    oPtr = (Object *) ckalloc(sizeof(Object));
+    memset(oPtr, 0, sizeof(Object));
+
+    /*
+     * Every object has a namespace; make one. Note that this also normally
+     * computes the creation epoch value for the object, a sequence number
+     * that is unique to the object (and which allows us to manage method
+     * caching without comparing pointers).
+     *
+     * When creating a namespace, we first check to see if the caller
+     * specified the name for the namespace. If not, we generate namespace
+     * names using the epoch until such time as a new namespace is actually
+     * created.
+     */
+
+    if (nsNameStr != NULL) {
+	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr,
+		ObjectNamespaceDeleted);
+	if (oPtr->namespacePtr != NULL) {
+	    creationEpoch = ++fPtr->tsdPtr->nsCount;
+	    goto configNamespace;
+	}
+	Tcl_ResetResult(interp);
+    }
+
+    while (1) {
+	char objName[10 + TCL_INTEGER_SPACE];
+
+	sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
+	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr,
+		ObjectNamespaceDeleted);
+	if (oPtr->namespacePtr != NULL) {
+	    creationEpoch = fPtr->tsdPtr->nsCount;
+	    break;
+	}
+
+	/*
+	 * Could not make that namespace, so we make another. But first we
+	 * have to get rid of the error message from Tcl_CreateNamespace,
+	 * since that's something that should not be exposed to the user.
+	 */
+
+	Tcl_ResetResult(interp);
+    }
+
+    /*
+     * Make the namespace know about the helper commands. This grants access
+     * to the [self] and [next] commands.
+     */
+
+  configNamespace:
+    TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs);
+
+    /*
+     * Fill in the rest of the non-zero/NULL parts of the structure.
+     */
+
+    oPtr->fPtr = fPtr;
+    oPtr->selfCls = fPtr->objectCls;
+    oPtr->creationEpoch = creationEpoch;
+    oPtr->refCount = 1;
+    oPtr->flags = USE_CLASS_CACHE;
+
+    /*
+     * Finally, create the object commands and initialize the trace on the
+     * public command (so that the object structures are deleted when the
+     * command is deleted).
+     */
+
+    if (nameStr) {
+	if (nameStr[0] != ':' || nameStr[1] != ':') {
+	    Tcl_DStringInit(&buffer);
+	    Tcl_DStringAppend(&buffer,
+		    Tcl_GetCurrentNamespace(interp)->fullName, -1);
+	    Tcl_DStringAppend(&buffer, "::", 2);
+	    Tcl_DStringAppend(&buffer, nameStr, -1);
+	    oPtr->command = Tcl_CreateObjCommand(interp,
+		    Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
+	    Tcl_DStringFree(&buffer);
+	} else {
+	    oPtr->command = Tcl_CreateObjCommand(interp, nameStr,
+		    PublicObjectCmd, oPtr, NULL);
+	}
+    } else {
+	oPtr->command = Tcl_CreateObjCommand(interp,
+		oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL);
+    }
+
+    /*
+     * Access the namespace command table directly when creating "my" to avoid
+     * a bottleneck in string manipulation. 
+     */
+
+    {
+	register Command *cmdPtr = (Command *) ckalloc(sizeof(Command));
+
+	memset(cmdPtr, 0, sizeof(Command));
+	cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr;
+	cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my",
+		&creationEpoch /*ignored*/ );
+	cmdPtr->refCount = 1;
+	cmdPtr->objProc = PrivateObjectCmd;
+	cmdPtr->objClientData = oPtr;
+	cmdPtr->proc = TclInvokeObjectCommand;
+	cmdPtr->clientData = cmdPtr;
+	Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr);
+    }
+
+    Tcl_TraceCommand(interp, TclGetString(TclOOObjectName(interp, oPtr)),
+	    TCL_TRACE_RENAME|TCL_TRACE_DELETE, ObjectRenamedTrace, oPtr);
+
+    return oPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectRenamedTrace --
+ *
+ *	This callback is triggered when the object is deleted by any
+ *	mechanism. It runs the destructors and arranges for the actual cleanup
+ *	of the object's namespace, which in turn triggers cleansing of the
+ *	object data structures.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ObjectRenamedTrace(
+    ClientData clientData,	/* The object being deleted. */
+    Tcl_Interp *interp,		/* The interpreter containing the object. */
+    const char *oldName,	/* What the object was (last) called. */
+    const char *newName,	/* Always NULL. */
+    int flags)			/* Why was the object deleted? */
+{
+    Object *oPtr = clientData;
+    Class *clsPtr;
+
+    /*
+     * If this is a rename and not a delete of the object, we just flush the
+     * cache of the object name.
+     */
+
+    if (flags & TCL_TRACE_RENAME) {
+	if (oPtr->cachedNameObj) {
+	    Tcl_DecrRefCount(oPtr->cachedNameObj);
+	    oPtr->cachedNameObj = NULL;
+	}
+	return;
+    }
+
+    /*
+     * Oh dear, the object really is being deleted. Handle this by running the
+     * destructors and deleting the object's namespace, which in turn causes
+     * the real object structures to be deleted.
+     */
+
+    AddRef(oPtr);
+    oPtr->flags |= OBJECT_DELETED;
+    if (!Tcl_InterpDeleted(interp)) {
+	CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR);
+
+	if (contextPtr != NULL) {
+	    int result;
+	    Tcl_InterpState state;
+
+	    contextPtr->callPtr->flags |= DESTRUCTOR;
+	    contextPtr->skip = 0;
+	    state = Tcl_SaveInterpState(interp, TCL_OK);
+	    result = TclOOInvokeContext(interp, contextPtr, 0, NULL);
+	    if (result != TCL_OK) {
+		Tcl_BackgroundError(interp);
+	    }
+	    Tcl_RestoreInterpState(interp, state);
+	    TclOODeleteContext(contextPtr);
+	}
+    }
+
+    /*
+     * OK, the destructor's been run. Time to splat the class data (if any)
+     * and nuke the namespace (which triggers the final crushing of the object
+     * structure itself).
+     */
+
+    clsPtr = oPtr->classPtr;
+    if (clsPtr != NULL) {
+	AddRef(clsPtr);
+	ReleaseClassContents(interp, oPtr);
+    }
+    Tcl_DeleteNamespace(oPtr->namespacePtr);
+    if (clsPtr) {
+	DelRef(clsPtr);
+    }
+    DelRef(oPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ReleaseClassContents --
+ *
+ *	Tear down the special class data structure, including deleting all
+ *	dependent classes and objects.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ReleaseClassContents(
+    Tcl_Interp *interp,		/* The interpreter containing the class. */
+    Object *oPtr)		/* The object representing the class. */
+{
+    int i, n;
+    Class *clsPtr = oPtr->classPtr, **list;
+    Object **insts;
+
+    /*
+     * Must empty list before processing the members of the list so that
+     * things happen in the correct order even if something tries to play
+     * fast-and-loose.
+     */
+
+    list = clsPtr->mixinSubs.list;
+    n = clsPtr->mixinSubs.num;
+    clsPtr->mixinSubs.list = NULL;
+    clsPtr->mixinSubs.num = 0;
+    clsPtr->mixinSubs.size = 0;
+    for (i=0 ; i<n ; i++) {
+	AddRef(list[i]);
+    }
+    for (i=0 ; i<n ; i++) {
+	if (!(list[i]->flags & OBJECT_DELETED) && interp != NULL) {
+	    Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
+	}
+	DelRef(list[i]);
+    }
+    if (list != NULL) {
+	ckfree((char *) list);
+    }
+
+    list = clsPtr->subclasses.list;
+    n = clsPtr->subclasses.num;
+    clsPtr->subclasses.list = NULL;
+    clsPtr->subclasses.num = 0;
+    clsPtr->subclasses.size = 0;
+    for (i=0 ; i<n ; i++) {
+	AddRef(list[i]);
+    }
+    for (i=0 ; i<n ; i++) {
+	if (!(list[i]->flags & OBJECT_DELETED) && interp != NULL) {
+	    Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
+	}
+	DelRef(list[i]);
+    }
+    if (list != NULL) {
+	ckfree((char *) list);
+    }
+
+    insts = clsPtr->instances.list;
+    n = clsPtr->instances.num;
+    clsPtr->instances.list = NULL;
+    clsPtr->instances.num = 0;
+    clsPtr->instances.size = 0;
+    for (i=0 ; i<n ; i++) {
+	AddRef(insts[i]);
+    }
+    for (i=0 ; i<n ; i++) {
+	if (!(insts[i]->flags & OBJECT_DELETED) && interp != NULL) {
+	    Tcl_DeleteCommandFromToken(interp, insts[i]->command);
+	}
+	DelRef(insts[i]);
+    }
+    if (insts != NULL) {
+	ckfree((char *) insts);
+    }
+
+    if (clsPtr->constructorChainPtr) {
+	TclOODeleteChain(clsPtr->constructorChainPtr);
+    }
+    if (clsPtr->destructorChainPtr) {
+	TclOODeleteChain(clsPtr->destructorChainPtr);
+    }
+    if (clsPtr->classChainCache) {
+	FOREACH_HASH_DECLS;
+	CallChain *callPtr;
+
+	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
+	    TclOODeleteChain(callPtr);
+	}
+	Tcl_DeleteHashTable(clsPtr->classChainCache);
+	ckfree((char *) clsPtr->classChainCache);
+    }
+
+    if (clsPtr->filters.num) {
+	Tcl_Obj *filterObj;
+
+	FOREACH(filterObj, clsPtr->filters) {
+	    Tcl_DecrRefCount(filterObj);
+	}
+	ckfree((char *) clsPtr->filters.list);
+	clsPtr->filters.num = 0;
+    }
+
+
+    if (clsPtr->metadataPtr != NULL) {
+	FOREACH_HASH_DECLS;
+	Tcl_ObjectMetadataType *metadataTypePtr;
+	ClientData value;
+
+	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
+	    metadataTypePtr->deleteProc(value);
+	}
+	Tcl_DeleteHashTable(clsPtr->metadataPtr);
+	ckfree((char *) clsPtr->metadataPtr);
+	clsPtr->metadataPtr = NULL;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ObjectNamespaceDeleted --
+ *
+ *	Callback when the object's namespace is deleted. Used to clean up the
+ *	data structures associated with the object. The complicated bit is
+ *	that this can sometimes happen before the object's command is deleted
+ *	(interpreter teardown is complex!)
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+ObjectNamespaceDeleted(
+    ClientData clientData)	/* Pointer to the class whose namespace is
+				 * being deleted. */
+{
+    Object *oPtr = clientData;
+    FOREACH_HASH_DECLS;
+    Class *clsPtr = oPtr->classPtr, *mixinPtr;
+    Method *mPtr;
+    Tcl_Obj *filterObj;
+    int i, preserved = !(oPtr->flags & OBJECT_DELETED);
+
+    /*
+     * Instruct everyone to no longer use any allocated fields of the object.
+     */
+
+    if (preserved) {
+	AddRef(oPtr);
+	if (clsPtr != NULL) {
+	    AddRef(clsPtr);
+	    ReleaseClassContents(NULL, oPtr);
+	}
+    }
+    oPtr->flags |= OBJECT_DELETED;
+
+    /*
+     * Splice the object out of its context. After this, we must *not* call
+     * methods on the object.
+     */
+
+    if (!(oPtr->flags & ROOT_OBJECT)) {
+	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
+    }
+
+    FOREACH(mixinPtr, oPtr->mixins) {
+	TclOORemoveFromInstances(oPtr, mixinPtr);
+    }
+    if (i) {
+	ckfree((char *) oPtr->mixins.list);
+    }
+
+    FOREACH(filterObj, oPtr->filters) {
+	Tcl_DecrRefCount(filterObj);
+    }
+    if (i) {
+	ckfree((char *) oPtr->filters.list);
+    }
+
+    if (oPtr->methodsPtr) {
+	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
+	    TclOODelMethodRef(mPtr);
+	}
+	Tcl_DeleteHashTable(oPtr->methodsPtr);
+	ckfree((char *) oPtr->methodsPtr);
+    }
+
+    if (oPtr->chainCache) {
+	TclOODeleteChainCache(oPtr->chainCache);
+    }
+
+    if (oPtr->cachedNameObj) {
+	Tcl_DecrRefCount(oPtr->cachedNameObj);
+	oPtr->cachedNameObj = NULL;
+    }
+
+    if (oPtr->metadataPtr != NULL) {
+	Tcl_ObjectMetadataType *metadataTypePtr;
+	ClientData value;
+
+	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
+	    metadataTypePtr->deleteProc(value);
+	}
+	Tcl_DeleteHashTable(oPtr->metadataPtr);
+	ckfree((char *) oPtr->metadataPtr);
+	oPtr->metadataPtr = NULL;
+    }
+
+    if (clsPtr != NULL && !(oPtr->flags & ROOT_OBJECT)) {
+	Class *superPtr, *mixinPtr;
+
+	if (clsPtr->metadataPtr != NULL) {
+	    FOREACH_HASH_DECLS;
+	    Tcl_ObjectMetadataType *metadataTypePtr;
+	    ClientData value;
+
+	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
+		metadataTypePtr->deleteProc(value);
+	    }
+	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
+	    ckfree((char *) clsPtr->metadataPtr);
+	    clsPtr->metadataPtr = NULL;
+	}
+
+	clsPtr->flags |= OBJECT_DELETED;
+	FOREACH(filterObj, clsPtr->filters) {
+	    Tcl_DecrRefCount(filterObj);
+	}
+	if (i) {
+	    ckfree((char *) clsPtr->filters.list);
+	    clsPtr->filters.num = 0;
+	}
+	FOREACH(mixinPtr, clsPtr->mixins) {
+	    if (!(mixinPtr->flags & OBJECT_DELETED)) {
+		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
+	    }
+	}
+	if (i) {
+	    ckfree((char *) clsPtr->mixins.list);
+	    clsPtr->mixins.num = 0;
+	}
+	FOREACH(superPtr, clsPtr->superclasses) {
+	    if (!(superPtr->flags & OBJECT_DELETED)) {
+		TclOORemoveFromSubclasses(clsPtr, superPtr);
+	    }
+	}
+	if (i) {
+	    ckfree((char *) clsPtr->superclasses.list);
+	    clsPtr->superclasses.num = 0;
+	}
+	if (clsPtr->subclasses.list) {
+	    ckfree((char *) clsPtr->subclasses.list);
+	    clsPtr->subclasses.num = 0;
+	}
+	if (clsPtr->instances.list) {
+	    ckfree((char *) clsPtr->instances.list);
+	    clsPtr->instances.num = 0;
+	}
+	if (clsPtr->mixinSubs.list) {
+	    ckfree((char *) clsPtr->mixinSubs.list);
+	    clsPtr->mixinSubs.num = 0;
+	}
+
+	FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
+	    TclOODelMethodRef(mPtr);
+	}
+	Tcl_DeleteHashTable(&clsPtr->classMethods);
+	TclOODelMethodRef(clsPtr->constructorPtr);
+	TclOODelMethodRef(clsPtr->destructorPtr);
+	DelRef(clsPtr);
+    }
+
+    /*
+     * Delete the object structure itself.
+     */
+
+    DelRef(oPtr);
+    if (preserved) {
+	if (clsPtr) {
+	    DelRef(clsPtr);
+	}
+	DelRef(oPtr);
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromInstances --
+ *
+ *	Utility function to remove an object from the list of instances within
+ *	a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOORemoveFromInstances(
+    Object *oPtr,		/* The instance to remove. */
+    Class *clsPtr)		/* The class (possibly) containing the
+				 * reference to the instance. */
+{
+    int i;
+    Object *instPtr;
+
+    FOREACH(instPtr, clsPtr->instances) {
+	if (oPtr == instPtr) {
+	    goto removeInstance;
+	}
+    }
+    return;
+
+  removeInstance:
+    clsPtr->instances.num--;
+    if (i < clsPtr->instances.num) {
+	clsPtr->instances.list[i] =
+		clsPtr->instances.list[clsPtr->instances.num];
+    }
+    clsPtr->instances.list[clsPtr->instances.num] = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOAddToInstances --
+ *
+ *	Utility function to add an object to the list of instances within a
+ *	class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOAddToInstances(
+    Object *oPtr,		/* The instance to add. */
+    Class *clsPtr)		/* The class to add the instance to. It is
+				 * assumed that the class is not already
+				 * present as an instance in the class. */
+{
+    if (clsPtr->instances.num >= clsPtr->instances.size) {
+	clsPtr->instances.size += ALLOC_CHUNK;
+	if (clsPtr->instances.size == ALLOC_CHUNK) {
+	    clsPtr->instances.list = (Object **)
+		    ckalloc(sizeof(Object *) * ALLOC_CHUNK);
+	} else {
+	    clsPtr->instances.list = (Object **)
+		    ckrealloc((char *) clsPtr->instances.list,
+		    sizeof(Object *) * clsPtr->instances.size);
+	}
+    }
+    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromSubclasses --
+ *
+ *	Utility function to remove a class from the list of subclasses within
+ *	another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOORemoveFromSubclasses(
+    Class *subPtr,		/* The subclass to remove. */
+    Class *superPtr)		/* The superclass to (possibly) remove the
+				 * subclass reference from. */
+{
+    int i;
+    Class *subclsPtr;
+
+    FOREACH(subclsPtr, superPtr->subclasses) {
+	if (subPtr == subclsPtr) {
+	    goto removeSubclass;
+	}
+    }
+    return;
+
+  removeSubclass:
+    superPtr->subclasses.num--;
+    if (i < superPtr->subclasses.num) {
+	superPtr->subclasses.list[i] =
+		superPtr->subclasses.list[superPtr->subclasses.num];
+    }
+    superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOAddToSubclasses --
+ *
+ *	Utility function to add a class to the list of subclasses within
+ *	another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOAddToSubclasses(
+    Class *subPtr,		/* The subclass to add. */
+    Class *superPtr)		/* The superclass to add the subclass to. It
+				 * is assumed that the class is not already
+				 * present as a subclass in the superclass. */
+{
+    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
+	superPtr->subclasses.size += ALLOC_CHUNK;
+	if (superPtr->subclasses.size == ALLOC_CHUNK) {
+	    superPtr->subclasses.list = (Class **)
+		    ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+	} else {
+	    superPtr->subclasses.list = (Class **)
+		    ckrealloc((char *) superPtr->subclasses.list,
+		    sizeof(Class *) * superPtr->subclasses.size);
+	}
+    }
+    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromMixinSubs --
+ *
+ *	Utility function to remove a class from the list of mixinSubs within
+ *	another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOORemoveFromMixinSubs(
+    Class *subPtr,		/* The subclass to remove. */
+    Class *superPtr)		/* The superclass to (possibly) remove the
+				 * subclass reference from. */
+{
+    int i;
+    Class *subclsPtr;
+
+    FOREACH(subclsPtr, superPtr->mixinSubs) {
+	if (subPtr == subclsPtr) {
+	    goto removeSubclass;
+	}
+    }
+    return;
+
+  removeSubclass:
+    superPtr->mixinSubs.num--;
+    if (i < superPtr->mixinSubs.num) {
+	superPtr->mixinSubs.list[i] =
+		superPtr->mixinSubs.list[superPtr->mixinSubs.num];
+    }
+    superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOAddToMixinSubs --
+ *
+ *	Utility function to add a class to the list of mixinSubs within
+ *	another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOAddToMixinSubs(
+    Class *subPtr,		/* The subclass to add. */
+    Class *superPtr)		/* The superclass to add the subclass to. It
+				 * is assumed that the class is not already
+				 * present as a subclass in the superclass. */
+{
+    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
+	superPtr->mixinSubs.size += ALLOC_CHUNK;
+	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
+	    superPtr->mixinSubs.list = (Class **)
+		    ckalloc(sizeof(Class *) * ALLOC_CHUNK);
+	} else {
+	    superPtr->mixinSubs.list = (Class **)
+		    ckrealloc((char *) superPtr->mixinSubs.list,
+		    sizeof(Class *) * superPtr->mixinSubs.size);
+	}
+    }
+    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AllocClass --
+ *
+ *	Allocate a basic class. Does not splice the class object into its
+ *	class's instance list.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Class *
+AllocClass(
+    Tcl_Interp *interp,		/* Interpreter within which to allocate the
+				 * class. */
+    Object *useThisObj)		/* Object that is to act as the class
+				 * representation, or NULL if a new object
+				 * (with automatic name) is to be used. */
+{
+    Foundation *fPtr = GetFoundation(interp);
+    Class *clsPtr = (Class *) ckalloc(sizeof(Class));
+    Tcl_Namespace *path[2];
+
+    /*
+     * Make an object if we haven't been given one.
+     */
+
+    memset(clsPtr, 0, sizeof(Class));
+    if (useThisObj == NULL) {
+	clsPtr->thisPtr = AllocObject(interp, NULL, NULL);
+    } else {
+	clsPtr->thisPtr = useThisObj;
+    }
+
+    /*
+     * Configure the namespace path for the class's object.
+     */
+
+    path[0] = fPtr->helpersNs;
+    path[1] = fPtr->ooNs;
+    TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
+
+    /*
+     * Class objects inherit from the class of classes unless they inherit
+     * from some subclass of it. Enforce this right now.
+     */
+
+    clsPtr->thisPtr->selfCls = fPtr->classCls;
+
+    /*
+     * Classes are subclasses of oo::object, i.e. the objects they create are
+     * objects.
+     */
+
+    clsPtr->superclasses.num = 1;
+    clsPtr->superclasses.list = (Class **) ckalloc(sizeof(Class *));
+    clsPtr->superclasses.list[0] = fPtr->objectCls;
+
+    /*
+     * Finish connecting the class structure to the object structure.
+     */
+
+    clsPtr->thisPtr->classPtr = clsPtr;
+
+    /*
+     * That's the complicated bit. Now fill in the rest of the non-zero/NULL
+     * fields.
+     */
+
+    clsPtr->refCount = 1;
+    Tcl_InitObjHashTable(&clsPtr->classMethods);
+    return clsPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_NewObjectInstance --
+ *
+ *	Allocate a new instance of an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_NewObjectInstance(
+    Tcl_Interp *interp,		/* Interpreter context. */
+    Tcl_Class cls,		/* Class to create an instance of. */
+    const char *nameStr,	/* Name of object to create, or NULL to ask
+				 * the code to pick its own unique name. */
+    const char *nsNameStr,	/* Name of namespace to create inside object,
+				 * or NULL to ask the code to pick its own
+				 * unique name. */
+    int objc,			/* Number of arguments. Negative value means
+				 * do not call constructor. */
+    Tcl_Obj *const *objv,	/* Argument list. */
+    int skip)			/* Number of arguments to _not_ pass to the
+				 * constructor. */
+{
+    register Class *classPtr = (Class *) cls;
+    Foundation *fPtr = GetFoundation(interp);
+    Object *oPtr;
+
+    /*
+     * Check if we're going to create an object over an existing command;
+     * that's not allowed.
+     */
+
+    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, 0)) {
+	Tcl_AppendResult(interp, "can't create object \"", nameStr,
+		"\": command already exists with that name", NULL);
+	return NULL;
+    }
+
+    /*
+     * Create the object.
+     */
+
+    oPtr = AllocObject(interp, nameStr, nsNameStr);
+    oPtr->selfCls = classPtr;
+    TclOOAddToInstances(oPtr, classPtr);
+
+    /*
+     * Check to see if we're really creating a class. If so, allocate the
+     * class structure as well.
+     */
+
+    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
+	/*
+	 * Is a class, so attach a class structure. Note that the AllocClass
+	 * function splices the structure into the object, so we don't have
+	 * to. Once that's done, we need to repatch the object to have the
+	 * right class since AllocClass interferes with that.
+	 */
+
+	AllocClass(interp, oPtr);
+	oPtr->selfCls = classPtr;
+	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
+    }
+
+    /*
+     * Run constructors, except when objc < 0 (a special flag case used for
+     * object cloning only).
+     */
+
+    if (objc >= 0) {
+	CallContext *contextPtr = TclOOGetCallContext(oPtr,NULL,CONSTRUCTOR);
+
+	if (contextPtr != NULL) {
+	    int result;
+	    Tcl_InterpState state;
+
+	    AddRef(oPtr);
+	    state = Tcl_SaveInterpState(interp, TCL_OK);
+	    contextPtr->callPtr->flags |= CONSTRUCTOR;
+	    contextPtr->skip = skip;
+	    result = TclOOInvokeContext(interp, contextPtr, objc, objv);
+	    TclOODeleteContext(contextPtr);
+	    DelRef(oPtr);
+	    if (result != TCL_OK) {
+		Tcl_DiscardInterpState(state);
+		Tcl_DeleteCommandFromToken(interp, oPtr->command);
+		return NULL;
+	    }
+	    Tcl_RestoreInterpState(interp, state);
+	}
+    }
+
+    return (Tcl_Object) oPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_CopyObjectInstance --
+ *
+ *	Creates a copy of an object. Does not copy the backing namespace,
+ *	since the correct way to do that (e.g., shallow/deep) depends on the
+ *	object/class's own policies.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_CopyObjectInstance(
+    Tcl_Interp *interp,
+    Tcl_Object sourceObject,
+    const char *targetName,
+    const char *targetNamespaceName)
+{
+    Object *oPtr = (Object *) sourceObject, *o2Ptr;
+    FOREACH_HASH_DECLS;
+    Method *mPtr;
+    Class *mixinPtr;
+    Tcl_Obj *keyPtr, *filterObj;
+    int i;
+
+    /*
+     * Sanity checks.
+     */
+
+    if (targetName == NULL && oPtr->classPtr != NULL) {
+	Tcl_AppendResult(interp, "must supply a name when copying a class",
+		NULL);
+	return NULL;
+    }
+    if (oPtr->classPtr == GetFoundation(interp)->classCls) {
+	Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
+	return NULL;
+    }
+
+    /*
+     * Build the instance. Note that this does not run any constructors.
+     */
+
+    o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
+	    (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1,
+	    NULL, -1);
+    if (o2Ptr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Copy the object-local methods to the new object.
+     */
+
+    if (oPtr->methodsPtr) {
+	FOREACH_HASH(keyPtr, mPtr, oPtr->methodsPtr) {
+	    if (CloneObjectMethod(interp, o2Ptr, mPtr, keyPtr) != TCL_OK) {
+		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+		return NULL;
+	    }
+	}
+    }
+
+    /*
+     * Copy the object's mixin references to the new object.
+     */
+
+    FOREACH(mixinPtr, o2Ptr->mixins) {
+	if (mixinPtr != o2Ptr->selfCls) {
+	    TclOORemoveFromInstances(o2Ptr, mixinPtr);
+	}
+    }
+    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
+    FOREACH(mixinPtr, o2Ptr->mixins) {
+	if (mixinPtr != o2Ptr->selfCls) {
+	    TclOOAddToInstances(o2Ptr, mixinPtr);
+	}
+    }
+
+    /*
+     * Copy the object's filter list to the new object.
+     */
+
+    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
+    FOREACH(filterObj, o2Ptr->filters) {
+	Tcl_IncrRefCount(filterObj);
+    }
+
+    /*
+     * Copy the object's flags to the new object, clearing those that must be
+     * kept object-local. The duplicate is never deleted at this point, nor is
+     * it the root of the object system or in the midst of processing a filter
+     * call.
+     */
+
+    o2Ptr->flags = oPtr->flags & ~(
+	    OBJECT_DELETED | ROOT_OBJECT | FILTER_HANDLING);
+
+    /*
+     * Copy the object's metadata.
+     */
+
+    if (oPtr->metadataPtr != NULL) {
+	Tcl_ObjectMetadataType *metadataTypePtr;
+	ClientData value, duplicate;
+
+	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
+	    if (metadataTypePtr->cloneProc == NULL) {
+		duplicate = value;
+	    } else {
+		if (metadataTypePtr->cloneProc(interp, value,
+			&duplicate) != TCL_OK) {
+		    Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+		    return NULL;
+		}
+	    }
+	    if (duplicate != NULL) {
+		Tcl_ObjectSetMetadata((Tcl_Object) o2Ptr, metadataTypePtr,
+			duplicate);
+	    }
+	}
+    }
+
+    /*
+     * Copy the class, if present. Note that if there is a class present in
+     * the source object, there must also be one in the copy.
+     */
+
+    if (oPtr->classPtr != NULL) {
+	Class *clsPtr = oPtr->classPtr;
+	Class *cls2Ptr = o2Ptr->classPtr;
+	Class *superPtr;
+
+	/*
+	 * Copy the class flags across.
+	 */
+
+	cls2Ptr->flags = clsPtr->flags;
+
+	/*
+	 * Ensure that the new class's superclass structure is the same as the
+	 * old class's.
+	 */
+
+	FOREACH(superPtr, cls2Ptr->superclasses) {
+	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
+	}
+	if (cls2Ptr->superclasses.num) {
+	    cls2Ptr->superclasses.list = (Class **)
+		    ckrealloc((char *) cls2Ptr->superclasses.list,
+		    sizeof(Class *) * clsPtr->superclasses.num);
+	} else {
+	    cls2Ptr->superclasses.list = (Class **)
+		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
+	}
+	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
+		sizeof(Class *) * clsPtr->superclasses.num);
+	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
+	FOREACH(superPtr, cls2Ptr->superclasses) {
+	    TclOOAddToSubclasses(cls2Ptr, superPtr);
+	}
+
+	/*
+	 * Duplicate the source class's filters.
+	 */
+
+	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
+	FOREACH(filterObj, cls2Ptr->filters) {
+	    Tcl_IncrRefCount(filterObj);
+	}
+
+	/*
+	 * Duplicate the source class's mixins (which cannot be circular
+	 * references to the duplicate).
+	 */
+
+	FOREACH(mixinPtr, cls2Ptr->mixins) {
+	    TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
+	}
+	if (cls2Ptr->mixins.num != 0) {
+	    ckfree((char *) clsPtr->mixins.list);
+	}
+	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
+	FOREACH(mixinPtr, cls2Ptr->mixins) {
+	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
+	}
+
+	/*
+	 * Duplicate the source class's methods, constructor and destructor.
+	 */
+
+	FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) {
+	    if (CloneClassMethod(interp, cls2Ptr, mPtr, keyPtr,
+		    NULL) != TCL_OK) {
+		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+		return NULL;
+	    }
+	}
+	if (clsPtr->constructorPtr) {
+	    if (CloneClassMethod(interp, cls2Ptr, clsPtr->constructorPtr,
+		    NULL, &cls2Ptr->constructorPtr) != TCL_OK) {
+		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+		return NULL;
+	    }
+	}
+	if (clsPtr->destructorPtr) {
+	    if (CloneClassMethod(interp, cls2Ptr, clsPtr->destructorPtr, NULL,
+		    &cls2Ptr->destructorPtr) != TCL_OK) {
+		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+		return NULL;
+	    }
+	}
+
+	/*
+	 * Duplicate the class's metadata.
+	 */
+
+	if (clsPtr->metadataPtr != NULL) {
+	    Tcl_ObjectMetadataType *metadataTypePtr;
+	    ClientData value, duplicate;
+
+	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
+		if (metadataTypePtr->cloneProc == NULL) {
+		    duplicate = value;
+		} else {
+		    if (metadataTypePtr->cloneProc(interp, value,
+			    &duplicate) != TCL_OK) {
+			Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
+			return NULL;
+		    }
+		}
+		if (duplicate != NULL) {
+		    Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
+			    duplicate);
+		}
+	    }
+	}
+    }
+
+    return (Tcl_Object) o2Ptr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * CloneObjectMethod, CloneClassMethod --
+ *
+ *	Helper functions used for cloning methods. They work identically to
+ *	each other, except for the difference between them in how they
+ *	register the cloned method on a successful clone.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+CloneObjectMethod(
+    Tcl_Interp *interp,
+    Object *oPtr,
+    Method *mPtr,
+    Tcl_Obj *namePtr)
+{
+    if (mPtr->typePtr == NULL) {
+	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+		mPtr->flags & PUBLIC_METHOD, NULL, NULL);
+    } else if (mPtr->typePtr->cloneProc) {
+	ClientData newClientData;
+
+	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
+		&newClientData) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);
+    } else {
+	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
+		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData);
+    }
+    return TCL_OK;
+}
+
+static int
+CloneClassMethod(
+    Tcl_Interp *interp,
+    Class *clsPtr,
+    Method *mPtr,
+    Tcl_Obj *namePtr,
+    Method **m2PtrPtr)
+{
+    Method *m2Ptr;
+
+    if (mPtr->typePtr == NULL) {
+	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+		namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
+    } else if (mPtr->typePtr->cloneProc) {
+	ClientData newClientData;
+
+	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
+		&newClientData) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
+		newClientData);
+    } else {
+	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
+		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
+		mPtr->clientData);
+    }
+    if (m2PtrPtr != NULL) {
+	*m2PtrPtr = m2Ptr;
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_ObjectGetMetadata,
+ * Tcl_ObjectSetMetadata --
+ *
+ *	Metadata management API. The metadata system allows code in extensions
+ *	to attach arbitrary non-NULL pointers to objects and classes without
+ *	the different things that might be interested being able to interfere
+ *	with each other. Apart from non-NULL-ness, these routines attach no
+ *	interpretation to the meaning of the metadata pointers.
+ *
+ *	The Tcl_*GetMetadata routines get the metadata pointer attached that
+ *	has been related with a particular type, or NULL if no metadata
+ *	associated with the given type has been attached.
+ *
+ *	The Tcl_*SetMetadata routines set or delete the metadata pointer that
+ *	is related to a particular type. The value associated with the type is
+ *	deleted (if present; no-op otherwise) if the value is NULL, and
+ *	attached (replacing the previous value, which is deleted if present)
+ *	otherwise. This means it is impossible to attach a NULL value for any
+ *	metadata type.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_ClassGetMetadata(
+    Tcl_Class clazz,
+    const Tcl_ObjectMetadataType *typePtr)
+{
+    Class *clsPtr = (Class *) clazz;
+    Tcl_HashEntry *hPtr;
+
+    /*
+     * If there's no metadata store attached, the type in question has
+     * definitely not been attached either!
+     */
+
+    if (clsPtr->metadataPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * There is a metadata store, so look in it for the given type.
+     */
+
+    hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
+
+    /*
+     * Return the metadata value if we found it, otherwise NULL.
+     */
+
+    if (hPtr == NULL) {
+	return NULL;
+    }
+    return Tcl_GetHashValue(hPtr);
+}
+
+void
+Tcl_ClassSetMetadata(
+    Tcl_Class clazz,
+    const Tcl_ObjectMetadataType *typePtr,
+    ClientData metadata)
+{
+    Class *clsPtr = (Class *) clazz;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    /*
+     * Attach the metadata store if not done already.
+     */
+
+    if (clsPtr->metadataPtr == NULL) {
+	if (metadata == NULL) {
+	    return;
+	}
+	clsPtr->metadataPtr = (Tcl_HashTable*) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
+    }
+
+    /*
+     * If the metadata is NULL, we're deleting the metadata for the type.
+     */
+
+    if (metadata == NULL) {
+	hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
+	if (hPtr != NULL) {
+	    typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+	return;
+    }
+
+    /*
+     * Otherwise we're attaching the metadata. Note that if there was already
+     * some metadata attached of this type, we delete that first.
+     */
+
+    hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, (char *) typePtr, &isNew);
+    if (!isNew) {
+	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+    }
+    Tcl_SetHashValue(hPtr, metadata);
+}
+
+ClientData
+Tcl_ObjectGetMetadata(
+    Tcl_Object object,
+    const Tcl_ObjectMetadataType *typePtr)
+{
+    Object *oPtr = (Object *) object;
+    Tcl_HashEntry *hPtr;
+
+    /*
+     * If there's no metadata store attached, the type in question has
+     * definitely not been attached either!
+     */
+
+    if (oPtr->metadataPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * There is a metadata store, so look in it for the given type.
+     */
+
+    hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
+
+    /*
+     * Return the metadata value if we found it, otherwise NULL.
+     */
+
+    if (hPtr == NULL) {
+	return NULL;
+    }
+    return Tcl_GetHashValue(hPtr);
+}
+
+void
+Tcl_ObjectSetMetadata(
+    Tcl_Object object,
+    const Tcl_ObjectMetadataType *typePtr,
+    ClientData metadata)
+{
+    Object *oPtr = (Object *) object;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    /*
+     * Attach the metadata store if not done already.
+     */
+
+    if (oPtr->metadataPtr == NULL) {
+	if (metadata == NULL) {
+	    return;
+	}
+	oPtr->metadataPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
+    }
+
+    /*
+     * If the metadata is NULL, we're deleting the metadata for the type.
+     */
+
+    if (metadata == NULL) {
+	hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
+	if (hPtr != NULL) {
+	    typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+	return;
+    }
+
+    /*
+     * Otherwise we're attaching the metadata. Note that if there was already
+     * some metadata attached of this type, we delete that first.
+     */
+
+    hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, (char *) typePtr, &isNew);
+    if (!isNew) {
+	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
+    }
+    Tcl_SetHashValue(hPtr, metadata);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject, TclOOObjectCmdCore --
+ *
+ *	Main entry point for object invokations. The Public* and Private*
+ *	wrapper functions are just thin wrappers round the main
+ *	TclOOObjectCmdCore function that does call chain creation, management
+ *	and invokation.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+PublicObjectCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
+	    NULL);
+}
+
+static int
+PrivateObjectCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL);
+}
+
+int
+TclOOInvokeObject(
+    Tcl_Interp *interp,		/* Interpreter for commands, variables,
+				 * results, error reporting, etc. */
+    Tcl_Object object,		/* The object to invoke. */
+    Tcl_Class startCls,		/* Where in the class chain to start the
+				 * invoke from, or NULL to traverse the whole
+				 * chain including filters. */
+    int publicPrivate,		/* Whether this is an invoke from a public
+				 * context (PUBLIC_METHOD), a private context
+				 * (PRIVATE_METHOD), or a *really* private
+				 * context (any other value; conventionally
+				 * 0). */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Array of argument objects. It is assumed
+				 * that the name of the method to invoke will
+				 * be at index 1. */
+{
+    switch (publicPrivate) {
+    case PUBLIC_METHOD:
+	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
+		PUBLIC_METHOD, (Class *) startCls);
+    case PRIVATE_METHOD:
+	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
+		PRIVATE_METHOD, (Class *) startCls);
+    default:
+	return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0,
+		(Class *) startCls);
+    }
+}
+
+int
+TclOOObjectCmdCore(
+    Object *oPtr,		/* The object being invoked. */
+    Tcl_Interp *interp,		/* The interpreter containing the object. */
+    int objc,			/* How many arguments are being passed in. */
+    Tcl_Obj *const *objv,	/* The array of arguments. */
+    int flags,			/* Whether this is an invokation through the
+				 * public or the private command interface. */
+    Class *startCls)		/* Where to start in the call chain, or NULL
+				 * if we are to start at the front with
+				 * filters and the object's methods (which is
+				 * the normal case). */
+{
+    CallContext *contextPtr;
+    Tcl_Obj *methodNamePtr;
+    int result;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Give plugged in code a chance to remap the method name.
+     */
+
+    methodNamePtr = objv[1];
+    if (oPtr->mapMethodNameProc != NULL) {
+	register Class **startClsPtr = &startCls;
+
+	methodNamePtr = Tcl_DuplicateObj(methodNamePtr);
+	result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
+		(Tcl_Class *) startClsPtr, methodNamePtr);
+	if (result != TCL_OK) {
+	    if (result == TCL_ERROR) {
+		Tcl_AddErrorInfo(interp, "\n    (while mapping method name)");
+	    }
+	    Tcl_DecrRefCount(methodNamePtr);
+	    return result;
+	}
+    }
+    Tcl_IncrRefCount(methodNamePtr);
+
+    /*
+     * Get the call chain.
+     */
+
+    contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
+	    flags | (oPtr->flags & FILTER_HANDLING));
+    if (contextPtr == NULL) {
+	Tcl_AppendResult(interp, "impossible to invoke method \"",
+		TclGetString(methodNamePtr),
+		"\": no defined method or unknown method", NULL);
+	Tcl_DecrRefCount(methodNamePtr);
+	return TCL_ERROR;
+    }
+    Tcl_DecrRefCount(methodNamePtr);
+
+    /*
+     * Check to see if we need to apply magical tricks to start part way
+     * through the call chain.
+     */
+
+    if (startCls != NULL) {
+	while (contextPtr->index < contextPtr->callPtr->numChain) {
+	    register struct MInvoke *miPtr =
+		    &contextPtr->callPtr->chain[contextPtr->index];
+
+	    if (miPtr->isFilter || miPtr->mPtr->declaringClassPtr!=startCls) {
+		contextPtr->index++;
+	    } else {
+		break;
+	    }
+	}
+	if (contextPtr->index >= contextPtr->callPtr->numChain) {
+	    result = TCL_ERROR;
+	    Tcl_SetResult(interp, "no valid method implementation",
+		    TCL_STATIC);
+	    AddRef(oPtr);		/* Just to balance. */
+	    goto disposeChain;
+	}
+    }
+
+    /*
+     * Invoke the call chain, locking the object structure against deletion
+     * for the duration.
+     */
+
+    AddRef(oPtr);
+    result = TclOOInvokeContext(interp, contextPtr, objc, objv);
+
+    /*
+     * Dispose of the call chain and drop the lock on the object's structure.
+     */
+
+  disposeChain:
+    TclOODeleteContext(contextPtr);
+    DelRef(oPtr);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_ObjectContextInvokeNext --
+ *
+ *	Invokes the next stage of the call chain described in an object
+ *	context. This is the core of the implementation of the [next] command.
+ *	Does not do management of the call-frame stack.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+Tcl_ObjectContextInvokeNext(
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv,
+    int skip)
+{
+    CallContext *contextPtr = (CallContext *) context;
+    int savedIndex = contextPtr->index;
+    int savedSkip = contextPtr->skip;
+    int result;
+
+    if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+	/*
+	 * We're at the end of the chain; return the empty string (the most
+	 * useful thing we can do, since it turns out that it's not always
+	 * trivial to detect in source code whether there is a parent
+	 * implementation, what with multiple-inheritance...)
+	 */
+
+	return TCL_OK;
+    }
+
+    /*
+     * Advance to the next method implementation in the chain in the method
+     * call context while we process the body. However, need to adjust the
+     * argument-skip control because we're guaranteed to have a single prefix
+     * arg (i.e., 'next') and not the variable amount that can happen because
+     * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+     * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
+     * all) come through the same code.
+     */
+
+    contextPtr->index++;
+    contextPtr->skip = skip;
+
+    /*
+     * Invoke the (advanced) method call context in the caller context.
+     */
+
+    result = TclOOInvokeContext(interp, contextPtr, objc, objv);
+
+    /*
+     * Restore the call chain context index as we've finished the inner invoke
+     * and want to operate in the outer context again.
+     */
+
+    contextPtr->index = savedIndex;
+    contextPtr->skip = savedSkip;
+
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_GetObjectFromObj --
+ *
+ *	Utility function to get an object from a Tcl_Obj containing its name.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_GetObjectFromObj(
+    Tcl_Interp *interp,		/* Interpreter in which to locate the object.
+				 * Will have an error message placed in it if
+				 * the name does not refer to an object. */
+    Tcl_Obj *objPtr)		/* The name of the object to look up, which is
+				 * exactly the name of its public command. */
+{
+    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
+
+    if (cmdPtr == NULL) {
+	goto notAnObject;
+    }
+    if (cmdPtr->objProc != PublicObjectCmd) {
+	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
+	if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
+	    goto notAnObject;
+	}
+    }
+    return cmdPtr->objClientData;
+
+  notAnObject:
+    Tcl_AppendResult(interp, TclGetString(objPtr),
+	    " does not refer to an object", NULL);
+    return NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOIsReachable --
+ *
+ *	Utility function that tests whether a class is a subclass (whether
+ *	directly or indirectly) of another class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOIsReachable(
+    Class *targetPtr,
+    Class *startPtr)
+{
+    int i;
+    Class *superPtr;
+
+  tailRecurse:
+    if (startPtr == targetPtr) {
+	return 1;
+    }
+    if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) {
+	startPtr = startPtr->superclasses.list[0];
+	goto tailRecurse;
+    }
+    FOREACH(superPtr, startPtr->superclasses) {
+	if (TclOOIsReachable(targetPtr, superPtr)) {
+	    return 1;
+	}
+    }
+    FOREACH(superPtr, startPtr->mixins) {
+	if (TclOOIsReachable(targetPtr, superPtr)) {
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectName --
+ *
+ *	Utility function that returns the name of the object. Note that this
+ *	simplifies cache management by keeping the code to do it in one place
+ *	and not sprayed all over. The value returned always has a reference
+ *	count of at least one.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOOObjectName(
+    Tcl_Interp *interp,
+    Object *oPtr)
+{
+    Tcl_Obj *namePtr;
+
+    if (oPtr->cachedNameObj) {
+	return oPtr->cachedNameObj;
+    }
+    namePtr = Tcl_NewObj();
+    Tcl_GetCommandFullName(interp, oPtr->command, namePtr);
+    Tcl_IncrRefCount(namePtr);
+    oPtr->cachedNameObj = namePtr;
+    return namePtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * assorted trivial 'getter' functions
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+Tcl_ObjectContextMethod(
+    Tcl_ObjectContext context)
+{
+    CallContext *contextPtr = (CallContext *) context;
+    return (Tcl_Method) contextPtr->callPtr->chain[contextPtr->index].mPtr;
+}
+
+int
+Tcl_ObjectContextIsFiltering(
+    Tcl_ObjectContext context)
+{
+    CallContext *contextPtr = (CallContext *) context;
+    return contextPtr->callPtr->chain[contextPtr->index].isFilter;
+}
+
+Tcl_Object
+Tcl_ObjectContextObject(
+    Tcl_ObjectContext context)
+{
+    return (Tcl_Object) ((CallContext *)context)->oPtr;
+}
+
+int
+Tcl_ObjectContextSkippedArgs(
+    Tcl_ObjectContext context)
+{
+    return ((CallContext *)context)->skip;
+}
+
+Tcl_Namespace *
+Tcl_GetObjectNamespace(
+    Tcl_Object object)
+{
+    return ((Object *)object)->namespacePtr;
+}
+
+Tcl_Command
+Tcl_GetObjectCommand(
+    Tcl_Object object)
+{
+    return ((Object *)object)->command;
+}
+
+Tcl_Class
+Tcl_GetObjectAsClass(
+    Tcl_Object object)
+{
+    return (Tcl_Class) ((Object *)object)->classPtr;
+}
+
+int
+Tcl_ObjectDeleted(
+    Tcl_Object object)
+{
+    return (((Object *)object)->flags & OBJECT_DELETED) ? 1 : 0;
+}
+
+Tcl_Object
+Tcl_GetClassAsObject(
+    Tcl_Class clazz)
+{
+    return (Tcl_Object) ((Class *)clazz)->thisPtr;
+}
+
+Tcl_ObjectMapMethodNameProc
+Tcl_ObjectGetMethodNameMapper(
+    Tcl_Object object)
+{
+    return ((Object *) object)->mapMethodNameProc;
+}
+
+void
+Tcl_ObjectSetMethodNameMapper(
+    Tcl_Object object,
+    Tcl_ObjectMapMethodNameProc mapMethodNameProc)
+{
+    ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
new file mode 100644
index 0000000..0fdbe47
--- /dev/null
+++ b/generic/tclOO.decls
@@ -0,0 +1,190 @@
+# -*- tcl -*-
+# $Id: tclOO.decls,v 1.1 2008/05/31 11:42:17 dkf Exp $
+
+# public API
+library tclOO
+interface tclOO
+epoch 0
+scspec TCLOOAPI
+
+declare 0 current {
+    Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
+	    Tcl_Object sourceObject, const char *targetName,
+	    const char *targetNamespaceName)
+}
+declare 1 current {
+    Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz)
+}
+declare 2 current {
+    Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object)
+}
+declare 3 current {
+    Tcl_Command Tcl_GetObjectCommand(Tcl_Object object)
+}
+declare 4 current {
+    Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 5 current {
+    Tcl_Namespace *Tcl_GetObjectNamespace(Tcl_Object object)
+}
+declare 6 current {
+    Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method)
+}
+declare 7 current {
+    Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method)
+}
+declare 8 current {
+    int Tcl_MethodIsPublic(Tcl_Method method)
+}
+declare 9 current {
+    int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr,
+	    ClientData *clientDataPtr)
+}
+declare 10 current {
+    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
+}
+declare 11 current {
+    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
+	    Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
+	    ClientData clientData)
+}
+declare 12 current {
+    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+	    Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
+	    ClientData clientData)
+}
+declare 13 current {
+    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
+	    const char *nameStr, const char *nsNameStr, int objc,
+	    Tcl_Obj *const *objv, int skip)
+}
+declare 14 current {
+    int Tcl_ObjectDeleted(Tcl_Object object)
+}
+declare 15 current {
+    int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context)
+}
+declare 16 current {
+    Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context)
+}
+declare 17 current {
+    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
+}
+declare 18 current {
+    int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
+}
+declare 19 current {
+    ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
+	    const Tcl_ObjectMetadataType *typePtr)
+}
+declare 20 current {
+    void Tcl_ClassSetMetadata(Tcl_Class clazz,
+	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
+}
+declare 21 current {
+    ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
+	    const Tcl_ObjectMetadataType *typePtr)
+}
+declare 22 current {
+    void Tcl_ObjectSetMetadata(Tcl_Object object,
+	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
+}
+declare 23 current {
+    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
+	    int skip)
+}
+declare 24 current {
+    Tcl_ObjectMapMethodNameProc Tcl_ObjectGetMethodNameMapper(
+	    Tcl_Object object)
+}
+declare 25 current {
+    void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+	    Tcl_ObjectMapMethodNameProc mapMethodNameProc)
+}
+declare 26 current {
+    void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz,
+	    Tcl_Method method)
+}
+declare 27 current {
+    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
+	    Tcl_Method method)
+}
+
+# private API, exposed to support advanced OO systems that plug in on top
+interface tclOOInt
+declare 0 current {
+    Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
+}
+declare 1 current {
+    Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
+	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+	    const Tcl_MethodType *typePtr, ClientData clientData,
+	    Proc **procPtrPtr)
+}
+declare 2 current {
+    Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr,
+	    int flags, Tcl_Obj *nameObj, const char *namePtr,
+	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr,
+	    ClientData clientData, Proc **procPtrPtr)
+}
+declare 3 current {
+    Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
+	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+	    ProcedureMethod **pmPtrPtr)
+}
+declare 4 current {
+    Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
+	    ProcedureMethod **pmPtrPtr)
+}
+declare 5 current {
+    int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc,
+	    Tcl_Obj *const *objv, int publicOnly, Class *startCls)
+}
+declare 6 current {
+    int TclOOIsReachable(Class *targetPtr, Class *startPtr)
+}
+declare 7 current {
+    Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr,
+	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
+}
+declare 8 current {
+    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
+	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
+}
+declare 9 current {
+    Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+	    Tcl_Object oPtr, TclOO_PreCallProc preCallPtr,
+	    TclOO_PostCallProc postCallPtr, ProcErrorProc errProc,
+	    ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
+	    Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
+}
+declare 10 current {
+    Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
+	    TclOO_PreCallProc preCallPtr, TclOO_PostCallProc postCallPtr,
+	    ProcErrorProc errProc, ClientData clientData, Tcl_Obj *nameObj,
+	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
+	    void **internalTokenPtr)
+}
+declare 11 current {
+    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
+	    Tcl_Class startCls, int publicPrivate, int objc,
+	    Tcl_Obj *const *objv)
+}
+declare 12 current {
+    void TclOOObjectSetFilters(Object *oPtr, int numFilters,
+	    Tcl_Obj *const *filters)
+}
+declare 13 current {
+    void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr,
+	    int numFilters, Tcl_Obj *const *filters)
+}
+declare 14 current {
+    void TclOOObjectSetMixins(Object *oPtr, int numMixins,
+	    Class *const *mixins)
+}
+declare 15 current {
+    void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
+	    int numMixins, Class *const *mixins)
+}
diff --git a/generic/tclOO.h b/generic/tclOO.h
new file mode 100644
index 0000000..f3fd73c
--- /dev/null
+++ b/generic/tclOO.h
@@ -0,0 +1,128 @@
+/*
+ * tclOO.h --
+ *
+ *	This file contains the public API definitions and some of the function
+ *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
+ *
+ * Copyright (c) 2006-2008 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.h,v 1.4 2008/05/31 11:42:17 dkf Exp $
+ */
+
+#ifndef TCLOO_H_INCLUDED
+#define TCLOO_H_INCLUDED
+#include "tcl.h"
+
+#if defined(BUILD_tcloo)
+#	define TCLOOAPI DLLEXPORT
+#	undef USE_TCLOO_STUBS
+#else
+#	define TCLOOAPI DLLIMPORT
+#endif
+
+/*
+ * Must match version at top of ../configure.in
+ */
+
+#define TCLOO_VERSION "0.4"
+#define TCLOO_PATCHLEVEL TCLOO_VERSION
+
+/*
+ * These are opaque types.
+ */
+
+typedef struct Tcl_Class_ *Tcl_Class;
+typedef struct Tcl_Method_ *Tcl_Method;
+typedef struct Tcl_Object_ *Tcl_Object;
+typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
+
+/*
+ * Public datatypes for callbacks and structures used in the TIP#257 (OO)
+ * implementation. These are used to implement custom types of method calls
+ * and to allow the attachment of arbitrary data to objects and classes.
+ */
+
+typedef int (*Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
+	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
+typedef void (*Tcl_MethodDeleteProc)(ClientData clientData);
+typedef int (*Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
+	ClientData *newClientData);
+typedef void (*Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
+typedef int (*Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
+	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
+
+/*
+ * The type of a method implementation. This describes how to call the method
+ * implementation, how to delete it (when the object or class is deleted) and
+ * how to create a clone of it (when the object or class is copied).
+ */
+
+typedef struct {
+    int version;		/* Structure version field. Always to be equal
+				 * to TCL_OO_METHOD_VERSION_CURRENT in
+				 * declarations. */
+    const char *name;		/* Name of this type of method, mostly for
+				 * debugging purposes. */
+    Tcl_MethodCallProc callProc;/* How to invoke this method. */
+    Tcl_MethodDeleteProc deleteProc;
+				/* How to delete this method's type-specific
+				 * data, or NULL if the type-specific data
+				 * does not need deleting. */
+    Tcl_CloneProc cloneProc;	/* How to copy this method's type-specific
+				 * data, or NULL if the type-specific data can
+				 * be copied directly. */
+} Tcl_MethodType;
+
+/*
+ * The correct value for the version field of the Tcl_MethodType structure.
+ * This allows new versions of the structure to be introduced without breaking
+ * binary compatability.
+ */
+
+#define TCL_OO_METHOD_VERSION_CURRENT 1
+
+/*
+ * The type of some object (or class) metadata. This describes how to delete
+ * the metadata (when the object or class is deleted) and how to create a
+ * clone of it (when the object or class is copied).
+ */
+
+typedef struct {
+    int version;		/* Structure version field. Always to be equal
+				 * to TCL_OO_METADATA_VERSION_CURRENT in
+				 * declarations. */
+    const char *name;
+    Tcl_ObjectMetadataDeleteProc deleteProc;
+				/* How to delete the metadata. This must not
+				 * be NULL. */
+    Tcl_CloneProc cloneProc;	/* How to copy the metadata, or NULL if the
+				 * type-specific data can be copied
+				 * directly. */
+} Tcl_ObjectMetadataType;
+
+/*
+ * The correct value for the version field of the Tcl_ObjectMetadataType
+ * structure. This allows new versions of the structure to be introduced
+ * without breaking binary compatability.
+ */
+
+#define TCL_OO_METADATA_VERSION_CURRENT 1
+
+/*
+ * Include all the public API, generated from tclOO.decls.
+ */
+
+#include "tclOODecls.h"
+
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
new file mode 100644
index 0000000..1cd07df
--- /dev/null
+++ b/generic/tclOOBasic.c
@@ -0,0 +1,925 @@
+/*
+ * tclOOBasic.c --
+ *
+ *	This file contains implementations of the "simple" commands and
+ *	methods from the object-system core.
+ *
+ * Copyright (c) 2005-2008 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.1 2008/05/31 11:42:17 dkf Exp $
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Class_Create --
+ *
+ *	Implementation for oo::class->create method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_Create(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+    Tcl_Object newObject;
+    const char *objName;
+    int len;
+
+    /*
+     * Sanity check; should not be possible to invoke this method on a
+     * non-class.
+     */
+
+    if (oPtr->classPtr == NULL) {
+	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check we have the right number of (sensible) arguments.
+     */
+
+    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"objectName ?arg ...?");
+	return TCL_ERROR;
+    }
+    objName = Tcl_GetStringFromObj(
+	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
+    if (len == 0) {
+	Tcl_AppendResult(interp, "object name must not be empty", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the object and return its name.
+     */
+
+    newObject = Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
+	    objName, NULL, objc, objv,
+	    Tcl_ObjectContextSkippedArgs(context)+1);
+    if (newObject == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) newObject));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Class_CreateNs --
+ *
+ *	Implementation for oo::class->createWithNamespace method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_CreateNs(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+    Tcl_Object newObject;
+    const char *objName, *nsName;
+    int len;
+
+    /*
+     * Sanity check; should not be possible to invoke this method on a
+     * non-class.
+     */
+
+    if (oPtr->classPtr == NULL) {
+	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Check we have the right number of (sensible) arguments.
+     */
+
+    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"objectName namespaceName ?arg ...?");
+	return TCL_ERROR;
+    }
+    objName = Tcl_GetStringFromObj(
+	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
+    if (len == 0) {
+	Tcl_AppendResult(interp, "object name must not be empty", NULL);
+	return TCL_ERROR;
+    }
+    nsName = Tcl_GetStringFromObj(
+	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
+    if (len == 0) {
+	Tcl_AppendResult(interp, "namespace name must not be empty", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the object and return its name.
+     */
+
+    newObject = Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
+	    objName, nsName, objc, objv,
+	    Tcl_ObjectContextSkippedArgs(context)+2);
+    if (newObject == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) newObject));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Class_New --
+ *
+ *	Implementation for oo::class->new method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Class_New(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+    Tcl_Object newObject;
+
+    /*
+     * Sanity check; should not be possible to invoke this method on a
+     * non-class.
+     */
+
+    if (oPtr->classPtr == NULL) {
+	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
+
+	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the object and return its name.
+     */
+
+    newObject = Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
+	    NULL, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context));
+    if (newObject == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) newObject));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_Destroy --
+ *
+ *	Implementation for oo::object->destroy method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_Destroy(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    if (objc != Tcl_ObjectContextSkippedArgs(context)) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    Tcl_DeleteCommandFromToken(interp,
+	    Tcl_GetObjectCommand(Tcl_ObjectContextObject(context)));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_Eval --
+ *
+ *	Implementation for oo::object->eval method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_Eval(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    CallContext *contextPtr = (CallContext *) context;
+    Tcl_Object object = Tcl_ObjectContextObject(context);
+    CallFrame *framePtr, **framePtrPtr;
+    Tcl_Obj *objnameObj;
+    int result;
+
+    if (objc-1 < Tcl_ObjectContextSkippedArgs(context)) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the object's namespace the current namespace and evaluate the
+     * command(s).
+     */
+
+    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
+    framePtrPtr = &framePtr;
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    Tcl_GetObjectNamespace(object), 0);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+    framePtr->objc = objc;
+    framePtr->objv = objv;	/* Reference counts do not need to be
+				 * incremented here. */
+
+    if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
+	objnameObj = TclOOObjectName(interp, (Object *) object);
+    } else {
+	objnameObj = Tcl_NewStringObj("my", 2);
+    }
+    Tcl_IncrRefCount(objnameObj);
+
+    if (objc == Tcl_ObjectContextSkippedArgs(context)+1) {
+	result = Tcl_EvalObjEx(interp,
+		objv[Tcl_ObjectContextSkippedArgs(context)], 0);
+    } else {
+	Tcl_Obj *objPtr;
+
+	/*
+	 * More than one argument: concatenate them together with spaces
+	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
+	 * object when it decrements its refcount after eval'ing it.
+	 */
+
+	objPtr = Tcl_ConcatObj(objc-Tcl_ObjectContextSkippedArgs(context),
+		objv+Tcl_ObjectContextSkippedArgs(context));
+	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
+    }
+
+    if (result == TCL_ERROR) {
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (in \"%s eval\" script line %d)",
+		TclGetString(objnameObj), interp->errorLine));
+    }
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    TclPopStackFrame(interp);
+    Tcl_DecrRefCount(objnameObj);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_Unknown --
+ *
+ *	Default unknown method handler method (defined in oo::object). This
+ *	just creates a suitable error message.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_Unknown(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    CallContext *contextPtr = (CallContext *) context;
+    Object *oPtr = contextPtr->oPtr;
+    const char **methodNames;
+    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
+
+    if (objc < skip+1) {
+	Tcl_WrongNumArgs(interp, skip, objv, "methodName ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the list of methods that we want to know about.
+     */
+
+    numMethodNames = TclOOGetSortedMethodList(oPtr,
+	    contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
+
+    /*
+     * Special message when there are no visible methods at all.
+     */
+
+    if (numMethodNames == 0) {
+	Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr);
+
+	Tcl_AppendResult(interp, "object \"", TclGetString(tmpBuf), NULL);
+	if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
+	    Tcl_AppendResult(interp, "\" has no visible methods", NULL);
+	} else {
+	    Tcl_AppendResult(interp, "\" has no methods", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[skip]),
+	    "\": must be ", NULL);
+    for (i=0 ; i<numMethodNames-1 ; i++) {
+	if (i) {
+	    Tcl_AppendResult(interp, ", ", NULL);
+	}
+	Tcl_AppendResult(interp, methodNames[i], NULL);
+    }
+    if (i) {
+	Tcl_AppendResult(interp, " or ", NULL);
+    }
+    Tcl_AppendResult(interp, methodNames[i], NULL);
+    ckfree((char *) methodNames);
+    return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_LinkVar --
+ *
+ *	Implementation of oo::object->variable method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_LinkVar(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Object object = Tcl_ObjectContextObject(context);
+    Namespace *savedNsPtr;
+    int i;
+
+    if (objc-Tcl_ObjectContextSkippedArgs(context) < 1) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"varName ?varName ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Do nothing if we are not called from the body of a method. In this
+     * respect, we are like the [global] command.
+     */
+
+    if (iPtr->varFramePtr == NULL ||
+	    !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	return TCL_OK;
+    }
+
+    for (i=Tcl_ObjectContextSkippedArgs(context) ; i<objc ; i++) {
+	Var *varPtr, *aryPtr;
+	const char *varName = TclGetString(objv[i]);
+
+	/*
+	 * The variable name must not contain a '::' since that's illegal in
+	 * local names.
+	 */
+
+	if (strstr(varName, "::") != NULL) {
+	    Tcl_AppendResult(interp, "variable name \"", varName,
+		    "\" illegal: must not contain namespace separator", NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Switch to the object's namespace for the duration of this call.
+	 * Like this, the variable is looked up in the namespace of the
+	 * object, and not in the namespace of the caller. Otherwise this
+	 * would only work if the caller was a method of the object itself,
+	 * which might not be true if the method was exported. This is a bit
+	 * of a hack, but the simplest way to do this (pushing a stack frame
+	 * would be horribly expensive by comparison). We never have to worry
+	 * about the case where we're dealing with the global namespace; we've
+	 * already checked that we are inside a method.
+	 */
+
+	savedNsPtr = iPtr->varFramePtr->nsPtr;
+	iPtr->varFramePtr->nsPtr = (Namespace *)
+		Tcl_GetObjectNamespace(object);
+	varPtr = TclObjLookupVar(interp, objv[i], NULL, TCL_NAMESPACE_ONLY,
+		"define", 1, 0, &aryPtr);
+	iPtr->varFramePtr->nsPtr = savedNsPtr;
+
+	if (varPtr == NULL || aryPtr != NULL) {
+	    /*
+	     * Variable cannot be an element in an array. If aryPtr is not
+	     * NULL, it is an element, so throw up an error and return.
+	     */
+
+	    TclVarErrMsg(interp, varName, NULL, "define",
+		    "name refers to an element in an array");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Arrange for the lifetime of the variable to be correctly managed.
+	 * This is copied out of Tcl_VariableObjCmd...
+	 */
+
+	if (!TclIsVarNamespaceVar(varPtr)) {
+	    TclSetVarNamespaceVar(varPtr);
+	}
+
+	if (TclPtrMakeUpvar(interp, varPtr, varName, 0, -1) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOO_Object_VarName --
+ *
+ *	Implementation of the oo::object->varname method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOO_Object_VarName(
+    ClientData clientData,	/* Ignored. */
+    Tcl_Interp *interp,		/* Interpreter in which to create the object;
+				 * also used for error reporting. */
+    Tcl_ObjectContext context,	/* The object/call context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* The actual arguments. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Var *varPtr, *aryVar;
+    Tcl_Obj *varNamePtr;
+
+    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"varName");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Switch to the object's namespace for the duration of this call. Like
+     * this, the variable is looked up in the namespace of the object, and not
+     * in the namespace of the caller. Otherwise this would only work if the
+     * caller was a method of the object itself, which might not be true if
+     * the method was exported. This is a bit of a hack, but the simplest way
+     * to do this (pushing a stack frame would be horribly expensive by
+     * comparison, and is only done when we'd otherwise interfere with the
+     * global namespace).
+     */
+
+    if (iPtr->varFramePtr == NULL) {
+	Tcl_CallFrame *dummyFrame;
+
+	TclPushStackFrame(interp, &dummyFrame,
+		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),0);
+	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
+		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
+	TclPopStackFrame(interp);
+    } else {
+	Namespace *savedNsPtr;
+
+	savedNsPtr = iPtr->varFramePtr->nsPtr;
+	iPtr->varFramePtr->nsPtr = (Namespace *)
+		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
+	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
+		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
+	iPtr->varFramePtr->nsPtr = savedNsPtr;
+    }
+
+    if (varPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    varNamePtr = Tcl_NewObj();
+    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
+    Tcl_SetObjResult(interp, varNamePtr);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONextObjCmd --
+ *
+ *	Implementation of the [next] command. Note that this command is only
+ *	ever to be used inside the body of a procedure-like method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOONextObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *framePtr = iPtr->varFramePtr;
+    Tcl_ObjectContext context;
+    int result;
+
+    /*
+     * Start with sanity checks on the calling context to make sure that we
+     * are invoked from a suitable method context. If so, we can safely
+     * retrieve the handle to the object call context.
+     */
+
+    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	Tcl_AppendResult(interp, TclGetString(objv[0]),
+		" may only be called from inside a method", NULL);
+	return TCL_ERROR;
+    }
+    context = framePtr->clientData;
+
+    /*
+     * Invoke the (advanced) method call context in the caller context. Note
+     * that this is like [uplevel 1] and not [eval].
+     */
+
+    iPtr->varFramePtr = framePtr->callerVarPtr;
+    result = Tcl_ObjectContextInvokeNext(interp, context, objc, objv, 1);
+    iPtr->varFramePtr = framePtr;
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOSelfObjCmd --
+ *
+ *	Implementation of the [self] command, which provides introspection of
+ *	the call context.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOSelfObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    static const char *subcmds[] = {
+	"caller", "class", "filter", "method", "namespace", "next", "object",
+	"target", NULL
+    };
+    enum SelfCmds {
+	SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS, SELF_NEXT,
+	SELF_OBJECT, SELF_TARGET
+    };
+    Interp *iPtr = (Interp *) interp;
+    CallFrame *framePtr = iPtr->varFramePtr;
+    CallContext *contextPtr;
+    int index;
+
+#define CurrentlyInvoked(contextPtr) \
+    ((contextPtr)->callPtr->chain[(contextPtr)->index])
+
+    /*
+     * Start with sanity checks on the calling context and the method context.
+     */
+
+    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	Tcl_AppendResult(interp, TclGetString(objv[0]),
+		" may only be called from inside a method", NULL);
+	return TCL_ERROR;
+    }
+
+    contextPtr = framePtr->clientData;
+
+    /*
+     * Now we do "conventional" argument parsing for a while. Note that no
+     * subcommand takes arguments.
+     */
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
+	return TCL_ERROR;
+    } else if (objc == 1) {
+	index = SELF_OBJECT;
+    } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum SelfCmds) index) {
+    case SELF_OBJECT:
+	Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
+	return TCL_OK;
+    case SELF_NS:
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		contextPtr->oPtr->namespacePtr->fullName,-1));
+	return TCL_OK;
+    case SELF_CLASS: {
+	Method *mPtr = CurrentlyInvoked(contextPtr).mPtr;
+	Object *declarerPtr;
+
+	if (mPtr->declaringClassPtr != NULL) {
+	    declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	} else if (mPtr->declaringObjectPtr != NULL) {
+	    declarerPtr = mPtr->declaringObjectPtr;
+	} else {
+	    /*
+	     * This should be unreachable code.
+	     */
+
+	    Tcl_AppendResult(interp, "method without declarer!", NULL);
+	    return TCL_ERROR;
+	}
+
+	Tcl_SetObjResult(interp, TclOOObjectName(interp, declarerPtr));
+	return TCL_OK;
+    }
+    case SELF_METHOD:
+	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+	    Tcl_AppendResult(interp, "<constructor>", NULL);
+	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+	    Tcl_AppendResult(interp, "<destructor>", NULL);
+	} else {
+	    Tcl_SetObjResult(interp,
+		    CurrentlyInvoked(contextPtr).mPtr->namePtr);
+	}
+	return TCL_OK;
+    case SELF_FILTER:
+	if (!CurrentlyInvoked(contextPtr).isFilter) {
+	    Tcl_AppendResult(interp, "not inside a filtering context", NULL);
+	    return TCL_ERROR;
+	} else {
+	    register struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
+	    Tcl_Obj *result[3];
+	    Object *oPtr;
+	    const char *type;
+
+	    if (miPtr->filterDeclarer != NULL) {
+		oPtr = miPtr->filterDeclarer->thisPtr;
+		type = "class";
+	    } else {
+		oPtr = contextPtr->oPtr;
+		type = "object";
+	    }
+
+	    result[0] = TclOOObjectName(interp, oPtr);
+	    result[1] = Tcl_NewStringObj(type, -1);
+	    result[2] = miPtr->mPtr->namePtr;
+	    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+	    return TCL_OK;
+	}
+    case SELF_CALLER:
+	if ((framePtr->callerVarPtr != NULL) &&
+		(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    CallContext *callerPtr = framePtr->callerVarPtr->clientData;
+	    Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
+	    Object *declarerPtr;
+
+	    if (mPtr->declaringClassPtr != NULL) {
+		declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	    } else if (mPtr->declaringObjectPtr != NULL) {
+		declarerPtr = mPtr->declaringObjectPtr;
+	    } else {
+		/*
+		 * This should be unreachable code.
+		 */
+
+		Tcl_AppendResult(interp, "method without declarer!", NULL);
+		return TCL_ERROR;
+	    }
+
+	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		    TclOOObjectName(interp, declarerPtr));
+	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		    TclOOObjectName(interp, callerPtr->oPtr));
+	    if (callerPtr->callPtr->flags & CONSTRUCTOR) {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			Tcl_NewStringObj("<constructor>", -1));
+	    } else if (callerPtr->callPtr->flags & DESTRUCTOR) {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			Tcl_NewStringObj("<destructor>", -1));
+	    } else {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			mPtr->namePtr);
+	    }
+	    return TCL_OK;
+	} else {
+	    Tcl_AppendResult(interp, "caller is not an object", NULL);
+	    return TCL_ERROR;
+	}
+    case SELF_NEXT:
+	if (contextPtr->index < contextPtr->callPtr->numChain-1) {
+	    Method *mPtr =
+		    contextPtr->callPtr->chain[contextPtr->index+1].mPtr;
+	    Object *declarerPtr;
+
+	    if (mPtr->declaringClassPtr != NULL) {
+		declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	    } else if (mPtr->declaringObjectPtr != NULL) {
+		declarerPtr = mPtr->declaringObjectPtr;
+	    } else {
+		/*
+		 * This should be unreachable code.
+		 */
+
+		Tcl_AppendResult(interp, "method without declarer!", NULL);
+		return TCL_ERROR;
+	    }
+
+	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		    TclOOObjectName(interp, declarerPtr));
+	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			Tcl_NewStringObj("<constructor>", -1));
+	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			Tcl_NewStringObj("<destructor>", -1));
+	    } else {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			mPtr->namePtr);
+	    }
+	}
+	return TCL_OK;
+    case SELF_TARGET:
+	if (!CurrentlyInvoked(contextPtr).isFilter) {
+	    Tcl_AppendResult(interp, "not inside a filtering context", NULL);
+	    return TCL_ERROR;
+	} else {
+	    Method *mPtr;
+	    Object *declarerPtr;
+	    int i;
+
+	    for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
+		if (!contextPtr->callPtr->chain[i].isFilter) {
+		    break;
+		}
+	    }
+	    if (i == contextPtr->callPtr->numChain) {
+		Tcl_Panic("filtering call chain without terminal non-filter");
+	    }
+	    mPtr = contextPtr->callPtr->chain[i].mPtr;
+	    if (mPtr->declaringClassPtr != NULL) {
+		declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	    } else if (mPtr->declaringObjectPtr != NULL) {
+		declarerPtr = mPtr->declaringObjectPtr;
+	    } else {
+		/*
+		 * This should be unreachable code.
+		 */
+
+		Tcl_AppendResult(interp, "method without declarer!", NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		    TclOOObjectName(interp, declarerPtr));
+	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		    mPtr->namePtr);
+	    return TCL_OK;
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * CopyObjectCmd --
+ *
+ *	Implementation of the [oo::copy] command, which clones an object (but
+ *	not its namespace). Note that no constructors are called during this
+ *	process.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOCopyObjectCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Tcl_Object oPtr, o2Ptr;
+
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName?");
+	return TCL_ERROR;
+    }
+
+    oPtr = Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Create a cloned object of the correct class. Note that constructors are
+     * not called. Also note that we must resolve the object name ourselves
+     * because we do not want to create the object in the current namespace,
+     * but rather in the context of the namespace of the caller of the overall
+     * [oo::define] command.
+     */
+
+    if (objc == 2) {
+	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
+    } else {
+	char *name;
+	Tcl_DString buffer;
+
+	name = TclGetString(objv[2]);
+	Tcl_DStringInit(&buffer);
+	if (name[0]!=':' || name[1]!=':') {
+	    Interp *iPtr = (Interp *) interp;
+
+	    if (iPtr->varFramePtr != NULL) {
+		Tcl_DStringAppend(&buffer,
+			iPtr->varFramePtr->nsPtr->fullName, -1);
+	    }
+	    Tcl_DStringAppend(&buffer, "::", 2);
+	    Tcl_DStringAppend(&buffer, name, -1);
+	    name = Tcl_DStringValue(&buffer);
+	}
+	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
+	Tcl_DStringFree(&buffer);
+    }
+
+    if (o2Ptr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Return the name of the cloned object.
+     */
+
+    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) o2Ptr));
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
new file mode 100644
index 0000000..551a3fd
--- /dev/null
+++ b/generic/tclOOCall.c
@@ -0,0 +1,1211 @@
+/*
+ * tclOOCall.c --
+ *
+ *	This file contains the method call chain management code for the
+ *	object-system core.
+ *
+ * Copyright (c) 2005-2008 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.4 2008/05/31 11:42:17 dkf Exp $
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Structure containing a CallContext and any other values needed only during
+ * the construction of the CallContext.
+ */
+
+struct ChainBuilder {
+    CallChain *callChainPtr;	/* The call chain being built. */
+    int filterLength;		/* Number of entries in the call chain that
+				 * are due to processing filters and not the
+				 * main call chain. */
+    Object *oPtr;		/* The object that we are building the chain
+				 * for. */
+};
+
+/*
+ * Extra flags used for call chain management.
+ */
+
+#define DEFINITE_PROTECTED 0x100000
+#define DEFINITE_PUBLIC    0x200000
+#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
+#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR)
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static void		AddClassFiltersToCallContext(Object *const oPtr,
+			    Class *clsPtr, struct ChainBuilder *const cbPtr,
+			    Tcl_HashTable *const doneFilters);
+static void		AddClassMethodNames(Class *clsPtr, const int flags,
+			    Tcl_HashTable *const namesPtr);
+static inline void	AddMethodToCallChain(Method *const mPtr,
+			    struct ChainBuilder *const cbPtr,
+			    Tcl_HashTable *const doneFilters,
+			    Class *const filterDecl);
+static inline void	AddSimpleChainToCallContext(Object *const oPtr,
+			    Tcl_Obj *const methodNameObj,
+			    struct ChainBuilder *const cbPtr,
+			    Tcl_HashTable *const doneFilters, int flags,
+			    Class *const filterDecl);
+static void		AddSimpleClassChainToCallContext(Class *classPtr,
+			    Tcl_Obj *const methodNameObj,
+			    struct ChainBuilder *const cbPtr,
+			    Tcl_HashTable *const doneFilters, int flags,
+			    Class *const filterDecl);
+static int		CmpStr(const void *ptr1, const void *ptr2);
+static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
+static void		FreeMethodNameRep(Tcl_Obj *objPtr);
+static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
+			    int flags, int reuseMask);
+static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
+
+/*
+ * Object type used to manage type caches attached to method names.
+ */
+
+static Tcl_ObjType methodNameType = {
+    "TclOO method name",
+    FreeMethodNameRep,
+    DupMethodNameRep,
+    NULL,
+    NULL
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODeleteContext --
+ *
+ *	Destroys a method call-chain context, which should not be in use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODeleteContext(
+    CallContext *contextPtr)
+{
+    TclOODeleteChain(contextPtr->callPtr);
+    TclStackFree(contextPtr->oPtr->fPtr->interp, contextPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODeleteChainCache --
+ *
+ *	Destroy the cache of method call-chains.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODeleteChainCache(
+    Tcl_HashTable *tablePtr)
+{
+    FOREACH_HASH_DECLS;
+    CallChain *callPtr;
+
+    FOREACH_HASH_VALUE(callPtr, tablePtr) {
+	if (callPtr) {
+	    TclOODeleteChain(callPtr);
+	}
+    }
+    Tcl_DeleteHashTable(tablePtr);
+    ckfree((char *) tablePtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODeleteChain --
+ *
+ *	Destroys a method call-chain.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODeleteChain(
+    CallChain *callPtr)
+{
+    if (--callPtr->refCount >= 1) {
+	return;
+    }
+    if (callPtr->chain != callPtr->staticChain) {
+	ckfree((char *) callPtr->chain);
+    }
+    ckfree((char *) callPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOStashContext --
+ *
+ *	Saves a reference to a method call context in a Tcl_Obj's internal
+ *	representation.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+StashCallChain(
+    Tcl_Obj *objPtr,
+    CallChain *callPtr)
+{
+    callPtr->refCount++;
+    if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->typePtr = &methodNameType;
+    objPtr->internalRep.otherValuePtr = callPtr;
+}
+
+void
+TclOOStashContext(
+    Tcl_Obj *objPtr,
+    CallContext *contextPtr)
+{
+    StashCallChain(objPtr, contextPtr->callPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DupMethodNameRep, FreeMethodNameRep --
+ *
+ *	Functions to implement the required parts of the Tcl_Obj guts needed
+ *	for caching of method contexts in Tcl_Objs.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DupMethodNameRep(
+    Tcl_Obj *srcPtr,
+    Tcl_Obj *dstPtr)
+{
+    register CallChain *callPtr = srcPtr->internalRep.otherValuePtr;
+
+    dstPtr->typePtr = &methodNameType;
+    dstPtr->internalRep.otherValuePtr = callPtr;
+    callPtr->refCount++;
+}
+
+static void
+FreeMethodNameRep(
+    Tcl_Obj *objPtr)
+{
+    register CallChain *callPtr = objPtr->internalRep.otherValuePtr;
+
+    TclOODeleteChain(callPtr);
+    objPtr->internalRep.otherValuePtr = NULL;
+    objPtr->typePtr = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOInvokeContext --
+ *
+ *	Invokes a single step along a method call-chain context. Note that the
+ *	invokation of a step along the chain can cause further steps along the
+ *	chain to be invoked. Note that this function is written to be as light
+ *	in stack usage as possible.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOInvokeContext(
+    Tcl_Interp *const interp,	/* Interpreter for error reporting, and many
+				 * other sorts of context handling (e.g.,
+				 * commands, variables) depending on method
+				 * implementation. */
+    CallContext *const contextPtr,
+				/* The method call context. */
+    const int objc,		/* The number of arguments. */
+    Tcl_Obj *const *const objv)	/* The arguments as actually seen. */
+{
+    Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+    const int isFirst = (contextPtr->index == 0);
+    const int isFilter =
+	    contextPtr->callPtr->chain[contextPtr->index].isFilter;
+    int result, wasFilter;
+
+    /*
+     * If this is the first step along the chain, we preserve the method
+     * entries in the chain so that they do not get deleted out from under our
+     * feet.
+     */
+
+    if (isFirst) {
+	int i;
+
+	for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
+	    AddRef(contextPtr->callPtr->chain[i].mPtr);
+	}
+
+	/*
+	 * Ensure that the method name itself is part of the arguments when
+	 * we're doing unknown processing.
+	 */
+
+	if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) {
+	    contextPtr->skip--;
+	}
+    }
+
+    /*
+     * Save whether we were in a filter and set up whether we are now.
+     */
+
+    wasFilter = contextPtr->oPtr->flags & FILTER_HANDLING;
+    if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
+	contextPtr->oPtr->flags |= FILTER_HANDLING;
+    } else {
+	contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+    }
+
+    /*
+     * Run the method implementation.
+     */
+
+    result = mPtr->typePtr->callProc(mPtr->clientData, interp,
+	    (Tcl_ObjectContext) contextPtr, objc, objv);
+
+    /*
+     * Restore the old filter-ness, release any locks on method
+     * implementations, and return the result code.
+     */
+
+    if (wasFilter) {
+	contextPtr->oPtr->flags |= FILTER_HANDLING;
+    } else {
+	contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+    }
+    if (isFirst) {
+	int i;
+
+	for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
+	    TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
+	}
+    }
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList --
+ *
+ *	Discovers the list of method names supported by an object or class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOGetSortedMethodList(
+    Object *oPtr,		/* The object to get the method names for. */
+    int flags,			/* Whether we just want the public method
+				 * names. */
+    const char ***stringsPtr)	/* Where to write a pointer to the array of
+				 * strings to. */
+{
+    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
+				 * mapping. */
+    FOREACH_HASH_DECLS;
+    int i;
+    Class *mixinPtr;
+    Tcl_Obj *namePtr;
+    Method *mPtr;
+    int isWantedIn;
+    void *isWanted;
+
+    Tcl_InitObjHashTable(&names);
+
+    /*
+     * Name the bits used in the names table values.
+     */
+#define IN_LIST 1
+#define NO_IMPLEMENTATION 2
+
+    /*
+     * Process method names due to the object.
+     */
+
+    if (oPtr->methodsPtr) {
+	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
+	    int isNew;
+
+	    if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
+		continue;
+	    }
+	    hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
+	    if (isNew) {
+		isWantedIn = ((!(flags & PUBLIC_METHOD)
+			|| mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
+		isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
+		Tcl_SetHashValue(hPtr, (void *) isWantedIn);
+	    }
+	}
+    }
+
+    /*
+     * Process method names due to private methods on the object's class.
+     */
+
+    if (flags & PRIVATE_METHOD) {
+	FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
+	    if (mPtr->flags & PRIVATE_METHOD) {
+		int isNew;
+
+		hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
+		if (isNew) {
+		    isWantedIn = IN_LIST;
+		    if (mPtr->typePtr == NULL) {
+			isWantedIn |= NO_IMPLEMENTATION;
+		    }
+		    Tcl_SetHashValue(hPtr, (void *) isWantedIn);
+		} else if (mPtr->typePtr != NULL) {
+		    isWantedIn = (int) Tcl_GetHashValue(hPtr);
+		    if (isWantedIn & NO_IMPLEMENTATION) {
+			isWantedIn &= ~NO_IMPLEMENTATION;
+			Tcl_SetHashValue(hPtr, (void *) isWantedIn);
+		    }
+		}
+	    }
+	}
+    }
+
+    /*
+     * Process (normal) method names from the class hierarchy and the mixin
+     * hierarchy.
+     */
+
+    AddClassMethodNames(oPtr->selfCls, flags, &names);
+    FOREACH(mixinPtr, oPtr->mixins) {
+	AddClassMethodNames(mixinPtr, flags, &names);
+    }
+
+    /*
+     * See how many (visible) method names there are. If none, we do not (and
+     * should not) try to sort the list of them.
+     */
+
+    i = 0;
+    if (names.numEntries != 0) {
+	const char **strings;
+
+	/*
+	 * We need to build the list of methods to sort. We will be using
+	 * qsort() for this, because it is very unlikely that the list will be
+	 * heavily sorted when it is long enough to matter.
+	 */
+
+	strings = (const char **) ckalloc(sizeof(char *) * names.numEntries);
+	FOREACH_HASH(namePtr, isWanted, &names) {
+	    if (!(flags & PUBLIC_METHOD) || (((int)isWanted) & IN_LIST)) {
+		if (((int)isWanted) & NO_IMPLEMENTATION) {
+		    continue;
+		}
+		strings[i++] = TclGetString(namePtr);
+	    }
+	}
+
+	/*
+	 * Note that 'i' may well be less than names.numEntries when we are
+	 * dealing with public method names.
+	 */
+
+	qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
+	*stringsPtr = strings;
+    }
+
+    Tcl_DeleteHashTable(&names);
+    return i;
+}
+
+int
+TclOOGetSortedClassMethodList(
+    Class *clsPtr,		/* The class to get the method names for. */
+    int flags,			/* Whether we just want the public method
+				 * names. */
+    const char ***stringsPtr)	/* Where to write a pointer to the array of
+				 * strings to. */
+{
+    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
+				 * mapping. */
+    FOREACH_HASH_DECLS;
+    int i;
+    Tcl_Obj *namePtr;
+    void *isWanted;
+
+    Tcl_InitObjHashTable(&names);
+
+    /*
+     * Process method names from the class hierarchy and the mixin hierarchy.
+     */
+
+    AddClassMethodNames(clsPtr, flags, &names);
+
+    /*
+     * See how many (visible) method names there are. If none, we do not (and
+     * should not) try to sort the list of them.
+     */
+
+    i = 0;
+    if (names.numEntries != 0) {
+	const char **strings;
+
+	/*
+	 * We need to build the list of methods to sort. We will be using
+	 * qsort() for this, because it is very unlikely that the list will be
+	 * heavily sorted when it is long enough to matter.
+	 */
+
+	strings = (const char **) ckalloc(sizeof(char *) * names.numEntries);
+	FOREACH_HASH(namePtr, isWanted, &names) {
+	    if (!(flags & PUBLIC_METHOD) || (((int)isWanted) & IN_LIST)) {
+		if (((int)isWanted) & NO_IMPLEMENTATION) {
+		    continue;
+		}
+		strings[i++] = TclGetString(namePtr);
+	    }
+	}
+
+	/*
+	 * Note that 'i' may well be less than names.numEntries when we are
+	 * dealing with public method names.
+	 */
+
+	qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
+	*stringsPtr = strings;
+    }
+
+    Tcl_DeleteHashTable(&names);
+    return i;
+}
+
+/* Comparator for GetSortedMethodList */
+static int
+CmpStr(
+    const void *ptr1,
+    const void *ptr2)
+{
+    const char **strPtr1 = (const char **) ptr1;
+    const char **strPtr2 = (const char **) ptr2;
+
+    return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddClassMethodNames --
+ *
+ *	Adds the method names defined by a class (or its superclasses) to the
+ *	collection being built. The collection is built in a hash table to
+ *	ensure that duplicates are excluded. Helper for GetSortedMethodList().
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddClassMethodNames(
+    Class *clsPtr,		/* Class to get method names from. */
+    const int flags,		/* Whether we are interested in just the
+				 * public method names. */
+    Tcl_HashTable *const namesPtr)
+				/* Reference to the hash table to put the
+				 * information in. The hash table maps the
+				 * Tcl_Obj * method name to an integral value
+				 * describing whether the method is wanted.
+				 * This ensures that public/private override
+				 * semantics are handled correctly.*/
+{
+    /*
+     * Scope all declarations so that the compiler can stand a good chance of
+     * making the recursive step highly efficient. We also hand-implement the
+     * tail-recursive case using a while loop; C compilers typically cannot do
+     * tail-recursion optimization usefully.
+     */
+
+    if (clsPtr->mixins.num != 0) {
+	Class *mixinPtr;
+	int i;
+
+	/* TODO: Beware of infinite loops! */
+	FOREACH(mixinPtr, clsPtr->mixins) {
+	    AddClassMethodNames(mixinPtr, flags, namesPtr);
+	}
+    }
+
+    while (1) {
+	FOREACH_HASH_DECLS;
+	Tcl_Obj *namePtr;
+	Method *mPtr;
+
+	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
+	    int isNew;
+
+	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
+	    if (isNew) {
+		int isWanted = (!(flags & PUBLIC_METHOD)
+			|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
+
+		Tcl_SetHashValue(hPtr, (void *) isWanted);
+	    } else if ((((int)Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
+		    && mPtr->typePtr != NULL) {
+		int isWanted = (int) Tcl_GetHashValue(hPtr);
+
+		isWanted &= ~NO_IMPLEMENTATION;
+		Tcl_SetHashValue(hPtr, (void *) isWanted);
+	    }
+	}
+
+	if (clsPtr->superclasses.num != 1) {
+	    break;
+	}
+	clsPtr = clsPtr->superclasses.list[0];
+    }
+    if (clsPtr->superclasses.num != 0) {
+	Class *superPtr;
+	int i;
+
+	FOREACH(superPtr, clsPtr->superclasses) {
+	    AddClassMethodNames(superPtr, flags, namesPtr);
+	}
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleChainToCallContext --
+ *
+ *	The core of the call-chain construction engine, this handles calling a
+ *	particular method on a particular object. Note that filters and
+ *	unknown handling are already handled by the logic that uses this
+ *	function.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddSimpleChainToCallContext(
+    Object *const oPtr,		/* Object to add call chain entries for. */
+    Tcl_Obj *const methodNameObj,
+				/* Name of method to add the call chain
+				 * entries for. */
+    struct ChainBuilder *const cbPtr,
+				/* Where to add the call chain entries. */
+    Tcl_HashTable *const doneFilters,
+				/* Where to record what call chain entries
+				 * have been processed. */
+    int flags,			/* What sort of call chain are we building. */
+    Class *const filterDecl)	/* The class that declared the filter. If
+				 * NULL, either the filter was declared by the
+				 * object or this isn't a filter. */
+{
+    int i;
+
+    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
+		(char *) methodNameObj);
+
+	if (hPtr != NULL) {
+	    Method *mPtr = Tcl_GetHashValue(hPtr);
+
+	    if (flags & PUBLIC_METHOD) {
+		if (!(mPtr->flags & PUBLIC_METHOD)) {
+		    return;
+		} else {
+		    flags |= DEFINITE_PUBLIC;
+		}
+	    } else {
+		flags |= DEFINITE_PROTECTED;
+	    }
+	}
+    }
+    if (!(flags & SPECIAL)) {
+	Tcl_HashEntry *hPtr;
+	Class *mixinPtr;
+
+	FOREACH(mixinPtr, oPtr->mixins) {
+	    AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
+		    doneFilters, flags, filterDecl);
+	}
+	if (oPtr->methodsPtr) {
+	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
+	    if (hPtr != NULL) {
+		AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
+			doneFilters, filterDecl);
+	    }
+	}
+    }
+    AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
+	    doneFilters, flags, filterDecl);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddMethodToCallChain --
+ *
+ *	Utility method that manages the adding of a particular method
+ *	implementation to a call-chain.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddMethodToCallChain(
+    Method *const mPtr,		/* Actual method implementation to add to call
+				 * chain (or NULL, a no-op). */
+    struct ChainBuilder *const cbPtr,
+				/* The call chain to add the method
+				 * implementation to. */
+    Tcl_HashTable *const doneFilters,
+				/* Where to record what filters have been
+				 * processed. If NULL, not processing filters.
+				 * Note that this function does not update
+				 * this hashtable. */
+    Class *const filterDecl)	/* The class that declared the filter. If
+				 * NULL, either the filter was declared by the
+				 * object or this isn't a filter. */
+{
+    register CallChain *callPtr = cbPtr->callChainPtr;
+    int i;
+
+    /*
+     * Return if this is just an entry used to record whether this is a public
+     * method. If so, there's nothing real to call and so nothing to add to
+     * the call chain.
+     */
+
+    if (mPtr == NULL || mPtr->typePtr == NULL) {
+	return;
+    }
+
+    /*
+     * Enforce real private method handling here. We will skip adding this
+     * method IF
+     *  1) we are not allowing private methods, AND
+     *  2) this is a private method, AND
+     *  3) this is a class method, AND
+     *  4) this method was not declared by the class of the current object.
+     *
+     * This does mean that only classes really handle private methods. This
+     * should be sufficient for [incr Tcl] support though.
+     */
+
+    if (!(callPtr->flags & PRIVATE_METHOD)
+	    && (mPtr->flags & PRIVATE_METHOD)
+	    && (mPtr->declaringClassPtr != NULL)
+	    && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
+	return;
+    }
+
+    /*
+     * First test whether the method is already in the call chain. Skip over
+     * any leading filters.
+     */
+
+    for (i=cbPtr->filterLength ; i<callPtr->numChain ; i++) {
+	if (callPtr->chain[i].mPtr == mPtr &&
+		callPtr->chain[i].isFilter == (doneFilters != NULL)) {
+	    /*
+	     * Call chain semantics states that methods come as *late* in the
+	     * call chain as possible. This is done by copying down the
+	     * following methods. Note that this does not change the number of
+	     * method invokations in the call chain; it just rearranges them.
+	     */
+
+	    Class *declCls = callPtr->chain[i].filterDeclarer;
+
+	    for (; i+1<callPtr->numChain ; i++) {
+		callPtr->chain[i] = callPtr->chain[i+1];
+	    }
+	    callPtr->chain[i].mPtr = mPtr;
+	    callPtr->chain[i].isFilter = (doneFilters != NULL);
+	    callPtr->chain[i].filterDeclarer = declCls;
+	    return;
+	}
+    }
+
+    /*
+     * Need to really add the method. This is made a bit more complex by the
+     * fact that we are using some "static" space initially, and only start
+     * realloc-ing if the chain gets long.
+     */
+
+    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
+	callPtr->chain = (struct MInvoke *)
+		ckalloc(sizeof(struct MInvoke)*(callPtr->numChain+1));
+	memcpy(callPtr->chain, callPtr->staticChain,
+		sizeof(struct MInvoke) * callPtr->numChain);
+    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
+	callPtr->chain = (struct MInvoke *) ckrealloc((char *) callPtr->chain,
+		sizeof(struct MInvoke) * (callPtr->numChain + 1));
+    }
+    callPtr->chain[i].mPtr = mPtr;
+    callPtr->chain[i].isFilter = (doneFilters != NULL);
+    callPtr->chain[i].filterDeclarer = filterDecl;
+    callPtr->numChain++;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitCallChain --
+ *	Encoding of the policy of how to set up a call chain. Doesn't populate
+ *	the chain with the method implementation data.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+InitCallChain(
+    CallChain *callPtr,
+    Object *oPtr,
+    int flags)
+{
+    if (oPtr->flags & USE_CLASS_CACHE) {
+	oPtr = oPtr->selfCls->thisPtr;
+    }
+    callPtr->epoch = oPtr->fPtr->epoch;
+    callPtr->objectCreationEpoch = oPtr->creationEpoch;
+    callPtr->objectEpoch = oPtr->epoch;
+    callPtr->flags = flags &
+	    (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
+    callPtr->refCount = 1;
+    callPtr->numChain = 0;
+    callPtr->chain = callPtr->staticChain;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * IsStillValid --
+ *	Calculates whether the given call chain can be used for executing a
+ *	method for the given object. The condition on a chain from a cached
+ *	location being reusable is:
+ *	- Refers to the same object (same creation epoch), and
+ *	- Still across the same class structure (same global epoch), and
+ *	- Still across the same object strucutre (same local epoch), and
+ *	- No public/private/filter magic leakage (same flags, modulo the fact
+ *	  that a public chain will satisfy a non-public call).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+IsStillValid(
+    CallChain *callPtr,
+    Object *oPtr,
+    int flags,
+    int mask)
+{
+    if ((oPtr->flags & USE_CLASS_CACHE)) {
+	register Object *coPtr = oPtr->selfCls->thisPtr;
+
+	return ((callPtr->objectCreationEpoch == coPtr->creationEpoch)
+		&& (callPtr->epoch == coPtr->fPtr->epoch)
+		&& (callPtr->objectEpoch == coPtr->epoch)
+		&& ((callPtr->flags & mask) == (flags & mask)));
+    }
+    return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
+	    && (callPtr->epoch == oPtr->fPtr->epoch)
+	    && (callPtr->objectEpoch == oPtr->epoch)
+	    && ((callPtr->flags & mask) == (flags & mask)));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetCallContext --
+ *
+ *	Responsible for constructing the call context, an ordered list of all
+ *	method implementations to be called as part of a method invokation.
+ *	This method is central to the whole operation of the OO system.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+CallContext *
+TclOOGetCallContext(
+    Object *oPtr,		/* The object to get the context for. */
+    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
+				 * for. NULL when getting a constructor or
+				 * destructor chain. */
+    int flags)			/* What sort of context are we looking for.
+				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
+				 * PRIVATE_METHOD, DESTRUCTOR and
+				 * FILTER_HANDLING are useful. */
+{
+    CallContext *contextPtr;
+    CallChain *callPtr;
+    struct ChainBuilder cb;
+    int i, count, doFilters;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashTable doneFilters;
+
+    if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
+	hPtr = NULL;
+	doFilters = 0;
+
+	/*
+	 * Check if we have a cached valid constructor or destructor.
+	 */
+
+	if (flags & CONSTRUCTOR) {
+	    callPtr = oPtr->selfCls->constructorChainPtr;
+	    if ((callPtr != NULL)
+		    && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
+		    && (callPtr->epoch == oPtr->fPtr->epoch)) {
+		callPtr->refCount++;
+		goto returnContext;
+	    }
+	} else if (flags & DESTRUCTOR) {
+	    callPtr = oPtr->selfCls->destructorChainPtr;
+	    if ((oPtr->mixins.num == 0) && (callPtr != NULL)
+		    && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
+		    && (callPtr->epoch == oPtr->fPtr->epoch)) {
+		callPtr->refCount++;
+		goto returnContext;
+	    }
+	}
+    } else {
+	/*
+	 * Check if we can get the chain out of the Tcl_Obj method name or out
+	 * of the cache. This is made a bit more complex by the fact that
+	 * there are multiple different layers of cache (in the Tcl_Obj, in
+	 * the object, and in the class).
+	 */
+
+	const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
+
+	if (methodNameObj->typePtr == &methodNameType) {
+	    callPtr = methodNameObj->internalRep.otherValuePtr;
+	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
+		callPtr->refCount++;
+		goto returnContext;
+	    }
+	    methodNameObj->typePtr->freeIntRepProc(methodNameObj);
+	}
+
+	if (oPtr->flags & USE_CLASS_CACHE) {
+	    if (oPtr->selfCls->classChainCache != NULL) {
+		hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
+			(char *) methodNameObj);
+	    } else {
+		hPtr = NULL;
+	    }
+	} else {
+	    if (oPtr->chainCache != NULL) {
+		hPtr = Tcl_FindHashEntry(oPtr->chainCache,
+			(char *) methodNameObj);
+	    } else {
+		hPtr = NULL;
+	    }
+	}
+
+	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
+	    callPtr = Tcl_GetHashValue(hPtr);
+	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
+		callPtr->refCount++;
+		goto returnContext;
+	    }
+	    Tcl_SetHashValue(hPtr, NULL);
+	    TclOODeleteChain(callPtr);
+	}
+
+	doFilters = 1;
+    }
+
+    callPtr = (CallChain *) ckalloc(sizeof(CallChain));
+    InitCallChain(callPtr, oPtr, flags);
+
+    cb.callChainPtr = callPtr;
+    cb.filterLength = 0;
+    cb.oPtr = oPtr;
+
+    /*
+     * Add all defined filters (if any, and if we're going to be processing
+     * them; they're not processed for constructors, destructors or when we're
+     * in the middle of processing a filter).
+     */
+
+    if (doFilters) {
+	Tcl_Obj *filterObj;
+	Class *mixinPtr;
+
+	doFilters = 1;
+	Tcl_InitObjHashTable(&doneFilters);
+	FOREACH(mixinPtr, oPtr->mixins) {
+	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters);
+	}
+	FOREACH(filterObj, oPtr->filters) {
+	    AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
+		    NULL);
+	}
+	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
+	Tcl_DeleteHashTable(&doneFilters);
+    }
+    count = cb.filterLength = callPtr->numChain;
+
+    /*
+     * Add the actual method implementations.
+     */
+
+    AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
+
+    /*
+     * Check to see if the method has no implementation. If so, we probably
+     * need to add in a call to the unknown method. Otherwise, set up the
+     * cacheing of the method implementation (if relevant).
+     */
+
+    if (count == callPtr->numChain) {
+	/*
+	 * Method does not actually exist. If we're dealing with constructors
+	 * or destructors, this isn't a problem.
+	 */
+
+	if (flags & SPECIAL) {
+	    TclOODeleteChain(callPtr);
+	    return NULL;
+	}
+	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
+		&cb, NULL, 0, NULL);
+	callPtr->flags |= OO_UNKNOWN_METHOD;
+	callPtr->epoch = -1;
+	if (count == callPtr->numChain) {
+	    TclOODeleteChain(callPtr);
+	    return NULL;
+	}
+    } else if (doFilters) {
+	if (hPtr == NULL) {
+	    if (oPtr->flags & USE_CLASS_CACHE) {
+		if (oPtr->selfCls->classChainCache == NULL) {
+		    oPtr->selfCls->classChainCache = (Tcl_HashTable *)
+			    ckalloc(sizeof(Tcl_HashTable));
+
+		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
+		}
+		hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
+			(char *) methodNameObj, &i);
+	    } else {
+		if (oPtr->chainCache == NULL) {
+		    oPtr->chainCache = (Tcl_HashTable *)
+			    ckalloc(sizeof(Tcl_HashTable));
+
+		    Tcl_InitObjHashTable(oPtr->chainCache);
+		}
+		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
+			(char *) methodNameObj, &i);
+	    }
+	}
+	callPtr->refCount++;
+	Tcl_SetHashValue(hPtr, callPtr);
+	StashCallChain(methodNameObj, callPtr);
+    } else if (flags & CONSTRUCTOR) {
+	if (oPtr->selfCls->constructorChainPtr) {
+	    TclOODeleteChain(oPtr->selfCls->constructorChainPtr);
+	}
+	oPtr->selfCls->constructorChainPtr = callPtr;
+	callPtr->refCount++;
+    } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) {
+	if (oPtr->selfCls->destructorChainPtr) {
+	    TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
+	}
+	oPtr->selfCls->destructorChainPtr = callPtr;
+	callPtr->refCount++;
+    }
+
+  returnContext:
+    contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
+    contextPtr->oPtr = oPtr;
+    contextPtr->callPtr = callPtr;
+    contextPtr->skip = 2;
+    contextPtr->index = 0;
+    return contextPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddClassFiltersToCallContext --
+ *
+ *	Logic to make extracting all the filters from the class context much
+ *	easier.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddClassFiltersToCallContext(
+    Object *const oPtr,		/* Object that the filters operate on. */
+    Class *clsPtr,		/* Class to get the filters from. */
+    struct ChainBuilder *const cbPtr,
+				/* Context to fill with call chain entries. */
+    Tcl_HashTable *const doneFilters)
+				/* Where to record what filters have been
+				 * processed. Keys are objects, values are
+				 * ignored. */
+{
+    int i;
+    Class *superPtr, *mixinPtr;
+    Tcl_Obj *filterObj;
+
+  tailRecurse:
+    if (clsPtr == NULL) {
+	return;
+    }
+
+    /*
+     * Add all the filters defined by classes mixed into the main class
+     * hierarchy.
+     */
+
+    FOREACH(mixinPtr, clsPtr->mixins) {
+	AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters);
+    }
+
+    /*
+     * Add all the class filters from the current class. Note that the filters
+     * are added starting at the object root, as this allows the object to
+     * override how filters work to extend their behaviour.
+     */
+
+    FOREACH(filterObj, clsPtr->filters) {
+	int isNew;
+
+	(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
+	if (isNew) {
+	    AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
+		    0, clsPtr);
+	}
+    }
+
+    /*
+     * Now process the recursive case. Notice the tail-call optimization.
+     */
+
+    switch (clsPtr->superclasses.num) {
+    case 1:
+	clsPtr = clsPtr->superclasses.list[0];
+	goto tailRecurse;
+    default:
+	FOREACH(superPtr, clsPtr->superclasses) {
+	    AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters);
+	}
+    case 0:
+	return;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleClassChainToCallContext --
+ *
+ *	Construct a call-chain from a class hierarchy.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddSimpleClassChainToCallContext(
+    Class *classPtr,		/* Class to add the call chain entries for. */
+    Tcl_Obj *const methodNameObj,
+				/* Name of method to add the call chain
+				 * entries for. */
+    struct ChainBuilder *const cbPtr,
+				/* Where to add the call chain entries. */
+    Tcl_HashTable *const doneFilters,
+				/* Where to record what call chain entries
+				 * have been processed. */
+    int flags,			/* What sort of call chain are we building. */
+    Class *const filterDecl)	/* The class that declared the filter. If
+				 * NULL, either the filter was declared by the
+				 * object or this isn't a filter. */
+{
+    int i;
+    Class *superPtr;
+
+    /*
+     * We hard-code the tail-recursive form. It's by far the most common case
+     * *and* it is much more gentle on the stack.
+     */
+
+  tailRecurse:
+    if (flags & CONSTRUCTOR) {
+	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
+		filterDecl);
+
+    } else if (flags & DESTRUCTOR) {
+	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
+		filterDecl);
+    } else {
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
+		(char *) methodNameObj);
+
+	if (hPtr != NULL) {
+	    register Method *mPtr = Tcl_GetHashValue(hPtr);
+
+	    if (!(flags & KNOWN_STATE)) {
+		if (flags & PUBLIC_METHOD) {
+		    if (mPtr->flags & PUBLIC_METHOD) {
+			flags |= DEFINITE_PUBLIC;
+		    } else {
+			return;
+		    }
+		} else {
+		    flags |= DEFINITE_PROTECTED;
+		}
+	    }
+	    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl);
+	}
+    }
+
+    FOREACH(superPtr, classPtr->mixins) {
+	AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
+		doneFilters, flags, filterDecl);
+    }
+
+    switch (classPtr->superclasses.num) {
+    case 1:
+	classPtr = classPtr->superclasses.list[0];
+	goto tailRecurse;
+    default:
+	FOREACH(superPtr, classPtr->superclasses) {
+	    AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
+		    doneFilters, flags, filterDecl);
+	}
+    case 0:
+	return;
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
new file mode 100644
index 0000000..d67333b
--- /dev/null
+++ b/generic/tclOODecls.h
@@ -0,0 +1,282 @@
+/*
+ * $Id: tclOODecls.h,v 1.1 2008/05/31 11:42:18 dkf Exp $
+ *
+ * This file is (mostly) automatically generated from tclOO.decls.
+ */
+
+
+#if defined(USE_TCLOO_STUBS)
+extern const char *TclOOInitializeStubs(
+	Tcl_Interp *, const char *version, int epoch, int revision);
+#define Tcl_OOInitStubs(interp) TclOOInitializeStubs( \
+	interp, TCLOO_VERSION, TCLOO_STUBS_EPOCH, TCLOO_STUBS_REVISION)
+#else
+#define Tcl_OOInitStubs(interp) Tcl_PkgRequire(interp, "TclOO", TCLOO_VERSION)
+#endif
+
+
+/* !BEGIN!: Do not edit below this line. */
+
+#define TCLOO_STUBS_EPOCH 0
+#define TCLOO_STUBS_REVISION 44
+
+#if !defined(USE_TCLOO_STUBS)
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TCLOOAPI Tcl_Object	Tcl_CopyObjectInstance (Tcl_Interp * interp, 
+				Tcl_Object sourceObject, 
+				const char * targetName, 
+				const char * targetNamespaceName);
+/* 1 */
+TCLOOAPI Tcl_Object	Tcl_GetClassAsObject (Tcl_Class clazz);
+/* 2 */
+TCLOOAPI Tcl_Class	Tcl_GetObjectAsClass (Tcl_Object object);
+/* 3 */
+TCLOOAPI Tcl_Command	Tcl_GetObjectCommand (Tcl_Object object);
+/* 4 */
+TCLOOAPI Tcl_Object	Tcl_GetObjectFromObj (Tcl_Interp * interp, 
+				Tcl_Obj * objPtr);
+/* 5 */
+TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace (Tcl_Object object);
+/* 6 */
+TCLOOAPI Tcl_Class	Tcl_MethodDeclarerClass (Tcl_Method method);
+/* 7 */
+TCLOOAPI Tcl_Object	Tcl_MethodDeclarerObject (Tcl_Method method);
+/* 8 */
+TCLOOAPI int		Tcl_MethodIsPublic (Tcl_Method method);
+/* 9 */
+TCLOOAPI int		Tcl_MethodIsType (Tcl_Method method, 
+				const Tcl_MethodType * typePtr, 
+				ClientData * clientDataPtr);
+/* 10 */
+TCLOOAPI Tcl_Obj *	Tcl_MethodName (Tcl_Method method);
+/* 11 */
+TCLOOAPI Tcl_Method	Tcl_NewInstanceMethod (Tcl_Interp * interp, 
+				Tcl_Object object, Tcl_Obj * nameObj, 
+				int isPublic, const Tcl_MethodType * typePtr, 
+				ClientData clientData);
+/* 12 */
+TCLOOAPI Tcl_Method	Tcl_NewMethod (Tcl_Interp * interp, Tcl_Class cls, 
+				Tcl_Obj * nameObj, int isPublic, 
+				const Tcl_MethodType * typePtr, 
+				ClientData clientData);
+/* 13 */
+TCLOOAPI Tcl_Object	Tcl_NewObjectInstance (Tcl_Interp * interp, 
+				Tcl_Class cls, const char * nameStr, 
+				const char * nsNameStr, int objc, 
+				Tcl_Obj *const * objv, int skip);
+/* 14 */
+TCLOOAPI int		Tcl_ObjectDeleted (Tcl_Object object);
+/* 15 */
+TCLOOAPI int		Tcl_ObjectContextIsFiltering (
+				Tcl_ObjectContext context);
+/* 16 */
+TCLOOAPI Tcl_Method	Tcl_ObjectContextMethod (Tcl_ObjectContext context);
+/* 17 */
+TCLOOAPI Tcl_Object	Tcl_ObjectContextObject (Tcl_ObjectContext context);
+/* 18 */
+TCLOOAPI int		Tcl_ObjectContextSkippedArgs (
+				Tcl_ObjectContext context);
+/* 19 */
+TCLOOAPI ClientData	Tcl_ClassGetMetadata (Tcl_Class clazz, 
+				const Tcl_ObjectMetadataType * typePtr);
+/* 20 */
+TCLOOAPI void		Tcl_ClassSetMetadata (Tcl_Class clazz, 
+				const Tcl_ObjectMetadataType * typePtr, 
+				ClientData metadata);
+/* 21 */
+TCLOOAPI ClientData	Tcl_ObjectGetMetadata (Tcl_Object object, 
+				const Tcl_ObjectMetadataType * typePtr);
+/* 22 */
+TCLOOAPI void		Tcl_ObjectSetMetadata (Tcl_Object object, 
+				const Tcl_ObjectMetadataType * typePtr, 
+				ClientData metadata);
+/* 23 */
+TCLOOAPI int		Tcl_ObjectContextInvokeNext (Tcl_Interp * interp, 
+				Tcl_ObjectContext context, int objc, 
+				Tcl_Obj *const * objv, int skip);
+/* 24 */
+TCLOOAPI Tcl_ObjectMapMethodNameProc Tcl_ObjectGetMethodNameMapper (
+				Tcl_Object object);
+/* 25 */
+TCLOOAPI void		Tcl_ObjectSetMethodNameMapper (Tcl_Object object, 
+				Tcl_ObjectMapMethodNameProc mapMethodNameProc);
+/* 26 */
+TCLOOAPI void		Tcl_ClassSetConstructor (Tcl_Interp * interp, 
+				Tcl_Class clazz, Tcl_Method method);
+/* 27 */
+TCLOOAPI void		Tcl_ClassSetDestructor (Tcl_Interp * interp, 
+				Tcl_Class clazz, Tcl_Method method);
+
+#endif /* !defined(USE_TCLOO_STUBS) */
+
+typedef struct TclOOStubs {
+    int magic;
+    int epoch;
+    int revision;
+    struct TclOOStubHooks *hooks;
+
+    Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp * interp, Tcl_Object sourceObject, const char * targetName, const char * targetNamespaceName); /* 0 */
+    Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */
+    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
+    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
+    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr); /* 4 */
+    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
+    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
+    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
+    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
+    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType * typePtr, ClientData * clientDataPtr); /* 9 */
+    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
+    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp * interp, Tcl_Object object, Tcl_Obj * nameObj, int isPublic, const Tcl_MethodType * typePtr, ClientData clientData); /* 11 */
+    Tcl_Method (*tcl_NewMethod) (Tcl_Interp * interp, Tcl_Class cls, Tcl_Obj * nameObj, int isPublic, const Tcl_MethodType * typePtr, ClientData clientData); /* 12 */
+    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp * interp, Tcl_Class cls, const char * nameStr, const char * nsNameStr, int objc, Tcl_Obj *const * objv, int skip); /* 13 */
+    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
+    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
+    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
+    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
+    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
+    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType * typePtr); /* 19 */
+    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType * typePtr, ClientData metadata); /* 20 */
+    ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType * typePtr); /* 21 */
+    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType * typePtr, ClientData metadata); /* 22 */
+    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp * interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const * objv, int skip); /* 23 */
+    Tcl_ObjectMapMethodNameProc (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
+    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc mapMethodNameProc); /* 25 */
+    void (*tcl_ClassSetConstructor) (Tcl_Interp * interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
+    void (*tcl_ClassSetDestructor) (Tcl_Interp * interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
+} TclOOStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern const TclOOStubs *tclOOStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCLOO_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef Tcl_CopyObjectInstance
+#define Tcl_CopyObjectInstance \
+	(tclOOStubsPtr->tcl_CopyObjectInstance) /* 0 */
+#endif
+#ifndef Tcl_GetClassAsObject
+#define Tcl_GetClassAsObject \
+	(tclOOStubsPtr->tcl_GetClassAsObject) /* 1 */
+#endif
+#ifndef Tcl_GetObjectAsClass
+#define Tcl_GetObjectAsClass \
+	(tclOOStubsPtr->tcl_GetObjectAsClass) /* 2 */
+#endif
+#ifndef Tcl_GetObjectCommand
+#define Tcl_GetObjectCommand \
+	(tclOOStubsPtr->tcl_GetObjectCommand) /* 3 */
+#endif
+#ifndef Tcl_GetObjectFromObj
+#define Tcl_GetObjectFromObj \
+	(tclOOStubsPtr->tcl_GetObjectFromObj) /* 4 */
+#endif
+#ifndef Tcl_GetObjectNamespace
+#define Tcl_GetObjectNamespace \
+	(tclOOStubsPtr->tcl_GetObjectNamespace) /* 5 */
+#endif
+#ifndef Tcl_MethodDeclarerClass
+#define Tcl_MethodDeclarerClass \
+	(tclOOStubsPtr->tcl_MethodDeclarerClass) /* 6 */
+#endif
+#ifndef Tcl_MethodDeclarerObject
+#define Tcl_MethodDeclarerObject \
+	(tclOOStubsPtr->tcl_MethodDeclarerObject) /* 7 */
+#endif
+#ifndef Tcl_MethodIsPublic
+#define Tcl_MethodIsPublic \
+	(tclOOStubsPtr->tcl_MethodIsPublic) /* 8 */
+#endif
+#ifndef Tcl_MethodIsType
+#define Tcl_MethodIsType \
+	(tclOOStubsPtr->tcl_MethodIsType) /* 9 */
+#endif
+#ifndef Tcl_MethodName
+#define Tcl_MethodName \
+	(tclOOStubsPtr->tcl_MethodName) /* 10 */
+#endif
+#ifndef Tcl_NewInstanceMethod
+#define Tcl_NewInstanceMethod \
+	(tclOOStubsPtr->tcl_NewInstanceMethod) /* 11 */
+#endif
+#ifndef Tcl_NewMethod
+#define Tcl_NewMethod \
+	(tclOOStubsPtr->tcl_NewMethod) /* 12 */
+#endif
+#ifndef Tcl_NewObjectInstance
+#define Tcl_NewObjectInstance \
+	(tclOOStubsPtr->tcl_NewObjectInstance) /* 13 */
+#endif
+#ifndef Tcl_ObjectDeleted
+#define Tcl_ObjectDeleted \
+	(tclOOStubsPtr->tcl_ObjectDeleted) /* 14 */
+#endif
+#ifndef Tcl_ObjectContextIsFiltering
+#define Tcl_ObjectContextIsFiltering \
+	(tclOOStubsPtr->tcl_ObjectContextIsFiltering) /* 15 */
+#endif
+#ifndef Tcl_ObjectContextMethod
+#define Tcl_ObjectContextMethod \
+	(tclOOStubsPtr->tcl_ObjectContextMethod) /* 16 */
+#endif
+#ifndef Tcl_ObjectContextObject
+#define Tcl_ObjectContextObject \
+	(tclOOStubsPtr->tcl_ObjectContextObject) /* 17 */
+#endif
+#ifndef Tcl_ObjectContextSkippedArgs
+#define Tcl_ObjectContextSkippedArgs \
+	(tclOOStubsPtr->tcl_ObjectContextSkippedArgs) /* 18 */
+#endif
+#ifndef Tcl_ClassGetMetadata
+#define Tcl_ClassGetMetadata \
+	(tclOOStubsPtr->tcl_ClassGetMetadata) /* 19 */
+#endif
+#ifndef Tcl_ClassSetMetadata
+#define Tcl_ClassSetMetadata \
+	(tclOOStubsPtr->tcl_ClassSetMetadata) /* 20 */
+#endif
+#ifndef Tcl_ObjectGetMetadata
+#define Tcl_ObjectGetMetadata \
+	(tclOOStubsPtr->tcl_ObjectGetMetadata) /* 21 */
+#endif
+#ifndef Tcl_ObjectSetMetadata
+#define Tcl_ObjectSetMetadata \
+	(tclOOStubsPtr->tcl_ObjectSetMetadata) /* 22 */
+#endif
+#ifndef Tcl_ObjectContextInvokeNext
+#define Tcl_ObjectContextInvokeNext \
+	(tclOOStubsPtr->tcl_ObjectContextInvokeNext) /* 23 */
+#endif
+#ifndef Tcl_ObjectGetMethodNameMapper
+#define Tcl_ObjectGetMethodNameMapper \
+	(tclOOStubsPtr->tcl_ObjectGetMethodNameMapper) /* 24 */
+#endif
+#ifndef Tcl_ObjectSetMethodNameMapper
+#define Tcl_ObjectSetMethodNameMapper \
+	(tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */
+#endif
+#ifndef Tcl_ClassSetConstructor
+#define Tcl_ClassSetConstructor \
+	(tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */
+#endif
+#ifndef Tcl_ClassSetDestructor
+#define Tcl_ClassSetDestructor \
+	(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
+#endif
+
+#endif /* defined(USE_TCLOO_STUBS) */
+
+/* !END!: Do not edit above this line. */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
new file mode 100644
index 0000000..77f9970
--- /dev/null
+++ b/generic/tclOODefineCmds.c
@@ -0,0 +1,1831 @@
+/*
+ * tclOODefineCmds.c --
+ *
+ *	This file contains the implementation of the ::oo::define command,
+ *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
+ *
+ * Copyright (c) 2006-2008 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: tclOODefineCmds.c,v 1.4 2008/05/31 11:42:18 dkf Exp $
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Forward declarations.
+ */
+
+static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
+static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
+			    Tcl_Namespace *const namespacePtr);
+static inline int	InitDefineContext(Tcl_Interp *interp,
+			    Tcl_Namespace *namespacePtr, Object *oPtr,
+			    int objc, Tcl_Obj *const objv[]);
+static inline void	RecomputeClassCacheFlag(Object *oPtr);
+static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
+			    int useClass, Tcl_Obj *const fromPtr,
+			    Tcl_Obj *const toPtr);
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * BumpGlobalEpoch --
+ *	Utility that ensures that call chains that are invalid will get thrown
+ *	away at an appropriate time. Note that exactly which epoch gets
+ *	advanced will depend on exactly what the class is tangled up in; in
+ *	the worst case, the simplest option is to advance the global epoch,
+ *	causing *everything* to be thrown away on next usage.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+BumpGlobalEpoch(
+    Tcl_Interp *interp,
+    Class *classPtr)
+{
+    if (classPtr != NULL
+	    && classPtr->subclasses.num == 0
+	    && classPtr->instances.num == 0
+	    && classPtr->mixinSubs.num == 0) {
+	/*
+	 * If a class has no subclasses or instances, and is not mixed into
+	 * anything, a change to its structure does not require us to
+	 * invalidate any call chains. Note that we still bump our object's
+	 * epoch if it has any mixins; the relation between a class and its
+	 * representative object is special. But it won't hurt.
+	 */
+
+	if (classPtr->thisPtr->mixins.num > 0) {
+	    classPtr->thisPtr->epoch++;
+	}
+	return;
+    }
+
+    /*
+     * Either there's no class (?!) or we're reconfiguring something that is
+     * in use. Force regeneration of call chains.
+     */
+
+    TclOOGetFoundation(interp)->epoch++;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RecomputeClassCacheFlag --
+ *	Determine whether the object is prototypical of its class, and hence
+ *	able to use the class's method chain cache.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+RecomputeClassCacheFlag(
+    Object *oPtr)
+{
+    if ((oPtr->methodsPtr == NULL || oPtr->methodsPtr->numEntries == 0)
+	    && (oPtr->mixins.num == 0) && (oPtr->filters.num == 0)) {
+	oPtr->flags |= USE_CLASS_CACHE;
+    } else {
+	oPtr->flags &= ~USE_CLASS_CACHE;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectSetFilters --
+ *	Install a list of filter method names into an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOObjectSetFilters(
+    Object *oPtr,
+    int numFilters,
+    Tcl_Obj *const *filters)
+{
+    int i;
+
+    if (oPtr->filters.num) {
+	Tcl_Obj *filterObj;
+
+	FOREACH(filterObj, oPtr->filters) {
+	    Tcl_DecrRefCount(filterObj);
+	}
+    }
+
+    if (numFilters == 0) {
+	/*
+	 * No list of filters was supplied, so we're deleting filters.
+	 */
+
+	ckfree((char *) oPtr->filters.list);
+	oPtr->filters.list = NULL;
+	oPtr->filters.num = 0;
+	RecomputeClassCacheFlag(oPtr);
+    } else {
+	/*
+	 * We've got a list of filters, so we're creating filters.
+	 */
+
+	Tcl_Obj **filtersList;
+	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */
+
+	if (oPtr->filters.num == 0) {
+	    filtersList = (Tcl_Obj **) ckalloc(size);
+	} else {
+	    filtersList = (Tcl_Obj **)
+		    ckrealloc((char *) oPtr->filters.list, size);
+	}
+	for (i=0 ; i<numFilters ; i++) {
+	    filtersList[i] = filters[i];
+	    Tcl_IncrRefCount(filters[i]);
+	}
+	oPtr->filters.list = filtersList;
+	oPtr->filters.num = numFilters;
+	oPtr->flags &= ~USE_CLASS_CACHE;
+    }
+    oPtr->epoch++;		/* Only this object can be affected. */
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOClassSetFilters --
+ *	Install a list of filter method names into a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOClassSetFilters(
+    Tcl_Interp *interp,
+    Class *classPtr,
+    int numFilters,
+    Tcl_Obj *const *filters)
+{
+    int i;
+
+    if (classPtr->filters.num) {
+	Tcl_Obj *filterObj;
+
+	FOREACH(filterObj, classPtr->filters) {
+	    Tcl_DecrRefCount(filterObj);
+	}
+    }
+
+    if (numFilters == 0) {
+	/*
+	 * No list of filters was supplied, so we're deleting filters.
+	 */
+
+	ckfree((char *) classPtr->filters.list);
+	classPtr->filters.list = NULL;
+	classPtr->filters.num = 0;
+    } else {
+	/*
+	 * We've got a list of filters, so we're creating filters.
+	 */
+
+	Tcl_Obj **filtersList;
+	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */
+
+	if (classPtr->filters.num == 0) {
+	    filtersList = (Tcl_Obj **) ckalloc(size);
+	} else {
+	    filtersList = (Tcl_Obj **)
+		    ckrealloc((char *) classPtr->filters.list, size);
+	}
+	for (i=0 ; i<numFilters ; i++) {
+	    filtersList[i] = filters[i];
+	    Tcl_IncrRefCount(filters[i]);
+	}
+	classPtr->filters.list = filtersList;
+	classPtr->filters.num = numFilters;
+    }
+
+    /*
+     * There may be many objects affected, so bump the global epoch.
+     */
+
+    BumpGlobalEpoch(interp, classPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjectSetMixins --
+ *	Install a list of mixin classes into an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOObjectSetMixins(
+    Object *oPtr,
+    int numMixins,
+    Class *const *mixins)
+{
+    Class *mixinPtr;
+    int i;
+
+    if (numMixins == 0) {
+	if (oPtr->mixins.num != 0) {
+	    FOREACH(mixinPtr, oPtr->mixins) {
+		TclOORemoveFromInstances(oPtr, mixinPtr);
+	    }
+	    ckfree((char *) oPtr->mixins.list);
+	    oPtr->mixins.num = 0;
+	}
+	RecomputeClassCacheFlag(oPtr);
+    } else {
+	if (oPtr->mixins.num != 0) {
+	    FOREACH(mixinPtr, oPtr->mixins) {
+		if (mixinPtr != oPtr->selfCls) {
+		    TclOORemoveFromInstances(oPtr, mixinPtr);
+		}
+	    }
+	    oPtr->mixins.list = (Class **)
+		    ckrealloc((char *) oPtr->mixins.list,
+		    sizeof(Class *) * numMixins);
+	} else {
+	    oPtr->mixins.list = (Class **)
+		    ckalloc(sizeof(Class *) * numMixins);
+	    oPtr->flags &= ~USE_CLASS_CACHE;
+	}
+	oPtr->mixins.num = numMixins;
+	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
+	FOREACH(mixinPtr, oPtr->mixins) {
+	    if (mixinPtr != oPtr->selfCls) {
+		TclOOAddToInstances(oPtr, mixinPtr);
+	    }
+	}
+    }
+    oPtr->epoch++;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOClassSetMixins --
+ *	Install a list of mixin classes into a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOClassSetMixins(
+    Tcl_Interp *interp,
+    Class *classPtr,
+    int numMixins,
+    Class *const *mixins)
+{
+    Class *mixinPtr;
+    int i;
+
+    if (numMixins == 0) {
+	if (classPtr->mixins.num != 0) {
+	    FOREACH(mixinPtr, classPtr->mixins) {
+		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
+	    }
+	    ckfree((char *) classPtr->mixins.list);
+	    classPtr->mixins.num = 0;
+	}
+    } else {
+	if (classPtr->mixins.num != 0) {
+	    FOREACH(mixinPtr, classPtr->mixins) {
+		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
+	    }
+	    classPtr->mixins.list = (Class **)
+		    ckrealloc((char *) classPtr->mixins.list,
+		    sizeof(Class *) * numMixins);
+	} else {
+	    classPtr->mixins.list = (Class **)
+		    ckalloc(sizeof(Class *) * numMixins);
+	}
+	classPtr->mixins.num = numMixins;
+	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
+	FOREACH(mixinPtr, classPtr->mixins) {
+	    TclOOAddToMixinSubs(classPtr, mixinPtr);
+	}
+    }
+    BumpGlobalEpoch(interp, classPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RenameDeleteMethod --
+ *	Core of the code to rename and delete methods.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+RenameDeleteMethod(
+    Tcl_Interp *interp,
+    Object *oPtr,
+    int useClass,
+    Tcl_Obj *const fromPtr,
+    Tcl_Obj *const toPtr)
+{
+    Tcl_HashEntry *hPtr, *newHPtr = NULL;
+    Method *mPtr;
+    int isNew;
+
+    if (!useClass) {
+	if (!oPtr->methodsPtr) {
+	noSuchMethod:
+	    Tcl_AppendResult(interp, "method ", TclGetString(fromPtr),
+		    " does not exist", NULL);
+	    return TCL_ERROR;
+	}
+	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr);
+	if (hPtr == NULL) {
+	    goto noSuchMethod;
+	}
+	if (toPtr) {
+	    newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr,
+		    &isNew);
+	    if (hPtr == newHPtr) {
+	    renameToSelf:
+		Tcl_AppendResult(interp, "cannot rename method to itself",
+			NULL);
+		return TCL_ERROR;
+	    } else if (!isNew) {
+	    renameToExisting:
+		Tcl_AppendResult(interp, "method called ",
+			TclGetString(toPtr), " already exists", NULL);
+		return TCL_ERROR;
+	    }
+	}
+    } else {
+	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
+		(char *) fromPtr);
+	if (hPtr == NULL) {
+	    goto noSuchMethod;
+	}
+	if (toPtr) {
+	    newHPtr = Tcl_CreateHashEntry(&oPtr->classPtr->classMethods,
+		    (char *) toPtr, &isNew);
+	    if (hPtr == newHPtr) {
+		goto renameToSelf;
+	    } else if (!isNew) {
+		goto renameToExisting;
+	    }
+	}
+    }
+
+    /*
+     * Complete the splicing by changing the method's name.
+     */
+
+    mPtr = Tcl_GetHashValue(hPtr);
+    if (toPtr) {
+	Tcl_IncrRefCount(toPtr);
+	Tcl_DecrRefCount(mPtr->namePtr);
+	mPtr->namePtr = toPtr;
+	Tcl_SetHashValue(newHPtr, mPtr);
+    } else {
+	if (!useClass) {
+	    RecomputeClassCacheFlag(oPtr);
+	}
+	TclOODelMethodRef(mPtr);
+    }
+    Tcl_DeleteHashEntry(hPtr);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOUnknownDefinition --
+ *	Handles what happens when an unknown command is encountered during the
+ *	processing of a definition script. Works by finding a command in the
+ *	operating definition namespace that the requested command is a unique
+ *	prefix of.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOUnknownDefinition(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
+    int soughtLen;
+    const char *soughtStr, *matchedStr = NULL;
+
+    if (objc < 2) {
+	Tcl_AppendResult(interp, "bad call of unknown handler", NULL);
+	return TCL_ERROR;
+    }
+    if (TclOOGetDefineCmdContext(interp) == NULL) {
+	return TCL_ERROR;
+    }
+
+    soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);
+    if (soughtLen == 0) {
+	goto noMatch;
+    }
+    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+    while (hPtr != NULL) {
+	const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
+
+	if (strncmp(soughtStr, nameStr, soughtLen) == 0) {
+	    if (matchedStr != NULL) {
+		goto noMatch;
+	    }
+	    matchedStr = nameStr;
+	}
+	hPtr = Tcl_NextHashEntry(&search);
+    }
+
+    if (matchedStr != NULL) {
+	/*
+	 * Got one match, and only one match!
+	 */
+
+	Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1));
+	int result;
+
+	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
+	Tcl_IncrRefCount(newObjv[0]);
+	if (objc > 2) {
+	    memcpy(newObjv+1, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+	}
+	result = Tcl_EvalObjv(interp, objc-1, newObjv, 0);
+	Tcl_DecrRefCount(newObjv[0]);
+	TclStackFree(interp, newObjv);
+	return result;
+    }
+
+  noMatch:
+    Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL);
+    return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FindCommand --
+ *	Specialized version of Tcl_FindCommand that handles command prefixes
+ *	and disallows namespace magic.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Command
+FindCommand(
+    Tcl_Interp *interp,
+    Tcl_Obj *stringObj,
+    Tcl_Namespace *const namespacePtr)
+{
+    int length;
+    const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
+    register Namespace *const nsPtr = (Namespace *) namespacePtr;
+    FOREACH_HASH_DECLS;
+    Tcl_Command cmd, cmd2;
+
+    /*
+     * If someone is playing games, we stop playing right now.
+     */
+
+    if (string[0] == '\0' || strstr(string, "::") != NULL) {
+	return NULL;
+    }
+
+    /*
+     * Do the exact lookup first.
+     */
+
+    cmd = Tcl_FindCommand(interp, string, namespacePtr, TCL_NAMESPACE_ONLY);
+    if (cmd != NULL) {
+	return cmd;
+    }
+
+    /*
+     * Bother, need to perform an approximate match. Iterate across the hash
+     * table of commands in the namespace.
+     */
+
+    FOREACH_HASH(nameStr, cmd2, &nsPtr->cmdTable) {
+	if (strncmp(string, nameStr, length) == 0) {
+	    if (cmd != NULL) {
+		return NULL;
+	    }
+	    cmd = cmd2;
+	}
+    }
+
+    /*
+     * Either we found one thing or we found nothing. Either way, return it.
+     */
+
+    return cmd;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitDefineContext --
+ *	Does the magic incantations necessary to push the special stack frame
+ *	used when processing object definitions. It is up to the caller to
+ *	dispose of the frame (with TclPopStackFrame) when finished.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+InitDefineContext(
+    Tcl_Interp *interp,
+    Tcl_Namespace *namespacePtr,
+    Object *oPtr,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    CallFrame *framePtr, **framePtrPtr = &framePtr;
+    int result;
+
+    /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
+
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    namespacePtr, FRAME_IS_OO_DEFINE);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+    framePtr->clientData = oPtr;
+    framePtr->objc = objc;
+    framePtr->objv = objv;	/* Reference counts do not need to be
+				 * incremented here. */
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetDefineCmdContext --
+ *	Extracts the magic token from the current stack frame, or returns NULL
+ *	(and leaves an error message) otherwise.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+TclOOGetDefineCmdContext(
+    Tcl_Interp *interp)
+{
+    Interp *iPtr = (Interp *) interp;
+
+    if ((iPtr->framePtr == NULL)
+	    || (iPtr->framePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
+	Tcl_AppendResult(interp, "this command may only be called from within"
+		" the context of an ::oo::define or ::oo::objdefine command",
+		NULL);
+	return NULL;
+    }
+    return (Tcl_Object) iPtr->framePtr->clientData;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineObjCmd --
+ *	Implementation of the "oo::define" command. Works by effectively doing
+ *	the same as 'namespace eval', but with extra magic applied so that the
+ *	object to be modified is known to the commands in the target
+ *	namespace. Also does ensemble-like tricks with dispatch so that error
+ *	messages are clearer.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Foundation *fPtr = TclOOGetFoundation(interp);
+    int result;
+    Object *oPtr;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, TclGetString(objv[1]),
+		" does not refer to a class", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the oo::define namespace the current namespace and evaluate the
+     * command(s).
+     */
+
+    if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){
+	return TCL_ERROR;
+    }
+
+    AddRef(oPtr);
+    if (objc == 3) {
+	result = TclEvalObjEx(interp, objv[2], 0,
+		((Interp *)interp)->cmdFramePtr, 2);
+
+	if (result == TCL_ERROR) {
+	    int length;
+	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
+	    int limit = 60;
+	    int overflow = (length > limit);
+
+	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		    "\n    (in definition script for object \"%.*s%s\" line %d)",
+		    (overflow ? limit : length), objName,
+		    (overflow ? "..." : ""), interp->errorLine));
+	}
+    } else {
+	Tcl_Obj *objPtr, *obj2Ptr, **objs;
+	Interp *iPtr = (Interp *) interp;
+	Tcl_Command cmd;
+	int dummy;
+
+	/*
+	 * More than one argument: fire them through the ensemble processing
+	 * engine so that everything appears to be good and proper in error
+	 * messages. Note that we cannot just concatenate and send through
+	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
+	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
+	 * the command, as that finds command names in the wrong namespace at
+	 * the moment. Ugly!
+	 */
+
+	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+	    iPtr->ensembleRewrite.sourceObjs = objv;
+	    iPtr->ensembleRewrite.numRemovedObjs = 3;
+	    iPtr->ensembleRewrite.numInsertedObjs = 1;
+	} else {
+	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
+	    if (ni < 3) {
+		iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
+	    } else {
+		iPtr->ensembleRewrite.numInsertedObjs -= 2;
+	    }
+	}
+
+	/*
+	 * Build the list of arguments using a Tcl_Obj as a workspace. See
+	 * comments above for why these contortions are necessary.
+	 */
+
+	objPtr = Tcl_NewObj();
+	obj2Ptr = Tcl_NewObj();
+	cmd = FindCommand(interp, objv[2], fPtr->defineNs);
+	if (cmd == NULL) {
+	    /* punt this case! */
+	    Tcl_AppendObjToObj(obj2Ptr, objv[2]);
+	} else {
+	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+	}
+	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
+	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+	result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
+	Tcl_DecrRefCount(objPtr);
+    }
+    DelRef(oPtr);
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    TclPopStackFrame(interp);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOObjDefObjCmd --
+ *	Implementation of the "oo::objdefine" command. Works by effectively
+ *	doing the same as 'namespace eval', but with extra magic applied so
+ *	that the object to be modified is known to the commands in the target
+ *	namespace. Also does ensemble-like tricks with dispatch so that error
+ *	messages are clearer.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOObjDefObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Foundation *fPtr = TclOOGetFoundation(interp);
+    int result;
+    Object *oPtr;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the oo::objdefine namespace the current namespace and evaluate the
+     * command(s).
+     */
+
+    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
+	return TCL_ERROR;
+    }
+
+    AddRef(oPtr);
+    if (objc == 3) {
+	result = TclEvalObjEx(interp, objv[2], 0,
+		((Interp *)interp)->cmdFramePtr, 2);
+
+	if (result == TCL_ERROR) {
+	    int length;
+	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
+	    int limit = 60;
+	    int overflow = (length > limit);
+
+	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		    "\n    (in definition script for object \"%.*s%s\" line %d)",
+		    (overflow ? limit : length), objName,
+		    (overflow ? "..." : ""), interp->errorLine));
+	}
+    } else {
+	Tcl_Obj *objPtr, *obj2Ptr, **objs;
+	Interp *iPtr = (Interp *) interp;
+	Tcl_Command cmd;
+	int dummy;
+
+	/*
+	 * More than one argument: fire them through the ensemble processing
+	 * engine so that everything appears to be good and proper in error
+	 * messages. Note that we cannot just concatenate and send through
+	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
+	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
+	 * the command, as that finds command names in the wrong namespace at
+	 * the moment. Ugly!
+	 */
+
+	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+	    iPtr->ensembleRewrite.sourceObjs = objv;
+	    iPtr->ensembleRewrite.numRemovedObjs = 3;
+	    iPtr->ensembleRewrite.numInsertedObjs = 1;
+	} else {
+	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
+	    if (ni < 3) {
+		iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
+	    } else {
+		iPtr->ensembleRewrite.numInsertedObjs -= 2;
+	    }
+	}
+
+	/*
+	 * Build the list of arguments using a Tcl_Obj as a workspace. See
+	 * comments above for why these contortions are necessary.
+	 */
+
+	objPtr = Tcl_NewObj();
+	obj2Ptr = Tcl_NewObj();
+	cmd = FindCommand(interp, objv[2], fPtr->objdefNs);
+	if (cmd == NULL) {
+	    /* punt this case! */
+	    Tcl_AppendObjToObj(obj2Ptr, objv[2]);
+	} else {
+	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+	}
+	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
+	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+	result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
+	Tcl_DecrRefCount(objPtr);
+    }
+    DelRef(oPtr);
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    TclPopStackFrame(interp);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineSelfObjCmd --
+ *	Implementation of the "self" subcommand of the "oo::define" command.
+ *	Works by effectively doing the same as 'namespace eval', but with
+ *	extra magic applied so that the object to be modified is known to the
+ *	commands in the target namespace. Also does ensemble-like tricks with
+ *	dispatch so that error messages are clearer.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineSelfObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Foundation *fPtr = TclOOGetFoundation(interp);
+    int result;
+    Object *oPtr;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Make the oo::objdefine namespace the current namespace and evaluate the
+     * command(s).
+     */
+
+    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
+	return TCL_ERROR;
+    }
+
+    AddRef(oPtr);
+    if (objc == 2) {
+	result = TclEvalObjEx(interp, objv[1], 0,
+		((Interp *)interp)->cmdFramePtr, 2);
+
+	if (result == TCL_ERROR) {
+	    int length;
+	    const char *objName = Tcl_GetStringFromObj(
+		    TclOOObjectName(interp, oPtr), &length);
+	    int limit = 60;
+	    int overflow = (length > limit);
+
+	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		    "\n    (in definition script for object \"%.*s%s\" line %d)",
+		    (overflow ? limit : length), objName,
+		    (overflow ? "..." : ""), interp->errorLine));
+	}
+    } else {
+	Tcl_Obj *objPtr, *obj2Ptr, **objs;
+	Interp *iPtr = (Interp *) interp;
+	Tcl_Command cmd;
+	int dummy;
+
+	/*
+	 * More than one argument: fire them through the ensemble processing
+	 * engine so that everything appears to be good and proper in error
+	 * messages. Note that we cannot just concatenate and send through
+	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
+	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
+	 * the command, as that finds command names in the wrong namespace at
+	 * the moment. Ugly!
+	 */
+
+	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+	    iPtr->ensembleRewrite.sourceObjs = objv;
+	    iPtr->ensembleRewrite.numRemovedObjs = 2;
+	    iPtr->ensembleRewrite.numInsertedObjs = 1;
+	} else {
+	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
+	    if (ni < 2) {
+		iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
+	    } else {
+		iPtr->ensembleRewrite.numInsertedObjs -= 1;
+	    }
+	}
+
+	/*
+	 * Build the list of arguments using a Tcl_Obj as a workspace. See
+	 * comments above for why these contortions are necessary.
+	 */
+
+	objPtr = Tcl_NewObj();
+	obj2Ptr = Tcl_NewObj();
+	cmd = FindCommand(interp, objv[1], fPtr->objdefNs);
+	if (cmd == NULL) {
+	    /* punt this case! */
+	    Tcl_AppendObjToObj(obj2Ptr, objv[1]);
+	} else {
+	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+	}
+	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-2, objv+2);
+	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+	result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
+	Tcl_DecrRefCount(objPtr);
+    }
+    DelRef(oPtr);
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    TclPopStackFrame(interp);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineClassObjCmd --
+ *	Implementation of the "class" subcommand of the "oo::objdefine"
+ *	command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineClassObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr, *o2Ptr;
+    Foundation *fPtr = TclOOGetFoundation(interp);
+
+    /*
+     * Parse the context to get the object to operate on.
+     */
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr == fPtr->objectCls->thisPtr) {
+	Tcl_AppendResult(interp,
+		"may not modify the class of the root object", NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == fPtr->classCls->thisPtr) {
+	Tcl_AppendResult(interp,
+		"may not modify the class of the class of classes", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Parse the argument to get the class to set the object's class to.
+     */
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className");
+	return TCL_ERROR;
+    }
+    o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (o2Ptr == NULL) {
+	return TCL_ERROR;
+    }
+    if (o2Ptr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "the class of an object must be a class",
+		NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Apply semantic checks. In particular, classes and non-classes are not
+     * interchangable (too complicated to do the conversion!) so we must
+     * produce an error if any attempt is made to swap from one to the other.
+     */
+
+    if ((oPtr->classPtr == NULL) == TclOOIsReachable(fPtr->classCls,
+	    o2Ptr->classPtr)) {
+	Tcl_AppendResult(interp, "may not change a ",
+		(oPtr->classPtr==NULL ? "non-" : ""), "class object into a ",
+		(oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set the object's class.
+     */
+
+    if (oPtr->selfCls != o2Ptr->classPtr) {
+	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
+	oPtr->selfCls = o2Ptr->classPtr;
+	TclOOAddToInstances(oPtr, oPtr->selfCls);
+	if (oPtr->classPtr != NULL) {
+	    BumpGlobalEpoch(interp, oPtr->classPtr);
+	} else {
+	    oPtr->epoch++;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineConstructorObjCmd --
+ *	Implementation of the "constructor" subcommand of the "oo::define"
+ *	command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineConstructorObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr;
+    Class *clsPtr;
+    Tcl_Method method;
+    int bodyLength;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Extract and validate the context, which is the class that we wish to
+     * modify.
+     */
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    Tcl_GetStringFromObj(objv[2], &bodyLength);
+    if (bodyLength > 0) {
+	/*
+	 * Create the method structure.
+	 */
+
+	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
+		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
+	if (method == NULL) {
+	    return TCL_ERROR;
+	}
+    } else {
+	/*
+	 * Delete the constructor method record and set the field in the
+	 * class record to NULL.
+	 */
+
+	method = NULL;
+    }
+
+    /*
+     * Place the method structure in the class record. Note that we might not
+     * immediately delete the constructor as this might be being done during
+     * execution of the constructor itself.
+     */
+
+    Tcl_ClassSetConstructor(interp, (Tcl_Class) clsPtr, method);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineDeleteMethodObjCmd --
+ *	Implementation of the "deletemethod" subcommand of the "oo::define"
+ *	and "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineDeleteMethodObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceDeleteMethod = (clientData != NULL);
+    Object *oPtr;
+    int i;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+
+    for (i=1 ; i<objc ; i++) {
+	/*
+	 * Delete the method structure from the appropriate hash table.
+	 */
+
+	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
+		objv[i], NULL) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+
+    if (isInstanceDeleteMethod) {
+	oPtr->epoch++;
+    } else {
+	BumpGlobalEpoch(interp, oPtr->classPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineDestructorObjCmd --
+ *	Implementation of the "destructor" subcommand of the "oo::define"
+ *	command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineDestructorObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr;
+    Class *clsPtr;
+    Tcl_Method method;
+    int bodyLength;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "body");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    Tcl_GetStringFromObj(objv[1], &bodyLength);
+    if (bodyLength > 0) {
+	/*
+	 * Create the method structure.
+	 */
+
+	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
+		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
+	if (method == NULL) {
+	    return TCL_ERROR;
+	}
+    } else {
+	/*
+	 * Delete the destructor method record and set the field in the class
+	 * record to NULL.
+	 */
+
+	method = NULL;
+    }
+
+    /*
+     * Place the method structure in the class record. Note that we might not
+     * immediately delete the destructor as this might be being done during
+     * execution of the destructor itself. Also note that setting a
+     * destructor during a destructor is fairly dumb anyway.
+     */
+
+    Tcl_ClassSetDestructor(interp, (Tcl_Class) clsPtr, method);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineExportObjCmd --
+ *	Implementation of the "export" subcommand of the "oo::define" and
+ *	"oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineExportObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceExport = (clientData != NULL);
+    Object *oPtr;
+    Method *mPtr;
+    Tcl_HashEntry *hPtr;
+    Class *clsPtr;
+    int i, isNew, changed = 0;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+    if (!isInstanceExport && !clsPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+
+    for (i=1 ; i<objc ; i++) {
+	/*
+	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
+	 * record. If there is no such method in this object or class (i.e.
+	 * the method comes from something inherited from or that we're an
+	 * instance of) then we put in a blank record with that flag; such
+	 * records are skipped over by the call chain engine *except* for
+	 * their flags member.
+	 */
+
+	if (isInstanceExport) {
+	    if (!oPtr->methodsPtr) {
+		oPtr->methodsPtr = (Tcl_HashTable *)
+			ckalloc(sizeof(Tcl_HashTable));
+		Tcl_InitObjHashTable(oPtr->methodsPtr);
+		oPtr->flags &= ~USE_CLASS_CACHE;
+	    }
+	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
+		    &isNew);
+	} else {
+	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
+		    &isNew);
+	}
+
+	if (isNew) {
+	    mPtr = (Method *) ckalloc(sizeof(Method));
+	    memset(mPtr, 0, sizeof(Method));
+	    Tcl_SetHashValue(hPtr, mPtr);
+	} else {
+	    mPtr = Tcl_GetHashValue(hPtr);
+	}
+	if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
+	    mPtr->flags |= PUBLIC_METHOD;
+	    changed = 1;
+	}
+    }
+
+    /*
+     * Bump the right epoch if we actually changed anything.
+     */
+
+    if (changed) {
+	if (isInstanceExport) {
+	    oPtr->epoch++;
+	} else {
+	    BumpGlobalEpoch(interp, clsPtr);
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineFilterObjCmd --
+ *	Implementation of the "filter" subcommand of the "oo::define" and
+ *	"oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineFilterObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceFilter = (clientData != NULL);
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (!isInstanceFilter && !oPtr->classPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+
+    if (!isInstanceFilter) {
+	TclOOClassSetFilters(interp, oPtr->classPtr, objc-1, objv+1);
+    } else {
+	TclOOObjectSetFilters(oPtr, objc-1, objv+1);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineForwardObjCmd --
+ *	Implementation of the "forward" subcommand of the "oo::define" and
+ *	"oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineForwardObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceForward = (clientData != NULL);
+    Object *oPtr;
+    Method *mPtr;
+    int isPublic;
+    Tcl_Obj *prefixObj;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name cmdName ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (!isInstanceForward && !oPtr->classPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
+	    ? PUBLIC_METHOD : 0;
+
+    /*
+     * Create the method structure.
+     */
+
+    prefixObj = Tcl_NewListObj(objc-2, objv+2);
+    if (isInstanceForward) {
+	mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
+		prefixObj);
+    } else {
+	mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic,
+		objv[1], prefixObj);
+    }
+    if (mPtr == NULL) {
+	Tcl_DecrRefCount(prefixObj);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineMethodObjCmd --
+ *	Implementation of the "method" subcommand of the "oo::define" and
+ *	"oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineMethodObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceMethod = (clientData != NULL);
+    Object *oPtr;
+    int isPublic;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (!isInstanceMethod && !oPtr->classPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
+	    ? PUBLIC_METHOD : 0;
+
+    /*
+     * Create the method by using the right back-end API.
+     */
+
+    if (isInstanceMethod) {
+	if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],
+		objv[2], objv[3], NULL) == NULL) {
+	    return TCL_ERROR;
+	}
+    } else {
+	if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1],
+		objv[2], objv[3], NULL) == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineMixinObjCmd --
+ *	Implementation of the "mixin" subcommand of the "oo::define" and
+ *	"oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineMixinObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    const int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceMixin = (clientData != NULL);
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Class **mixins;
+    int i;
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (!isInstanceMixin && !oPtr->classPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+    mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
+
+    for (i=1 ; i<objc ; i++) {
+	Object *o2Ptr;
+
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[i]);
+	if (o2Ptr == NULL) {
+	    goto freeAndError;
+	}
+	if (o2Ptr->classPtr == NULL) {
+	    Tcl_AppendResult(interp, "may only mix in classes; \"",
+		    TclGetString(objv[i]), "\" is not a class", NULL);
+	    goto freeAndError;
+	}
+	if (!isInstanceMixin &&
+		TclOOIsReachable(oPtr->classPtr,o2Ptr->classPtr)){
+	    Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
+	    goto freeAndError;
+	}
+	mixins[i-1] = o2Ptr->classPtr;
+    }
+
+    if (isInstanceMixin) {
+	TclOOObjectSetMixins(oPtr, objc-1, mixins);
+    } else {
+	TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
+    }
+
+    TclStackFree(interp, mixins);
+    return TCL_OK;
+
+  freeAndError:
+    TclStackFree(interp, mixins);
+    return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineRenameMethodObjCmd --
+ *	Implementation of the "renamemethod" subcommand of the "oo::define"
+ *	and "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineRenameMethodObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceRenameMethod = (clientData != NULL);
+    Object *oPtr;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (!isInstanceRenameMethod && !oPtr->classPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Delete the method entry from the appropriate hash table, and transfer
+     * the thing it points to to its new entry. To do this, we first need to
+     * get the entries from the appropriate hash tables (this can generate a
+     * range of errors...)
+     */
+
+    if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod,
+	    objv[1], objv[2]) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (isInstanceRenameMethod) {
+	oPtr->epoch++;
+    } else {
+	BumpGlobalEpoch(interp, oPtr->classPtr);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineSuperclassObjCmd --
+ *	Implementation of the "superclass" subcommand of the "oo::define"
+ *	command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineSuperclassObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr, *o2Ptr;
+    Foundation *fPtr = TclOOGetFoundation(interp);
+    Class **superclasses, *superPtr;
+    int i, j;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className ?className ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Get the class to operate on.
+     */
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "only classes may have superclasses defined",
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == fPtr->objectCls->thisPtr) {
+	Tcl_AppendResult(interp,
+		"may not modify the superclass of the root object", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Allocate some working space.
+     */
+
+    superclasses = (Class **) ckalloc(sizeof(Class *) * (objc-1));
+
+    /*
+     * Parse the arguments to get the class to use as superclasses.
+     */
+
+    for (i=0 ; i<objc-1 ; i++) {
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[i+1]);
+	if (o2Ptr == NULL) {
+	    goto failedAfterAlloc;
+	}
+	if (o2Ptr->classPtr == NULL) {
+	    Tcl_AppendResult(interp, "only a class can be a superclass",NULL);
+	    goto failedAfterAlloc;
+	}
+	for (j=0 ; j<i ; j++) {
+	    if (superclasses[j] == o2Ptr->classPtr) {
+		Tcl_AppendResult(interp,
+			"class should only be a direct superclass once",NULL);
+		goto failedAfterAlloc;
+	    }
+	}
+	if (TclOOIsReachable(oPtr->classPtr, o2Ptr->classPtr)) {
+	    Tcl_AppendResult(interp,
+		    "attempt to form circular dependency graph", NULL);
+	failedAfterAlloc:
+	    ckfree((char *) superclasses);
+	    return TCL_ERROR;
+	}
+	superclasses[i] = o2Ptr->classPtr;
+    }
+
+    /*
+     * Install the list of superclasses into the class. Note that this also
+     * involves splicing the class out of the superclasses' subclass list that
+     * it used to be a member of and splicing it into the new superclasses'
+     * subclass list.
+     */
+
+    if (oPtr->classPtr->superclasses.num != 0) {
+	FOREACH(superPtr, oPtr->classPtr->superclasses) {
+	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
+	}
+	ckfree((char *) oPtr->classPtr->superclasses.list);
+    }
+    oPtr->classPtr->superclasses.list = superclasses;
+    oPtr->classPtr->superclasses.num = objc-1;
+    FOREACH(superPtr, oPtr->classPtr->superclasses) {
+	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
+    }
+    BumpGlobalEpoch(interp, oPtr->classPtr);
+
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefineUnexportObjCmd --
+ *	Implementation of the "unexport" subcommand of the "oo::define" and
+ *	"oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineUnexportObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int isInstanceUnexport = (clientData != NULL);
+    Object *oPtr;
+    Method *mPtr;
+    Tcl_HashEntry *hPtr;
+    Class *clsPtr;
+    int i, isNew, changed = 0;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+    if (!isInstanceUnexport && !clsPtr) {
+	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+	return TCL_ERROR;
+    }
+
+    for (i=1 ; i<objc ; i++) {
+	/*
+	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
+	 * method record. If there is no such method in this object or class
+	 * (i.e. the method comes from something inherited from or that we're
+	 * an instance of) then we put in a blank record without that flag;
+	 * such records are skipped over by the call chain engine *except* for
+	 * their flags member.
+	 */
+
+	if (isInstanceUnexport) {
+	    if (!oPtr->methodsPtr) {
+		oPtr->methodsPtr = (Tcl_HashTable *)
+			ckalloc(sizeof(Tcl_HashTable));
+		Tcl_InitObjHashTable(oPtr->methodsPtr);
+		oPtr->flags &= ~USE_CLASS_CACHE;
+	    }
+	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
+		    &isNew);
+	} else {
+	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
+		    &isNew);
+	}
+
+	if (isNew) {
+	    mPtr = (Method *) ckalloc(sizeof(Method));
+	    memset(mPtr, 0, sizeof(Method));
+	    Tcl_SetHashValue(hPtr, mPtr);
+	} else {
+	    mPtr = Tcl_GetHashValue(hPtr);
+	}
+	if (isNew || mPtr->flags & PUBLIC_METHOD) {
+	    mPtr->flags &= ~PUBLIC_METHOD;
+	    changed = 1;
+	}
+    }
+
+    /*
+     * Bump the right epoch if we actually changed anything.
+     */
+
+    if (changed) {
+	if (isInstanceUnexport) {
+	    oPtr->epoch++;
+	} else {
+	    BumpGlobalEpoch(interp, clsPtr);
+	}
+    }
+    return TCL_OK;
+}
+
+void
+Tcl_ClassSetConstructor(
+    Tcl_Interp *interp,
+    Tcl_Class clazz,
+    Tcl_Method method)
+{
+    Class *clsPtr = (Class *) clazz;
+
+    if (method != (Tcl_Method) clsPtr->constructorPtr) {
+	TclOODelMethodRef(clsPtr->constructorPtr);
+	clsPtr->constructorPtr = (Method *) method;
+	BumpGlobalEpoch(interp, clsPtr);
+    }
+}
+
+void
+Tcl_ClassSetDestructor(
+    Tcl_Interp *interp,
+    Tcl_Class clazz,
+    Tcl_Method method)
+{
+    Class *clsPtr = (Class *) clazz;
+
+    if (method != (Tcl_Method) clsPtr->destructorPtr) {
+	TclOODelMethodRef(clsPtr->destructorPtr);
+	clsPtr->destructorPtr = (Method *) method;
+	BumpGlobalEpoch(interp, clsPtr);
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
new file mode 100644
index 0000000..bded40c
--- /dev/null
+++ b/generic/tclOOInfo.c
@@ -0,0 +1,1271 @@
+/*
+ * tclOODefineCmds.c --
+ *
+ *	This file contains the implementation of the ::oo-related [info]
+ *	subcommands.
+ *
+ * Copyright (c) 2006-2008 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: tclOOInfo.c,v 1.4 2008/05/31 11:42:18 dkf Exp $
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+static Tcl_ObjCmdProc InfoObjectClassCmd;
+static Tcl_ObjCmdProc InfoObjectDefnCmd;
+static Tcl_ObjCmdProc InfoObjectFiltersCmd;
+static Tcl_ObjCmdProc InfoObjectForwardCmd;
+static Tcl_ObjCmdProc InfoObjectIsACmd;
+static Tcl_ObjCmdProc InfoObjectMethodsCmd;
+static Tcl_ObjCmdProc InfoObjectMixinsCmd;
+static Tcl_ObjCmdProc InfoObjectVarsCmd;
+static Tcl_ObjCmdProc InfoClassConstrCmd;
+static Tcl_ObjCmdProc InfoClassDefnCmd;
+static Tcl_ObjCmdProc InfoClassDestrCmd;
+static Tcl_ObjCmdProc InfoClassFiltersCmd;
+static Tcl_ObjCmdProc InfoClassForwardCmd;
+static Tcl_ObjCmdProc InfoClassInstancesCmd;
+static Tcl_ObjCmdProc InfoClassMethodsCmd;
+static Tcl_ObjCmdProc InfoClassMixinsCmd;
+static Tcl_ObjCmdProc InfoClassSubsCmd;
+static Tcl_ObjCmdProc InfoClassSupersCmd;
+
+struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };
+
+/*
+ * List of commands that are used to implement the [info object] subcommands.
+ */
+
+static const struct NameProcMap infoObjectCmds[] = {
+    {"::oo::InfoObject::class",	     InfoObjectClassCmd},
+    {"::oo::InfoObject::definition", InfoObjectDefnCmd},
+    {"::oo::InfoObject::filters",    InfoObjectFiltersCmd},
+    {"::oo::InfoObject::forward",    InfoObjectForwardCmd},
+    {"::oo::InfoObject::isa",	     InfoObjectIsACmd},
+    {"::oo::InfoObject::methods",    InfoObjectMethodsCmd},
+    {"::oo::InfoObject::mixins",     InfoObjectMixinsCmd},
+    {"::oo::InfoObject::vars",	     InfoObjectVarsCmd},
+    {NULL, NULL}
+};
+
+/*
+ * List of commands that are used to implement the [info class] subcommands.
+ */
+
+static const struct NameProcMap infoClassCmds[] = {
+    {"::oo::InfoClass::constructor",  InfoClassConstrCmd},
+    {"::oo::InfoClass::definition",   InfoClassDefnCmd},
+    {"::oo::InfoClass::destructor",   InfoClassDestrCmd},
+    {"::oo::InfoClass::filters",      InfoClassFiltersCmd},
+    {"::oo::InfoClass::forward",      InfoClassForwardCmd},
+    {"::oo::InfoClass::instances",    InfoClassInstancesCmd},
+    {"::oo::InfoClass::methods",      InfoClassMethodsCmd},
+    {"::oo::InfoClass::mixins",	      InfoClassMixinsCmd},
+    {"::oo::InfoClass::subclasses",   InfoClassSubsCmd},
+    {"::oo::InfoClass::superclasses", InfoClassSupersCmd},
+    {NULL, NULL}
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOInitInfo --
+ *
+ *	Adjusts the Tcl core [info] command to contain subcommands ("object"
+ *	and "class") for introspection of objects and classes.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOOInitInfo(
+    Tcl_Interp *interp)
+{
+    Tcl_Namespace *nsPtr;
+    Tcl_Command infoCmd;
+    int i;
+
+    /*
+     * Build the ensemble used to implement [info object].
+     */
+
+    nsPtr = Tcl_CreateNamespace(interp, "::oo::InfoObject", NULL, NULL);
+    Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX);
+    Tcl_Export(interp, nsPtr, "[a-z]*", 1);
+    for (i=0 ; infoObjectCmds[i].name!=NULL ; i++) {
+	Tcl_CreateObjCommand(interp, infoObjectCmds[i].name,
+		infoObjectCmds[i].proc, NULL, NULL);
+    }
+
+    /*
+     * Build the ensemble used to implement [info class].
+     */
+
+    nsPtr = Tcl_CreateNamespace(interp, "::oo::InfoClass", NULL, NULL);
+    Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX);
+    Tcl_Export(interp, nsPtr, "[a-z]*", 1);
+    for (i=0 ; infoClassCmds[i].name!=NULL ; i++) {
+	Tcl_CreateObjCommand(interp, infoClassCmds[i].name,
+		infoClassCmds[i].proc, NULL, NULL);
+    }
+
+    /*
+     * Install into the master [info] ensemble.
+     */
+
+    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
+    if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) {
+	Tcl_Obj *mapDict, *objectObj, *classObj;
+
+	Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
+	if (mapDict != NULL) {
+	    objectObj = Tcl_NewStringObj("object", -1);
+	    classObj = Tcl_NewStringObj("class", -1);
+
+	    Tcl_IncrRefCount(objectObj);
+	    Tcl_IncrRefCount(classObj);
+	    Tcl_DictObjPut(NULL, mapDict, objectObj,
+		    Tcl_NewStringObj("::oo::InfoObject", -1));
+	    Tcl_DictObjPut(NULL, mapDict, classObj,
+		    Tcl_NewStringObj("::oo::InfoClass", -1));
+	    Tcl_DecrRefCount(objectObj);
+	    Tcl_DecrRefCount(classObj);
+	    Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
+	}
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectClassCmd --
+ *
+ *	Implements [info object class $objName ?$className?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectClassCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+
+    if (objc != 2 && objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    if (objc == 2) {
+	Tcl_SetObjResult(interp,
+		TclOOObjectName(interp, oPtr->selfCls->thisPtr));
+	return TCL_OK;
+    } else {
+	Object *o2Ptr;
+	Class *mixinPtr;
+	int i;
+
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+	if (o2Ptr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (o2Ptr->classPtr == NULL) {
+	    Tcl_AppendResult(interp, "object \"", TclGetString(objv[2]),
+		    "\" is not a class", NULL);
+	    return TCL_ERROR;
+	}
+
+	FOREACH(mixinPtr, oPtr->mixins) {
+	    if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+		return TCL_OK;
+	    }
+	}
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(
+		TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)));
+	return TCL_OK;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectDefnCmd --
+ *
+ *	Implements [info object definition $objName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectDefnCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    Tcl_HashEntry *hPtr;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *argsObj;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 3, objv, "objName methodName");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    if (!oPtr->methodsPtr) {
+	goto unknownMethod;
+    }
+    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
+    if (hPtr == NULL) {
+    unknownMethod:
+	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
+		"\"", NULL);
+	return TCL_ERROR;
+    }
+    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+    if (procPtr == NULL) {
+	Tcl_AppendResult(interp,
+		"definition not available for this kind of method", NULL);
+	return TCL_ERROR;
+    }
+
+    argsObj = Tcl_NewObj();
+    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
+	    localPtr=localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_Obj *argObj;
+
+	    argObj = Tcl_NewObj();
+	    Tcl_ListObjAppendElement(NULL, argObj,
+		    Tcl_NewStringObj(localPtr->name, -1));
+	    if (localPtr->defValuePtr != NULL) {
+		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+	    }
+	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+	}
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
+
+    /*
+     * This is copied from the [info body] implementation. See the comments
+     * there for why this copy has to be done here.
+     */
+
+    if (procPtr->bodyPtr->bytes == NULL) {
+	(void) Tcl_GetString(procPtr->bodyPtr);
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+	    Tcl_NewStringObj(procPtr->bodyPtr->bytes,
+	    procPtr->bodyPtr->length));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectFiltersCmd --
+ *
+ *	Implements [info object filters $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectFiltersCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int i;
+    Tcl_Obj *filterObj;
+    Object *oPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    FOREACH(filterObj, oPtr->filters) {
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), filterObj);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectForwardCmd --
+ *
+ *	Implements [info object forward $objName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectForwardCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_Obj *prefixObj;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
+	return TCL_ERROR;
+    }
+
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    if (!oPtr->methodsPtr) {
+	goto unknownMethod;
+    }
+    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
+    if (hPtr == NULL) {
+    unknownMethod:
+	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
+		"\"", NULL);
+	return TCL_ERROR;
+    }
+    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
+    if (prefixObj == NULL) {
+	Tcl_AppendResult(interp,
+		"prefix argument list not available for this kind of method",
+		NULL);
+	return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, prefixObj);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectIsACmd --
+ *
+ *	Implements [info object isa $category $objName ...]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectIsACmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    static const char *categories[] = {
+	"class", "metaclass", "mixin", "object", "typeof", NULL
+    };
+    enum IsACats {
+	IsClass, IsMetaclass, IsMixin, IsObject, IsType
+    };
+    Object *oPtr, *o2Ptr;
+    int idx, i;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
+	    &idx) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (idx == IsObject) {
+	int ok = (Tcl_GetObjectFromObj(interp, objv[2]) != NULL);
+
+	if (!ok) {
+	    Tcl_ResetResult(interp);
+	}
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0));
+	return TCL_OK;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum IsACats) idx) {
+    case IsClass:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objName");
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0));
+	return TCL_OK;
+    case IsMetaclass:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objName");
+	    return TCL_ERROR;
+	}
+	if (oPtr->classPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	} else {
+	    Class *classCls = TclOOGetFoundation(interp)->classCls;
+
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
+		    TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0));
+	}
+	return TCL_OK;
+    case IsMixin:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objName className");
+	    return TCL_ERROR;
+	}
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
+	if (o2Ptr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (o2Ptr->classPtr == NULL) {
+	    Tcl_AppendResult(interp, "non-classes cannot be mixins", NULL);
+	    return TCL_ERROR;
+	} else {
+	    Class *mixinPtr;
+
+	    FOREACH(mixinPtr, oPtr->mixins) {
+		if (mixinPtr == o2Ptr->classPtr) {
+		    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+		    return TCL_OK;
+		}
+	    }
+	}
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	return TCL_OK;
+    case IsType:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objName className");
+	    return TCL_ERROR;
+	}
+	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
+	if (o2Ptr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (o2Ptr->classPtr == NULL) {
+	    Tcl_AppendResult(interp, "non-classes cannot be types", NULL);
+	    return TCL_ERROR;
+	}
+	if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	}
+	return TCL_OK;
+    case IsObject:
+	Tcl_Panic("unexpected fallthrough");
+    }
+    return TCL_ERROR;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectMethodsCmd --
+ *
+ *	Implements [info object methods $objName ?$option ...?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectMethodsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    int flag = PUBLIC_METHOD, recurse = 0;
+    FOREACH_HASH_DECLS;
+    Tcl_Obj *namePtr;
+    Method *mPtr;
+    static const char *options[] = {
+	"-all", "-localprivate", "-private", NULL
+    };
+    enum Options {
+	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
+    };
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName ?options...?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (objc != 2) {
+	int i, idx;
+
+	for (i=2 ; i<objc ; i++) {
+	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		    &idx) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum Options) idx) {
+	    case OPT_ALL:
+		recurse = 1;
+		break;
+	    case OPT_LOCALPRIVATE:
+		flag = PRIVATE_METHOD;
+		break;
+	    case OPT_PRIVATE:
+		flag = 0;
+		break;
+	    }
+	}
+    }
+
+    if (recurse) {
+	const char **names;
+	int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
+	Tcl_Obj *resultObj = Tcl_NewObj();
+
+	for (i=0 ; i<numNames ; i++) {
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(names[i], -1));
+	}
+	ckfree((char *) names);
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+    }
+
+    if (oPtr->methodsPtr) {
+	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
+	    if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
+		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+			namePtr);
+	    }
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectMixinsCmd --
+ *
+ *	Implements [info object mixins $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectMixinsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Class *mixinPtr;
+    Object *oPtr;
+    int i;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 3, objv, "objName");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    FOREACH(mixinPtr, oPtr->mixins) {
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		TclOOObjectName(interp, mixinPtr->thisPtr));
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoObjectVarsCmd --
+ *
+ *	Implements [info object vars $objName ?$pattern?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectVarsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    const char *pattern = NULL;
+    FOREACH_HASH_DECLS;
+    VarInHash *vihPtr;
+    Tcl_Obj *nameObj, *resultObj;
+
+    if (objc != 2 && objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName ?pattern?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (objc == 3) {
+	pattern = TclGetString(objv[2]);
+    }
+    resultObj = Tcl_NewObj();
+
+    /*
+     * Extract the information we need from the object's namespace's table of
+     * variables. Note that this involves horrific knowledge of the guts of
+     * tclVar.c, so we can't leverage our hash-iteration macros properly.
+     */
+
+    FOREACH_HASH_VALUE(vihPtr,
+	    &((Namespace *) oPtr->namespacePtr)->varTable.table) {
+	nameObj = vihPtr->entry.key.objPtr;
+
+	if (TclIsVarUndefined(&vihPtr->var)
+		|| !TclIsVarNamespaceVar(&vihPtr->var)) {
+	    continue;
+	}
+	if (pattern != NULL
+		&& !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
+	    continue;
+	}
+	Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
+    }
+
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassConstrCmd --
+ *
+ *	Implements [info class constructor $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassConstrCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *argsObj;
+    Object *oPtr;
+    Class *clsPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    if (clsPtr->constructorPtr == NULL) {
+	return TCL_OK;
+    }
+    procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
+    if (procPtr == NULL) {
+	Tcl_AppendResult(interp,
+		"definition not available for this kind of method", NULL);
+	return TCL_ERROR;
+    }
+
+    argsObj = Tcl_NewObj();
+    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
+	    localPtr=localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_Obj *argObj;
+
+	    argObj = Tcl_NewObj();
+	    Tcl_ListObjAppendElement(NULL, argObj,
+		    Tcl_NewStringObj(localPtr->name, -1));
+	    if (localPtr->defValuePtr != NULL) {
+		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+	    }
+	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+	}
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
+    if (procPtr->bodyPtr->bytes == NULL) {
+	(void) Tcl_GetString(procPtr->bodyPtr);
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+	    Tcl_NewStringObj(procPtr->bodyPtr->bytes,
+	    procPtr->bodyPtr->length));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassDefnCmd --
+ *
+ *	Implements [info class definition $clsName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassDefnCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_HashEntry *hPtr;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *argsObj;
+    Object *oPtr;
+    Class *clsPtr;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
+		"\"", NULL);
+	return TCL_ERROR;
+    }
+    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+    if (procPtr == NULL) {
+	Tcl_AppendResult(interp,
+		"definition not available for this kind of method", NULL);
+	return TCL_ERROR;
+    }
+
+    argsObj = Tcl_NewObj();
+    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
+	    localPtr=localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_Obj *argObj;
+
+	    argObj = Tcl_NewObj();
+	    Tcl_ListObjAppendElement(NULL, argObj,
+		    Tcl_NewStringObj(localPtr->name, -1));
+	    if (localPtr->defValuePtr != NULL) {
+		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+	    }
+	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+	}
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
+    if (procPtr->bodyPtr->bytes == NULL) {
+	(void) Tcl_GetString(procPtr->bodyPtr);
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+	    Tcl_NewStringObj(procPtr->bodyPtr->bytes,
+	    procPtr->bodyPtr->length));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassDestrCmd --
+ *
+ *	Implements [info class destructor $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassDestrCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Proc *procPtr;
+    Object *oPtr;
+    Class *clsPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    if (clsPtr->destructorPtr == NULL) {
+	return TCL_OK;
+    }
+    procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
+    if (procPtr == NULL) {
+	Tcl_AppendResult(interp,
+		"definition not available for this kind of method", NULL);
+	return TCL_ERROR;
+    }
+
+    if (procPtr->bodyPtr->bytes == NULL) {
+	(void) Tcl_GetString(procPtr->bodyPtr);
+    }
+    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+	    Tcl_NewStringObj(procPtr->bodyPtr->bytes,
+	    procPtr->bodyPtr->length));
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassFiltersCmd --
+ *
+ *	Implements [info class filters $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassFiltersCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int i;
+    Tcl_Obj *filterObj;
+    Object *oPtr;
+    Class *clsPtr;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    FOREACH(filterObj, clsPtr->filters) {
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), filterObj);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassForwardCmd --
+ *
+ *	Implements [info class forward $clsName $methodName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassForwardCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_Obj *prefixObj;
+    Object *oPtr;
+    Class *clsPtr;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
+		"\"", NULL);
+	return TCL_ERROR;
+    }
+    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
+    if (prefixObj == NULL) {
+	Tcl_AppendResult(interp,
+		"prefix argument list not available for this kind of method",
+		NULL);
+	return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, prefixObj);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassInstancesCmd --
+ *
+ *	Implements [info class instances $clsName ?$pattern?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassInstancesCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    Class *clsPtr;
+    int i;
+    const char *pattern = NULL;
+
+    if (objc != 2 && objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+    if (objc == 3) {
+	pattern = TclGetString(objv[2]);
+    }
+
+    FOREACH(oPtr, clsPtr->instances) {
+	Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr);
+
+	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
+	    continue;
+	}
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), tmpObj);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassMethodsCmd --
+ *
+ *	Implements [info class methods $clsName ?-private?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassMethodsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int flag = PUBLIC_METHOD, recurse = 0;
+    FOREACH_HASH_DECLS;
+    Tcl_Obj *namePtr;
+    Method *mPtr;
+    Object *oPtr;
+    Class *clsPtr;
+    static const char *options[] = {
+	"-all", "-localprivate", "-private", NULL
+    };
+    enum Options {
+	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
+    };
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className ?options...?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+    if (objc != 2) {
+	int i, idx;
+
+	for (i=2 ; i<objc ; i++) {
+	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+		    &idx) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum Options) idx) {
+	    case OPT_ALL:
+		recurse = 1;
+		break;
+	    case OPT_LOCALPRIVATE:
+		flag = PRIVATE_METHOD;
+		break;
+	    case OPT_PRIVATE:
+		flag = 0;
+		break;
+	    }
+	}
+    }
+
+    if (recurse) {
+	const char **names;
+	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);
+	Tcl_Obj *resultObj = Tcl_NewObj();
+
+	for (i=0 ; i<numNames ; i++) {
+	    Tcl_ListObjAppendElement(NULL, resultObj,
+		    Tcl_NewStringObj(names[i], -1));
+	}
+	ckfree((char *) names);
+	Tcl_SetObjResult(interp, resultObj);
+	return TCL_OK;
+    }
+
+    FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
+	if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
+	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), namePtr);
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassMixinsCmd --
+ *
+ *	Implements [info class mixins $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassMixinsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    Class *clsPtr, *mixinPtr;
+    int i;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    FOREACH(mixinPtr, clsPtr->mixins) {
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		TclOOObjectName(interp, mixinPtr->thisPtr));
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassSubsCmd --
+ *
+ *	Implements [info class subclasses $clsName ?$pattern?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassSubsCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    Class *clsPtr, *subclassPtr;
+    int i;
+    const char *pattern = NULL;
+
+    if (objc != 2 && objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+    if (objc == 3) {
+	pattern = TclGetString(objv[2]);
+    }
+
+    FOREACH(subclassPtr, clsPtr->subclasses) {
+	Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);
+
+	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
+	    continue;
+	}
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), tmpObj);
+    }
+    FOREACH(subclassPtr, clsPtr->mixinSubs) {
+	Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);
+
+	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
+	    continue;
+	}
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), tmpObj);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassSupersCmd --
+ *
+ *	Implements [info class superclasses $clsName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassSupersCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    Class *clsPtr, *superPtr;
+    int i;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    if (oPtr->classPtr == NULL) {
+	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
+		"\" is not a class", NULL);
+	return TCL_ERROR;
+    }
+    clsPtr = oPtr->classPtr;
+
+    FOREACH(superPtr, clsPtr->superclasses) {
+	Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
+		TclOOObjectName(interp, superPtr->thisPtr));
+    }
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
new file mode 100644
index 0000000..7c0b6a7
--- /dev/null
+++ b/generic/tclOOInt.h
@@ -0,0 +1,579 @@
+/*
+ * tclOOInt.h --
+ *
+ *	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
+ *
+ * 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.1 2008/05/31 11:42:18 dkf Exp $
+ */
+
+#include <tclInt.h>
+#include "tclOO.h"
+
+/*
+ * Forward declarations.
+ */
+
+struct CallChain;
+struct Class;
+struct Foundation;
+struct Object;
+
+/*
+ * The data that needs to be stored per method. This record is used to collect
+ * information about all sorts of methods, including forwards, constructors
+ * and destructors.
+ */
+
+typedef struct Method {
+    const Tcl_MethodType *typePtr;
+				/* The type of method. If NULL, this is a
+				 * special flag record which is just used for
+				 * the setting of the flags field. */
+    int refCount;
+    ClientData clientData;	/* Type-specific data. */
+    Tcl_Obj *namePtr;		/* Name of the method. */
+    struct Object *declaringObjectPtr;
+				/* The object that declares this method, or
+				 * NULL if it was declared by a class. */
+    struct Class *declaringClassPtr;
+				/* The class that declares this method, or
+				 * NULL if it was declared directly on an
+				 * object. */
+    int flags;			/* Assorted flags. Includes whether this
+				 * method is public/exported or not. */
+} Method;
+
+/*
+ * Pre- and post-call callbacks, to allow procedure-like methods to be fine
+ * tuned in their behaviour.
+ */
+
+typedef int (*TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
+	Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
+typedef int (*TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
+	Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
+typedef void (*TclOO_PmCDDeleteProc)(ClientData clientData);
+typedef ClientData (*TclOO_PmCDCloneProc)(ClientData clientData);
+
+/*
+ * Procedure-like methods have the following extra information.
+ */
+
+typedef struct ProcedureMethod {
+    int version;		/* Version of this structure. Currently must
+				 * be 0. */
+    Proc *procPtr;		/* Core of the implementation of the method;
+				 * includes the argument definition and the
+				 * body bytecodes. */
+    int flags;			/* Flags to control features. */
+    int refCount;
+    ClientData clientData;
+    TclOO_PmCDDeleteProc deleteClientdataProc;
+    TclOO_PmCDCloneProc cloneClientdataProc;
+    ProcErrorProc errProc;	/* Replacement error handler. */
+    TclOO_PreCallProc preCallProc;
+				/* Callback to allow for additional setup
+				 * before the method executes. */
+    TclOO_PostCallProc postCallProc;
+				/* Callback to allow for additional cleanup
+				 * after the method executes. */
+    GetFrameInfoValueProc gfivProc;
+				/* Callback to allow for fine tuning of how
+				 * the method reports itself. */
+} ProcedureMethod;
+
+#define TCLOO_PROCEDURE_METHOD_VERSION 0
+
+/*
+ * Flags for use in a ProcedureMethod.
+ *
+ * When the USE_DECLARER_NS flag is set, the method will use the namespace of
+ * the object or class that declared it (or the clone of it, if it was from
+ * such that the implementation of the method came to the particular use)
+ * instead of the namespace of the object on which the method was invoked.
+ * This flag must be distinct from all others that are associated with
+ * methods.
+ */
+
+#define USE_DECLARER_NS		0x80
+
+/*
+ * Forwarded methods have the following extra information. It is a
+ * single-field structure because this allows for future expansion without
+ * changing vast amounts of code.
+ */
+
+typedef struct ForwardMethod {
+    Tcl_Obj *prefixObj;
+} ForwardMethod;
+
+/*
+ * Helper definitions that declare a "list" array. The two varieties are
+ * either optimized for simplicity (in the case that the whole array is
+ * typically assigned at once) or efficiency (in the case that the array is
+ * expected to be expanded over time). These lists are designed to be iterated
+ * over with the help of the FOREACH macro (see later in this file).
+ *
+ * The "num" field always counts the number of listType_t elements used in the
+ * "list" field. When a "size" field exists, it describes how many elements
+ * are present in the list; when absent, exactly "num" elements are present.
+ */
+
+#define LIST_STATIC(listType_t) \
+    struct { int num; listType_t *list; }
+#define LIST_DYNAMIC(listType_t) \
+    struct { int num, size; listType_t *list; }
+
+/*
+ * Now, the definition of what an object actually is.
+ */
+
+typedef struct Object {
+    struct Foundation *fPtr;	/* The basis for the object system. Putting
+				 * this here allows the avoidance of quite a
+				 * lot of hash lookups on the critical path
+				 * for object invokation and creation. */
+    Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
+    Tcl_Command command;	/* Reference to this object's public
+				 * command. */
+    Tcl_Command myCommand;	/* Reference to this object's internal
+				 * command. */
+    struct Class *selfCls;	/* This object's class. */
+    Tcl_HashTable *methodsPtr;	/* Object-local Tcl_Obj (method name) to
+				 * Method* mapping. */
+    LIST_STATIC(struct Class *) mixins;
+				/* Classes mixed into this object. */
+    LIST_STATIC(Tcl_Obj *) filters;
+				/* List of filter names. */
+    struct Class *classPtr;	/* All classes have this non-NULL; it points
+				 * to the class structure. Everything else has
+				 * this NULL. */
+    int refCount;		/* Number of strong references to this object.
+				 * Note that there may be many more weak
+				 * references; this mechanism is there to
+				 * avoid Tcl_Preserve. */
+    int flags;
+    int creationEpoch;		/* Unique value to make comparisons of objects
+				 * easier. */
+    int epoch;			/* Per-object epoch, incremented when the way
+				 * an object should resolve call chains is
+				 * changed. */
+    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
+				 * the ClientData values that are the values
+				 * of each piece of attached metadata. This
+				 * field starts out as NULL and is only
+				 * allocated if metadata is attached. */
+    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
+    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
+				 * is indexed by method name as Tcl_Obj. */
+    Tcl_ObjectMapMethodNameProc mapMethodNameProc;
+				/* Function to allow remapping of method
+				 * names. For itcl-ng. */
+} Object;
+
+#define OBJECT_DELETED	1	/* Flag to say that an object has been
+				 * destroyed. */
+#define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
+				 * the class hierarchy and should be treated
+				 * specially during teardown. */
+#define FILTER_HANDLING 0x2000	/* Flag set when the object is processing a
+				 * filter; when set, filters are *not*
+				 * processed on the object, preventing nasty
+				 * recursive filtering problems. */
+#define USE_CLASS_CACHE 0x4000	/* Flag set to say that the object is a pure
+				 * instance of the class, and has had nothing
+				 * added that changes the dispatch chain (i.e.
+				 * no methods, mixins, or filters. */
+
+/*
+ * And the definition of a class. Note that every class also has an associated
+ * object, through which it is manipulated.
+ */
+
+typedef struct Class {
+    Object *thisPtr;		/* Reference to the object associated with
+				 * this class. */
+    int refCount;		/* Number of strong references to this class.
+				 * Weak references are not counted; the
+				 * purpose of this is to avoid Tcl_Preserve as
+				 * that is quite slow. */
+    int flags;			/* Assorted flags. */
+    LIST_STATIC(struct Class *) superclasses;
+				/* List of superclasses, used for generation
+				 * of method call chains. */
+    LIST_DYNAMIC(struct Class *) subclasses;
+				/* List of subclasses, used to ensure deletion
+				 * of dependent entities happens properly when
+				 * the class itself is deleted. */
+    LIST_DYNAMIC(Object *) instances;
+				/* List of instances, used to ensure deletion
+				 * of dependent entities happens properly when
+				 * the class itself is deleted. */
+    LIST_STATIC(Tcl_Obj *) filters;
+				/* List of filter names, used for generation
+				 * of method call chains. */
+    LIST_STATIC(struct Class *) mixins;
+				/* List of mixin classes, used for generation
+				 * of method call chains. */
+    LIST_DYNAMIC(struct Class *) mixinSubs;
+				/* List of classes that this class is mixed
+				 * into, used to ensure deletion of dependent
+				 * entities happens properly when the class
+				 * itself is deleted. */
+    Tcl_HashTable classMethods;	/* Hash table of all methods. Hash maps from
+				 * the (Tcl_Obj*) method name to the (Method*)
+				 * method record. */
+    Method *constructorPtr;	/* Method record of the class constructor (if
+				 * any). */
+    Method *destructorPtr;	/* Method record of the class destructor (if
+				 * any). */
+    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
+				 * the ClientData values that are the values
+				 * of each piece of attached metadata. This
+				 * field starts out as NULL and is only
+				 * allocated if metadata is attached. */
+    struct CallChain *constructorChainPtr;
+    struct CallChain *destructorChainPtr;
+    Tcl_HashTable *classChainCache;
+				/* Places where call chains are stored. For
+				 * constructors, the class chain is always
+				 * used. For destructors and ordinary methods,
+				 * the class chain is only used when the
+				 * object doesn't override with its own mixins
+				 * (and filters and method implementations for
+				 * when getting method chains). */
+} Class;
+
+/*
+ * The foundation of the object system within an interpreter contains
+ * references to the key classes and namespaces, together with a few other
+ * useful bits and pieces. Probably ought to eventually go in the Interp
+ * structure itself.
+ */
+
+typedef struct ThreadLocalData {
+    int nsCount;		/* Master epoch counter is used for keeping
+				 * the values used in Tcl_Obj internal
+				 * representations sane. Must be thread-local
+				 * because Tcl_Objs can cross interpreter
+				 * boundaries within a thread (objects don't
+				 * generally cross threads). */
+} ThreadLocalData;
+
+typedef struct Foundation {
+    Tcl_Interp *interp;
+    Class *objectCls;		/* The root of the object system. */
+    Class *classCls;		/* The class of all classes. */
+    Tcl_Namespace *ooNs;	/* Master ::oo namespace. */
+    Tcl_Namespace *defineNs;	/* Namespace containing special commands for
+				 * manipulating objects and classes. The
+				 * "oo::define" command acts as a special kind
+				 * of ensemble for this namespace. */
+    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
+				 * manipulating objects and classes. The
+				 * "oo::objdefine" command acts as a special
+				 * kind of ensemble for this namespace. */
+    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
+				 * only valid when executing inside a
+				 * procedural method. */
+    int epoch;			/* Used to invalidate method chains when the
+				 * class structure changes. */
+    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
+				 * namespace to each object. */
+    Tcl_Obj *unknownMethodNameObj;
+				/* Shared object containing the name of the
+				 * unknown method handler method. */
+    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
+				 * constructor. */
+    Tcl_Obj *destructorName;	/* Shared object containing the "name" of a
+				 * destructor. */
+} Foundation;
+
+/*
+ * A call context structure is built when a method is called. They contain the
+ * chain of method implementations that are to be invoked by a particular
+ * call, and the process of calling walks the chain, with the [next] command
+ * proceeding to the next entry in the chain.
+ */
+
+#define CALL_CHAIN_STATIC_SIZE 4
+
+struct MInvoke {
+    Method *mPtr;		/* Reference to the method implementation
+				 * record. */
+    int isFilter;		/* Whether this is a filter invokation. */
+    Class *filterDeclarer;	/* What class decided to add the filter; if
+				 * NULL, it was added by the object. */
+};
+
+typedef struct CallChain {
+    int objectCreationEpoch;	/* The object's creation epoch. Note that the
+				 * object reference is not stored in the call
+				 * chain; it is in the call context. */
+    int objectEpoch;		/* Local (object structure) epoch counter
+				 * snapshot. */
+    int epoch;			/* Global (class structure) epoch counter
+				 * snapshot. */
+    int flags;			/* Assorted flags, see below. */
+    int refCount;		/* Reference count. */
+    int numChain;		/* Size of the call chain. */
+    struct MInvoke *chain;	/* Array of call chain entries. May point to
+				 * staticChain if the number of entries is
+				 * small. */
+    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
+} CallChain;
+
+typedef struct CallContext {
+    Object *oPtr;		/* The object associated with this call. */
+    int index;			/* Index into the call chain of the currently
+				 * executing method implementation. */
+    int skip;			/* Current number of arguments to skip; can
+				 * vary depending on whether it is a direct
+				 * method call or a continuation via the
+				 * [next] command. */
+    CallChain *callPtr;		/* The actual call chain. */
+} CallContext;
+
+/*
+ * Bits for the 'flags' field of the call context.
+ */
+
+#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
+#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
+				 * only) method. */
+#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
+#define CONSTRUCTOR	  0x08	/* This is a constructor. */
+#define DESTRUCTOR	  0x10	/* This is a destructor. */
+
+/*
+ * Assorted flags for call frames. Note that bits 1 and 2 are already taken by
+ * Tcl itself.
+ */
+
+#if 0
+#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
+				 * clientData field contains a CallContext
+				 * reference. */
+#define FRAME_IS_OO_DEFINE 0x8	/* The frame is part of the inside workings of
+				 * the [oo::define] command; the clientData
+				 * field contains an Object reference that has
+				 * been confirmed to refer to a class. */
+#endif
+
+/*
+ * Structure containing definition information about basic class methods.
+ */
+
+typedef struct {
+    const char *name;		/* Name of the method in question. */
+    int isPublic;		/* Whether the method is public by default. */
+    Tcl_MethodType definition;	/* How to call the method. */
+} DeclaredClassMethod;
+
+/*
+ *----------------------------------------------------------------
+ * Commands relating to OO support.
+ *----------------------------------------------------------------
+ */
+
+MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
+MODULE_SCOPE int	TclOODefineObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOOObjDefObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineConstructorObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineDeleteMethodObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineExportObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineFilterObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineForwardObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineMethodObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineMixinObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, const int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineSuperclassObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineUnexportObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOONextObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOOSelfObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv);
+
+/*
+ * Method implementations (in tclOOBasic.c).
+ */
+
+MODULE_SCOPE int	TclOO_Class_Create(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Class_CreateNs(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Class_New(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Object_Destroy(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Object_Eval(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Object_LinkVar(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Object_Unknown(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+MODULE_SCOPE int	TclOO_Object_VarName(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+
+/*
+ * Private definitions, some of which perhaps ought to be exposed properly or
+ * maybe just put in the internal stubs table.
+ */
+
+MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
+MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
+MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
+MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
+MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
+MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
+MODULE_SCOPE void	TclOODelMethodRef(Method *method);
+MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
+			    Tcl_Obj *methodNameObj, int flags);
+MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
+MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
+MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
+MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
+			    int flags, const char ***stringsPtr);
+MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr, int flags,
+			    const char ***stringsPtr);
+MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
+MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
+MODULE_SCOPE int	TclOOInvokeContext(Tcl_Interp *interp,
+			    CallContext *contextPtr, int objc,
+			    Tcl_Obj *const *objv);
+MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
+			    const DeclaredClassMethod *dcm);
+MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
+MODULE_SCOPE void	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
+MODULE_SCOPE void	TclOORemoveFromMixinSubs(Class *subPtr,
+			    Class *mixinPtr);
+MODULE_SCOPE void	TclOORemoveFromSubclasses(Class *subPtr,
+			    Class *superPtr);
+MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
+			    CallContext *contextPtr);
+
+/*
+ * Include all the private API, generated from tclOO.decls.
+ */
+
+#include "tclOOIntDecls.h"
+
+/*
+ * A convenience macro for iterating through the lists used in the internal
+ * memory management of objects. This is a bit gnarly because we want to do
+ * the assignment of the picked-out value only when the body test succeeds,
+ * but we cannot rely on the assigned value being useful, forcing us to do
+ * some nasty stuff with the comma operator. The compiler's optimizer should
+ * be able to sort it all out!
+ *
+ * REQUIRES DECLARATION: int i;
+ */
+
+#define FOREACH(var,ary) \
+	for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
+
+/*
+ * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
+ * sets up the declarations needed for the main macro, FOREACH_HASH, which
+ * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
+ * only iterates over values.
+ */
+
+#define FOREACH_HASH_DECLS \
+    Tcl_HashEntry *hPtr;Tcl_HashSearch search
+#define FOREACH_HASH(key,val,tablePtr) \
+    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
+	    ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
+	    (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
+#define FOREACH_HASH_VALUE(val,tablePtr) \
+    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
+	    ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
+
+/*
+ * Convenience macro for duplicating a list. Needs no external declaration,
+ * but all arguments are used multiple times and so must have no side effects.
+ */
+
+#define DUPLICATE(target,source,type) \
+    do { \
+	register unsigned len = sizeof(type) * ((target).num=(source).num);\
+	if (len != 0) { \
+	    memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \
+	} else { \
+	    (target).list = NULL; \
+	} \
+    } while(0)
+
+/*
+ * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
+ */
+
+#define AddRef(ptr) ((ptr)->refCount++)
+#define DelRef(ptr) do {			\
+	if (--(ptr)->refCount < 1) {		\
+	    ckfree((char *) (ptr));		\
+	}					\
+    } while(0)
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
new file mode 100644
index 0000000..e39b457
--- /dev/null
+++ b/generic/tclOOIntDecls.h
@@ -0,0 +1,209 @@
+/*
+ * $Id: tclOOIntDecls.h,v 1.1 2008/05/31 11:42:18 dkf Exp $
+ *
+ * This file is (mostly) automatically generated from tclOO.decls.
+ */
+
+/* !BEGIN!: Do not edit below this line. */
+
+#define TCLOOINT_STUBS_EPOCH 0
+#define TCLOOINT_STUBS_REVISION 44
+
+#if !defined(USE_TCLOO_STUBS)
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TCLOOAPI Tcl_Object	TclOOGetDefineCmdContext (Tcl_Interp * interp);
+/* 1 */
+TCLOOAPI Tcl_Method	TclOOMakeProcInstanceMethod (Tcl_Interp * interp, 
+				Object * oPtr, int flags, Tcl_Obj * nameObj, 
+				Tcl_Obj * argsObj, Tcl_Obj * bodyObj, 
+				const Tcl_MethodType * typePtr, 
+				ClientData clientData, Proc ** procPtrPtr);
+/* 2 */
+TCLOOAPI Tcl_Method	TclOOMakeProcMethod (Tcl_Interp * interp, 
+				Class * clsPtr, int flags, Tcl_Obj * nameObj, 
+				const char * namePtr, Tcl_Obj * argsObj, 
+				Tcl_Obj * bodyObj, 
+				const Tcl_MethodType * typePtr, 
+				ClientData clientData, Proc ** procPtrPtr);
+/* 3 */
+TCLOOAPI Method *	TclOONewProcInstanceMethod (Tcl_Interp * interp, 
+				Object * oPtr, int flags, Tcl_Obj * nameObj, 
+				Tcl_Obj * argsObj, Tcl_Obj * bodyObj, 
+				ProcedureMethod ** pmPtrPtr);
+/* 4 */
+TCLOOAPI Method *	TclOONewProcMethod (Tcl_Interp * interp, 
+				Class * clsPtr, int flags, Tcl_Obj * nameObj, 
+				Tcl_Obj * argsObj, Tcl_Obj * bodyObj, 
+				ProcedureMethod ** pmPtrPtr);
+/* 5 */
+TCLOOAPI int		TclOOObjectCmdCore (Object * oPtr, 
+				Tcl_Interp * interp, int objc, 
+				Tcl_Obj *const * objv, int publicOnly, 
+				Class * startCls);
+/* 6 */
+TCLOOAPI int		TclOOIsReachable (Class * targetPtr, 
+				Class * startPtr);
+/* 7 */
+TCLOOAPI Method *	TclOONewForwardMethod (Tcl_Interp * interp, 
+				Class * clsPtr, int isPublic, 
+				Tcl_Obj * nameObj, Tcl_Obj * prefixObj);
+/* 8 */
+TCLOOAPI Method *	TclOONewForwardInstanceMethod (Tcl_Interp * interp, 
+				Object * oPtr, int isPublic, 
+				Tcl_Obj * nameObj, Tcl_Obj * prefixObj);
+/* 9 */
+TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx (Tcl_Interp * interp, 
+				Tcl_Object oPtr, 
+				TclOO_PreCallProc preCallPtr, 
+				TclOO_PostCallProc postCallPtr, 
+				ProcErrorProc errProc, ClientData clientData, 
+				Tcl_Obj * nameObj, Tcl_Obj * argsObj, 
+				Tcl_Obj * bodyObj, int flags, 
+				void ** internalTokenPtr);
+/* 10 */
+TCLOOAPI Tcl_Method	TclOONewProcMethodEx (Tcl_Interp * interp, 
+				Tcl_Class clsPtr, 
+				TclOO_PreCallProc preCallPtr, 
+				TclOO_PostCallProc postCallPtr, 
+				ProcErrorProc errProc, ClientData clientData, 
+				Tcl_Obj * nameObj, Tcl_Obj * argsObj, 
+				Tcl_Obj * bodyObj, int flags, 
+				void ** internalTokenPtr);
+/* 11 */
+TCLOOAPI int		TclOOInvokeObject (Tcl_Interp * interp, 
+				Tcl_Object object, Tcl_Class startCls, 
+				int publicPrivate, int objc, 
+				Tcl_Obj *const * objv);
+/* 12 */
+TCLOOAPI void		TclOOObjectSetFilters (Object * oPtr, int numFilters, 
+				Tcl_Obj *const * filters);
+/* 13 */
+TCLOOAPI void		TclOOClassSetFilters (Tcl_Interp * interp, 
+				Class * classPtr, int numFilters, 
+				Tcl_Obj *const * filters);
+/* 14 */
+TCLOOAPI void		TclOOObjectSetMixins (Object * oPtr, int numMixins, 
+				Class *const * mixins);
+/* 15 */
+TCLOOAPI void		TclOOClassSetMixins (Tcl_Interp * interp, 
+				Class * classPtr, int numMixins, 
+				Class *const * mixins);
+
+#endif /* !defined(USE_TCLOO_STUBS) */
+
+typedef struct TclOOIntStubs {
+    int magic;
+    int epoch;
+    int revision;
+    struct TclOOIntStubHooks *hooks;
+
+    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp * interp); /* 0 */
+    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp * interp, Object * oPtr, int flags, Tcl_Obj * nameObj, Tcl_Obj * argsObj, Tcl_Obj * bodyObj, const Tcl_MethodType * typePtr, ClientData clientData, Proc ** procPtrPtr); /* 1 */
+    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp * interp, Class * clsPtr, int flags, Tcl_Obj * nameObj, const char * namePtr, Tcl_Obj * argsObj, Tcl_Obj * bodyObj, const Tcl_MethodType * typePtr, ClientData clientData, Proc ** procPtrPtr); /* 2 */
+    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp * interp, Object * oPtr, int flags, Tcl_Obj * nameObj, Tcl_Obj * argsObj, Tcl_Obj * bodyObj, ProcedureMethod ** pmPtrPtr); /* 3 */
+    Method * (*tclOONewProcMethod) (Tcl_Interp * interp, Class * clsPtr, int flags, Tcl_Obj * nameObj, Tcl_Obj * argsObj, Tcl_Obj * bodyObj, ProcedureMethod ** pmPtrPtr); /* 4 */
+    int (*tclOOObjectCmdCore) (Object * oPtr, Tcl_Interp * interp, int objc, Tcl_Obj *const * objv, int publicOnly, Class * startCls); /* 5 */
+    int (*tclOOIsReachable) (Class * targetPtr, Class * startPtr); /* 6 */
+    Method * (*tclOONewForwardMethod) (Tcl_Interp * interp, Class * clsPtr, int isPublic, Tcl_Obj * nameObj, Tcl_Obj * prefixObj); /* 7 */
+    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp * interp, Object * oPtr, int isPublic, Tcl_Obj * nameObj, Tcl_Obj * prefixObj); /* 8 */
+    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp * interp, Tcl_Object oPtr, TclOO_PreCallProc preCallPtr, TclOO_PostCallProc postCallPtr, ProcErrorProc errProc, ClientData clientData, Tcl_Obj * nameObj, Tcl_Obj * argsObj, Tcl_Obj * bodyObj, int flags, void ** internalTokenPtr); /* 9 */
+    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp * interp, Tcl_Class clsPtr, TclOO_PreCallProc preCallPtr, TclOO_PostCallProc postCallPtr, ProcErrorProc errProc, ClientData clientData, Tcl_Obj * nameObj, Tcl_Obj * argsObj, Tcl_Obj * bodyObj, int flags, void ** internalTokenPtr); /* 10 */
+    int (*tclOOInvokeObject) (Tcl_Interp * interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const * objv); /* 11 */
+    void (*tclOOObjectSetFilters) (Object * oPtr, int numFilters, Tcl_Obj *const * filters); /* 12 */
+    void (*tclOOClassSetFilters) (Tcl_Interp * interp, Class * classPtr, int numFilters, Tcl_Obj *const * filters); /* 13 */
+    void (*tclOOObjectSetMixins) (Object * oPtr, int numMixins, Class *const * mixins); /* 14 */
+    void (*tclOOClassSetMixins) (Tcl_Interp * interp, Class * classPtr, int numMixins, Class *const * mixins); /* 15 */
+} TclOOIntStubs;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern const TclOOIntStubs *tclOOIntStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TCLOO_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef TclOOGetDefineCmdContext
+#define TclOOGetDefineCmdContext \
+	(tclOOIntStubsPtr->tclOOGetDefineCmdContext) /* 0 */
+#endif
+#ifndef TclOOMakeProcInstanceMethod
+#define TclOOMakeProcInstanceMethod \
+	(tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) /* 1 */
+#endif
+#ifndef TclOOMakeProcMethod
+#define TclOOMakeProcMethod \
+	(tclOOIntStubsPtr->tclOOMakeProcMethod) /* 2 */
+#endif
+#ifndef TclOONewProcInstanceMethod
+#define TclOONewProcInstanceMethod \
+	(tclOOIntStubsPtr->tclOONewProcInstanceMethod) /* 3 */
+#endif
+#ifndef TclOONewProcMethod
+#define TclOONewProcMethod \
+	(tclOOIntStubsPtr->tclOONewProcMethod) /* 4 */
+#endif
+#ifndef TclOOObjectCmdCore
+#define TclOOObjectCmdCore \
+	(tclOOIntStubsPtr->tclOOObjectCmdCore) /* 5 */
+#endif
+#ifndef TclOOIsReachable
+#define TclOOIsReachable \
+	(tclOOIntStubsPtr->tclOOIsReachable) /* 6 */
+#endif
+#ifndef TclOONewForwardMethod
+#define TclOONewForwardMethod \
+	(tclOOIntStubsPtr->tclOONewForwardMethod) /* 7 */
+#endif
+#ifndef TclOONewForwardInstanceMethod
+#define TclOONewForwardInstanceMethod \
+	(tclOOIntStubsPtr->tclOONewForwardInstanceMethod) /* 8 */
+#endif
+#ifndef TclOONewProcInstanceMethodEx
+#define TclOONewProcInstanceMethodEx \
+	(tclOOIntStubsPtr->tclOONewProcInstanceMethodEx) /* 9 */
+#endif
+#ifndef TclOONewProcMethodEx
+#define TclOONewProcMethodEx \
+	(tclOOIntStubsPtr->tclOONewProcMethodEx) /* 10 */
+#endif
+#ifndef TclOOInvokeObject
+#define TclOOInvokeObject \
+	(tclOOIntStubsPtr->tclOOInvokeObject) /* 11 */
+#endif
+#ifndef TclOOObjectSetFilters
+#define TclOOObjectSetFilters \
+	(tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */
+#endif
+#ifndef TclOOClassSetFilters
+#define TclOOClassSetFilters \
+	(tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */
+#endif
+#ifndef TclOOObjectSetMixins
+#define TclOOObjectSetMixins \
+	(tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */
+#endif
+#ifndef TclOOClassSetMixins
+#define TclOOClassSetMixins \
+	(tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */
+#endif
+
+#endif /* defined(USE_TCLOO_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+struct TclOOStubAPI {
+    TclOOStubs *stubsPtr;
+    TclOOIntStubs *intStubsPtr;
+};
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
new file mode 100644
index 0000000..f190533
--- /dev/null
+++ b/generic/tclOOMethod.c
@@ -0,0 +1,1425 @@
+/*
+ * tclOOMethod.c --
+ *
+ *	This file contains code to create and manage methods.
+ *
+ * Copyright (c) 2005-2008 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: tclOOMethod.c,v 1.1 2008/05/31 11:42:19 dkf Exp $
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclInt.h"
+#include "tclOOInt.h"
+
+/*
+ * Structure used to help delay computing names of objects or classes for
+ * [info frame] until needed, making invokation faster in the normal case.
+ */
+
+struct PNI {
+    Tcl_Interp *interp;		/* Interpreter in which to compute the name of
+				 * a method. */
+    Tcl_Method method;		/* Method to compute the name of. */
+};
+
+/*
+ * Structure used to contain all the information needed about a call frame
+ * used in a procedure-like method.
+ */
+
+typedef struct {
+    CallFrame *framePtr;	/* Reference to the call frame itself (it's
+				 * actually allocated on the Tcl stack). */
+    ProcErrorProc errProc;	/* The error handler for the body. */
+    Tcl_Obj *nameObj;		/* The "name" of the command. */
+    Command cmd;		/* The command structure. Mostly bogus. */
+    ExtraFrameInfo efi;		/* Extra information used for [info frame]. */
+    struct PNI pni;		/* Specialist information used in the efi
+				 * field for this type of call. */
+} PMFrameData;
+
+/*
+ * Function declarations for things defined in this file.
+ */
+
+static Tcl_Obj **	InitEnsembleRewrite(Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const *objv, int toRewrite,
+			    int rewriteLength, Tcl_Obj *const *rewriteObjs,
+			    int *lengthPtr);
+static int		InvokeProcedureMethod(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+static int		PushMethodCallFrame(Tcl_Interp *interp,
+			    CallContext *contextPtr, ProcedureMethod *pmPtr,
+			    int objc, Tcl_Obj *const *objv,
+			    PMFrameData *fdPtr);
+static void		DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
+static void		DeleteProcedureMethod(ClientData clientData);
+static int		CloneProcedureMethod(Tcl_Interp *interp,
+			    ClientData clientData, ClientData *newClientData);
+static void		MethodErrorHandler(Tcl_Interp *interp,
+			    Tcl_Obj *procNameObj);
+static void		ConstructorErrorHandler(Tcl_Interp *interp,
+			    Tcl_Obj *procNameObj);
+static void		DestructorErrorHandler(Tcl_Interp *interp,
+			    Tcl_Obj *procNameObj);
+static Tcl_Obj *	RenderDeclarerName(ClientData clientData);
+static int		InvokeForwardMethod(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
+static void		DeleteForwardMethod(ClientData clientData);
+static int		CloneForwardMethod(Tcl_Interp *interp,
+			    ClientData clientData, ClientData *newClientData);
+
+/*
+ * The types of methods defined by the core OO system.
+ */
+
+static const Tcl_MethodType procMethodType = {
+    TCL_OO_METHOD_VERSION_CURRENT, "procedural method",
+    InvokeProcedureMethod, DeleteProcedureMethod, CloneProcedureMethod
+};
+static const Tcl_MethodType fwdMethodType = {
+    TCL_OO_METHOD_VERSION_CURRENT, "forward",
+    InvokeForwardMethod, DeleteForwardMethod, CloneForwardMethod
+};
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_NewInstanceMethod --
+ *
+ *	Attach a method to an object instance.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+Tcl_NewInstanceMethod(
+    Tcl_Interp *interp,		/* Unused? */
+    Tcl_Object object,		/* The object that has the method attached to
+				 * it. */
+    Tcl_Obj *nameObj,		/* The name of the method. May be NULL; if so,
+				 * up to caller to manage storage (e.g., when
+				 * it is a constructor or destructor). */
+    int flags,			/* Whether this is a public method. */
+    const Tcl_MethodType *typePtr,
+				/* The type of method this is, which defines
+				 * how to invoke, delete and clone the
+				 * method. */
+    ClientData clientData)	/* Some data associated with the particular
+				 * method to be created. */
+{
+    register Object *oPtr = (Object *) object;
+    register Method *mPtr;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    if (nameObj == NULL) {
+	mPtr = (Method *) ckalloc(sizeof(Method));
+	mPtr->namePtr = NULL;
+	goto populate;
+    }
+    if (!oPtr->methodsPtr) {
+	oPtr->methodsPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitObjHashTable(oPtr->methodsPtr);
+	oPtr->flags &= ~USE_CLASS_CACHE;
+    }
+    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
+    if (isNew) {
+	mPtr = (Method *) ckalloc(sizeof(Method));
+	mPtr->namePtr = nameObj;
+	Tcl_IncrRefCount(nameObj);
+	Tcl_SetHashValue(hPtr, mPtr);
+    } else {
+	mPtr = Tcl_GetHashValue(hPtr);
+	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
+	    mPtr->typePtr->deleteProc(mPtr->clientData);
+	}
+    }
+
+  populate:
+    mPtr->typePtr = typePtr;
+    mPtr->clientData = clientData;
+    mPtr->refCount = 1;
+    mPtr->flags = 0;
+    mPtr->declaringObjectPtr = oPtr;
+    mPtr->declaringClassPtr = NULL;
+    if (flags) {
+	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+    }
+    oPtr->epoch++;
+    return (Tcl_Method) mPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Tcl_NewMethod --
+ *
+ *	Attach a method to a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+Tcl_NewMethod(
+    Tcl_Interp *interp,		/* The interpreter containing the class. */
+    Tcl_Class cls,		/* The class to attach the method to. */
+    Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
+				 * for constructors or destructors); if so, up
+				 * to caller to manage storage. */
+    int flags,			/* Whether this is a public method. */
+    const Tcl_MethodType *typePtr,
+				/* The type of method this is, which defines
+				 * how to invoke, delete and clone the
+				 * method. */
+    ClientData clientData)	/* Some data associated with the particular
+				 * method to be created. */
+{
+    register Class *clsPtr = (Class *) cls;
+    register Method *mPtr;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    if (nameObj == NULL) {
+	mPtr = (Method *) ckalloc(sizeof(Method));
+	mPtr->namePtr = NULL;
+	goto populate;
+    }
+    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
+    if (isNew) {
+	mPtr = (Method *) ckalloc(sizeof(Method));
+	mPtr->namePtr = nameObj;
+	Tcl_IncrRefCount(nameObj);
+	Tcl_SetHashValue(hPtr, mPtr);
+    } else {
+	mPtr = Tcl_GetHashValue(hPtr);
+	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
+	    mPtr->typePtr->deleteProc(mPtr->clientData);
+	}
+    }
+
+  populate:
+    clsPtr->thisPtr->fPtr->epoch++;
+    mPtr->typePtr = typePtr;
+    mPtr->clientData = clientData;
+    mPtr->refCount = 1;
+    mPtr->flags = 0;
+    mPtr->declaringObjectPtr = NULL;
+    mPtr->declaringClassPtr = clsPtr;
+    if (flags) {
+	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+    }
+
+    return (Tcl_Method) mPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODelMethodRef --
+ *
+ *	How to delete a method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOODelMethodRef(
+    Method *mPtr)
+{
+    if ((mPtr != NULL) && (--mPtr->refCount < 0)) {
+	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
+	    mPtr->typePtr->deleteProc(mPtr->clientData);
+	}
+	if (mPtr->namePtr != NULL) {
+	    Tcl_DecrRefCount(mPtr->namePtr);
+	}
+
+	ckfree((char *) mPtr);
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewBasicMethod --
+ *
+ *	Helper that makes it cleaner to create very simple methods during
+ *	basic system initialization. Not suitable for general use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+TclOONewBasicMethod(
+    Tcl_Interp *interp,
+    Class *clsPtr,		/* Class to attach the method to. */
+    const DeclaredClassMethod *dcm)
+				/* Name of the method, whether it is public,
+				 * and the function to implement it. */
+{
+    Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1);
+
+    Tcl_IncrRefCount(namePtr);
+    Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr,
+	    (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL);
+    Tcl_DecrRefCount(namePtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewProcInstanceMethod --
+ *
+ *	Create a new procedure-like method for an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewProcInstanceMethod(
+    Tcl_Interp *interp,		/* The interpreter containing the object. */
+    Object *oPtr,		/* The object to modify. */
+    int flags,			/* Whether this is a public method. */
+    Tcl_Obj *nameObj,		/* The name of the method, which must not be
+				 * NULL. */
+    Tcl_Obj *argsObj,		/* The formal argument list for the method,
+				 * which must not be NULL. */
+    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
+				 * NULL. */
+    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
+				 * structure to allow for deeper tuning of the
+				 * structure's contents. NULL if caller is not
+				 * interested. */
+{
+    int argsLen;
+    register ProcedureMethod *pmPtr;
+    Tcl_Method method;
+
+    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
+	return NULL;
+    }
+    pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod));
+    memset(pmPtr, 0, sizeof(ProcedureMethod));
+    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
+    pmPtr->flags = flags & USE_DECLARER_NS;
+    pmPtr->refCount = 1;
+    method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
+	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
+    if (method == NULL) {
+	ckfree((char *) pmPtr);
+    } else if (pmPtrPtr != NULL) {
+	*pmPtrPtr = pmPtr;
+    }
+    return (Method *) method;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewProcMethod --
+ *
+ *	Create a new procedure-like method for a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewProcMethod(
+    Tcl_Interp *interp,		/* The interpreter containing the class. */
+    Class *clsPtr,		/* The class to modify. */
+    int flags,			/* Whether this is a public method. */
+    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
+				 * if so, up to caller to manage storage
+				 * (e.g., because it is a constructor or
+				 * destructor). */
+    Tcl_Obj *argsObj,		/* The formal argument list for the method,
+				 * which may be NULL; if so, it is equivalent
+				 * to an empty list. */
+    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
+				 * NULL. */
+    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
+				 * structure to allow for deeper tuning of the
+				 * structure's contents. NULL if caller is not
+				 * interested. */
+{
+    int argsLen;		/* -1 => delete argsObj before exit */
+    register ProcedureMethod *pmPtr;
+    const char *procName;
+    Tcl_Method method;
+
+    if (argsObj == NULL) {
+	argsLen = -1;
+	argsObj = Tcl_NewObj();
+	Tcl_IncrRefCount(argsObj);
+	procName = "<destructor>";
+    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
+	return NULL;
+    } else {
+	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
+    }
+
+    pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod));
+    memset(pmPtr, 0, sizeof(ProcedureMethod));
+    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
+    pmPtr->flags = flags & USE_DECLARER_NS;
+    pmPtr->refCount = 1;
+
+    method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj,
+	    procName, argsObj, bodyObj, &procMethodType, pmPtr,
+	    &pmPtr->procPtr);
+
+    if (argsLen == -1) {
+	Tcl_DecrRefCount(argsObj);
+    }
+    if (method == NULL) {
+	ckfree((char *) pmPtr);
+    } else if (pmPtrPtr != NULL) {
+	*pmPtrPtr = pmPtr;
+    }
+
+    return (Method *) method;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOMakeProcInstanceMethod --
+ *
+ *	The guts of the code to make a procedure-like method for an object.
+ *	Split apart so that it is easier for other extensions to reuse (in
+ *	particular, it frees them from having to pry so deeply into Tcl's
+ *	guts).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+TclOOMakeProcInstanceMethod(
+    Tcl_Interp *interp,		/* The interpreter containing the object. */
+    Object *oPtr,		/* The object to modify. */
+    int flags,			/* Whether this is a public method. */
+    Tcl_Obj *nameObj,		/* The name of the method, which _must not_ be
+				 * NULL. */
+    Tcl_Obj *argsObj,		/* The formal argument list for the method,
+				 * which _must not_ be NULL. */
+    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
+				 * NULL. */
+    const Tcl_MethodType *typePtr,
+				/* The type of the method to create. */
+    ClientData clientData,	/* The per-method type-specific data. */
+    Proc **procPtrPtr)		/* A pointer to the variable in which to write
+				 * the procedure record reference. Presumably
+				 * inside the structure indicated by the
+				 * pointer in clientData. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Proc *procPtr;
+
+    if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
+	    procPtrPtr) != TCL_OK) {
+	return NULL;
+    }
+    procPtr = *procPtrPtr;
+    procPtr->cmdPtr = NULL;
+
+    if (iPtr->cmdFramePtr) {
+	CmdFrame context = *iPtr->cmdFramePtr;
+
+	if (context.type == TCL_LOCATION_BC) {
+	    /*
+	     * Retrieve source information from the bytecode, if possible. If
+	     * the information is retrieved successfully, context.type will be
+	     * TCL_LOCATION_SOURCE and the reference held by
+	     * context.data.eval.path will be counted.
+	     */
+
+	    TclGetSrcInfoForPc(&context);
+	} else if (context.type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * The copy into 'context' up above has created another reference
+	     * to 'context.data.eval.path'; account for it.
+	     */
+
+	    Tcl_IncrRefCount(context.data.eval.path);
+	}
+
+	if (context.type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * We can account for source location within a proc only if the
+	     * proc body was not created by substitution.
+	     * (FIXME: check that this is sane and correct!)
+	     */
+
+	    if (context.line
+		    && (context.nline >= 4) && (context.line[3] >= 0)) {
+		int isNew;
+		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+		Tcl_HashEntry *hPtr;
+
+		cfPtr->level = -1;
+		cfPtr->type = context.type;
+		cfPtr->line = (int *) ckalloc(sizeof(int));
+		cfPtr->line[0] = context.line[3];
+		cfPtr->nline = 1;
+		cfPtr->framePtr = NULL;
+		cfPtr->nextPtr = NULL;
+
+		cfPtr->data.eval.path = context.data.eval.path;
+		Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+		cfPtr->cmd.str.cmd = NULL;
+		cfPtr->cmd.str.len = 0;
+
+		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
+			(char *) procPtr, &isNew);
+		Tcl_SetHashValue(hPtr, cfPtr);
+	    }
+
+	    /*
+	     * 'context' is going out of scope; account for the reference that
+	     * it's holding to the path name.
+	     */
+
+	    Tcl_DecrRefCount(context.data.eval.path);
+	    context.data.eval.path = NULL;
+	}
+    }
+
+    return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
+	    typePtr, clientData);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOMakeProcMethod --
+ *
+ *	The guts of the code to make a procedure-like method for a class.
+ *	Split apart so that it is easier for other extensions to reuse (in
+ *	particular, it frees them from having to pry so deeply into Tcl's
+ *	guts).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Method
+TclOOMakeProcMethod(
+    Tcl_Interp *interp,		/* The interpreter containing the class. */
+    Class *clsPtr,		/* The class to modify. */
+    int flags,			/* Whether this is a public method. */
+    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
+				 * if so, up to caller to manage storage
+				 * (e.g., because it is a constructor or
+				 * destructor). */
+    const char *namePtr,	/* The name of the method as a string, which
+				 * _must not_ be NULL. */
+    Tcl_Obj *argsObj,		/* The formal argument list for the method,
+				 * which _must not_ be NULL. */
+    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
+				 * NULL. */
+    const Tcl_MethodType *typePtr,
+				/* The type of the method to create. */
+    ClientData clientData,	/* The per-method type-specific data. */
+    Proc **procPtrPtr)		/* A pointer to the variable in which to write
+				 * the procedure record reference. Presumably
+				 * inside the structure indicated by the
+				 * pointer in clientData. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Proc *procPtr;
+
+    if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
+	    procPtrPtr) != TCL_OK) {
+	return NULL;
+    }
+    procPtr = *procPtrPtr;
+    procPtr->cmdPtr = NULL;
+
+    if (iPtr->cmdFramePtr) {
+	CmdFrame context = *iPtr->cmdFramePtr;
+
+	if (context.type == TCL_LOCATION_BC) {
+	    /*
+	     * Retrieve source information from the bytecode, if possible. If
+	     * the information is retrieved successfully, context.type will be
+	     * TCL_LOCATION_SOURCE and the reference held by
+	     * context.data.eval.path will be counted.
+	     */
+
+	    TclGetSrcInfoForPc(&context);
+	} else if (context.type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * The copy into 'context' up above has created another reference
+	     * to 'context.data.eval.path'; account for it.
+	     */
+
+	    Tcl_IncrRefCount(context.data.eval.path);
+	}
+
+	if (context.type == TCL_LOCATION_SOURCE) {
+	    /*
+	     * We can account for source location within a proc only if the
+	     * proc body was not created by substitution.
+	     * (FIXME: check that this is sane and correct!)
+	     */
+
+	    if (context.line
+		    && (context.nline >= 4) && (context.line[3] >= 0)) {
+		int isNew;
+		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+		Tcl_HashEntry *hPtr;
+
+		cfPtr->level = -1;
+		cfPtr->type = context.type;
+		cfPtr->line = (int *) ckalloc(sizeof(int));
+		cfPtr->line[0] = context.line[3];
+		cfPtr->nline = 1;
+		cfPtr->framePtr = NULL;
+		cfPtr->nextPtr = NULL;
+
+		cfPtr->data.eval.path = context.data.eval.path;
+		Tcl_IncrRefCount(cfPtr->data.eval.path);
+
+		cfPtr->cmd.str.cmd = NULL;
+		cfPtr->cmd.str.len = 0;
+
+		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
+			(char *) procPtr, &isNew);
+		Tcl_SetHashValue(hPtr, cfPtr);
+	    }
+
+	    /*
+	     * 'context' is going out of scope; account for the reference that
+	     * it's holding to the path name.
+	     */
+
+	    Tcl_DecrRefCount(context.data.eval.path);
+	    context.data.eval.path = NULL;
+	}
+    }
+
+    return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
+	    clientData);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InvokeProcedureMethod, PushMethodCallFrame --
+ *
+ *	How to invoke a procedure-like method.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InvokeProcedureMethod(
+    ClientData clientData,	/* Pointer to some per-method context. */
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,	/* The method calling context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
+{
+    ProcedureMethod *pmPtr = clientData;
+    int result;
+    register int skip;
+    PMFrameData *fdPtr;		/* Important data that has to have a lifetime
+				 * matched by this function (or rather, by the
+				 * call frame's lifetime). */
+
+    /*
+     * Allocate the special frame data.
+     */
+
+    fdPtr = (PMFrameData *) TclStackAlloc(interp, sizeof(PMFrameData));
+    pmPtr->refCount++;
+
+    /*
+     * Create a call frame for this method.
+     */
+
+    result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr,
+	    objc, objv, fdPtr);
+    if (result != TCL_OK) {
+	goto done;
+    }
+
+    /*
+     * Give the pre-call callback a chance to do some setup and, possibly,
+     * veto the call.
+     */
+
+    if (pmPtr->preCallProc != NULL) {
+	int isFinished;
+
+	result = pmPtr->preCallProc(pmPtr->clientData, interp, context,
+		(Tcl_CallFrame *) fdPtr->framePtr, &isFinished);
+	if (isFinished || result != TCL_OK) {
+	    Tcl_PopCallFrame(interp);
+	    TclStackFree(interp, fdPtr->framePtr);
+	    goto done;
+	}
+    }
+
+    /*
+     * Now invoke the body of the method. Note that we need to take special
+     * action when doing unknown processing to ensure that the missing method
+     * name is passed as an argument.
+     */
+
+    skip = Tcl_ObjectContextSkippedArgs(context);
+    result = TclObjInterpProcCore(interp, fdPtr->nameObj, skip,
+	    fdPtr->errProc);
+
+    /*
+     * Give the post-call callback a chance to do some cleanup. Note that at
+     * this point the call frame itself is invalid; it's already been popped.
+     */
+
+    if (pmPtr->postCallProc) {
+	result = pmPtr->postCallProc(pmPtr->clientData, interp, context,
+		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),
+		result);
+    }
+
+    /*
+     * Scrap the special frame data now that we're done with it. Note that we
+     * are inlining DeleteProcedureMethod() here; this location is highly
+     * sensitive when it comes to performance!
+     */
+
+  done:
+    if (--pmPtr->refCount < 1) {
+	DeleteProcedureMethodRecord(pmPtr);
+    }
+    TclStackFree(interp, fdPtr);
+    return result;
+}
+
+static int
+PushMethodCallFrame(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    CallContext *contextPtr,	/* Current method call context. */
+    ProcedureMethod *pmPtr,	/* Information about this procedure-like
+				 * method. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv,	/* Array of arguments. */
+    PMFrameData *fdPtr)		/* Place to store information about the call
+				 * frame. */
+{
+    Tcl_Namespace *nsPtr = contextPtr->oPtr->namespacePtr;
+    register int result;
+    const char *namePtr;
+    CallFrame **framePtrPtr = &fdPtr->framePtr;
+    static Tcl_ObjType *byteCodeTypePtr = NULL;	/* HACK! */
+
+    /*
+     * Compute basic information on the basis of the type of method it is.
+     */
+
+    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+	namePtr = "<constructor>";
+	fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName;
+	fdPtr->errProc = ConstructorErrorHandler;
+    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+	namePtr = "<destructor>";
+	fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName;
+	fdPtr->errProc = DestructorErrorHandler;
+    } else {
+	fdPtr->nameObj = Tcl_MethodName(
+		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr));
+	namePtr = TclGetString(fdPtr->nameObj);
+	fdPtr->errProc = MethodErrorHandler;
+    }
+    if (pmPtr->errProc != NULL) {
+	fdPtr->errProc = pmPtr->errProc;
+    }
+
+    /*
+     * Magic to enable things like [incr Tcl], which wants methods to run in
+     * their class's namespace.
+     */
+
+    if (pmPtr->flags & USE_DECLARER_NS) {
+	register Method *mPtr =
+		contextPtr->callPtr->chain[contextPtr->index].mPtr;
+
+	if (mPtr->declaringClassPtr != NULL) {
+	    nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr;
+	} else {
+	    nsPtr = mPtr->declaringObjectPtr->namespacePtr;
+	}
+    }
+
+    /*
+     * Compile the body. This operation may fail.
+     */
+
+    fdPtr->efi.length = 2;
+    memset(&fdPtr->cmd, 0, sizeof(Command));
+    fdPtr->cmd.nsPtr = (Namespace *) nsPtr;
+    fdPtr->cmd.clientData = &fdPtr->efi;
+    pmPtr->procPtr->cmdPtr = &fdPtr->cmd;
+
+    /* Should be a reference to tclByteCodeType, but that's MODULE_SCOPE */
+    if (byteCodeTypePtr == NULL ||
+	    pmPtr->procPtr->bodyPtr->typePtr != byteCodeTypePtr) {
+	result = TclProcCompileProc(interp, pmPtr->procPtr,
+		pmPtr->procPtr->bodyPtr, (Namespace *) nsPtr,
+		"body of method", namePtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	if (byteCodeTypePtr == NULL) {
+	    byteCodeTypePtr = pmPtr->procPtr->bodyPtr->typePtr;
+	}
+    }
+
+    /*
+     * Make the stack frame and fill it out with information about this call.
+     * This operation may fail.
+     */
+
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, nsPtr,
+	    FRAME_IS_PROC|FRAME_IS_METHOD);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    fdPtr->framePtr->clientData = contextPtr;
+    fdPtr->framePtr->objc = objc;
+    fdPtr->framePtr->objv = objv;
+    fdPtr->framePtr->procPtr = pmPtr->procPtr;
+
+    /*
+     * Finish filling out the extra frame info so that [info frame] works.
+     */
+
+    fdPtr->efi.fields[0].name = "method";
+    fdPtr->efi.fields[0].proc = NULL;
+    fdPtr->efi.fields[0].clientData = fdPtr->nameObj;
+    if (pmPtr->gfivProc != NULL) {
+	fdPtr->efi.fields[1].proc = pmPtr->gfivProc;
+	fdPtr->efi.fields[1].clientData = pmPtr;
+    } else {
+	register Tcl_Method method =
+		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr);
+
+	if (Tcl_MethodDeclarerObject(method) != NULL) {
+	    fdPtr->efi.fields[1].name = "object";
+	} else {
+	    fdPtr->efi.fields[1].name = "class";
+	}
+	fdPtr->efi.fields[1].proc = RenderDeclarerName;
+	fdPtr->efi.fields[1].clientData = &fdPtr->pni;
+	fdPtr->pni.interp = interp;
+	fdPtr->pni.method = method;
+    }
+
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RenderDeclarerName --
+ *
+ *	Returns the name of the entity (object or class) which declared a
+ *	method. Used for producing information for [info frame] in such a way
+ *	that the expensive part of this (generating the object or class name
+ *	itself) isn't done until it is needed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+RenderDeclarerName(
+    ClientData clientData)
+{
+    struct PNI *pni = clientData;
+    Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);
+
+    if (object == NULL) {
+	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
+    }
+    return TclOOObjectName(pni->interp, (Object *) object);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler --
+ *
+ *	How to fill in the stack trace correctly upon error in various forms
+ *	of procedure-like methods. LIMIT is how long the inserted strings in
+ *	the error traces should get before being converted to have ellipses,
+ *	and ELLIPSIFY is a macro to do the conversion (with the help of a
+ *	%.*s%s format field). Note that ELLIPSIFY is only safe for use in
+ *	suitable formatting contexts.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+#define LIMIT 60
+#define ELLIPSIFY(str,len) \
+	((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "")
+
+static void
+MethodErrorHandler(
+    Tcl_Interp *interp,
+    Tcl_Obj *methodNameObj)
+{
+    int nameLen, objectNameLen;
+    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
+    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+    const char *objectName, *kindName, *methodName =
+	    Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
+    Object *declarerPtr;
+
+    if (mPtr->declaringObjectPtr != NULL) {
+	declarerPtr = mPtr->declaringObjectPtr;
+	kindName = "object";
+    } else {
+	if (mPtr->declaringClassPtr == NULL) {
+	    Tcl_Panic("method not declared in class or object");
+	}
+	declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	kindName = "class";
+    }
+
+    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
+	    &objectNameLen);
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
+	    kindName, ELLIPSIFY(objectName, objectNameLen),
+	    ELLIPSIFY(methodName, nameLen), interp->errorLine));
+}
+
+static void
+ConstructorErrorHandler(
+    Tcl_Interp *interp,
+    Tcl_Obj *methodNameObj)
+{
+    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
+    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+    Object *declarerPtr;
+    const char *objectName, *kindName;
+    int objectNameLen;
+
+    if (interp->errorLine == 0xDEADBEEF) {
+	/*
+	 * Horrible hack to deal with certain constructors that must not add
+	 * information to the error trace.
+	 */
+
+	return;
+    }
+
+    if (mPtr->declaringObjectPtr != NULL) {
+	declarerPtr = mPtr->declaringObjectPtr;
+	kindName = "object";
+    } else {
+	if (mPtr->declaringClassPtr == NULL) {
+	    Tcl_Panic("method not declared in class or object");
+	}
+	declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	kindName = "class";
+    }
+
+    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
+	    &objectNameLen);
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (%s \"%.*s%s\" constructor line %d)", kindName,
+	    ELLIPSIFY(objectName, objectNameLen), interp->errorLine));
+}
+
+static void
+DestructorErrorHandler(
+    Tcl_Interp *interp,
+    Tcl_Obj *methodNameObj)
+{
+    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
+    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+    Object *declarerPtr;
+    const char *objectName, *kindName;
+    int objectNameLen;
+
+    if (mPtr->declaringObjectPtr != NULL) {
+	declarerPtr = mPtr->declaringObjectPtr;
+	kindName = "object";
+    } else {
+	if (mPtr->declaringClassPtr == NULL) {
+	    Tcl_Panic("method not declared in class or object");
+	}
+	declarerPtr = mPtr->declaringClassPtr->thisPtr;
+	kindName = "class";
+    }
+
+    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
+	    &objectNameLen);
+    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
+	    ELLIPSIFY(objectName, objectNameLen), interp->errorLine));
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteProcedureMethod, CloneProcedureMethod --
+ *
+ *	How to delete and clone procedure-like methods.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteProcedureMethodRecord(
+    ProcedureMethod *pmPtr)
+{
+    TclProcDeleteProc(pmPtr->procPtr);
+    if (pmPtr->deleteClientdataProc) {
+	pmPtr->deleteClientdataProc(pmPtr->clientData);
+    }
+    ckfree((char *) pmPtr);
+}
+
+static void
+DeleteProcedureMethod(
+    ClientData clientData)
+{
+    register ProcedureMethod *pmPtr = clientData;
+
+    if (--pmPtr->refCount < 1) {
+	DeleteProcedureMethodRecord(pmPtr);
+    }
+}
+
+static int
+CloneProcedureMethod(
+    Tcl_Interp *interp,
+    ClientData clientData,
+    ClientData *newClientData)
+{
+    ProcedureMethod *pmPtr = clientData;
+    ProcedureMethod *pm2Ptr = (ProcedureMethod *)
+	    ckalloc(sizeof(ProcedureMethod));
+
+    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
+    pm2Ptr->refCount = 1;
+    pm2Ptr->procPtr->refCount++;
+    if (pmPtr->cloneClientdataProc) {
+	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
+    }
+    *newClientData = pm2Ptr;
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewForwardMethod --
+ *
+ *	Create a forwarded method for an object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewForwardInstanceMethod(
+    Tcl_Interp *interp,		/* Interpreter for error reporting. */
+    Object *oPtr,		/* The object to attach the method to. */
+    int flags,			/* Whether the method is public or not. */
+    Tcl_Obj *nameObj,		/* The name of the method. */
+    Tcl_Obj *prefixObj)		/* List of arguments that form the command
+				 * prefix to forward to. */
+{
+    int prefixLen;
+    register ForwardMethod *fmPtr;
+
+    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+	return NULL;
+    }
+    if (prefixLen < 1) {
+	Tcl_AppendResult(interp, "method forward prefix must be non-empty",
+		NULL);
+	return NULL;
+    }
+
+    fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
+    fmPtr->prefixObj = prefixObj;
+    Tcl_IncrRefCount(prefixObj);
+    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
+	    nameObj, flags, &fwdMethodType, fmPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOONewForwardMethod --
+ *
+ *	Create a new forwarded method for a class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Method *
+TclOONewForwardMethod(
+    Tcl_Interp *interp,		/* Interpreter for error reporting. */
+    Class *clsPtr,		/* The class to attach the method to. */
+    int flags,			/* Whether the method is public or not. */
+    Tcl_Obj *nameObj,		/* The name of the method. */
+    Tcl_Obj *prefixObj)		/* List of arguments that form the command
+				 * prefix to forward to. */
+{
+    int prefixLen;
+    register ForwardMethod *fmPtr;
+
+    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+	return NULL;
+    }
+    if (prefixLen < 1) {
+	Tcl_AppendResult(interp, "method forward prefix must be non-empty",
+		NULL);
+	return NULL;
+    }
+
+    fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
+    fmPtr->prefixObj = prefixObj;
+    Tcl_IncrRefCount(prefixObj);
+    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
+	    flags, &fwdMethodType, fmPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InvokeForwardMethod --
+ *
+ *	How to invoke a forwarded method. Works by doing some ensemble-like
+ *	command rearranging and then invokes some other Tcl command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InvokeForwardMethod(
+    ClientData clientData,	/* Pointer to some per-method context. */
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,	/* The method calling context. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
+{
+    CallContext *contextPtr = (CallContext *) context;
+    ForwardMethod *fmPtr = clientData;
+    Tcl_Obj **argObjs, **prefixObjs;
+    int numPrefixes, result, len, skip = contextPtr->skip;
+
+    /*
+     * Build the real list of arguments to use. Note that we know that the
+     * prefixObj field of the ForwardMethod structure holds a reference to a
+     * non-empty list, so there's a whole class of failures ("not a list") we
+     * can ignore here.
+     */
+
+    Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
+    argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
+	    numPrefixes, prefixObjs, &len);
+
+    result = Tcl_EvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE);
+    TclStackFree(interp, argObjs);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteForwardMethod, CloneForwardMethod --
+ *
+ *	How to delete and clone forwarded methods.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteForwardMethod(
+    ClientData clientData)
+{
+    ForwardMethod *fmPtr = clientData;
+
+    Tcl_DecrRefCount(fmPtr->prefixObj);
+    ckfree((char *) fmPtr);
+}
+
+static int
+CloneForwardMethod(
+    Tcl_Interp *interp,
+    ClientData clientData,
+    ClientData *newClientData)
+{
+    ForwardMethod *fmPtr = clientData;
+    ForwardMethod *fm2Ptr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
+
+    fm2Ptr->prefixObj = fmPtr->prefixObj;
+    Tcl_IncrRefCount(fm2Ptr->prefixObj);
+    *newClientData = fm2Ptr;
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetProcFromMethod, TclOOGetFwdFromMethod --
+ *
+ *	Utility functions used for procedure-like and forwarding method
+ *	introspection.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Proc *
+TclOOGetProcFromMethod(
+    Method *mPtr)
+{
+    if (mPtr->typePtr == &procMethodType) {
+	ProcedureMethod *pmPtr = mPtr->clientData;
+
+	return pmPtr->procPtr;
+    }
+    return NULL;
+}
+
+Tcl_Obj *
+TclOOGetFwdFromMethod(
+    Method *mPtr)
+{
+    if (mPtr->typePtr == &fwdMethodType) {
+	ForwardMethod *fwPtr = mPtr->clientData;
+
+	return fwPtr->prefixObj;
+    }
+    return NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitEnsembleRewrite --
+ *
+ *	Utility function that wraps up a lot of the complexity involved in
+ *	doing ensemble-like command forwarding. Here is a picture of memory
+ *	management plan:
+ *
+ *                    <-----------------objc---------------------->
+ *      objv:        |=============|===============================|
+ *                    <-toRewrite->           |
+ *                                             \
+ *                    <-rewriteLength->         \
+ *      rewriteObjs: |=================|         \
+ *                           |                    |
+ *                           V                    V
+ *      argObjs:     |=================|===============================|
+ *                    <------------------*lengthPtr------------------->
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj **
+InitEnsembleRewrite(
+    Tcl_Interp *interp,		/* Place to log the rewrite info. */
+    int objc,			/* Number of real arguments. */
+    Tcl_Obj *const *objv,	/* The real arguments. */
+    int toRewrite,		/* Number of real arguments to replace. */
+    int rewriteLength,		/* Number of arguments to insert instead. */
+    Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
+    int *lengthPtr)		/* Where to write the resulting length of the
+				 * array of rewritten arguments. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+    Tcl_Obj **argObjs;
+    unsigned len = rewriteLength + objc - toRewrite;
+
+    argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
+    memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
+    memcpy(argObjs + rewriteLength, objv + toRewrite,
+	    sizeof(Tcl_Obj *) * (objc - toRewrite));
+
+    /*
+     * Now plumb this into the core ensemble rewrite logging system so that
+     * Tcl_WrongNumArgs() can rewrite its result appropriately. The rules for
+     * how to store the rewrite rules get complex solely because of the case
+     * where an ensemble rewrites itself out of the picture; when that
+     * happens, the quality of the error message rewrite falls drastically
+     * (and unavoidably).
+     */
+
+    if (isRootEnsemble) {
+	iPtr->ensembleRewrite.sourceObjs = objv;
+	iPtr->ensembleRewrite.numRemovedObjs = toRewrite;
+	iPtr->ensembleRewrite.numInsertedObjs = rewriteLength;
+    } else {
+	int numIns = iPtr->ensembleRewrite.numInsertedObjs;
+
+	if (numIns < toRewrite) {
+	    iPtr->ensembleRewrite.numRemovedObjs += toRewrite - numIns;
+	    iPtr->ensembleRewrite.numInsertedObjs += rewriteLength - 1;
+	} else {
+	    iPtr->ensembleRewrite.numInsertedObjs +=
+		    rewriteLength - toRewrite;
+	}
+    }
+
+    *lengthPtr = len;
+    return argObjs;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * assorted trivial 'getter' functions
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Object
+Tcl_MethodDeclarerObject(
+    Tcl_Method method)
+{
+    return (Tcl_Object) ((Method *) method)->declaringObjectPtr;
+}
+
+Tcl_Class
+Tcl_MethodDeclarerClass(
+    Tcl_Method method)
+{
+    return (Tcl_Class) ((Method *) method)->declaringClassPtr;
+}
+
+Tcl_Obj *
+Tcl_MethodName(
+    Tcl_Method method)
+{
+    return ((Method *) method)->namePtr;
+}
+
+int
+Tcl_MethodIsType(
+    Tcl_Method method,
+    const Tcl_MethodType *typePtr,
+    ClientData *clientDataPtr)
+{
+    Method *mPtr = (Method *) method;
+
+    if (mPtr->typePtr == typePtr) {
+	if (clientDataPtr != NULL) {
+	    *clientDataPtr = mPtr->clientData;
+	}
+	return 1;
+    }
+    return 0;
+}
+
+int
+Tcl_MethodIsPublic(
+    Tcl_Method method)
+{
+    return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
+}
+
+/*
+ * Extended method construction for itcl-ng.
+ */
+
+Tcl_Method
+TclOONewProcInstanceMethodEx(
+    Tcl_Interp *interp,		/* The interpreter containing the object. */
+    Tcl_Object oPtr,		/* The object to modify. */
+    TclOO_PreCallProc preCallPtr,
+    TclOO_PostCallProc postCallPtr,
+    ProcErrorProc errProc,
+    ClientData clientData,
+    Tcl_Obj *nameObj,		/* The name of the method, which must not be
+				 * NULL. */
+    Tcl_Obj *argsObj,		/* The formal argument list for the method,
+				 * which must not be NULL. */
+    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
+				 * NULL. */
+    int flags,			/* Whether this is a public method. */
+    void **internalTokenPtr)	/* If non-NULL, points to a variable that gets
+				 * the reference to the ProcedureMethod
+				 * structure. */
+{
+    ProcedureMethod *pmPtr;
+    Tcl_Method method = (Tcl_Method) TclOONewProcInstanceMethod(interp,
+	    (Object *) oPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);
+
+    if (method == NULL) {
+	return NULL;
+    }
+    pmPtr->flags = flags & USE_DECLARER_NS;
+    pmPtr->preCallProc = preCallPtr;
+    pmPtr->postCallProc = postCallPtr;
+    pmPtr->errProc = errProc;
+    pmPtr->clientData = clientData;
+    if (internalTokenPtr != NULL) {
+	*internalTokenPtr = pmPtr;
+    }
+    return method;
+}
+
+Tcl_Method
+TclOONewProcMethodEx(
+    Tcl_Interp *interp,		/* The interpreter containing the class. */
+    Tcl_Class clsPtr,		/* The class to modify. */
+    TclOO_PreCallProc preCallPtr,
+    TclOO_PostCallProc postCallPtr,
+    ProcErrorProc errProc,
+    ClientData clientData,
+    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
+				 * if so, up to caller to manage storage
+				 * (e.g., because it is a constructor or
+				 * destructor). */
+    Tcl_Obj *argsObj,		/* The formal argument list for the method,
+				 * which may be NULL; if so, it is equivalent
+				 * to an empty list. */
+    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
+				 * NULL. */
+    int flags,			/* Whether this is a public method. */
+    void **internalTokenPtr)	/* If non-NULL, points to a variable that gets
+				 * the reference to the ProcedureMethod
+				 * structure. */
+{
+    ProcedureMethod *pmPtr;
+    Tcl_Method method = (Tcl_Method) TclOONewProcMethod(interp,
+	    (Class *) clsPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);
+
+    if (method == NULL) {
+	return NULL;
+    }
+    pmPtr->flags = flags & USE_DECLARER_NS;
+    pmPtr->preCallProc = preCallPtr;
+    pmPtr->postCallProc = postCallPtr;
+    pmPtr->errProc = errProc;
+    pmPtr->clientData = clientData;
+    if (internalTokenPtr != NULL) {
+	*internalTokenPtr = pmPtr;
+    }
+    return method;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
new file mode 100644
index 0000000..b49dc12
--- /dev/null
+++ b/generic/tclOOStubInit.c
@@ -0,0 +1,79 @@
+/*
+ * $Id: tclOOStubInit.c,v 1.1 2008/05/31 11:42:19 dkf Exp $
+ *
+ * This file is (mostly) automatically generated from tclOO.decls.
+ * It is compiled and linked in with the tclOO package proper.
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tclOO.h"
+#include "tclOOInt.h"
+
+/* !BEGIN!: Do not edit below this line. */
+
+TclOOStubs tclOOStubs = {
+    TCL_STUB_MAGIC,
+    TCLOO_STUBS_EPOCH,
+    TCLOO_STUBS_REVISION,
+    0,
+    Tcl_CopyObjectInstance, /* 0 */
+    Tcl_GetClassAsObject, /* 1 */
+    Tcl_GetObjectAsClass, /* 2 */
+    Tcl_GetObjectCommand, /* 3 */
+    Tcl_GetObjectFromObj, /* 4 */
+    Tcl_GetObjectNamespace, /* 5 */
+    Tcl_MethodDeclarerClass, /* 6 */
+    Tcl_MethodDeclarerObject, /* 7 */
+    Tcl_MethodIsPublic, /* 8 */
+    Tcl_MethodIsType, /* 9 */
+    Tcl_MethodName, /* 10 */
+    Tcl_NewInstanceMethod, /* 11 */
+    Tcl_NewMethod, /* 12 */
+    Tcl_NewObjectInstance, /* 13 */
+    Tcl_ObjectDeleted, /* 14 */
+    Tcl_ObjectContextIsFiltering, /* 15 */
+    Tcl_ObjectContextMethod, /* 16 */
+    Tcl_ObjectContextObject, /* 17 */
+    Tcl_ObjectContextSkippedArgs, /* 18 */
+    Tcl_ClassGetMetadata, /* 19 */
+    Tcl_ClassSetMetadata, /* 20 */
+    Tcl_ObjectGetMetadata, /* 21 */
+    Tcl_ObjectSetMetadata, /* 22 */
+    Tcl_ObjectContextInvokeNext, /* 23 */
+    Tcl_ObjectGetMethodNameMapper, /* 24 */
+    Tcl_ObjectSetMethodNameMapper, /* 25 */
+    Tcl_ClassSetConstructor, /* 26 */
+    Tcl_ClassSetDestructor, /* 27 */
+};
+
+TclOOIntStubs tclOOIntStubs = {
+    TCL_STUB_MAGIC,
+    TCLOOINT_STUBS_EPOCH,
+    TCLOOINT_STUBS_REVISION,
+    0,
+    TclOOGetDefineCmdContext, /* 0 */
+    TclOOMakeProcInstanceMethod, /* 1 */
+    TclOOMakeProcMethod, /* 2 */
+    TclOONewProcInstanceMethod, /* 3 */
+    TclOONewProcMethod, /* 4 */
+    TclOOObjectCmdCore, /* 5 */
+    TclOOIsReachable, /* 6 */
+    TclOONewForwardMethod, /* 7 */
+    TclOONewForwardInstanceMethod, /* 8 */
+    TclOONewProcInstanceMethodEx, /* 9 */
+    TclOONewProcMethodEx, /* 10 */
+    TclOOInvokeObject, /* 11 */
+    TclOOObjectSetFilters, /* 12 */
+    TclOOClassSetFilters, /* 13 */
+    TclOOObjectSetMixins, /* 14 */
+    TclOOClassSetMixins, /* 15 */
+};
+
+/* !END!: Do not edit above this line. */
+
+struct TclOOStubAPI tclOOStubAPI = {
+    &tclOOStubs,
+    &tclOOIntStubs
+};
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
new file mode 100644
index 0000000..6988638
--- /dev/null
+++ b/generic/tclOOStubLib.c
@@ -0,0 +1,82 @@
+/*
+ * $Id: tclOOStubLib.c,v 1.1 2008/05/31 11:42:19 dkf Exp $
+ * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
+ */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+#include "tcl.h"
+
+#define USE_TCLOO_STUBS 1
+#include "tclOO.h"
+#include "tclOOInt.h"
+
+const TclOOStubs *tclOOStubsPtr;
+const TclOOIntStubs *tclOOIntStubsPtr;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOOInitializeStubs --
+ *	Load the tclOO package, initialize stub table pointer. Do not call
+ *	this function directly, use Tcl_OOInitStubs() macro instead.
+ *
+ * Results:
+ *	The actual version of the package that satisfies the request, or NULL
+ *	to indicate that an error occurred.
+ *
+ * Side effects:
+ *	Sets the stub table pointer.
+ *
+ */
+
+const char *TclOOInitializeStubs(
+    Tcl_Interp *interp, const char *version, int epoch, int revision)
+{
+    int exact = 0;
+    const char *packageName = "TclOO";
+    const char *errMsg = NULL;
+    ClientData clientData = NULL;
+    const char *actualVersion =
+	    Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData);
+    struct TclOOStubAPI *stubsAPIPtr = clientData;
+
+    if (stubsAPIPtr == NULL) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "Error loading ", packageName, " package; ",
+		"package not present or incomplete", NULL);
+	return NULL;
+    } else {
+	TclOOStubs *stubsPtr = stubsAPIPtr->stubsPtr;
+	TclOOIntStubs *intStubsPtr = stubsAPIPtr->intStubsPtr;
+
+	if (!actualVersion) {
+	    return NULL;
+	}
+
+	if (!stubsPtr || !intStubsPtr) {
+	    errMsg = "missing stub table pointer";
+	    goto error;
+	}
+	if (stubsPtr->epoch != epoch || intStubsPtr->epoch != epoch) {
+	    errMsg = "epoch number mismatch";
+	    goto error;
+	}
+	if (stubsPtr->revision<revision || intStubsPtr->revision<revision) {
+	    errMsg = "require later revision";
+	    goto error;
+	}
+
+	tclOOStubsPtr = stubsPtr;
+	tclOOIntStubsPtr = intStubsPtr;
+	return actualVersion;
+
+    error:
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "Error loading ", packageName, " package",
+		" (requested version '", version, "', loaded version '",
+		actualVersion, "'): ", errMsg, NULL);
+	return NULL;
+    }
+}
diff --git a/tests/info.test b/tests/info.test
index a6fa48d..b6b708c 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.47 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.48 2008/05/31 11:42:20 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -675,16 +675,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
 } -result {wrong # args: should be "info subcommand ?argument ...?"}
 test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
     info gorp
-} -result {unknown or ambiguous subcommand "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
     info c
-} -result {unknown or ambiguous subcommand "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
     info l
-} -result {unknown or ambiguous subcommand "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
     info s
-} -result {unknown or ambiguous subcommand "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 
 ##
 # ### ### ### ######### ######### #########
diff --git a/tests/interp.test b/tests/interp.test
index 76d642b..2bbd7a3 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: interp.test,v 1.54 2008/03/02 19:12:41 msofer Exp $
+# RCS: @(#) $Id: interp.test,v 1.55 2008/05/31 11:42:20 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -2360,22 +2360,23 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
     set r
 } {}
 
-test interp-28.2 {master's nsName cache should not cross} {
+test interp-28.2 {master's nsName cache should not cross} -setup {
     set i [interp create]
-    set res [$i eval {
+} -body {
+    $i eval {
 	set x {namespace children ::}
 	set y [list namespace children ::]
-	namespace delete [{*}$y]
+	namespace delete {*}[{*}$y]
 	set j [interp create]
 	$j eval {namespace delete {*}[namespace children ::]}
 	namespace eval foo {}
 	set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]]
 	interp delete $j
 	set res
-    }]
+    }
+} -cleanup {
     interp delete $i
-    set res
-} {::foo ::foo {} {}}
+} -result {::foo ::foo {} {}}
 
 # Part 29: recursion limit
 #  29.1.*  Argument checking
diff --git a/tests/oo.test b/tests/oo.test
new file mode 100644
index 0000000..087e786
--- /dev/null
+++ b/tests/oo.test
@@ -0,0 +1,1769 @@
+# This file contains a collection of tests for Tcl's built-in object system.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2006-2008 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: oo.test,v 1.4 2008/05/31 11:42:20 dkf Exp $
+
+package require TclOO 0.4 ;# Must match value in configure.in
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
+proc initInterpreter name {
+    $name eval [list package ifneeded TclOO [package provide TclOO] \
+		    [package ifneeded TclOO [package provide TclOO]]]
+}
+
+test oo-0.1 {basic test of OO's ability to clean up its initial state} {
+    interp create t
+    initInterpreter t
+    t eval {
+	package require TclOO
+    }
+    interp delete t
+} {}
+test oo-0.2 {basic test of OO's ability to clean up its initial state} {
+    set i [interp create]
+    initInterpreter $i
+    interp eval $i {
+	package require TclOO
+	namespace delete ::
+    }
+} {}
+test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
+    leaktest {
+	[oo::object new] destroy
+    }
+} -constraints memory -result 0
+test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
+    leaktest {
+	oo::class create foo
+	foo new
+	foo destroy
+    }
+} -constraints memory -result 0
+
+test oo-1.1 {basic test of OO functionality: no classes} {
+    set result {}
+    lappend result [oo::object create foo]
+    lappend result [oo::objdefine foo {
+	method bar args {
+	    global result
+	    lappend result {*}$args
+	    return [llength $args]
+	}
+    }]
+    lappend result [foo bar a b c]
+    lappend result [foo destroy] [info commands foo]
+} {::foo {} a b c 3 {} {}}
+test oo-1.2 {basic test of OO functionality: no classes} -body {
+    oo::define oo::object method missingArgs
+} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name args body\""
+test oo-1.3 {basic test of OO functionality: no classes} {
+    catch {oo::define oo::object method missingArgs}
+    set errorInfo
+} "wrong # args: should be \"oo::define oo::object method name args body\"
+    while executing
+\"oo::define oo::object method missingArgs\""
+test oo-1.4 {basic test of OO functionality} -body {
+    oo::object create {}
+} -returnCodes 1 -result {object name must not be empty}
+test oo-1.5 {basic test of OO functionality} -body {
+    oo::object doesnotexist
+} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
+test oo-1.6 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -body {
+    oo::objdefine aninstance unexport destroy
+    aninstance doesnotexist
+} -cleanup {
+    rename aninstance {}
+} -returnCodes 1 -result {object "::aninstance" has no visible methods}
+test oo-1.7 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -body {
+    oo::objdefine aninstance {
+	# Do not do this in real code! Ever! This is *not* supported!
+	::oo::define::method ha ha ha
+    }
+} -returnCodes error -cleanup {
+    aninstance destroy
+} -result {attempt to misuse API}
+test oo-1.8 {basic test of OO functionality} -setup {
+    oo::object create obj
+    set result {}
+} -cleanup {
+    obj destroy
+} -body {
+    oo::objdefine obj method foo {} {return bar}
+    lappend result [obj foo]
+    oo::objdefine obj method foo {} {}
+    lappend result [obj foo]
+} -result {bar {}}
+test oo-1.9 {basic test of OO functionality} -setup {
+    oo::object create a
+    oo::object create b
+} -cleanup {
+    catch {a destroy}
+    b destroy
+} -body {
+    oo::objdefine a method foo {} { return A }
+    oo::objdefine b method foo {} { return B }
+    apply {{} {
+	set m foo
+	return [a $m],[a destroy],[b $m]
+    }}
+} -result A,,B
+test oo-1.10 {basic test of OO functionality} -body {
+    namespace eval foo {
+	namespace eval bar {
+	    oo::object create o
+	    namespace export o
+	}
+	namespace import bar::o
+    }
+    list [info object isa object foo::bar::o] [info object isa object foo::o]
+} -cleanup {
+    namespace delete foo
+} -result {1 1}
+test oo-1.11 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c super oo::class
+    info class super c
+} -result ::oo::class
+test oo-1.12 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c {super oo::class}
+    info class super c
+} -result ::oo::class
+test oo-1.13 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c self {forw a b}
+    info object forw c a
+} -result b
+test oo-1.14 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c self forw a b
+    info object forw c a
+} -result b
+test oo-1.15 {basic test of OO functionality: abbreviating} -setup {
+    oo::object create o
+} -cleanup {
+    o destroy
+} -body {
+    oo::objdefine o {forw a b}
+    info object forw o a
+} -result b
+test oo-1.16 {basic test of OO functionality: abbreviating} -setup {
+    oo::object create o
+} -cleanup {
+    o destroy
+} -body {
+    oo::objdefine o forw a b
+    info object forw o a
+} -result b
+
+test oo-2.1 {basic test of OO functionality: constructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    initInterpreter subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object constructor {} {
+	    lappend ::result [info level 0]
+	}
+	lappend result 1
+	lappend result 2 [oo::object create foo]
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 {oo::object create foo} 2 ::foo}
+test oo-2.2 {basic test of OO functionality: constructor} {
+    oo::class create testClass {
+	constructor {} {
+	    global result
+	    lappend result "[self]->construct"
+	}
+	method bar {} {
+	    global result
+	    lappend result "[self]->bar"
+	}
+    }
+    set result {}
+    [testClass create foo] bar
+    testClass destroy
+    return $result
+} {::foo->construct ::foo->bar}
+
+test oo-3.1 {basic test of OO functionality: destructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    initInterpreter subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object destructor {
+	    lappend ::result died
+	}
+	lappend result 1 [oo::object create foo]
+	lappend result 2 [rename foo {}]
+	oo::define oo::object destructor {}
+	return $result
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 ::foo died 2 {}}
+test oo-3.2 {basic test of OO functionality: destructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    initInterpreter subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object destructor {
+	    lappend ::result died
+	}
+	lappend result 1 [oo::object create foo]
+	lappend result 2 [rename foo {}]
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 ::foo died 2 {}}
+
+test oo-4.1 {basic test of OO functionality: export} {
+    set o [oo::object new]
+    set result {}
+    oo::objdefine $o method Foo {} {lappend ::result Foo; return}
+    lappend result [catch {$o Foo} msg] $msg
+    oo::objdefine $o export Foo
+    lappend result [$o Foo] [$o destroy]
+} {1 {unknown method "Foo": must be destroy} Foo {} {}}
+test oo-4.2 {basic test of OO functionality: unexport} {
+    set o [oo::object new]
+    set result {}
+    oo::objdefine $o method foo {} {lappend ::result foo; return}
+    lappend result [$o foo]
+    oo::objdefine $o unexport foo
+    lappend result [catch {$o foo} msg] $msg [$o destroy]
+} {foo {} 1 {unknown method "foo": must be destroy} {}}
+test oo-4.3 {exporting and error messages, Bug 1824958} -setup {
+    oo::class create testClass
+} -cleanup {
+    testClass destroy
+} -body {
+    oo::define testClass self export Bad
+    testClass Bad
+} -returnCodes 1 -result {unknown method "Bad": must be create, destroy or new}
+test oo-4.4 {exporting a class method from an object} -setup {
+    oo::class create testClass
+    testClass create testObject
+} -cleanup {
+    testClass destroy
+} -body {
+    oo::define testClass method Good {} { return ok }
+    oo::objdefine testObject export Good
+    testObject Good
+} -result ok
+
+test oo-5.1 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::objdefine oo::object method foo {} { return "in object" }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.2 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object self method foo {} { return "in object" }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.3 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::objdefine oo::object {
+	method foo {} { return "in object" }
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.4 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object {
+	self method foo {} { return "in object" }
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.5 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object {
+	self {
+	    method foo {} { return "in object" }
+	}
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+
+test oo-6.1 {OO: forward} {
+    oo::object create foo
+    oo::objdefine foo {
+	forward a lappend
+	forward b lappend result
+    }
+    set result {}
+    foo a result 1
+    foo b 2
+    foo destroy
+    return $result
+} {1 2}
+
+test oo-7.1 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {lappend ::result $x}
+    oo::define subClass superclass superClass
+    set result [list [catch {subClass doit bad} msg] $msg]
+    instance doit ok
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {1 {unknown method "doit": must be create, destroy or new} ok}
+test oo-7.2 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {
+	lappend ::result |$x|
+    }
+    oo::define subClass superclass superClass
+    oo::objdefine instance method doit x {
+	lappend ::result =$x=
+	next [incr x]
+    }
+    set result {}
+    instance doit 1
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {=1= |2|}
+test oo-7.3 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {
+	lappend ::result |$x|
+    }
+    oo::define subClass {
+	superclass superClass
+	method doit x {lappend ::result -$x-; next [incr x]}
+    }
+    oo::objdefine instance method doit x {
+	lappend ::result =$x=;
+	next [incr x]
+    }
+    set result {}
+    instance doit 1
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {=1= -2- |3|}
+test oo-7.4 {OO: inheritance from oo::class} -body {
+    oo::class create meta {
+	superclass oo::class
+	self {
+	    unexport create new
+	    method make {x {definitions {}}} {
+		if {![string match ::* $x]} {
+		    set ns [uplevel 1 {::namespace current}]
+		    set x ${ns}::$x
+		}
+		set o [my create $x]
+		lappend ::result "made $o"
+		oo::define $o $definitions
+		return $o
+	    }
+	}
+    }
+    set result [list [catch {meta create foo} msg] $msg]
+    lappend result [meta make classinstance {
+	lappend ::result "in definition script in [namespace current]"
+    }]
+    lappend result [classinstance create instance]
+} -cleanup {
+    catch {classinstance destroy}
+    catch {meta destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body {
+    oo::class create other
+    oo::class create meta {
+	superclass other oo::class
+	self {
+	    unexport create new
+	    method make {x {definitions {}}} {
+		if {![string match ::* $x]} {
+		    set ns [uplevel 1 {::namespace current}]
+		    set x ${ns}::$x
+		}
+		set o [my create $x]
+		lappend ::result "made $o"
+		oo::define $o $definitions
+		return $o
+	    }
+	}
+    }
+    set result [list [catch {meta create foo} msg] $msg]
+    lappend result [meta make classinstance {
+	lappend ::result "in definition script in [namespace current]"
+    }]
+    lappend result [classinstance create instance]
+} -cleanup {
+    catch {classinstance destroy}
+    catch {meta destroy}
+    catch {other destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup {
+    oo::class create Aclass
+    oo::class create Bclass
+    Bclass create Binstance
+} -body {
+    oo::define Aclass {
+	method incr {var step} {
+	    upvar 1 $var v
+	    ::incr v $step
+	}
+    }
+    oo::define Bclass {
+	superclass Aclass
+	method incr {var {step 1}} {
+	    global result
+	    lappend result $var $step
+	    set r [next $var $step]
+	    lappend result returning:$r
+	    return $r
+	}
+    }
+    set result {}
+    set x 10
+    lappend result x=$x
+    lappend result [Binstance incr x]
+    lappend result x=$x
+} -result {x=10 x 1 returning:11 11 x=11} -cleanup {
+    Aclass destroy
+}
+test oo-7.7 {OO: inheritance and errorInfo} -setup {
+    oo::class create A
+    oo::class create B
+    B create c
+} -body {
+    oo::define A method foo {} {error foo!}
+    oo::define B {
+	superclass A
+	method foo {} { next }
+    }
+    oo::objdefine c method foo {} { next }
+    catch {c ?} msg
+    set result [list $msg]
+    catch {c foo} msg
+    lappend result $msg $errorInfo
+} -cleanup {
+    A destroy
+} -result {{unknown method "?": must be destroy or foo} foo! {foo!
+    while executing
+"error foo!"
+    (class "::A" method "foo" line 1)
+    invoked from within
+"next "
+    (class "::B" method "foo" line 1)
+    invoked from within
+"next "
+    (object "::c" method "foo" line 1)
+    invoked from within
+"c foo"}}
+test oo-7.8 {OO: next at the end of the method chain} {
+    oo::class create foo {
+	method bar {} {lappend ::result [next] foo}
+    }
+    oo::class create foo2 {
+	superclass foo
+	method bar {} {lappend ::result [next] foo2}
+    }
+    set o [foo2 new]
+    set ::result ""
+    catch {$o bar}
+    foo destroy
+    return $result
+} {{} foo {{} foo} foo2}
+
+test oo-8.1 {OO: global must work in methods} {
+    oo::object create foo
+    oo::objdefine foo method bar x {global result; lappend result $x}
+    set result {}
+    foo bar this
+    foo bar is
+    lappend result a
+    foo bar test
+    foo destroy
+    return $result
+} {this is a test}
+
+test oo-9.1 {OO: multiple inheritance} -setup {
+    oo::class create A
+    oo::class create B
+    oo::class create C
+    oo::class create D
+    D create foo
+} -body {
+    oo::define A method test {} {lappend ::result A; return ok}
+    oo::define B {
+	superclass A
+	method test {} {lappend ::result B; next}
+    }
+    oo::define C {
+	superclass A
+	method test {} {lappend ::result C; next}
+    }
+    oo::define D {
+	superclass B C
+	method test {} {lappend ::result D; next}
+    }
+    set result {}
+    lappend result [foo test]
+} -cleanup {
+    D destroy
+    C destroy
+    B destroy
+    A destroy
+} -result {D B C A ok}
+test oo-9.2 {OO: multiple inheritance} -setup {
+    oo::class create A
+    oo::class create B
+    oo::class create C
+    oo::class create D
+    D create foo
+} -body {
+    oo::define A method test {} {lappend ::result A; return ok}
+    oo::define B {
+	superclass A
+	method test {} {lappend ::result B; next}
+    }
+    oo::define C {
+	superclass A
+	method test {} {lappend ::result C; next}
+    }
+    oo::define D {
+	superclass B C
+	method test {} {lappend ::result D; next}
+    }
+    set result {}
+    lappend result [foo test]
+} -cleanup {
+    A destroy
+} -result {D B C A ok}
+
+test oo-10.1 {OO: recursive invoke and modify} -setup {
+    [oo::class create C] create O
+} -cleanup {
+    C destroy
+} -body {
+    oo::define C method foo x {
+	lappend ::result $x
+	if {$x} {
+	    [self object] foo [incr x -1]
+	}
+    }
+    oo::objdefine O method foo x {
+	lappend ::result -$x-
+	if {$x == 1} {
+	    oo::objdefine O deletemethod foo
+	}
+	next $x
+    }
+    set result {}
+    O foo 2
+    return $result
+} -result {-2- 2 -1- 1 0}
+test oo-10.2 {OO: recursive invoke and modify} -setup {
+    oo::object create O
+} -cleanup {
+    O destroy
+} -body {
+    oo::objdefine O method foo {} {
+	oo::objdefine [self] method foo {} {
+	    error "not called"
+	}
+	return [format %s%s call ed]
+    }
+    O foo
+} -result called
+test oo-10.3 {OO: invoke and modify} -setup {
+    oo::class create A {
+	method a {} {return A.a}
+	method b {} {return A.b}
+	method c {} {return A.c}
+    }
+    oo::class create B {
+	superclass A
+	method a {} {return [next],B.a}
+	method b {} {return [next],B.b}
+	method c {} {return [next],B.c}
+    }
+    B create C
+    set result {}
+} -cleanup {
+    A destroy
+} -body {
+    lappend result [C a] [C b] [C c] -
+    oo::define B deletemethod b
+    lappend result [C a] [C b] [C c] -
+    oo::define B renamemethod a b
+    lappend result [C a] [C b] [C c] -
+    oo::define B deletemethod b c
+    lappend result [C a] [C b] [C c]
+} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
+
+test oo-11.1 {OO: cleanup} {
+    oo::object create foo
+    set result [list [catch {oo::object create foo} msg] $msg]
+    lappend result [foo destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.2 {OO: cleanup} {
+    oo::class create bar
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.3 {OO: cleanup} {
+    oo::class create bar0
+    oo::class create bar
+    oo::define bar superclass bar0
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar0 destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.4 {OO: cleanup} {
+    oo::class create bar0
+    oo::class create bar1
+    oo::define bar1 superclass bar0
+    oo::class create bar2
+    oo::define bar2 {
+	superclass bar0
+	destructor {lappend ::result destroyed}
+    }
+    oo::class create bar
+    oo::define bar superclass bar1 bar2
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
+	[oo::object create bar2] [bar2 destroy]
+} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
+
+test oo-12.1 {OO: filters} {
+    oo::class create Aclass
+    Aclass create Aobject
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+    }
+    oo::objdefine Aobject filter logFilter
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5]
+    Aclass destroy
+    return $result
+} {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345}
+test oo-12.2 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+    }
+    oo::objdefine Aobject filter logFilter
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+    Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.3 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+	filter logFilter
+    }
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+    Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.4 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.5 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.6 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return [my Bar3] }
+	method Bar3 {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.7 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method outerfoo {} { return [my InnerFoo] }
+	method InnerFoo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return [my Bar3] }
+	method Bar3 {} { return 1 }
+	method boo {} {
+	    lappend ::log [self target]
+	    if {[my Bar]} { next } else { error forbidden }
+	}
+	filter boo
+    }
+    set log {}
+    list [Aobject outerfoo] $log
+} -cleanup {
+    Aclass destroy
+} -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}}
+
+test oo-13.1 {OO: changing an object's class} {
+    oo::class create Aclass
+    oo::define Aclass {method bar {} {lappend ::result "in A [self object]"}}
+    oo::class create Bclass
+    oo::define Bclass {method bar {} {lappend ::result "in B [self object]"}}
+    set result [Aclass create foo]
+    foo bar
+    oo::objdefine foo class Bclass
+    foo bar
+    Aclass destroy
+    lappend result [info command foo]
+    Bclass destroy
+    return $result
+} {::foo {in A ::foo} {in B ::foo} foo}
+test oo-13.2 {OO: changing an object's class} -body {
+    oo::object create foo
+    oo::objdefine foo class oo::class
+} -cleanup {
+    foo destroy
+} -returnCodes 1 -result {may not change a non-class object into a class object}
+test oo-13.3 {OO: changing an object's class} -body {
+    oo::class create foo
+    oo::objdefine foo class oo::object
+} -cleanup {
+    foo destroy
+} -returnCodes 1 -result {may not change a class object into a non-class object}
+# todo: changing a class subtype (metaclass) to another class subtype
+
+test oo-14.1 {OO: mixins} {
+    oo::class create Aclass
+    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
+    oo::class create Bclass
+    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
+    oo::objdefine [Aclass create fooTest] mixin Bclass
+    oo::objdefine [Aclass create fooTest2] mixin Bclass
+    set result [list [catch {fooTest ?} msg] $msg]
+    fooTest bar
+    fooTest boo
+    fooTest2 bar
+    fooTest2 boo
+    oo::objdefine fooTest2 mixin
+    lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy]
+} {1 {unknown method "?": must be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}}
+test oo-14.2 {OO: mixins} {
+    oo::class create Aclass {
+	method bar {} {return "[self object] in bar"}
+    }
+    oo::class create Bclass {
+	method boo {} {return "[self object] in boo"}
+    }
+    oo::define Aclass mixin Bclass
+    Aclass create fooTest
+    set result [list [catch {fooTest ?} msg] $msg]
+    lappend result [catch {fooTest bar} msg] $msg
+    lappend result [catch {fooTest boo} msg] $msg
+    lappend result [Bclass destroy] [info commands Aclass]
+} {1 {unknown method "?": must be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}}
+test oo-14.3 {OO and mixins and filters - advanced case} -setup {
+    oo::class create mix
+    oo::class create c {
+	mixin mix
+    }
+    c create i
+} -body {
+    oo::define mix {
+	method foo {} {return >>[next]<<}
+	filter foo
+    }
+    oo::objdefine i method bar {} {return foobar}
+    i bar
+} -cleanup {
+    mix destroy
+    if {[info object isa object i]} {
+	error "mixin deletion failed to destroy dependent instance"
+    }
+} -result >>foobar<<
+test oo-14.4 {OO: mixin error case} -setup {
+    oo::class create c
+} -body {
+    oo::define c mixin c
+} -returnCodes error -cleanup {
+    c destroy
+} -result {may not mix a class into itself}
+test oo-14.5 {OO and mixins and filters - advanced case} -setup {
+    oo::class create mix
+    oo::class create c {
+	mixin mix
+    }
+    c create i
+} -body {
+    oo::define mix {
+	method foo {} {return >>[next]<<}
+	filter foo
+    }
+    oo::objdefine i method bar {} {return foobar}
+    i bar
+} -cleanup {
+    c destroy
+    mix destroy
+} -result >>foobar<<
+test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create A {
+	superclass master
+	method egg {} {
+	    return chicken
+	}
+    }
+    oo::class create B {
+	superclass master
+	mixin A
+	method bar {} {
+	    # mixin from A
+	    my egg
+	}
+    }
+    oo::class create C {
+	superclass master
+	mixin B
+	method foo {} {
+	    # mixin from B
+	    my bar
+	}
+    }
+    [C new] foo
+} -result chicken
+test oo-14.7 {OO and filters from mixins of mixins} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create A {
+	superclass master
+	method egg {} {
+	    return chicken
+	}
+	filter f
+	method f args {
+	    set m [lindex [self target] 1]
+	    return "($m) [next {*}$args] ($m)"
+	}
+    }
+    oo::class create B {
+	superclass master
+	mixin A
+	filter f
+	method bar {} {
+	    # mixin from A
+	    my egg
+	}
+    }
+    oo::class create C {
+	superclass master
+	mixin B
+	filter f
+	method foo {} {
+	    # mixin from B
+	    my bar
+	}
+    }
+    [C new] foo
+} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
+
+test oo-15.1 {OO: object cloning} {
+    oo::class create Aclass
+    oo::define Aclass method test {} {lappend ::result [self object]->test}
+    Aclass create Ainstance
+    set result {}
+    Ainstance test
+    oo::copy Ainstance Binstance
+    Binstance test
+    Ainstance test
+    Ainstance destroy
+    namespace eval foo {
+	oo::copy Binstance Cinstance
+	Cinstance test
+    }
+    Aclass destroy
+    namespace delete foo
+    lappend result [info commands Binstance]
+} {::Ainstance->test ::Binstance->test ::Ainstance->test ::foo::Cinstance->test {}}
+test oo-15.2 {OO: object cloning} {
+    oo::object create foo
+    oo::objdefine foo {
+	method m x {lappend ::result [self object] >$x<}
+	forward f ::lappend ::result fwd
+    }
+    set result {}
+    foo m 1
+    foo f 2
+    lappend result [oo::copy foo bar]
+    foo m 3
+    foo f 4
+    bar m 5
+    bar f 6
+    lappend result [foo destroy]
+    bar m 7
+    bar f 8
+    lappend result [bar destroy]
+} {::foo >1< fwd 2 ::bar ::foo >3< fwd 4 ::bar >5< fwd 6 {} ::bar >7< fwd 8 {}}
+catch {foo destroy}
+catch {bar destroy}
+test oo-15.3 {OO: class cloning} {
+    oo::class create foo {
+	method testme {} {lappend ::result [self class]->[self object]}
+    }
+    set result {}
+    foo create baseline
+    baseline testme
+    oo::copy foo bar
+    baseline testme
+    bar create tester
+    tester testme
+    foo destroy
+    tester testme
+    bar destroy
+    return $result
+} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
+
+test oo-16.1 {OO: object introspection} -body {
+    info object
+} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?argument ...?\""
+test oo-16.2 {OO: object introspection} -body {
+    info object class NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-16.3 {OO: object introspection} -body {
+    info object gorp oo::object
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be class, definition, filters, forward, isa, methods, mixins, or vars}
+test oo-16.4 {OO: object introspection} -setup {
+    oo::class create meta { superclass oo::class }
+    [meta create instance1] create instance2
+} -body {
+    list [list [info object class oo::object] \
+	      [info object class oo::class] \
+	      [info object class meta] \
+	      [info object class instance1] \
+	      [info object class instance2]] \
+	[list [info object isa class oo::object] \
+	     [info object isa class meta] \
+	     [info object isa class instance1] \
+	     [info object isa class instance2]] \
+	[list [info object isa metaclass oo::object] \
+	     [info object isa metaclass oo::class] \
+	     [info object isa metaclass meta] \
+	     [info object isa metaclass instance1] \
+	     [info object isa metaclass instance2]] \
+	[list [info object isa object oo::object] \
+	     [info object isa object oo::class] \
+	     [info object isa object meta] \
+	     [info object isa object instance1] \
+	     [info object isa object instance2] \
+	     [info object isa object oo::define] \
+	     [info object isa object NOTANOBJECT]]
+} -cleanup {
+    meta destroy
+} -result {{::oo::class ::oo::class ::oo::class ::meta ::instance1} {1 1 1 0} {0 1 1 0 0} {1 1 1 1 1 0 0}}
+test oo-16.5 {OO: object introspection} {info object methods oo::object} {}
+test oo-16.6 {OO: object introspection} {
+    oo::object create foo
+    set result [list [info object methods foo]]
+    oo::objdefine foo method bar {} {...}
+    lappend result [info object methods foo] [foo destroy]
+} {{} bar {}}
+test oo-16.7 {OO: object introspection} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo method bar {a {b c} args} {the body}
+    set result [info object methods foo]
+    lappend result [info object definition foo bar]
+} -cleanup {
+    foo destroy
+} -result {bar {{a {b c} args} {the body}}}
+test oo-16.8 {OO: object introspection} {
+    oo::object create foo
+    oo::class create bar
+    oo::objdefine foo mixin bar
+    set result [list [info object mixins foo] \
+		    [info object isa mixin foo bar] \
+		    [info object isa mixin foo oo::class]]
+    foo destroy
+    bar destroy
+    return $result
+} {::bar 1 0}
+test oo-16.9 {OO: object introspection} -body {
+    oo::class create Ac
+    oo::class create Bc; oo::define Bc superclass Ac
+    oo::class create Cc; oo::define Cc superclass Bc
+    oo::class create Dc; oo::define Dc mixin Cc
+    Cc create E
+    Dc create F
+    list [info object isa    typeof E oo::class] \
+	    [info object isa typeof E Ac] \
+	    [info object isa typeof F Bc] \
+	    [info object isa typeof F Cc]
+} -cleanup {
+    catch {Ac destroy}
+} -result {0 1 1 1}
+test oo-16.10 {OO: object introspection} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo export eval
+    foo eval {variable c 3 a 1 b 2 ddd 4 e}
+    lsort [info object vars foo ?]
+} -cleanup {
+    foo destroy
+} -result {a b c}
+test oo-16.11 {OO: object introspection} -setup {
+    oo::class create foo
+    foo create bar
+} -body {
+    oo::define foo method spong {} {...}
+    oo::objdefine bar method boo {a {b c} args} {the body}
+    list [info object methods bar -all] [info object methods bar -all -private]
+} -cleanup {
+    foo destroy
+} -result {{boo destroy spong} {boo destroy eval spong unknown variable varname}}
+
+test oo-17.1 {OO: class introspection} -body {
+    info class
+} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?argument ...?\""
+test oo-17.2 {OO: class introspection} -body {
+    info class superclass NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-17.3 {OO: class introspection} -setup {
+    oo::object create foo
+} -body {
+    info class superclass foo
+} -returnCodes 1 -cleanup {
+    foo destroy
+} -result {"foo" is not a class}
+test oo-17.4 {OO: class introspection} -body {
+    info class gorp oo::object
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be constructor, definition, destructor, filters, forward, instances, methods, mixins, subclasses, or superclasses}
+test oo-17.5 {OO: class introspection} -setup {
+    oo::class create testClass
+} -body {
+    testClass create foo
+    testClass create bar
+    testClass create spong
+    lsort [info class instances testClass]
+} -cleanup {
+    testClass destroy
+} -result {::bar ::foo ::spong}
+test oo-17.6 {OO: class introspection} -setup {
+    oo::class create foo
+} -body {
+    oo::define foo method bar {a {b c} args} {the body}
+    set result [info class methods foo]
+    lappend result [info class definition foo bar]
+} -cleanup {
+    foo destroy
+} -result {bar {{a {b c} args} {the body}}}
+test oo-17.7 {OO: class introspection} {
+    info class superclasses oo::class
+} ::oo::object
+test oo-17.8 {OO: class introspection} -setup {
+    oo::class create testClass
+    oo::class create superClass1
+    oo::class create superClass2
+} -body {
+    oo::define testClass superclass superClass1 superClass2
+    list [info class superclasses testClass] \
+	[lsort [info class subclass oo::object ::superClass?]]
+} -cleanup {
+    testClass destroy
+    superClass1 destroy
+    superClass2 destroy
+} -result {{::superClass1 ::superClass2} {::superClass1 ::superClass2}}
+test oo-17.9 {OO: class introspection} -setup {
+    oo::class create foo
+    oo::class create subfoo {superclass foo}
+} -body {
+    oo::define foo {
+	method bar {a {b c} args} {the body}
+	self {
+	    method bad {} {...}
+	}
+    }
+    oo::define subfoo method boo {a {b c} args} {the body}
+    list [info class methods subfoo -all] \
+	[info class methods subfoo -all -private]
+} -cleanup {
+    foo destroy
+} -result {{bar boo destroy} {bar boo destroy eval unknown variable varname}}
+
+test oo-18.1 {OO: define command support} {
+    list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
+} {1 foo {foo
+    while executing
+"error foo"
+    (in definition script for object "oo::object" line 1)
+    invoked from within
+"oo::define oo::object {error foo}"}}
+test oo-18.2 {OO: define command support} {
+    list [catch {oo::define oo::object error foo} msg] $msg $errorInfo
+} {1 foo {foo
+    while executing
+"oo::define oo::object error foo"}}
+test oo-18.3 {OO: define command support} {
+    list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
+} {1 bar {bar
+    while executing
+"error bar"
+    (in definition script for object "::foo" line 1)
+    invoked from within
+"oo::class create foo {error bar}"}}
+test oo-18.4 {OO: more error traces from the guts} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj method bar {} {my eval {error foo}}
+    list [catch {obj bar} msg] $msg $errorInfo
+} -cleanup {
+    obj destroy
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in "my eval" script line 1)
+    invoked from within
+"my eval {error foo}"
+    (object "::obj" method "bar" line 1)
+    invoked from within
+"obj bar"}}
+test oo-18.5 {OO: more error traces from the guts} -setup {
+    [oo::class create cls] create obj
+    set errorInfo {}
+} -body {
+    oo::define cls {
+	method eval script {next $script}
+	export eval
+    }
+    oo::objdefine obj method bar {} {my eval {error foo}}
+    set result {}
+    lappend result [catch {obj bar} msg] $msg $errorInfo
+    lappend result [catch {obj eval {error bar}} msg] $msg $errorInfo
+} -cleanup {
+    cls destroy
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in "my eval" script line 1)
+    invoked from within
+"next $script"
+    (class "::cls" method "eval" line 1)
+    invoked from within
+"my eval {error foo}"
+    (object "::obj" method "bar" line 1)
+    invoked from within
+"obj bar"} 1 bar {bar
+    while executing
+"error bar"
+    (in "::obj eval" script line 1)
+    invoked from within
+"next $script"
+    (class "::cls" method "eval" line 1)
+    invoked from within
+"obj eval {error bar}"}}
+
+test oo-19.1 {OO: varname method} -setup {
+    oo::object create inst
+    oo::objdefine inst export eval
+    set result {}
+} -body {
+    inst eval {trace add variable x write foo}
+    set ns [inst eval namespace current]
+    proc foo args {
+	global ns result
+	set context [uplevel 1 namespace current]
+	lappend result $args [expr {
+	    $ns eq $context ? "ok" : [list $ns ne $context]
+	}] [expr {
+	    "${ns}::x" eq [uplevel 1 my varname x] ? "ok" : [list ${ns}::x ne [uplevel 1 my varname x]]
+	}]
+    }
+    lappend result [inst eval set x 0]
+} -cleanup {
+    inst destroy
+    rename foo {}
+} -result {{x {} write} ok ok 0}
+
+test oo-20.1 {OO: variable method} -body {
+    oo::class create testClass {
+	constructor {} {
+	    my variable ok
+	    set ok {}
+	}
+    }
+    lsort [info object vars [testClass new]]
+} -cleanup {
+    catch {testClass destroy}
+} -result ok
+test oo-20.2 {OO: variable method} -body {
+    oo::class create testClass {
+	constructor {} {
+	    my variable a b c
+	    set a [set b [set c {}]]
+	}
+    }
+    lsort [info object vars [testClass new]]
+} -cleanup {
+    catch {testClass destroy}
+} -result {a b c}
+test oo-20.3 {OO: variable method} -body {
+    oo::class create testClass {
+	export varname
+	method bar {} {
+	    my variable a(b)
+	}
+    }
+    testClass create foo
+    array set [foo varname a] {b c}
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.4 {OO: variable method} -body {
+    oo::class create testClass {
+	export varname
+	method bar {} {
+	    my variable a(b)
+	}
+    }
+    testClass create foo
+    set [foo varname a] b
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.5 {OO: variable method} -body {
+    oo::class create testClass {
+	method bar {} {
+	    my variable a::b
+	}
+    }
+    testClass create foo
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {variable name "a::b" illegal: must not contain namespace separator}
+test oo-20.6 {OO: variable method} -setup {
+    oo::class create testClass {
+	export varname
+	self export eval
+    }
+} -body {
+    testClass eval variable a 0
+    oo::objdefine [testClass create foo] method bar {other} {
+	$other variable a
+	set a 3
+    }
+    oo::objdefine [testClass create boo] export variable
+    set [foo varname a] 1
+    set [boo varname a] 2
+    foo bar boo
+    list [testClass eval set a] [set [foo varname a]] [set [boo varname a]]
+} -cleanup {
+    testClass destroy
+} -result {0 1 3}
+test oo-20.7 {OO: variable method} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {
+	method a {} {
+	    my variable d b
+	    lappend b $d
+	}
+	method e {} {
+	    my variable b d
+	    return [list $b $d]
+	}
+	method f {x y} {
+	    my variable b d
+	    set b $x
+	    set d $y
+	}
+    }
+    cls create obj
+    obj f p q
+    obj a
+    obj a
+    obj e
+} -cleanup {
+    cls destroy
+} -result {{p q q} q}
+# oo-20.8 tested explicitly for functionality removed due to [Bug 1959457]
+test oo-20.9 {OO: variable method} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj {
+	method a {} {
+	    my variable ::b
+	}
+    }
+    obj a
+} -returnCodes 1 -cleanup {
+    obj destroy
+} -result {variable name "::b" illegal: must not contain namespace separator}
+test oo-20.10 {OO: variable and varname methods refer to same things} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj {
+	method a {} {
+	    my variable b
+	    set b [self]
+	    return [my varname b]
+	}
+    }
+    list [set [obj a]] [namespace tail [obj a]]
+} -cleanup {
+    obj destroy
+} -result {::obj b}
+test oo-20.11 {OO: variable mustn't crash when recursing} -body {
+    oo::class create A {
+	constructor {name} {
+	    my variable np_name 
+	    set np_name $name
+	}
+	method copy {nm} {
+	    set cpy [[info object class [self]] new $nm]
+	    foreach var [info object vars [self]] {
+		my variable $var
+		set val [set $var]
+		if {[string match o_* $var]} {
+		    set objs {}
+		    foreach ref $val {
+			# call to "copy" crashes
+			lappend objs [$ref copy {}]
+		    }
+		    $cpy prop $var $objs
+		} else { 
+		    $cpy prop $var $val
+		}
+	    }
+	    return $cpy
+	}
+	method prop {name val} {
+	    my variable $name
+	    set $name $val
+	}
+    }
+    set o1 [A new {}]
+    set o2 [A new {}]
+    $o1 prop o_object $o2
+    $o1 copy aa
+} -cleanup {
+    catch {A destroy}
+} -match glob -result *
+
+test oo-21.1 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    D create o
+    oo::objdefine o method m {} {lappend ::result o;next}
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {o D B C A}
+test oo-21.2 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Fmix Emix o D B C A}
+test oo-21.3 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+	method f {} {lappend ::result B-filt;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+	method f {} {lappend ::result Emix-filt;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+	filter f
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Emix-filt B-filt Fmix Emix o D B C A}
+test oo-21.4 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+	method f {} {lappend ::result B-filt;next}
+	method g {} {lappend ::result B-cfilt;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+	method g {} {lappend ::result D-cfilt;next}
+	filter g
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+	method f {} {lappend ::result Emix-filt;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+	filter f
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A}
+
+test oo-22.1 {OO and info frame} -setup {
+    oo::class create c
+    c create i
+} -body {
+    oo::define c self method frame {} {
+	info frame 0
+    }
+    oo::define c {
+	method frames {} {
+	    info frame 0
+	}
+	method level {} {
+	    info frame
+	}
+    }
+    oo::objdefine i {
+	method frames {} {
+	    list [next] [info frame 0]
+	}
+	method level {} {
+	    expr {[next] - [info frame]}
+	}
+    }
+    list [i level] [i frames] [dict get [c frame] object]
+} -cleanup {
+    c destroy
+} -result {1 {{type proc line 2 cmd {info frame 0} method frames class ::c level 0} {type proc line 2 cmd {info frame 0} method frames object ::i level 0}} ::c}
+
+# Prove that the issue in [Bug 1865054] isn't an issue any more
+test oo-23.1 {Self-like derivation; complex case!} -setup {
+    oo::class create SELF {
+	superclass oo::class
+	unexport create new
+	# Next is just a convenience
+	method method args {oo::define [self] method {*}$args}
+	method derive {name} {
+	    set o [my new [list superclass [self]]]
+	    oo::objdefine $o mixin $o
+	    uplevel 1 [list rename $o $name]\;[list namespace which $name]
+	}
+	self mixin SELF
+    }
+    set result {}
+} -body {
+    [SELF derive foo1] method bar1 {} {return 1}
+    lappend result [foo1 bar1]
+    [foo1 derive foo2] method bar2 {} {return [my bar1],2}
+    lappend result [foo2 bar2]
+    [foo2 derive foo3] method bar3 {} {return [my bar2],3}
+    lappend result [foo3 bar3]
+    [foo3 derive foo4] method bar4 {} {return [my bar3],4}
+    lappend result [foo4 bar4]
+    foo2 method bar2 {} {return [my bar1],x}
+    lappend result [foo4 bar4]
+} -cleanup {
+    SELF destroy
+} -result {1 1,2 1,2,3 1,2,3,4 1,x,3,4}
+
+test oo-24.1 {unknown method method - Bug 1965063} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -returnCodes error -body {
+    oo::define cls {
+	method dummy {} {}
+	method unknown args {next {*}$args}
+    }
+    [cls new] foo bar
+} -result {unknown method "foo": must be destroy, dummy or unknown}
+test oo-24.2 {unknown method method - Bug 1965063} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -returnCodes error -body {
+    oo::define cls {
+	method dummy {} {}
+	method unknown args {next {*}$args}
+    }
+    cls create obj
+    oo::objdefine obj {
+	method dummy2 {} {}
+	method unknown args {next {*}$args}
+    }
+    obj foo bar
+} -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown}
+
+# Probably need a better set of tests, but this is quite difficult to devise
+test oo-25.1 {call chain caching} -setup {
+    oo::class create cls {
+	method ab {} {return ok}
+    }
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    cls create foo
+    cls create bar
+    set m1 ab
+    set m2 a; append m2 b ;# different object!
+    lappend result [foo $m1] [foo $m1] [bar $m1] [foo $m1]
+    lappend result [foo $m2] [bar $m2]
+    oo::objdefine foo method ab {} {return good}
+    lappend result [foo $m1] [bar $m2]
+} -result {ok ok ok ok ok ok good ok}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 12db7c0..25a067c 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -4,7 +4,7 @@
 # "./configure", which is a configuration script generated by the "autoconf"
 # program (constructs like "@foo@" will get replaced in the actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.233 2008/05/23 21:05:13 andreas_kupries Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.234 2008/05/31 11:42:21 dkf Exp $
 
 VERSION 		= @TCL_VERSION@
 MAJOR_VERSION		= @TCL_MAJOR_VERSION@
@@ -294,6 +294,9 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o \
 	tclTomMathInterface.o
 
+OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
+	tclOOMethod.o tclOOStubInit.o
+
 TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
 	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
         bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
@@ -328,13 +331,14 @@ MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
 DTRACE_OBJ = tclDTrace.o
 
 TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
-	@DL_OBJS@ @PLAT_OBJS@
+	${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@
 
 OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@
 
 TCL_DECLS = \
 	$(GENERIC_DIR)/tcl.decls \
 	$(GENERIC_DIR)/tclInt.decls \
+	$(GENERIC_DIR)/tclOO.decls \
 	$(GENERIC_DIR)/tclTomMath.decls
 
 GENERIC_HDRS = \
@@ -345,6 +349,10 @@ GENERIC_HDRS = \
 	$(GENERIC_DIR)/tclIntPlatDecls.h \
 	$(GENERIC_DIR)/tclTomMath.h \
 	$(GENERIC_DIR)/tclTomMathDecls.h \
+	$(GENERIC_DIR)/tclOO.h \
+	$(GENERIC_DIR)/tclOODecls.h \
+	$(GENERIC_DIR)/tclOOInt.h \
+	$(GENERIC_DIR)/tclOOIntDecls.h \
 	$(GENERIC_DIR)/tclPatch.h \
 	$(GENERIC_DIR)/tclPlatDecls.h \
 	$(GENERIC_DIR)/tclPort.h \
@@ -422,6 +430,15 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclUtil.c \
 	$(GENERIC_DIR)/tclVar.c
 
+OO_SRCS = \
+	$(GENERIC_DIR)/tclOO.c \
+	$(GENERIC_DIR)/tclOOBasic.c \
+	$(GENERIC_DIR)/tclOOCall.c \
+	$(GENERIC_DIR)/tclOODefineCmds.c \
+	$(GENERIC_DIR)/tclOOInfo.c \
+	$(GENERIC_DIR)/tclOOMethod.c \
+	$(GENERIC_DIR)/tclOOStubInit.c
+
 STUB_SRCS = \
 	$(GENERIC_DIR)/tclStubLib.c
 
@@ -1104,6 +1121,27 @@ tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
 tclNotify.o: $(GENERIC_DIR)/tclNotify.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
 
+tclOO.o: $(GENERIC_DIR)/tclOO.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c
+
+tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOBasic.c
+
+tclOOCall.o: $(GENERIC_DIR)/tclOOCall.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOCall.c
+
+tclOODefineCmds.o: $(GENERIC_DIR)/tclOODefineCmds.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOODefineCmds.c
+
+tclOOInfo.o: $(GENERIC_DIR)/tclOOInfo.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOInfo.c
+
+tclOOMethod.o: $(GENERIC_DIR)/tclOOMethod.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOMethod.c
+
+tclOOStubInit.o: $(GENERIC_DIR)/tclOOStubInit.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOStubInit.c
+
 tclParse.o: $(GENERIC_DIR)/tclParse.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c
 
@@ -1512,6 +1550,9 @@ waitpid.o: $(COMPAT_DIR)/waitpid.c
 tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
 	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclStubLib.c
 
+tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c
+	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclOOStubLib.c
+
 .c.o:
 	$(CC) -c $(CC_SWITCHES) $<
 
@@ -1525,10 +1566,15 @@ $(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
 	@echo "Developers may want to run \"make genstubs\" to regenerate."
 	@echo "This warning can be safely ignored, do not report as a bug!"
 
+$(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
+	@echo "Warning: tclOOStubInit.c may be out of date."
+	@echo "Developers may want to run \"make genstubs\" to regenerate."
+	@echo "This warning can be safely ignored, do not report as a bug!"
+
 genstubs:
 	$(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
 		$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
-		$(GENERIC_DIR)/tclTomMath.decls
+		$(GENERIC_DIR)/tclTomMath.decls $(GENERIC_DIR)/tclOO.decls
 
 #
 # Target to check that all exported functions have an entry in the stubs
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index 8848a62..527c116 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -31,6 +31,10 @@
 /* Do we have access to Darwin CoreFoundation.framework? */
 #undef HAVE_COREFOUNDATION
 
+/* Define to 1 if you have the declaration of `tzname', and to 0 if you don't.
+   */
+#undef HAVE_DECL_TZNAME
+
 /* Do we have fts functions? */
 #undef HAVE_FTS
 
@@ -493,7 +497,7 @@
 /* Define to `int' if <sys/types.h> does not define. */
 #undef pid_t
 
-/* Define to `unsigned' if <sys/types.h> does not define. */
+/* Define to `unsigned int' if <sys/types.h> does not define. */
 #undef size_t
 
 /* Define as int if socklen_t is not available */