Dispatch is mostly working now; just got to get dispatch to "procedure-like"

methods done now; tricky, but a more scoped problem.

5 files changed, 775 insertions, 283 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 38d0c5d..6cf8164 100644
--- a/generic/tcl.h
+++ b/generic/tcl.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: tcl.h,v 1.210.2.1 2006/04/17 23:24:20 dkf Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.210.2.2 2006/07/10 01:17:31 dkf Exp $
  */
 
 #ifndef _TCL
@@ -504,6 +504,7 @@ typedef struct Tcl_Interp {
 typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
 typedef struct Tcl_Channel_ *Tcl_Channel;
 typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
+typedef struct Tcl_Class_ *Tcl_Class;
 typedef struct Tcl_Command_ *Tcl_Command;
 typedef struct Tcl_Condition_ *Tcl_Condition;
 typedef struct Tcl_Dict_ *Tcl_Dict;
@@ -512,7 +513,9 @@ typedef struct Tcl_Encoding_ *Tcl_Encoding;
 typedef struct Tcl_Event Tcl_Event;
 typedef struct Tcl_InterpState_ *Tcl_InterpState;
 typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
+typedef struct Tcl_Method_ *Tcl_Method;
 typedef struct Tcl_Mutex_ *Tcl_Mutex;
+typedef struct Tcl_Object_ *Tcl_Object;
 typedef struct Tcl_Pid_ *Tcl_Pid;
 typedef struct Tcl_RegExp_ *Tcl_RegExp;
 typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index bd6dc4b..cb3da44 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,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.267.2.3 2006/04/23 23:08:08 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.267.2.4 2006/07/10 01:17:32 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -167,10 +167,6 @@ typedef struct Tcl_ResolverInfo {
 typedef struct Tcl_Ensemble Tcl_Ensemble;
 typedef struct NamespacePathEntry NamespacePathEntry;
 
-// FIXME: Tidy up
-typedef void (*TclEnsembleCallbackProc)(ClientData clientData);
-MODULE_SCOPE void TclEnsembleSetCallbacks(Tcl_Command ensemble, TclEnsembleCallbackProc enterProc, TclEnsembleCallbackProc leaveProc, ClientData clientData);
-
 /*
  * The structure below defines a namespace.
  * Note: the first five fields must match exactly the fields in a
@@ -902,6 +898,7 @@ typedef struct CallFrame {
 
 #define FRAME_IS_PROC	0x1
 #define FRAME_IS_METHOD	0x2	/* TODO: Docme */
+#define FRAME_IS_FILTER	0x4	/* TODO: Docme */
 
 /*
  *----------------------------------------------------------------
@@ -2106,7 +2103,7 @@ MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
 MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
 MODULE_SCOPE void	TclInitNotifier(void);
 MODULE_SCOPE void	TclInitObjSubsystem(void);
-MODULE_SCOPE void	TclInitSubsystems ();
+MODULE_SCOPE void	TclInitSubsystems(void);
 MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
 MODULE_SCOPE int	TclIsLocalScalar(CONST char *src, int len);
 MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int* result);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f9b9877..8736b49 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.93.2.2 2006/04/23 23:08:08 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.93.2.3 2006/07/10 01:17:32 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -117,19 +117,8 @@ typedef struct EnsembleConfig {
 				 * all lists, and cannot be found by scanning
 				 * the list from the namespace's ensemble
 				 * field. */
-    int flags;			/* ORed combo of ENS_DEAD and
-				 * TCL_ENSEMBLE_PREFIX. */
-    TclEnsembleCallbackProc enterProc;
-				/* Function to call immediately before
-				 * dispatch of a particular ensemble command
-				 * or its unknown callback, or NULL if no such
-				 * callback is to be performed. */
-    TclEnsembleCallbackProc leaveProc;
-				/* Function to call immediately after dispatch
-				 * of a particular ensemble command or its
-				 * unknown callback, or NULL if no such
-				 * callback is to be performed. */
-    ClientData clientData;	/* Data for the above two callbacks. */
+    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX and
+				 * ENS_DEAD. */
 
     /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
 
@@ -5483,9 +5472,6 @@ Tcl_CreateEnsemble(
     ensemblePtr->subcmdList = NULL;
     ensemblePtr->subcommandDict = NULL;
     ensemblePtr->flags = flags;
-    ensemblePtr->enterProc = NULL;
-    ensemblePtr->leaveProc = NULL;
-    ensemblePtr->clientData = NULL;
     ensemblePtr->unknownHandler = NULL;
     ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
 	    NsEnsembleImplementationCmd, (ClientData)ensemblePtr,
@@ -5954,26 +5940,6 @@ Tcl_GetEnsembleNamespace(
     return TCL_OK;
 }
 
-void
-TclEnsembleSetCallbacks(
-    Tcl_Command ensemble,
-    TclEnsembleCallbackProc enterProc,
-    TclEnsembleCallbackProc leaveProc,
-    ClientData clientData)
-{
-    Command *cmdPtr = (Command *) ensemble;
-    EnsembleConfig *ensemblePtr;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	Tcl_Panic("command is not an ensemble");
-    }
-
-    ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
-    ensemblePtr->enterProc = enterProc;
-    ensemblePtr->leaveProc = leaveProc;
-    ensemblePtr->clientData = clientData;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -6250,12 +6216,7 @@ NsEnsembleImplementationCmd(
     {
 	Interp *iPtr = (Interp *) interp;
 	int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-	TclEnsembleCallbackProc leaveProc = ensemblePtr->leaveProc;
-	ClientData cbClientData = ensemblePtr->clientData;
 
-	if (ensemblePtr->enterProc != NULL) {
-	    ensemblePtr->enterProc(cbClientData);
-	}
 	Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
 	if (isRootEnsemble) {
 	    iPtr->ensembleRewrite.sourceObjs = objv;
@@ -6282,9 +6243,6 @@ NsEnsembleImplementationCmd(
 	    iPtr->ensembleRewrite.numRemovedObjs = 0;
 	    iPtr->ensembleRewrite.numInsertedObjs = 0;
 	}
-	if (leaveProc != NULL) {
-	    leaveProc(cbClientData);
-	}
 	return result;
     }
 
@@ -6299,8 +6257,6 @@ NsEnsembleImplementationCmd(
     if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
 	int paramc, i;
 	Tcl_Obj **paramv, *unknownCmd, *ensObj;
-	TclEnsembleCallbackProc leaveProc = ensemblePtr->leaveProc;
-	ClientData cbClientData = ensemblePtr->clientData;
 
 	unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
 	TclNewObj(ensObj);
@@ -6312,13 +6268,7 @@ NsEnsembleImplementationCmd(
 	Tcl_ListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
 	Tcl_Preserve(ensemblePtr);
 	Tcl_IncrRefCount(unknownCmd);
-	if (ensemblePtr->enterProc != NULL) {
-	    ensemblePtr->enterProc(cbClientData);
-	}
 	result = Tcl_EvalObjv(interp, paramc, paramv, 0);
-	if (leaveProc != NULL) {
-	    leaveProc(cbClientData);
-	}
 	if (result == TCL_OK) {
 	    prefixObj = Tcl_GetObjResult(interp);
 	    Tcl_IncrRefCount(prefixObj);
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 14fdd73..8516982 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,99 +8,26 @@
  * 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.1.2.5 2006/04/23 23:08:08 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.1.2.6 2006/07/10 01:17:32 dkf Exp $
  */
 
-#include <tclInt.h>
+#include "tclInt.h"
+#include "tclOO.h"
 
-#define ALLOC_CHUNK 8
+void			TclOOInit(Tcl_Interp *interp);
+Tcl_Method		Tcl_OONewMethod(Tcl_Interp *interp, Tcl_Object object,
+			    Tcl_Obj *nameObj, int isPublic,
+			    Tcl_OOMethodCallProc callProc,
+			    ClientData clientData,
+			    Tcl_OOMethodDeleteProc deleteProc);
+Tcl_Method		Tcl_OONewClassMethod(Tcl_Interp *interp, Tcl_Class cls,
+			    Tcl_Obj *nameObj, int isPublic,
+			    Tcl_OOMethodCallProc callProc,
+			    ClientData clientData,
+			    Tcl_OOMethodDeleteProc deleteProc);
 
-struct Class;
-struct Object;
-struct Method;
-//struct Foundation;
-
-typedef struct Method {
-    Tcl_Obj *bodyObj;
-    Proc *procPtr;
-    int epoch;
-    int flags;
-    int formalc;
-    Tcl_Obj **formalv;
-} Method;
-
-typedef struct Object {
-    Namespace *nsPtr;		/* 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 methods;	/* Tcl_Obj (method name) to Method*
-				 * mapping. */
-    int numMixins;		/* Number of classes mixed into this
-				 * object. */
-    struct Class **mixins;	/* References to classes mixed into this
-				 * object. */
-    int numFilters;
-    Tcl_Obj **filterObjs;
-    struct Class *classPtr;	/* All classes have this non-NULL; it points
-				 * to the class structure. Everything else has
-				 * this NULL. */
-    Tcl_Interp *interp;		/* The interpreter (for the PushObject and
-				 * PopObject callbacks. */
-} Object;
-
-typedef struct Class {
-    struct Object *thisPtr;
-    int flags;
-    int numSuperclasses;
-    struct Class **superclasses;
-    int numSubclasses;
-    struct Class **subclasses;
-    int subclassesSize;
-    int numInstances;
-    struct Object **instances;
-    int instancesSize;
-    Tcl_HashTable classMethods;
-    struct Method *constructorPtr;
-    struct Method *destructorPtr;
-} Class;
-
-typedef struct ObjectStack {
-    Object *oPtr;
-    struct ObjectStack *nextPtr;
-} ObjectStack;
-
-typedef struct Foundation {
-    struct Class *objectCls;
-    struct Class *classCls;
-    struct Class *definerCls;
-    struct Class *structCls;
-    Tcl_Namespace *helpersNs;
-    int epoch;
-    int nsCount;
-    Tcl_Obj *unknownMethodNameObj;
-    ObjectStack *objStack;	// should this be in stack frames?
-} Foundation;
-
-#define CALL_CHAIN_STATIC_SIZE 4
-
-struct MInvoke {
-    Method *mPtr;
-    int isFilter;
-};
-typedef struct {
-    int epoch;
-    int flags;
-    int numCallChain;
-    struct MInvoke **callChain;
-    struct MInvoke *staticCallChain[CALL_CHAIN_STATIC_SIZE];
-    int filterLength;
-} CallContext;
-
-#define OO_UNKNOWN_METHOD	1
-#define PUBLIC_METHOD		2
+
+#define ALLOC_CHUNK 8
 
 /*
  * Function declarations.
@@ -108,51 +35,76 @@ typedef struct {
 
 static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
 static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr);
-#if 0
+static int		DeclareClassMethod(Tcl_Interp *interp, Class *clsPtr,
+			    const char *name, int isPublic,
+			    Tcl_OOMethodCallProc callProc);
 static void		AddClassMethodNames(Class *clsPtr, int publicOnly,
 			    Tcl_HashTable *namesPtr);
 static void		AddMethodToCallChain(Tcl_HashTable *methodTablePtr,
 			    Tcl_Obj *methodObj, CallContext *contextPtr,
-			    int isFilter);
+			    int isFilter, int isPublic);
 static void		AddSimpleChainToCallContext(Object *oPtr,
 			    Tcl_Obj *methodNameObj, CallContext *contextPtr,
-			    int isFilter);
+			    int isFilter, int isPublic);
 static void		AddSimpleClassChainToCallContext(Class *classPtr,
 			    Tcl_Obj *methodNameObj, CallContext *contextPtr,
-			    int isFilter);
+			    int isFilter, int isPublic);
 static int		CmpStr(const void *ptr1, const void *ptr2);
+static void		DeleteContext(CallContext *contextPtr);
 static CallContext *	GetCallContext(Foundation *fPtr, Object *oPtr,
-			    Tcl_Obj *methodNameObj);
-static int		InvokeContext(Tcl_Interp *interp, Object *oPtr,
-			    CallContext *contextPtr, int idx, int objc,
+			    Tcl_Obj *methodNameObj, int isPublic,
+			    Tcl_HashTable *cachePtr);
+static int		InvokeContext(Tcl_Interp *interp,
+			    CallContext *contextPtr, int objc,
 			    Tcl_Obj *const *objv);
 static int		ObjectCmd(Object *oPtr, Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv, int publicOnly);
-#endif
+			    Tcl_Obj *const *objv, int publicOnly,
+			    Tcl_HashTable *cachePtr);
 static Object *		NewInstance(Tcl_Interp *interp, Class *clsPtr,
 			    char *name, int objc, Tcl_Obj *const *objv);
-static Method *		NewMethod(Tcl_Interp *interp, Object *oPtr,
+static Method *		NewProcMethod(Tcl_Interp *interp, Object *oPtr,
 			    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
 			    Tcl_Obj *bodyObj);
 static void		ObjectNamespaceDeleted(ClientData clientData);
 static void		ObjNameChangedTrace(ClientData clientData,
 			    Tcl_Interp *interp, const char *oldName,
 			    const char *newName, int flags);
-static void		PushObject(ClientData clientData);
-static void		PopObject(ClientData clientData);
 
-static int		ClassCreate(ClientData clientData, Tcl_Interp *interp,
+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);
+
+static int		InvokeProcedureMethod(ClientData clientData,
+			    Tcl_Interp *interp, CallContext *oPtr,
 			    int objc, Tcl_Obj *const *objv);
-static int		ClassNew(ClientData clientData, Tcl_Interp *interp,
+static void		DeleteProcedureMethod(ClientData clientData);
+static int		InvokeForwardMethod(ClientData clientData,
+			    Tcl_Interp *interp, CallContext *oPtr,
 			    int objc, Tcl_Obj *const *objv);
+static void		DeleteForwardMethod(ClientData clientData);
+
+static int		ClassCreate(ClientData clientData, Tcl_Interp *interp,
+			    CallContext *oPtr, int objc, Tcl_Obj *const *objv);
+static int		ClassNew(ClientData clientData, Tcl_Interp *interp,
+			    CallContext *oPtr, int objc, Tcl_Obj *const *objv);
+static int		ObjectDestroy(ClientData clientData,Tcl_Interp *interp,
+			    CallContext *oPtr, int objc, Tcl_Obj *const *objv);
+static int		ObjectEval(ClientData clientData, Tcl_Interp *interp,
+			    CallContext *oPtr, int objc, Tcl_Obj *const *objv);
+static int		ObjectLinkVar(ClientData clientData,Tcl_Interp *interp,
+			    CallContext *oPtr, int objc, Tcl_Obj *const *objv);
+static int		ObjectUnknown(ClientData clientData,Tcl_Interp *interp,
+			    CallContext *oPtr, int objc, Tcl_Obj *const *objv);
 
 void
-OO_Init(
+TclOOInit(
     Tcl_Interp *interp)
 {
     Interp *iPtr = (Interp *) interp;
     Foundation *fPtr;
-    Tcl_DString ds;
 
     fPtr = iPtr->ooFoundation = (Foundation *) ckalloc(sizeof(Foundation));
     Tcl_CreateNamespace(interp, "::oo", fPtr, NULL);
@@ -169,22 +121,19 @@ OO_Init(
     fPtr->objectCls->superclasses = NULL;
     fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
 
-    Tcl_DStringInit(&ds);
-    Tcl_DStringAppend(&ds, fPtr->classCls->thisPtr->nsPtr->fullName, -1);
-    Tcl_DStringAppend(&ds, "::create", -1);
-    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), ClassCreate, NULL,
-	     NULL);
-    Tcl_DStringFree(&ds);
-    Tcl_DStringAppend(&ds, fPtr->classCls->thisPtr->nsPtr->fullName, -1);
-    Tcl_DStringAppend(&ds, "::new", -1);
-    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds), ClassNew, NULL, NULL);
-    Tcl_DStringFree(&ds);
+    DeclareClassMethod(interp, fPtr->objectCls, "destroy", 1, ObjectDestroy);
+    DeclareClassMethod(interp, fPtr->objectCls, "eval", 0, ObjectEval);
+    DeclareClassMethod(interp, fPtr->objectCls, "unknown", 0, ObjectUnknown);
+    DeclareClassMethod(interp, fPtr->objectCls, "variable", 0, ObjectLinkVar);
+    DeclareClassMethod(interp, fPtr->classCls, "create", 1, ClassCreate);
+    DeclareClassMethod(interp, fPtr->classCls, "new", 1, ClassNew);
 
     /*
      * TODO: finish splicing "object" and "class" together.
      * Need to create the following methods:
-     *	- object::eval
      *	- object::destroy
+     *	- object::eval
+     *	- object::unknown
      *	- object::variable
      *	- class::create
      *	- class::new
@@ -230,6 +179,7 @@ AllocObject(
     Interp *iPtr = (Interp *) interp;
     Foundation *fPtr = iPtr->ooFoundation;
     Tcl_Obj *cmdnameObj;
+    Tcl_DString buffer;
 
     oPtr = (Object *) ckalloc(sizeof(Object));
     do {
@@ -242,6 +192,8 @@ AllocObject(
     TclSetNsPath(oPtr->nsPtr, 1, &fPtr->helpersNs);
     oPtr->selfCls = fPtr->objectCls;
     Tcl_InitObjHashTable(&oPtr->methods);
+    Tcl_InitObjHashTable(&oPtr->publicContextCache);
+    Tcl_InitObjHashTable(&oPtr->privateContextCache);
     oPtr->numMixins = 0;
     oPtr->mixins = NULL;
     oPtr->classPtr = NULL;
@@ -251,12 +203,29 @@ AllocObject(
      * Initialize the traces.
      */
 
-    oPtr->command = Tcl_CreateEnsemble(interp, (nameStr ? nameStr : ""),
-	    (Tcl_Namespace *) oPtr->nsPtr, TCL_ENSEMBLE_PREFIX);
-    TclEnsembleSetCallbacks(oPtr->command, PushObject, PopObject, oPtr);
-    oPtr->myCommand = Tcl_CreateEnsemble(interp, "my",
-	    (Tcl_Namespace *) oPtr->nsPtr, TCL_ENSEMBLE_PREFIX);
-    TclEnsembleSetCallbacks(oPtr->myCommand, PushObject, PopObject, oPtr);
+    Tcl_DStringInit(&buffer);
+    if (nameStr) {
+	if (nameStr[0] != ':' || nameStr[1] != ':') {
+	    Tcl_DStringAppend(&buffer,
+		    ((Namespace *) Tcl_GetCurrentNamespace(interp))->fullName,
+		    -1);
+	    Tcl_DStringAppend(&buffer, "::", 2);
+	}
+	Tcl_DStringAppend(&buffer, nameStr, -1);
+    } else {
+	Tcl_DStringAppend(&buffer, oPtr->nsPtr->fullName, -1);
+    }
+    oPtr->command = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
+	    PublicObjectCmd, oPtr, NULL);
+    if (nameStr) {
+	Tcl_DStringFree(&buffer);
+	Tcl_DStringAppend(&buffer, oPtr->nsPtr->fullName, -1);
+    }
+    Tcl_DStringAppend(&buffer, "::my", 4);
+    oPtr->myCommand = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
+	    PrivateObjectCmd, oPtr, NULL);
+    Tcl_DStringFree(&buffer);
+
     TclNewObj(cmdnameObj);
     Tcl_GetCommandFullName(interp, oPtr->command, cmdnameObj);
     Tcl_TraceCommand(interp, TclGetString(cmdnameObj),
@@ -290,35 +259,6 @@ ObjNameChangedTrace(
 }
 
 static void
-PushObject(
-    ClientData clientData)
-{
-    Object *oPtr = clientData;
-    Foundation *fPtr = ((Interp *) oPtr->interp)->ooFoundation;
-    ObjectStack *stkPtr;
-
-    stkPtr = (ObjectStack *) ckalloc(sizeof(struct ObjectStack));
-    stkPtr->oPtr = oPtr;
-    stkPtr->nextPtr = fPtr->objStack;
-    fPtr->objStack = stkPtr;
-}
-
-static void
-PopObject(
-    ClientData clientData)
-{
-    Object *oPtr = clientData;
-    Foundation *fPtr = ((Interp *) oPtr->interp)->ooFoundation;
-    ObjectStack *stkPtr = fPtr->objStack;
-
-    if (stkPtr == NULL || stkPtr->oPtr != oPtr) {
-	Tcl_Panic("stack management failure");
-    }
-    fPtr->objStack = stkPtr->nextPtr;
-    ckfree((char *) stkPtr);
-}
-
-static void
 ObjectNamespaceDeleted(
     ClientData clientData)
 {
@@ -434,7 +374,7 @@ NewInstance(
      */
 
     for (classPtr=clsPtr ; classPtr->numSuperclasses>0 ;
-	    classPtr=classPtr->superclasses[0]) { //FIXME: Multiple inheritance
+	    classPtr=classPtr->superclasses[0]) { //TODO: fix multiple inheritance
 	Foundation *fPtr = ((Interp *) interp)->ooFoundation;
 
 	if (classPtr == fPtr->classCls) {
@@ -455,58 +395,248 @@ NewInstance(
     return oPtr;
 }
 
-static Method *
-NewMethod(
+static int
+DeclareClassMethod(
     Tcl_Interp *interp,
-    Object *oPtr,
+    Class *clsPtr,
+    const char *name,
     int isPublic,
+    Tcl_OOMethodCallProc callPtr)
+{
+    Tcl_Obj *namePtr;
+
+    TclNewStringObj(namePtr, name, strlen(name));
+    Tcl_IncrRefCount(namePtr);
+    Tcl_OONewClassMethod(interp, (Tcl_Class) clsPtr, namePtr, isPublic,
+	    callPtr, NULL, NULL);
+    TclDecrRefCount(namePtr);
+    return TCL_OK;
+}
+
+Tcl_Method
+Tcl_OONewMethod(
+    Tcl_Interp *interp,
+    Tcl_Object object,
     Tcl_Obj *nameObj,
-    Tcl_Obj *argsObj,
-    Tcl_Obj *bodyObj)
+    int isPublic,
+    Tcl_OOMethodCallProc callProc,
+    ClientData clientData,
+    Tcl_OOMethodDeleteProc deleteProc)
 {
+    register Object *oPtr = (Object *) object;
     register Method *mPtr;
     Tcl_HashEntry *hPtr;
-    int isNew, argsc;
-    Tcl_Obj **argsv;
+    int isNew;
 
-    if (Tcl_ListObjGetElements(interp, argsObj, &argsc, &argsv) != TCL_OK) {
-	return NULL;
-    }
     hPtr = Tcl_CreateHashEntry(&oPtr->methods, (char *) nameObj, &isNew);
     if (isNew) {
 	mPtr = (Method *) ckalloc(sizeof(Method));
 	Tcl_SetHashValue(hPtr, mPtr);
     } else {
 	mPtr = Tcl_GetHashValue(hPtr);
-	if (mPtr->formalc != 0) {
-	    int i;
+	if (mPtr->deletePtr != NULL) {
+	    mPtr->deletePtr(mPtr->clientData);
+	}
+    }
+    mPtr->callPtr = callProc;
+    mPtr->clientData = clientData;
+    mPtr->deletePtr = deleteProc;
+    mPtr->epoch = ((Interp *) interp)->ooFoundation->epoch;
+    mPtr->flags = 0;
+    if (isPublic) {
+	mPtr->flags |= PUBLIC_METHOD;
+    }
+    return (Tcl_Method) mPtr;
+}
 
-	    for (i=0 ; i>mPtr->formalc ; i++) {
-		Tcl_DecrRefCount(mPtr->formalv[i]);
-	    }
-	    ckfree((char *) mPtr->formalv);
+Tcl_Method
+Tcl_OONewClassMethod(
+    Tcl_Interp *interp,
+    Tcl_Class cls,
+    Tcl_Obj *nameObj,
+    int isPublic,
+    Tcl_OOMethodCallProc callProc,
+    ClientData clientData,
+    Tcl_OOMethodDeleteProc deleteProc)
+{
+    register Class *clsPtr = (Class *) cls;
+    register Method *mPtr;
+    Tcl_HashEntry *hPtr;
+    int isNew;
+
+    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj, &isNew);
+    if (isNew) {
+	mPtr = (Method *) ckalloc(sizeof(Method));
+	Tcl_SetHashValue(hPtr, mPtr);
+    } else {
+	mPtr = Tcl_GetHashValue(hPtr);
+	if (mPtr->deletePtr != NULL) {
+	    mPtr->deletePtr(mPtr->clientData);
 	}
-	Tcl_DecrRefCount(mPtr->bodyObj);
     }
-    mPtr->formalc = argsc;
+    mPtr->callPtr = callProc;
+    mPtr->clientData = clientData;
+    mPtr->deletePtr = deleteProc;
+    mPtr->epoch = ((Interp *) interp)->ooFoundation->epoch;
+    mPtr->flags = 0;
+    if (isPublic) {
+	mPtr->flags |= PUBLIC_METHOD;
+    }
+    return (Tcl_Method) mPtr;
+}
+
+static Method *
+NewProcMethod(
+    Tcl_Interp *interp,
+    Object *oPtr,
+    int isPublic,
+    Tcl_Obj *nameObj,
+    Tcl_Obj *argsObj,
+    Tcl_Obj *bodyObj)
+{
+    int argsc;
+    Tcl_Obj **argsv;
+    register ProcedureMethod *pmPtr;
+
+    if (Tcl_ListObjGetElements(interp, argsObj, &argsc, &argsv) != TCL_OK) {
+	return NULL;
+    }
+    pmPtr = (ProcedureMethod *) ckalloc(sizeof(ProcedureMethod));
+    pmPtr->bodyObj = bodyObj;
+    Tcl_IncrRefCount(bodyObj);
+    pmPtr->formalc = argsc;
     if (argsc != 0) {
 	int i;
 	unsigned numBytes = sizeof(Tcl_Obj *) * (unsigned) argsc;
 
-	mPtr->formalv = (Tcl_Obj **) ckalloc(numBytes);
-	memcpy(mPtr->formalv, argsv, numBytes);
+	pmPtr->formalv = (Tcl_Obj **) ckalloc(numBytes);
+	memcpy(pmPtr->formalv, argsv, numBytes);
 	for (i=0 ; i>argsc ; i++) {
-	    Tcl_IncrRefCount(mPtr->formalv[i]);
+	    Tcl_IncrRefCount(pmPtr->formalv[i]);
 	}
     }
-    mPtr->epoch = ((Interp *) interp)->ooFoundation->epoch;
-    mPtr->bodyObj = bodyObj;
-    Tcl_IncrRefCount(bodyObj);
-    mPtr->flags = 0;
-    return mPtr;
+    return (Method *) Tcl_OONewMethod(interp, (Tcl_Object) oPtr, nameObj,
+	    isPublic, &InvokeProcedureMethod, pmPtr, &DeleteProcedureMethod);
+}
+
+static int
+InvokeProcedureMethod(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
+    int result, flags = FRAME_IS_METHOD;
+    CallFrame *framePtr, **framePtrPtr;
+    Object *oPtr = contextPtr->oPtr;
+
+    result = TclProcCompileProc(interp, pmPtr->procPtr,
+	    pmPtr->procPtr->bodyPtr, oPtr->nsPtr, "body of method",
+	    TclGetString(objv[1]));
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    if (contextPtr->callChain[contextPtr->index]->isFilter) {
+	flags |= FRAME_IS_FILTER;
+    }
+    framePtrPtr = &framePtr;
+    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
+	    (Tcl_Namespace *) oPtr->nsPtr, flags);
+    if (result != TCL_OK) {
+	return result;
+    }
+    framePtr->methodChain = contextPtr;
+    // TODO: Call the procedure!
+}
+
+static void
+DeleteProcedureMethod(
+    ClientData clientData)
+{
+    register ProcedureMethod *pmPtr = (ProcedureMethod *) clientData;
+
+    if (pmPtr->formalc != 0) {
+	int i;
+
+	for (i=0 ; i>pmPtr->formalc ; i++) {
+	    Tcl_DecrRefCount(pmPtr->formalv[i]);
+	}
+	ckfree((char *) pmPtr->formalv);
+    }
+    Tcl_DecrRefCount(pmPtr->bodyObj);
+    // TODO: delete the procPtr member
+    ckfree((char *) pmPtr);
+}
+
+static Method *
+NewForwardMethod(
+    Tcl_Interp *interp,
+    Object *oPtr,
+    int isPublic,
+    Tcl_Obj *nameObj,
+    Tcl_Obj *prefixObj)
+{
+    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_OONewMethod(interp, (Tcl_Object) oPtr, nameObj,
+	    isPublic, &InvokeForwardMethod, fmPtr, &DeleteForwardMethod);
+}
+
+static int
+InvokeForwardMethod(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    ForwardMethod *fmPtr = (ForwardMethod *) clientData;
+    Tcl_Obj **argObjs;
+    int numPrefixes, result;
+
+    /*
+     * 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_ListObjLength(NULL, fmPtr->prefixObj, &numPrefixes);
+    argObjs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (numPrefixes + objc-2));
+    Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &argObjs);
+    memcpy(argObjs + numPrefixes, objv + 2, (objc-2)*sizeof(Tcl_Obj *));
+
+    // TODO: Apply invoke magic (see [namespace ensemble])
+    result = Tcl_EvalObjv(interp, numPrefixes + objc - 2, argObjs, 0);
+    ckfree((char *) argObjs);
+    return result;
+}
+
+static void
+DeleteForwardMethod(
+    ClientData clientData)
+{
+    ForwardMethod *fmPtr = (ForwardMethod *) clientData;
+
+    TclDecrRefCount(fmPtr->prefixObj);
+    ckfree((char *) fmPtr);
 }
 
-#if 0
 static int
 PublicObjectCmd(
     ClientData clientData,
@@ -514,7 +644,8 @@ PublicObjectCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    return ObjectCmd(clientData, interp, objc, objv, 1);
+    return ObjectCmd(clientData, interp, objc, objv, 1,
+	    &((Object *)clientData)->publicContextCache);
 }
 
 static int
@@ -524,7 +655,8 @@ PrivateObjectCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    return ObjectCmd(clientData, interp, objc, objv, 0);
+    return ObjectCmd(clientData, interp, objc, objv, 0,
+	    &((Object *)clientData)->privateContextCache);
 }
 
 static int
@@ -533,7 +665,8 @@ ObjectCmd(
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv,
-    int publicOnly)
+    int publicOnly,
+    Tcl_HashTable *cachePtr)
 {
     Interp *iPtr = (Interp *) interp;
     CallContext *contextPtr;
@@ -545,21 +678,68 @@ ObjectCmd(
     }
 
     // How to differentiate public and private call-chains?
-    // TODO: Cache contexts
-    contextPtr = GetCallContext(iPtr->ooFoundation, oPtr, objv[1]);
+    contextPtr = GetCallContext(iPtr->ooFoundation, oPtr, objv[1], publicOnly,
+	    cachePtr);
+    if (contextPtr == NULL) {
+	Tcl_AppendResult(interp, "impossible to invoke method \"",
+		TclGetString(objv[1]),
+		"\": no defined method or unknown method", NULL);
+	return TCL_ERROR;
+    }
+
+    Tcl_Preserve(oPtr);
+    result = InvokeContext(interp, contextPtr, objc, objv);
+    if (!(contextPtr->flags & OO_UNKNOWN_METHOD)) {
+	Tcl_HashEntry *hPtr;
+
+	hPtr = Tcl_FindHashEntry(cachePtr, (char *) objv[1]);
+	if (hPtr != NULL && Tcl_GetHashValue(hPtr) == NULL) {
+	    Tcl_SetHashValue(hPtr, contextPtr);
+	} else {
+	    DeleteContext(contextPtr);
+	}
+    } else {
+	DeleteContext(contextPtr);
+    }
+    Tcl_Release(oPtr);
 
-    Tcl_Preserve(contextPtr);
-    result = InvokeContext(interp, oPtr, contextPtr, 0, objc, objv);
-    Tcl_Release(contextPtr);
     return result;
 }
 
+static void
+DeleteContext(
+    CallContext *contextPtr)
+{
+    int i;
+
+    for (i=0 ; i<contextPtr->numCallChain ; i++) {
+	ckfree((char *) contextPtr->callChain[i]);
+    }
+    if (contextPtr->callChain != contextPtr->staticCallChain) {
+	ckfree((char *) contextPtr->callChain);
+    }
+    ckfree((char *) contextPtr);
+}
+
+static int
+InvokeContext(
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Method *mPtr = contextPtr->callChain[contextPtr->index]->mPtr;
+
+    return mPtr->callPtr(mPtr->clientData, interp, contextPtr, objc, objv);
+    // TODO: Better annotation of stack trace?
+}
+
+#ifdef WRONG_BUT_KEPT_FOR_NOTES
 static int
 InvokeContext(
     Tcl_Interp *interp,
     Object *oPtr,
     CallContext *contextPtr,
-    int idx,
     int objc,
     Tcl_Obj *const *objv)
 {
@@ -589,6 +769,7 @@ InvokeContext(
 
     return TCL_ERROR;
 }
+#endif /* WRONG_BUT_KEPT_FOR_NOTES */
 
 static int
 GetSortedMethodList(
@@ -695,32 +876,56 @@ static CallContext *
 GetCallContext(
     Foundation *fPtr,
     Object *oPtr,
-    Tcl_Obj *methodNameObj)
+    Tcl_Obj *methodNameObj,
+    int isPublic,
+    Tcl_HashTable *cachePtr)
 {
     CallContext *contextPtr;
     int i, count;
+    Tcl_HashEntry *hPtr;
 
+    hPtr = Tcl_FindHashEntry(cachePtr, (char *) methodNameObj);
+    if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
+	contextPtr = Tcl_GetHashValue(hPtr);
+	Tcl_SetHashValue(hPtr, NULL);
+	return contextPtr;
+    }
     contextPtr = (CallContext *) ckalloc(sizeof(CallContext));
     contextPtr->numCallChain = 0;
     contextPtr->callChain = contextPtr->staticCallChain;
     contextPtr->filterLength = 0;
-    contextPtr->epoch = 0; /* FIXME */
+    contextPtr->epoch = 0; /* TODO: fix to real epoch */
     contextPtr->flags = 0;
+    if (isPublic) {
+	contextPtr->flags |= PUBLIC_METHOD;
+    }
+    contextPtr->oPtr = oPtr;
+    contextPtr->index = 0;
 
     for (i=0 ; i<oPtr->numFilters ; i++) {
-	AddSimpleChainToCallContext(oPtr, oPtr->filterObjs[i], contextPtr, 1);
+	AddSimpleChainToCallContext(oPtr, oPtr->filterObjs[i], contextPtr, 1,
+		0);
     }
     count = contextPtr->filterLength = contextPtr->numCallChain;
-    AddSimpleChainToCallContext(oPtr, methodNameObj, contextPtr, 0);
+    AddSimpleChainToCallContext(oPtr, methodNameObj, contextPtr, 0, isPublic);
     if (count == contextPtr->numCallChain) {
 	/*
 	 * Method does not actually exist.
 	 */
 
 	AddSimpleChainToCallContext(oPtr, fPtr->unknownMethodNameObj,
-		contextPtr, 0);
+		contextPtr, 0, 0);
 	contextPtr->flags |= OO_UNKNOWN_METHOD;
 	contextPtr->epoch = -1;
+	if (count == contextPtr->numCallChain) {
+	    DeleteContext(contextPtr);
+	    return NULL;
+	}
+    } else {
+	if (hPtr == NULL) {
+	    hPtr = Tcl_CreateHashEntry(cachePtr, (char *) methodNameObj, &i);
+	}
+	Tcl_SetHashValue(hPtr, NULL);
     }
     return contextPtr;
 }
@@ -730,17 +935,31 @@ AddSimpleChainToCallContext(
     Object *oPtr,
     Tcl_Obj *methodNameObj,
     CallContext *contextPtr,
-    int isFilter)
+    int isFilter,
+    int isPublic)
 {
     int i;
 
-    AddMethodToCallChain(&oPtr->methods, methodNameObj, contextPtr, isFilter);
+    if (isPublic) {
+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&oPtr->methods,
+		(char *) methodNameObj);
+
+	if (hPtr != NULL) {
+	    Method *mPtr = Tcl_GetHashValue(hPtr);
+
+	    if (!(mPtr->flags & PUBLIC_METHOD)) {
+		return;
+	    }
+	}
+    }
+    AddMethodToCallChain(&oPtr->methods, methodNameObj, contextPtr, isFilter,
+	    isPublic);
     for (i=0 ; i<oPtr->numMixins ; i++) {
 	AddSimpleClassChainToCallContext(oPtr->mixins[i], methodNameObj,
-		contextPtr, isFilter);
+		contextPtr, isFilter, isPublic);
     }
     AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, contextPtr,
-	    isFilter);
+	    isFilter, isPublic);
 }
 
 static void
@@ -748,7 +967,8 @@ AddSimpleClassChainToCallContext(
     Class *classPtr,
     Tcl_Obj *methodNameObj,
     CallContext *contextPtr,
-    int isFilter)
+    int isFilter,
+    int isPublic)
 {
     int i;
 
@@ -759,7 +979,7 @@ AddSimpleClassChainToCallContext(
 
     do {
 	AddMethodToCallChain(&classPtr->classMethods, methodNameObj,
-		contextPtr, isFilter);
+		contextPtr, isFilter, isPublic);
 	if (classPtr->numSuperclasses != 1) {
 	    if (classPtr->numSuperclasses == 0) {
 		return;
@@ -771,7 +991,7 @@ AddSimpleClassChainToCallContext(
 
     for (i=0 ; i<classPtr->numSuperclasses ; i++) {
 	AddSimpleClassChainToCallContext(classPtr->superclasses[i],
-		methodNameObj, contextPtr, isFilter);
+		methodNameObj, contextPtr, isFilter, isPublic);
     }
 }
 
@@ -780,7 +1000,8 @@ AddMethodToCallChain(
     Tcl_HashTable *methodTablePtr,
     Tcl_Obj *methodObj,
     CallContext *contextPtr,
-    int isFilter)
+    int isFilter,
+    int isPublic)
 {
     Method *mPtr;
     Tcl_HashEntry *hPtr;
@@ -793,6 +1014,24 @@ AddMethodToCallChain(
     mPtr = (Method *) Tcl_GetHashValue(hPtr);
 
     /*
+     * 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->callPtr == NULL) {
+	return;
+    }
+
+    /*
+     * Ignore public calls of private methods.
+     */
+
+    if (isPublic && !(mPtr->flags & PUBLIC_METHOD)) {
+	return;
+    }
+
+    /*
      * First test whether the method is already in the call chain. Skip over
      * any leading filters.
      */
@@ -839,24 +1078,17 @@ AddMethodToCallChain(
     contextPtr->callChain[contextPtr->numCallChain]->mPtr = mPtr;
     contextPtr->callChain[contextPtr->numCallChain++]->isFilter = isFilter;
 }
-#endif
 
 static int
 ClassCreate(
     ClientData clientData,
     Tcl_Interp *interp,
+    CallContext *contextPtr,
     int objc,
     Tcl_Obj *const *objv)
 {
-    Foundation *fPtr = ((Interp *) interp)->ooFoundation;
-    ObjectStack *stkPtr = fPtr->objStack;
-    Object *oPtr, *newObjPtr;
+    Object *oPtr = contextPtr->oPtr, *newObjPtr;
 
-    if (stkPtr == NULL) {
-	Tcl_AppendResult(interp, "not an object context", NULL);
-	return TCL_ERROR;
-    }
-    oPtr = stkPtr->oPtr;
     if (oPtr->classPtr == NULL) {
 	Tcl_Obj *cmdnameObj;
 
@@ -867,12 +1099,12 @@ ClassCreate(
 	Tcl_DecrRefCount(cmdnameObj);
 	return TCL_ERROR;
     }
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "create ?arg ...?");
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "objectName ?arg ...?");
 	return TCL_ERROR;
     }
-    newObjPtr = NewInstance(interp, oPtr->classPtr, TclGetString(objv[1]),
-	    objc-2, objv+2);
+    newObjPtr = NewInstance(interp, oPtr->classPtr, TclGetString(objv[2]),
+	    objc-3, objv+3);
     Tcl_GetCommandFullName(interp, oPtr->command, Tcl_GetObjResult(interp));
     return TCL_OK;
 }
@@ -881,18 +1113,12 @@ static int
 ClassNew(
     ClientData clientData,
     Tcl_Interp *interp,
+    CallContext *contextPtr,
     int objc,
     Tcl_Obj *const *objv)
 {
-    Foundation *fPtr = ((Interp *) interp)->ooFoundation;
-    ObjectStack *stkPtr = fPtr->objStack;
-    Object *oPtr, *newObjPtr;
+    Object *oPtr = contextPtr->oPtr, *newObjPtr;
 
-    if (stkPtr == NULL) {
-	Tcl_AppendResult(interp, "not an object context", NULL);
-	return TCL_ERROR;
-    }
-    oPtr = stkPtr->oPtr;
     if (oPtr->classPtr == NULL) {
 	Tcl_Obj *cmdnameObj;
 
@@ -903,11 +1129,199 @@ ClassNew(
 	Tcl_DecrRefCount(cmdnameObj);
 	return TCL_ERROR;
     }
-    newObjPtr = NewInstance(interp, oPtr->classPtr, NULL, objc-1, objv+1);
+    newObjPtr = NewInstance(interp, oPtr->classPtr, NULL, objc-2, objv+2);
     Tcl_GetCommandFullName(interp, oPtr->command, Tcl_GetObjResult(interp));
     return TCL_OK;
 }
 
+static int
+ObjectDestroy(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, "");
+	return TCL_ERROR;
+    }
+    Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
+    return TCL_OK;
+}
+
+static int
+ObjectEval(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = contextPtr->oPtr;
+    CallFrame *framePtr, **framePtrPtr;
+    int result;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, 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_Namespace *) oPtr->nsPtr, /*isProcCallFrame*/ 0);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+    framePtr->objc = objc;
+    framePtr->objv = objv;	/* Reference counts do not need to be
+				 * incremented here. */
+
+    if (objc == 3) {
+	result = Tcl_EvalObjEx(interp, objv[2], 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-2, objv+2);
+	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
+    }
+
+    if (result == TCL_ERROR) {
+	int length = strlen(oPtr->nsPtr->fullName);
+	int limit = 200;
+	int overflow = (length > limit);
+
+	// TODO: fix trace
+	TclFormatToErrorInfo(interp,
+		"\n    (in namespace eval \"%.*s%s\" script line %d)",
+		(overflow ? limit : length), oPtr->nsPtr->fullName,
+		(overflow ? "..." : ""), interp->errorLine);
+    }
+
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    TclPopStackFrame(interp);
+    return result;
+}
+
+static int
+ObjectUnknown(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = contextPtr->oPtr;
+    const char **methodNames;
+    int numMethodNames, i;
+
+    numMethodNames = GetSortedMethodList(oPtr,
+	    contextPtr->flags & PUBLIC_METHOD, &methodNames);
+    if (numMethodNames == 0) {
+	Tcl_AppendResult(interp, "object \"", TclGetString(objv[0]),
+		"\" has no visible methods", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[1]),
+	    "\": 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;
+}
+
+static int
+ObjectLinkVar(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    CallContext *contextPtr,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Interp *iPtr = (Interp *) interp;
+    Object *oPtr = contextPtr->oPtr;
+    int i;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "varName ?varName ...?");
+	return TCL_ERROR;
+    }
+    Tcl_DStringInit(&buffer);
+    for (i=2 ; i<objc ; i++) {
+	Var *varPtr, *aryPtr;
+	Tcl_Obj *tmpObjPtr;
+
+	if (strstr("::", TclGetString(objv[i])) == NULL) {
+	    Tcl_AppendResult("variable name \"", TclGetString(objv[i]),
+		    "\" illegal: must not contain namespace separator", NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * I know this is non-optimal. Improvements welcome!
+	 */
+	TclNewStringObj(tmpObjPtr, oPtr->nsPtr->fullName,
+		strlen(oPtr->nsPtr->fullName));
+	Tcl_AppendToObj(tmpObjPtr, "::", 2);
+	Tcl_AppendObjToObj(tmpObjPtr, objv[i]);
+	Tcl_IncrRefCount(tmpObjPtr);
+	varPtr = TclObjLookupVar(interp, tmpObjPtr, NULL,
+		TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG, "access", 1, 0, &aryPtr);
+	TclDecrRefCount(tmpObjPtr);
+	if (varPtr == NULL) {
+	    Tcl_Panic("unexpected NULL from TclObjLookupVar");
+	}
+	if (aryPtr != NULL) {
+	    /*
+	     * Variable cannot be an element in an array. If arrayPtr is
+	     * non-NULL, it is, so throw up an error and return.
+	     */
+
+	    TclVarErrMsg(interp, TclGetString(objv[i]), NULL, "define",
+		    "name refers to an element in an array");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * This is out of Tcl_VariableObjCmd...
+	 */
+
+	if (!TclIsVarNamespaceVar(varPtr)) {
+	    TclSetVarNamespaceVar(varPtr);
+	    varPtr->refCount++;
+	}
+
+	if (TclPtrMakeUpvar(interp, varPtr, TclGetString(objv[i]), 0,
+		-1) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tclOO.h b/generic/tclOO.h
new file mode 100644
index 0000000..cd6124f
--- /dev/null
+++ b/generic/tclOO.h
@@ -0,0 +1,128 @@
+/*
+ * tclOO.c --
+ *
+ *	This file contains the structures for the object-system (NB:
+ *	not Tcl_Obj, but ::oo)
+ *
+ * Copyright (c) 2005 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.1.2.1 2006/07/10 01:17:32 dkf Exp $
+ */
+
+struct Class;
+struct Object;
+struct Method;
+struct CallContext;
+//struct Foundation;
+
+typedef int (*Tcl_OOMethodCallProc)(ClientData clientData, Tcl_Interp *interp,
+	struct CallContext *contextPtr, int objc, Tcl_Obj *const *objv);
+typedef void (*Tcl_OOMethodDeleteProc)(ClientData clientData);
+
+typedef struct Method {
+    Tcl_OOMethodCallProc callPtr;
+    ClientData clientData;
+    Tcl_OOMethodDeleteProc deletePtr;
+    int epoch;
+    int flags;
+} Method;
+
+typedef struct ProcedureMethod {
+    Tcl_Obj *bodyObj;
+    Proc *procPtr;
+    int formalc;
+    Tcl_Obj **formalv;
+} ProcedureMethod;
+
+typedef struct ForwardMethod {
+    Tcl_Obj *prefixObj;
+} ForwardMethod;
+
+
+typedef struct Object {
+    Namespace *nsPtr;		/* 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 methods;	/* Tcl_Obj (method name) to Method*
+				 * mapping. */
+    int numMixins;		/* Number of classes mixed into this
+				 * object. */
+    struct Class **mixins;	/* References to classes mixed into this
+				 * object. */
+    int numFilters;
+    Tcl_Obj **filterObjs;
+    struct Class *classPtr;	/* All classes have this non-NULL; it points
+				 * to the class structure. Everything else has
+				 * this NULL. */
+    Tcl_Interp *interp;		/* The interpreter (for the PushObject and
+				 * PopObject callbacks. */
+    Tcl_HashTable publicContextCache;	/* Place to keep unused contexts. */
+    Tcl_HashTable privateContextCache;	/* Place to keep unused contexts. */
+} Object;
+
+typedef struct Class {
+    struct Object *thisPtr;
+    int flags;
+    int numSuperclasses;
+    struct Class **superclasses;
+    int numSubclasses;
+    struct Class **subclasses;
+    int subclassesSize;
+    int numInstances;
+    struct Object **instances;
+    int instancesSize;
+    Tcl_HashTable classMethods;
+    struct Method *constructorPtr;
+    struct Method *destructorPtr;
+} Class;
+
+typedef struct ObjectStack {
+    Object *oPtr;
+    struct ObjectStack *nextPtr;
+} ObjectStack;
+
+typedef struct Foundation {
+    struct Class *objectCls;
+    struct Class *classCls;
+    struct Class *definerCls;
+    struct Class *structCls;
+    Tcl_Namespace *helpersNs;
+    int epoch;
+    int nsCount;
+    Tcl_Obj *unknownMethodNameObj;
+    ObjectStack *objStack;	// should this be in stack frames?
+} Foundation;
+
+#define CALL_CHAIN_STATIC_SIZE 4
+
+struct MInvoke {
+    Method *mPtr;
+    int isFilter;
+};
+typedef struct CallContext {
+    Object *oPtr;
+    int epoch;
+    int flags;
+    int index;
+    int numCallChain;
+    struct MInvoke **callChain;
+    struct MInvoke *staticCallChain[CALL_CHAIN_STATIC_SIZE];
+    int filterLength;
+} CallContext;
+
+#define OO_UNKNOWN_METHOD	1
+#define PUBLIC_METHOD		2
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */