/*  -*- Mode: c++ -*-
 *
 *  $Id: xotcl.c,v 1.43 2001/03/09 13:34:01 neumann Exp $
 *
 *  XOTcl - Extended OTcl
 *
 *  Copyright (C) 1999-2001 Gustaf Neumann (a), Uwe Zdun (b)
 *
 * (a) Vienna University of Economics and Business Administration
 *     Dept. of Information Systems / New Media
 *     A-1090, Augasse 2-6
 *     Vienna, Austria
 *
 * (b) University of Essen
 *     Specification of Software Systems
 *     Altendorferstraße 97-101
 *     D-45143 Essen, Germany
 *     
 *  Permission to use, copy, modify, distribute, and sell this
 *  software and its documentation for any purpose is hereby granted
 *  without fee, provided that the above copyright notice appear in
 *  all copies and that both that copyright notice and this permission
 *  notice appear in supporting documentation. We make no
 *  representations about the suitability of this software for any
 *  purpose.  It is provided "as is" without express or implied
 *  warranty.
 *
 *
 *  This software is based upon MIT Object Tcl by David Wetherall and
 *  Christopher J. Lindblad, that contains the following copyright
 *  message:
 *
 *   "Copyright 1993 Massachusetts Institute of Technology
 *
 *    Permission to use, copy, modify, distribute, and sell this
 *    software and its documentation for any purpose is hereby granted
 *    without fee, provided that the above copyright notice appear in
 *    all copies and that both that copyright notice and this
 *    permission notice appear in supporting documentation, and that
 *    the name of M.I.T. not be used in advertising or publicity
 *    pertaining to distribution of the software without specific,
 *    written prior permission.  M.I.T. makes no representations about
 *    the suitability of this software for any purpose.  It is
 *    provided "as is" without express or implied warranty."
 * */
#include "xotclInt.h"
/*
 * Tcl_Obj Types for XOTcl Objects
 */

static int SetXOTclObjectFromAny(Tcl_Interp* interp, Tcl_Obj* objPtr);
static void UpdateStringOfXOTclObject(Tcl_Obj* objPtr);
static int XOTcl_IncrObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]);
static int XOTcl_VariableObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]);

static Tcl_ObjType XOTclObjectType = {
  "XOTclObject",			
  (Tcl_FreeInternalRepProc *) NULL,
  (Tcl_DupInternalRepProc *) NULL,
  UpdateStringOfXOTclObject,	
  SetXOTclObjectFromAny		
};

/* these are names and contents for global (corresponding) Tcl_Objs
   and Strings - otherwise these "constants" would have to be built
   every time they are used; now they are built once in XOTcl_Init */
typedef enum {
    EMPTY, UNKNOWN, CREATE, DESTROY, INSTDESTROY, ALLOC,
    INIT, INCR, INSTVAR, AUTONAMES,
    ZERO, ONE, MOVE, SELF, CLASS, RECREATE,
    SELF_CLASS, SELF_PROC, OBJECT, PARAM_CL, 
    DEFAULT, SEARCH_DEFAULTS, EXIT_HANDLER, 
    CLEANUP, CONFIGURE, FILTER, INSTFILTER,
    INSTPROC, PROC, MKGETTERSETTER, FORMAT,
    RENAME, INFO, UPVAR, UPLEVEL, SUBST, VARIABLE
} global_names;
static char *global_strings[] = {
  "", "unknown", "create", "destroy", "instdestroy", "alloc",
  "init", "incr", "instvar", "__autonames",
  "0", "1", "move", "self", "class", "recreate",
  "self class", "self proc",  "Object", "Class::Parameter",
  "default", "searchDefaults", "::Object::__exitHandler", 
  "cleanup", "configure", "filter", "instfilter", 
  "instproc", "proc", "mkGetterSetter", "format", 
  "rename", "info", "upvar", "uplevel", "subst", "variable"
};
static TclObjCmdProcType tcl_commands[VARIABLE+1];

#define global_objects RUNTIME_STATE(in)->methodObjNames
#define RS(in) RUNTIME_STATE(in)

static int XOTclObjDispatch(ClientData cd, Tcl_Interp* in,
			    int objc, Tcl_Obj *CONST objv[]);
static int ObjDispatch(ClientData cd, Tcl_Interp* in,
		       int objc, Tcl_Obj *CONST objv[],
		       int flags);
static int TclCommands(Tcl_Interp* in, int load);

static XOTclObject* GetObject(Tcl_Interp* in, char* name);
static XOTclClass*  GetClass(Tcl_Interp* in, char* name);

static XOTclCallStackContent*
CallStackGetFrame(Tcl_Interp* in);

#ifdef PRE81
/* for backward compatibility only 
*/
static int 
Tcl_EvalObjv(Tcl_Interp* in, 
	     int objc, Tcl_Obj *CONST objv[], int flags) {
  int i, result;
  Tcl_DString ds, *dsp = &ds;

  assert(flags == 0);
  Tcl_DStringInit(dsp);
  for (i = 0; i < objc; i++) {
    Tcl_DStringAppendElement(dsp, ObjStr(objv[i]));
  }
  result = Tcl_Eval(in, Tcl_DStringValue(dsp));
  Tcl_DStringFree(dsp);
  return result;
}
static int 
Tcl_SubstObjCmd(ClientData cd, Tcl_Interp* in, 
		int objc, Tcl_Obj *CONST objv[]) {
  char *ov[20];
  int i;
  assert(objc<19);
  for (i=0; i<objc; i++)
    ov[i] = ObjStr(objv[i]);
  
  return Tcl_SubstCmd(cd, in, objc, ov); 
}
# define SUBST_CMD Tcl_SubstObjCmd
#else
# define SUBST_CMD 0
#endif

/*
 * call a Tcl command with given objv's ... replace objv[0] 
 * with the given command name
 */
static XOTCLINLINE int
callCommand(Tcl_Interp* in,  global_names name,
	    int objc, Tcl_Obj *CONST objv[]) {
  DEFINE_NEW_TCL_OBJECTS_ON_STACK(objc, ov);
  /*
  fprintf(stderr,"calling %s (%p)\n",
     global_strings[name],tcl_commands[name]);
  */
  ov[0] = global_objects[name];
  if (objc > 1)
    memcpy(ov+1, objv+1, sizeof(Tcl_Obj *)*(objc-1));

  return (*tcl_commands[name])(NULL, in, objc, ov);
}

/*
 * call an XOTcl method
 */
static int
callMethod(ClientData cd, Tcl_Interp* in, Tcl_Obj* method, 
	   int objc, Tcl_Obj *CONST objv[], int flags) {
  XOTclObject* obj = (XOTclObject*) cd;
  int result;
  DEFINE_NEW_TCL_OBJECTS_ON_STACK(objc, tov);

#ifdef OBJDELETION_TRACE
  if (method == global_objects[CLEANUP] || 
      method == global_objects[DESTROY]) {
    fprintf(stderr, "%s->%s id=%p destroyCalled=%d\n",
	    ObjStr(obj->cmdName), ObjStr(method), obj, obj->destroyCalled);
  }
#endif
  tov[0] = obj->cmdName;
  tov[1] = method;
  if (objc>2)
    memcpy(tov+2, objv, sizeof(Tcl_Obj *)*(objc-2));

  result = ObjDispatch(cd, in, objc, tov, flags);
  /*fprintf(stderr, "     callMethod returns %d\n", result);*/
  FREE_TCL_OBJECTS_ON_STACK(tov);
  return result;
}

static int
callMethodWithArg(ClientData cd, Tcl_Interp* in, 
		  Tcl_Obj* method, Tcl_Obj* arg,
		  int objc, Tcl_Obj *CONST objv[], int flags) {
  XOTclObject* obj = (XOTclObject*) cd;
  int result;
  DEFINE_NEW_TCL_OBJECTS_ON_STACK(objc, tov);

  tov[0] = obj->cmdName;
  tov[1] = method;
  tov[2] = arg;
  if (objc>3)
    memcpy(tov+3, objv, sizeof(Tcl_Obj *)*(objc-3));

  result = ObjDispatch(cd, in, objc, tov, flags);

  FREE_TCL_OBJECTS_ON_STACK(tov);
  return result;
}

/*
 *  realize self, class, proc through the [self] command
 */

static XOTCLINLINE char*
GetSelfProc(Tcl_Interp *in) {
  return CallStackGetFrame(in)->procName;
}

static XOTCLINLINE XOTclClass*
GetSelfClass(Tcl_Interp *in) {
  return CallStackGetFrame(in)->cl;
}

static XOTCLINLINE XOTclObject*
GetSelfObj(Tcl_Interp* in) {
  return CallStackGetFrame(in)->self;
}

/*
 * prints a msg to the screen that oldCmd is deprecated
 * optinal: give a new cmd
 */
extern void
XOTclDeprecatedMsg(char* oldCmd, char* newCmd) {
  fprintf(stderr, "**\n**\n** The command/method <%s> is deprecated.\n", oldCmd);
  if (newCmd)
    fprintf(stderr, "** Use <%s> instead.\n", newCmd);
  fprintf(stderr, "**\n");
}

static int
XOTcl_DeprecatedCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  char* new;
  if (objc == 2)
    new = 0;
  else if (objc == 3)
    new = ObjStr(objv[2]);
  else
    return XOTclObjErrArgCnt(in, NULL, "deprecated oldcmd ?newcmd?");
  XOTclDeprecatedMsg(ObjStr(objv[1]), new);
  return TCL_OK;
}

/*
 *  Tcl_Obj functions for objects
 */

static void RegisterObjTypes() {
  Tcl_RegisterObjType(&XOTclObjectType);
}

static int
SetXOTclObjectFromAny(Tcl_Interp *interp, register Tcl_Obj * objPtr) {
  Tcl_ObjType *oldTypePtr = objPtr->typePtr;
  char *string = ObjStr(objPtr);
  XOTclObject* obj;

  if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
    oldTypePtr->freeIntRepProc(objPtr);
  }

  obj = GetObject(interp, string);
  if (!obj) {
    if (interp != NULL)
      return XOTclVarErrMsg(interp, "Expected an Object, but got ",
			    string, (char*) NULL);
    return TCL_ERROR;
  }

  objPtr->internalRep.otherValuePtr = (XOTclObject*) obj;
  objPtr->typePtr = &XOTclObjectType;
  return TCL_OK;
}

static void
UpdateStringOfXOTclObject(register Tcl_Obj *objPtr) {
  XOTclObject* obj = (XOTclObject*) objPtr->internalRep.otherValuePtr;
  char* nsFullName = NULL;
  register Command *cmdPtr;

  /* Here we use GetCommandName, because it doesnt need
     Interp*, but Tcl_GetCommandFullName(in,obj->id,ObjName); does*/
  if (obj) {
    cmdPtr = (Command *) obj->id;
  } else {
    cmdPtr = NULL;
  }	
  if (cmdPtr != NULL) {
    Tcl_DString ds, *dsp = &ds;
    unsigned l;
    Tcl_DStringInit(dsp);
    nsFullName = cmdPtr->nsPtr->fullName;
    if (!(*nsFullName==':' && *(nsFullName+1)==':' &&
	  *(nsFullName+2)=='\0')) {
      Tcl_DStringAppend(dsp, nsFullName, -1);
    }
    Tcl_DStringAppend(dsp, "::", 2);
    Tcl_DStringAppend(dsp, Tcl_GetCommandName(NULL, obj->id), -1);

    l = (unsigned) Tcl_DStringLength(dsp)+1;
    objPtr->bytes = (char*) ckalloc(l);
    memcpy(objPtr->bytes, Tcl_DStringValue(dsp), l);
    objPtr->length = Tcl_DStringLength(dsp);
    Tcl_DStringFree(dsp);
  } else {
    objPtr->bytes = NULL;
    objPtr->length = 0;
  }
}

static Tcl_Obj *
NewXOTclObjectObj(register XOTclObject* obj)
{
    register Tcl_Obj *objPtr = 0;

    XOTclNewObj(objPtr);
    objPtr->bytes = NULL;

    objPtr->internalRep.otherValuePtr = obj;
    objPtr->typePtr = &XOTclObjectType;
    return objPtr;
}

/*
static void
SetXOTclObjectObj(objPtr, obj)
    register Tcl_Obj *objPtr;
    register XOTclObject* obj;
{
    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;

    if (Tcl_IsShared(objPtr)) {
  	panic("Tcl_SetXOTclObjectObj called with shared object");
    }

    Tcl_InvalidateStringRep(objPtr);
    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
	oldTypePtr->freeIntRepProc(objPtr);
    }

    objPtr->internalRep.otherValuePtr = obj;
    objPtr->typePtr = &XOTclObjectType;
}

static int
GetXOTclObjectfromObj(interp, objPtr, obj)
    register Tcl_Interp *interp; 	
    register Tcl_Obj *objPtr;	
    register XOTclObject **obj;
{
    register int result;

    result = SetXOTclObjectFromAny(interp, objPtr);
    if (result == TCL_OK) {
	*obj = (XOTclObject*) objPtr->internalRep.otherValuePtr;
    }
    return result;
}
*/

/*
 * precedence ordering functions
 */

enum colors { WHITE, GRAY, BLACK };

static int
TopoSort(XOTclClass* cl, XOTclClass* base, XOTclClasses* (*next)(XOTclClass*)) {
  XOTclClasses* sl = (*next)(cl);
  XOTclClasses* pl;

  /*
   * careful to reset the color of unreported classes to
   * white in case we unwind with error, and on final exit
   * reset color of reported classes to white
   */

  cl->color = GRAY;
  for (; sl != 0; sl = sl->next) {
    XOTclClass* sc = sl->cl;
    if (sc->color==GRAY) { cl->color = WHITE; return 0; }
    if (sc->color==WHITE && !TopoSort(sc, base, next)) {
      cl->color=WHITE;
      if (cl == base) {
        XOTclClasses* pc = cl->order;
        while (pc != 0) { pc->cl->color = WHITE; pc = pc->next; }
      }
      return 0;
    }
  }
  cl->color = BLACK;
  pl = (XOTclClasses*)ckalloc(sizeof(XOTclClasses));
  pl->cl = cl;
  pl->next = base->order;
  base->order = pl;
  if (cl == base) {
    XOTclClasses* pc = cl->order;
    while (pc != 0) { pc->cl->color = WHITE; pc = pc->next; }
  }
  return 1;
}

extern void
XOTclRemoveClasses(XOTclClasses* sl) {
  while (sl != 0) {
    XOTclClasses* n = sl->next;
    ckfree((char*)sl); sl = n;
  }
}

extern void
XOTclAddClass(XOTclClasses** cList, XOTclClass* cl) {
  XOTclClasses *l = *cList,
    *new = (XOTclClasses*) ckalloc(sizeof (XOTclClasses));

  new->cl = cl;
  new->next = NULL;
  if (l) {
    while (l->next) l = l->next;
    l->next = new;
  } else
    *cList = new;
}

static XOTclClasses* Super(XOTclClass* cl) { return cl->super; }
static XOTclClasses* Sub(XOTclClass* cl) { return cl->sub; }

static XOTclClasses*
TopoOrder(XOTclClass* cl, XOTclClasses* (*next)(XOTclClass*)) {
     if (TopoSort(cl, cl, next))
	  return cl->order;
     XOTclRemoveClasses(cl->order);
     cl->order = 0;
     return 0;
}

static XOTCLINLINE XOTclClasses*
ComputeOrder(XOTclClass *cl, XOTclClasses* (*direction)(XOTclClass*)) {
  if (cl->order)
    return cl->order;
  return (cl->order = TopoOrder(cl, direction));
}

extern XOTclClasses*
XOTclComputePrecedence(XOTclClass* cl) {
  return ComputeOrder(cl, Super);
}

extern XOTclClasses*
XOTclComputeDependents(XOTclClass* cl) {
  return ComputeOrder(cl, Sub);
}

static void
FlushPrecedences(XOTclClass* cl) {
  XOTclClasses* pc;
  XOTclRemoveClasses(cl->order); cl->order = 0;
  pc = ComputeOrder(cl, Sub);

  /*
   * ordering doesn't matter here - we're just using toposort
   * to find all lower classes so we can flush their caches
   */

  if (pc) pc = pc->next;
  while (pc != 0) {
    XOTclRemoveClasses(pc->cl->order); pc->cl->order = 0;
    pc = pc->next;
  }
  XOTclRemoveClasses(cl->order); cl->order = 0;
}

static void
AddInstance(XOTclObject* obj, XOTclClass* cl) {
  obj->filterinfo.valid = 0;
  obj->cl = cl;
  if (cl != 0) {
    int nw;
    (void) Tcl_CreateHashEntry(&cl->instances, (char*)obj, &nw);
  }
}

static int
RemoveInstance(XOTclObject* obj, XOTclClass* cl) {
  obj->filterinfo.valid = 0;
  if (cl) {
    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&cl->instances, (char*)obj);
    if (hPtr) {
	Tcl_DeleteHashEntry(hPtr);
	return 1;
    }
  }
  return 0;
}

/*
 * superclass/subclass list maintenance
 */

static void
AS(XOTclClass* cl, XOTclClass* s, XOTclClasses** sl) {
  XOTclClasses* l = *sl;
  while (l &&  l->cl != s) l = l->next;
  if (!l) {
    XOTclClasses* sc = (XOTclClasses*)ckalloc(sizeof(XOTclClasses));
    sc->cl = s; sc->next = *sl; *sl = sc;
  }
}

static void
AddSuper(XOTclClass* cl, XOTclClass* super) {
  if (cl && super) {
    /*
     * keep corresponding sub in step with super
     */
    AS(cl, super, &cl->super);
    AS(super, cl, &super->sub);
  }
}

static int
RemoveSuper1(XOTclClass* cl, XOTclClass* s, XOTclClasses** sl) {
  XOTclClasses* l = *sl;
  if (!l) return 0;
  if (l->cl == s) {
    *sl = l->next;
    ckfree((char*)l);
    return 1;
  }
  while (l->next && l->next->cl != s) l = l->next;
  if (l->next) {
    XOTclClasses* n = l->next->next;
    ckfree((char*)(l->next));
    l->next = n;
    return 1;
  }
  return 0;
}

static int
RemoveSuper(XOTclClass* cl, XOTclClass* super) {
  /*
   * keep corresponding sub in step with super
   */
  int sp = RemoveSuper1(cl, super, &cl->super);
  int sb = RemoveSuper1(super, cl, &super->sub);

  return sp && sb;
}

/*
 * internal type checking
 */

extern XOTCLINLINE int
XOTclIsType(XOTclObject* obj, XOTclClass* type) {
  register XOTclClass* t = obj ? obj->type : 0;
  while (t && type && t != type)
    t = t->parent;
  return t != 0;
}

extern XOTclObject*
XOTclIsObject(Tcl_Interp* in, ClientData cd) {
  return XOTclIsType((XOTclObject*)cd, RUNTIME_STATE(in)->theObject) ?
    (XOTclObject*)cd : 0;
}
extern  XOTclClass*
XOTclIsClass(Tcl_Interp* in, ClientData cd) {
  return XOTclIsType((XOTclObject*)cd, RUNTIME_STATE(in)->theClass) ?
    (XOTclClass*)cd : 0;
}

/*
 * methods lookup
 */

static XOTCLINLINE Command*
FindMethod (char* methodName, Namespace* nsPtr) {
  Tcl_HashEntry* entryPtr;
  assert(nsPtr);
  
  if ((entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, methodName))) {
    Command *cp = (Command *) Tcl_GetHashValue(entryPtr);
    if (cp->objProc != XOTclObjDispatch)
      return cp;
  }
  return NULL;
}

static XOTclClass*
SearchCMethod(XOTclObject* obj,
	      XOTclClass* cl,
	      XOTclClasses* pl,
	      char* nm,
	      Command **procInfo) {
  if (cl) {
    if (!cl->order)
      cl->order = ComputeOrder(cl, Super);
    pl = cl->order;
  }

  /* Search the class hierarchy */
  while (pl) {
    Command *pi = FindMethod(nm, pl->cl->nsPtr);
    if (pi) {
      *procInfo = pi;
      return pl->cl;
    }
    pl = pl->next;
  }
  *procInfo = NULL;
  return NULL;
}

static int
callDestroyMethod(ClientData cd, Tcl_Interp *in,
		  XOTclObject* obj, int flags) {
  int result;

  /* don't call destroy after exit handler started physical
     destruction */
  if (RUNTIME_STATE(in)->exitHandlerDestroyRound ==
      XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY)
    return TCL_OK;

  /* we don't call destroy, if we're in the exit handler
     during destruction of Object and Class */
  if (!RUNTIME_STATE(in)->callDestroy) {
    obj->destroyCalled = 1;
    /* return TCL_ERROR so that clients know we haven't deleted the
       associated command yet */
    return TCL_ERROR;
  }
  if (obj->destroyCalled)
    return TCL_OK;

#if !defined(NDEBUG)
  {char* cmdName = ObjStr(obj->cmdName);
  assert(ObjStr(obj->cmdName));
  assert(((Command *)Tcl_FindCommand(in, cmdName, NULL, 0)) != NULL);
  }
#endif


#ifdef OBJDELETION_TRACE
  fprintf(stderr, "   command found\n");
  PRINTOBJ("callDestroy", obj);
#endif
  result = callMethod(cd, in, global_objects[DESTROY], 2, 0, flags);
  if (result != TCL_OK) {
    static char cmd[] =
	"puts stderr \"[self]: Error in instproc destroy\n\
	 $::errorCode $::errorInfo\"";
    Tcl_VarEval(in, cmd, 0);
    if (++RUNTIME_STATE(in)->errorCount > 20)
      panic("too many destroy errors occured. Endless loop?", NULL);
  } else {
    if (RUNTIME_STATE(in)->errorCount > 0)
      RUNTIME_STATE(in)->errorCount--;
  }

#ifdef OBJDELETION_TRACE
  fprintf(stderr, "callDestroyMethod for %p exit\n", obj);
#endif
  return result;
}

/*
 * Namespace related commands
 */

static int
NSDeleteCmd(Tcl_Interp* in, Namespace* ns, char* name) {
  /* a simple deletion would delete a global command with
     the same name, if the command is not existing, so
     we use the CmdToken */
  Command* token = FindMethod (name, ns);
  /*fprintf(stderr, "NSDeleteCmd for %s\n",name);*/
  if (token) {
    return Tcl_DeleteCommandFromToken(in, (Tcl_Command) token);
  }
  return 0;
}

static Tcl_Command
NSCreateObjCmd(Tcl_Interp* in, char *cmdName, Tcl_ObjCmdProc *proc,
                ClientData cD, Tcl_CmdDeleteProc *dProc, Namespace* ns) {
    Tcl_DString ds;
    Tcl_Command c;

    ALLOC_NAME_NS (&ds, ns->fullName, cmdName);

    c = Tcl_CreateObjCommand(in, Tcl_DStringValue(&ds), *proc, cD, dProc);
    Tcl_DStringFree(&ds);
    return c;
}

static void
CallStackDestroyObject(Tcl_Interp* in, XOTclObject* obj);
static void
PrimitiveCDestroy(ClientData cd);
static void
PrimitiveODestroy(ClientData cd);

static void
NSDeleteChildren(Tcl_Interp* in, Namespace* nsPtr) {
  if (&nsPtr->childTable) {
    Tcl_HashSearch hSrch;
    Tcl_HashEntry* hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &hSrch);
    for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
      char *oname = Tcl_GetHashKey(&nsPtr->childTable, hPtr);
      Tcl_DString name;
      XOTclObject* obj;

      ALLOC_NAME_NS(&name, nsPtr->fullName, oname);
      obj = GetObject(in, Tcl_DStringValue(&name));
      assert(obj);

      /* in the exit handler physical destroy --> directly call destroy */
      if (RUNTIME_STATE(in)->exitHandlerDestroyRound 
          == XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY) {
        XOTclClass* cl = GetClass(in, ObjStr(obj->cmdName));
        if (cl)
          PrimitiveCDestroy((ClientData) cl);
        else
          PrimitiveODestroy((ClientData) obj);

      } else { /* FIXME: part below was not conditionaly executed */

        if (obj->teardown != 0 && obj->id && !obj->destroyCalled) {
          /*         Tcl_Command oid = obj->id;*/
          if (callDestroyMethod((ClientData)obj, in, obj, 0) != TCL_OK) {
            /* destroy method failed, but we have to remove the command
               anyway. */
            obj->destroyCalled = 1;
            if (obj->teardown) {
              CallStackDestroyObject(in, obj);
            }
            /*(void*) Tcl_DeleteCommandFromToken(in, oid);*/
          }
        }
      }
      Tcl_DStringFree(&name);
    }
  }
}

static void
NSNamespaceDeleteProc(ClientData clientData) {
    /*	
	fprintf(stderr, "NSDeleteNamespace deleting %s\n", nsPtr->fullName);
    */
}

/* delete a namespace recursively, but check whether the
   namespace is an object or not */
static void
NSDeleteNamespace(Tcl_Interp* in, Namespace* nsPtr) {
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;

  NSDeleteChildren(in, nsPtr);

  hPtr = &nsPtr->childTable ?
    Tcl_FirstHashEntry(&nsPtr->childTable, &hSrch) : 0;

  for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
    Namespace *child = ((Namespace*)Tcl_GetHashValue(hPtr));
    NSDeleteNamespace(in, child);
  }
  /*	
  fprintf(stderr, "NSDeleteNamespace deleting %s\n", nsPtr->fullName);
  */
  Tcl_DeleteNamespace((Tcl_Namespace*) nsPtr);
}

/*
 * delete all vars & procs in a namespace
 */
static void
NSCleanupNamespace(Tcl_Interp* in, Namespace* nsPtr) {
  Interp *iPtr = (Interp *) in;
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;
  Command* procInfo;
  /* 
   * Delete all variables and initialize var table again
   * (deletevars frees the vartable)
   */
  TclDeleteVars(iPtr, &nsPtr->varTable);
  Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
  
  /* 
   * Delete all user-defined procs in the namespace
   */
  hPtr = &nsPtr->cmdTable ?
    Tcl_FirstHashEntry(&nsPtr->cmdTable, &hSrch) : 0;
  while (hPtr != NULL) {
    procInfo = (Command *) Tcl_GetHashValue(hPtr);
    if (TclIsProc(procInfo)) /* +++uwe, das tcl macht das auch nicht+++*/
      Tcl_DeleteCommandFromToken(in, (Tcl_Command)procInfo);
    hPtr = Tcl_NextHashEntry(&hSrch);
  }
}

/* cuts preceding ::XOTclClasses away */
#define NSCutXOTclClasses(n) (\
	(strncmp(n, "::XOTclClasses", 14) == 0) ?(n + 14) : n)
/*
#define NSCutXOTclClasses(n) (\
	(strncmp(n, "::xotcl::classes", 16) == 0) ?(n + 16) : n)
*/

static void
NSBuildFullName(Tcl_Interp* in, Namespace* nsPtr) {
  Interp *iPtr = (Interp *) in;
  Namespace *ancestorPtr;
  Namespace *globalNsPtr = iPtr->globalNsPtr;
  Tcl_DString buffer1, buffer2;
  char* name;
  int l;
  /*
   * Build the fully qualified name for this namespace.
   * this is from Tcl_CreateNamespace in the Tcl - Source
   */
  Tcl_DStringInit(&buffer1);
  Tcl_DStringInit(&buffer2);
  for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
       ancestorPtr = ancestorPtr->parentPtr) {
    if (ancestorPtr != globalNsPtr) {
      Tcl_DStringAppend(&buffer1, "::", 2);
      Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
    }
    Tcl_DStringAppend(&buffer1,
		      Tcl_DStringValue(&buffer2),
		      Tcl_DStringLength(&buffer2));

    Tcl_DStringSetLength(&buffer2, 0);
    Tcl_DStringAppend(&buffer2,
		      Tcl_DStringValue(&buffer1),
		      Tcl_DStringLength(&buffer1));
    Tcl_DStringSetLength(&buffer1, 0);
  }

  l = Tcl_DStringLength(&buffer2)+1;
  name = Tcl_DStringValue(&buffer2);
  if (nsPtr->fullName) ckfree((char*)nsPtr->fullName);
  nsPtr->fullName = (char *) ckalloc((unsigned)l);
  memcpy(nsPtr->fullName, name, l);
  Tcl_DStringFree(&buffer1);
  Tcl_DStringFree(&buffer2);
}

static void
NSTreeBuildFullName(Tcl_Interp* in, Namespace* nsPtr) {
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr = &nsPtr->childTable ?
    Tcl_FirstHashEntry(&nsPtr->childTable, &hSrch) : 0;
  for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
    Namespace *child = ((Namespace*)Tcl_GetHashValue(hPtr));
    NSTreeBuildFullName(in, child);
  }
  NSBuildFullName(in, nsPtr);
}

/*
 * check colons for illegal object/class names
 */

static XOTCLINLINE int
NSCheckColons(char* name, int l) {
  register char* n = name;
  if (*n == '\0') return 0; /* empty name */
  if (*(n+l-1) == ':')  return 0; /* name ends with : */
  if (*n == ':' && *(n+1) != ':') return 0; /* name begins with single : */
  for (; *n != '\0'; n++) {
    if (*n == ':' && *(n+1) == ':' && *(n+2) == ':')
      return 0;   /* more than 2 colons in series in a name */
  }
  return 1;
}

/*
 * check for parent namespace existance (used before commands are created)
 */
static XOTCLINLINE int
NSCheckForParent(Tcl_Interp* in, char* name, int l) {
  register char* n = name+l;
  while ((*n != ':' || *(n-1) != ':') && n-1 > name) {n--; } /*search for last '::'*/
  if (*n == ':' && n > name && *(n-1) == ':') {n--;}

  if ((n-name)>0) {
    Tcl_DString parentNSName;
    Namespace* nsPtr;
    Tcl_DStringInit(&parentNSName);
    Tcl_DStringAppend(&parentNSName, name, (n-name));
    nsPtr = (Namespace*)Tcl_FindNamespace(in, Tcl_DStringValue(&parentNSName),
					  (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&parentNSName);
    if (nsPtr == 0) 
      return 0;
  }
  return 1;
}

static int
GetProcDefault(Tcl_Interp* in, Tcl_HashTable* table,
	       char* name, char* arg, Tcl_Obj** resultObj);


/*
 * Autonaming
 */

static Tcl_Obj*
AutonameIncr(Tcl_Interp* in, Tcl_Obj* Name, XOTclObject* obj,  int instanceOpt, int resetOpt) {
  int valueLength, cmdNameLength, mustCopy=1, format = 0;
  char *valueString, *c,
    *cmdName = Tcl_GetStringFromObj(obj->cmdName,&cmdNameLength);
  Tcl_Obj* valueObject, *result=NULL, *autonames, *savedResult;

  autonames = Tcl_NewStringObj(cmdName, cmdNameLength);
  INCR_REF_COUNT(autonames);

  Tcl_AppendToObj(autonames, "::", 2);
  Tcl_AppendToObj(autonames, global_strings[AUTONAMES], -1);
  valueObject = TclIncrVar2(in, autonames, Name, 1, 0);

  if (resetOpt) {
    if (valueObject != NULL) { /* we have an entry */
      Tcl_UnsetVar2(in, ObjStr(autonames), ObjStr(Name), (TCL_LEAVE_ERR_MSG));
    }
    result = global_objects[EMPTY];
    DECR_REF_COUNT(autonames);
  } else {
    if (valueObject == NULL) {
      valueObject = Tcl_ObjSetVar2(in, autonames, Name,
				   global_objects[ZERO], 0);
    }
    DECR_REF_COUNT(autonames);

    if (instanceOpt) {
      char buffer[1], firstChar, *nextChars;
      nextChars = ObjStr(Name);
      firstChar = *(nextChars ++);
      if (isupper((int)firstChar)) {
	buffer[0] = tolower((int)firstChar);
	result = Tcl_NewStringObj(buffer,1);
	Tcl_AppendToObj(result, nextChars, -1);
	mustCopy = 0;
      }
    }
    if (mustCopy) {
      result = Tcl_DuplicateObj(Name);
    }
    valueString = Tcl_GetStringFromObj(valueObject,&valueLength);

    /* if we find a % in the autoname -> We use Tcl_FormatObjCmd
       to let the autoname string be formated, like Tcl "format"
       command, with the value. E.g.:
	    autoname a%06d --> a000000, a000001, a000002, ...
    */
    c = ObjStr(result);
    while (c != 0 && *c != '\0') {
      if (*c == '%') {
	if (*(c+1) != '%') {
	  format = 1; break;
	} else {
	  /* when we find a %% we format and then append autoname, e.g.
	     autoname a%% --> a%1, a%2, ... */
	  format = 2;
	}
      }
      c++;
    }

    if (format) {
      DEFINE_NEW_TCL_OBJECTS_ON_STACK(3, ov);
      savedResult = Tcl_GetObjResult(in);
      INCR_REF_COUNT(savedResult);
      ov[0] = global_objects[FORMAT];
      ov[1] = result;
      ov[2] = valueObject;
      if (Tcl_EvalObjv(in, 3, ov, 0) != TCL_OK)
	return 0;
      result = Tcl_DuplicateObj(Tcl_GetObjResult(in));
      Tcl_SetObjResult(in, savedResult);
      DECR_REF_COUNT(savedResult);
      FREE_TCL_OBJECTS_ON_STACK(ov);
    }
    if (format != 1) {
      /* append the value string, if not
	 formated or if only %% occurs */
      Tcl_AppendToObj(result, valueString, valueLength);
    }
  }
  return result;
}

/*
 * XOTcl CallStack
 */

static XOTCLINLINE int
CallStackPush(Tcl_Interp* in, XOTclObject* obj, XOTclClass* cl, 
	      char* procName,
	      int objc, Tcl_Obj *CONST objv[],
	      int isFilterEntry, int isMixinEntry) {
  XOTclCallStack *cs;
  register XOTclCallStackContent *csc;

  cs = &RUNTIME_STATE(in)->cs;
  if (cs->top >= &cs->content[MAX_NESTING_DEPTH-1]) {
    Tcl_SetResult(in,
		  "too many nested calls to Tcl_EvalObj (infinite loop?)",
		  TCL_STATIC);
    return TCL_ERROR;
  }
  csc = ++cs->top;
  csc->self          = obj;

  /*fprintf(stderr, "PUSH=obj %s proc %s\n", obj->nsPtr->fullName, procName);*/

  csc->cl            = cl;
  csc->procName      = procName;
  csc->destroyedCmd  = 0;
  csc->isFilterEntry = isFilterEntry;
  csc->isMixinEntry  = isMixinEntry;
  csc->frameCut      = 0;
  csc->objv          = objv;
  csc->objc          = objc;

  cs->topFrameCache = 0;
  return TCL_OK;
}

static XOTCLINLINE void
CallStackDoDestroy(Tcl_Interp* in, XOTclObject* obj) {
  Tcl_Command oid;

  oid = obj->id;
  PRINTOBJ("CallStackDoDestroy", obj);

  obj->id = 0;
  if (obj->teardown && oid) {
    Tcl_DeleteCommandFromToken(in, oid);
  }
}

static void
CallStackDestroyObject(Tcl_Interp* in, XOTclObject* obj) {
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc;
  int countSelfs = 0;

  Tcl_Command oid = obj->id;

  for (csc = &cs->content[1]; csc <= cs->top; csc++) {
    if (csc->self == obj) {
      csc->destroyedCmd = (Command *) oid;
      if (csc->destroyedCmd) {
	csc->destroyedCmd->refCount++;
      }
      countSelfs++;
    }
  }
  /* if the object is not referenced at the callstack anymore
     we have to directly destroy it, because CallStackPop won't
     find the object destroy */
  if (countSelfs == 0) {
    CallStackDoDestroy(in, obj);
  } else
    /* to prevail the deletion order call delete children now
       -> children destructors are called before parent's
       destructor */
    if (obj->teardown)
      NSDeleteChildren(in, obj->nsPtr);
}

static XOTCLINLINE int
CallStackIsDestroyed(Tcl_Interp* in) {
  return (RUNTIME_STATE(in)->cs.top->destroyedCmd == NULL) ? 0 : 1;
}

static XOTCLINLINE void
CallStackPop(Tcl_Interp* in) {
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc;
  XOTclCallStackContent *h = cs->top;

  assert(cs->top > cs->content);
  csc = cs->top;
  if (csc->destroyedCmd != 0) {
    int destroy = 1;
    TclCleanupCommand(csc->destroyedCmd);
    /* do not physically destroy, when callstack still contains "self"
       entries of the object */
    while (--h > cs->content) {
      if (h->self == csc->self) {
	destroy = 0;
	break;
      }
    }
    if (destroy) {
      CallStackDoDestroy(in, csc->self);
    }
  }

  cs->topFrameCache = 0;
  cs->top--;
}

static XOTclCallStackContent*
CallStackGetFrame(Tcl_Interp* in) {
  Interp *iPtr = (Interp *) in;
  CallFrame *v = iPtr->varFramePtr, *f = iPtr->framePtr;
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *top = cs->top;

  if (cs->topFrameCache)
    return cs->topFrameCache;

  /* the xotcl call stack contains entries for filters, these are cut out
     of the tcl stack -> determine the entry in the xotcl stack that
     corresponds to the varFramePtr of the tcl stack */
  if (f && v) {
    int i, diff = f->level - v->level;
    XOTclCallStackContent *bot =  cs->content;
    CallFrame* d = iPtr->framePtr;

    for (i = diff; i > 0; i--, d = d->callerPtr) {
      if (d && d->nsPtr
	  && !GetObject(in, d->nsPtr->fullName)
	  && !GetClass(in, NSCutXOTclClasses(d->nsPtr->fullName))) {
	diff--;
      }
    }

    /* step through the diff, overstep filters */
    while (diff > 0 && top > bot) {
      if (!top->isFilterEntry)
        diff--;
      do
	top--;
      while (top->isFilterEntry);
    }
  }
  cs->topFrameCache = top;
  return top;
}

/*
 * Assertions
 */

static void
AssertionDeleteList(XOTclAssertion* alist) {
  XOTclAssertion* delAss;
  while (alist) {
    delAss = alist;
    alist = alist->next;
    DECR_REF_COUNT(delAss->content);
    ckfree((char*)delAss);
  }
}

static XOTclAssertion*
AssertionNewElement(Tcl_Interp* in, Tcl_Obj* ov) {
  XOTclAssertion* elt = (XOTclAssertion *)ckalloc(sizeof(XOTclAssertion));
  INCR_REF_COUNT(ov);
  elt->content = ov;
  elt->next = NULL;
  return elt;
}

static XOTclAssertion*
AssertionNewList(Tcl_Interp* in, Tcl_Obj* aObj) {
  Tcl_Obj **ov; int oc;
  XOTclAssertion *last=NULL, *result=NULL, *elt;

  if (Tcl_ListObjGetElements(in, aObj, &oc, &ov) == TCL_OK) {
    if (oc > 0) {
      int i;
      result = last = AssertionNewElement(in, ov[0]);
      for (i=1; i<oc; i++) {
	elt = AssertionNewElement(in, ov[i]);
	last->next = elt;
	last = elt;
      }
    }
  }
  return result;
}

static Tcl_Obj*
AssertionList(Tcl_Interp* in, XOTclAssertion* alist) {
  Tcl_Obj* newAssStr = Tcl_NewStringObj("",0); 
  for (; alist!=NULL; alist = alist->next) {
    Tcl_AppendStringsToObj(newAssStr, "{",  ObjStr(alist->content),
			   "}", (char *) NULL);
    if (alist->next != NULL) 
      Tcl_AppendStringsToObj(newAssStr, " ", (char*) NULL);
  }
  return newAssStr;
}

/* append a string of pre and post assertions to a proc
   or instproc body */
static void
AssertionAppendPrePost(Tcl_Interp* in, Tcl_DString *dsPtr, 
		       XOTclProcAssertion* procs) {
  if (procs) {
    Tcl_Obj* preAss = AssertionList(in, procs->pre);
    Tcl_Obj* postAss = AssertionList(in, procs->post);
    INCR_REF_COUNT(preAss); INCR_REF_COUNT(postAss);
    Tcl_DStringAppendElement(dsPtr, ObjStr(preAss));
    Tcl_DStringAppendElement(dsPtr, ObjStr(postAss));
    DECR_REF_COUNT(preAss); DECR_REF_COUNT(postAss);
  }
}

static void
AssertionListCheckOption(Tcl_Interp* in, XOTclObject* obj) {
  if (obj->checkoptions & CHECK_OBJINVAR)
    Tcl_AppendElement(in, "invar");
  if (obj->checkoptions & CHECK_CLINVAR)
    Tcl_AppendElement(in, "instinvar");
  if (obj->checkoptions & CHECK_PRE)
    Tcl_AppendElement(in, "pre");
  if (obj->checkoptions & CHECK_POST)
    Tcl_AppendElement(in, "post");
}

static XOTclProcAssertion*
AssertionFindProcs(XOTclAssertionStore* aStore, char* name) {
  Tcl_HashEntry *hPtr;
  if (aStore == NULL) return NULL;
  hPtr = Tcl_FindHashEntry(&aStore->procs, name);
  if (hPtr == NULL) return NULL;
  return (XOTclProcAssertion*) Tcl_GetHashValue(hPtr);
}

static void
AssertionRemoveProc(XOTclAssertionStore* aStore, char* name) {
  Tcl_HashEntry *hPtr;
  if (aStore) {
    hPtr = Tcl_FindHashEntry(&aStore->procs, name);
    if (hPtr) {
      XOTclProcAssertion* procAss = 
	(XOTclProcAssertion*) Tcl_GetHashValue(hPtr);
      AssertionDeleteList(procAss->pre);
      AssertionDeleteList(procAss->post);
      ckfree((char*)procAss);
      Tcl_DeleteHashEntry(hPtr);
    }
  }
}

static void
AssertionAddProc(Tcl_Interp* in, char* name, XOTclAssertionStore* aStore,
		 Tcl_Obj* pre, Tcl_Obj* post) {
  int nw = 0; Tcl_HashEntry* hPtr = NULL;
  XOTclProcAssertion* procs = 
    (XOTclProcAssertion *) ckalloc(sizeof(XOTclProcAssertion));
  AssertionRemoveProc(aStore, name);
  procs->pre = AssertionNewList(in, pre);
  procs->post = AssertionNewList(in, post);
  hPtr = Tcl_CreateHashEntry(&aStore->procs, name, &nw);
  if (nw) Tcl_SetHashValue(hPtr, (ClientData)procs);
}


XOTclAssertionStore* 
AssertionCreateStore() {
  XOTclAssertionStore* aStore = 
    (XOTclAssertionStore*)ckalloc(sizeof(XOTclAssertionStore));
  aStore->invariants = NULL;
  Tcl_InitHashTable(&aStore->procs, TCL_STRING_KEYS);
  return aStore;
}


static void
AssertionRemoveStore(XOTclAssertionStore* aStore) {
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;
  if (aStore) {
    hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch);
    while (hPtr) {
      AssertionRemoveProc(aStore, Tcl_GetHashKey(&aStore->procs, hPtr));
      hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch); /** +++uwe, nicht *next*has entry? */
    }
    Tcl_DeleteHashTable(&aStore->procs);
    AssertionDeleteList(aStore->invariants);
    ckfree((char*)aStore);
  }
}

static int
AssertionCheckList(Tcl_Interp* in, XOTclObject* obj,
		   XOTclAssertion* alist, char* methodName) {
  char* strResult = 0;
  int result;
  XOTclAssertion* checkFailed = NULL;
  Tcl_Obj* savedObjResult = Tcl_GetObjResult(in);
  int savedCheckoptions;

  /* we do not check assertion modifying methods, otherwise
     we can not react in catch on a runtime assertion check failure */
  if (isCheckString(methodName) || isInfoString(methodName) ||
      isInvarString(methodName) || isInstinvarString(methodName) ||
      isProcString(methodName) || isInstprocString(methodName))
    return TCL_OK;

  INCR_REF_COUNT(savedObjResult);
  Tcl_ResetResult(in);

  while (alist != NULL) {
    /* Eval instead of IfObjCmd => the substitutions in the
       conditions will be done by Tcl */
    char* assStr = ObjStr(alist->content), *c = assStr;
    int comment = 0;
    Tcl_Obj* ifCmd;

    while (c != 0 && *c != '\0') {
      if (*c == '#') {
	comment = 1; break;
      }
      c++;
    }
    if (!comment) {
      Tcl_CallFrame frame;
      Tcl_PushCallFrame(in, &frame, (Tcl_Namespace*)obj->nsPtr,0);
      CallStackPush(in, obj, 0, 0, 0, 0, 0, 0);

      /* don't check assertion during assertion check */
      savedCheckoptions = obj->checkoptions;
      obj->checkoptions = CHECK_NONE;

      ifCmd = Tcl_NewStringObj("if {",-1);
      INCR_REF_COUNT(ifCmd);
      Tcl_AppendStringsToObj(ifCmd, assStr,
			     "} {return 1} else {return 0}", (char*)NULL);

      /*fprintf(stderr, "Checking Assertion %s ", assStr);*/

      result = EvalObj(in, ifCmd);

      obj->checkoptions = savedCheckoptions;

      DECR_REF_COUNT(ifCmd);
      strResult = Tcl_GetStringResult(in);
      if ((result == TCL_ERROR) || (*strResult != '1'))
	checkFailed = alist;
      /*
	 if (checkFailed)
	 fprintf(stderr, "...failed\n");
	 else
	 fprintf(stderr, "...ok\n");
      */
      CallStackPop(in);
      Tcl_PopCallFrame(in);
    }
    if (checkFailed)
      break;
    alist = alist->next;
  }

  if (checkFailed != NULL) {
    DECR_REF_COUNT(savedObjResult);
    return XOTclVarErrMsg(in,
			  "Error - Assertion failed check: {",
			  ObjStr(checkFailed->content), "} in proc '",
			  GetSelfProc(in), "'",(char*)NULL);
  }

  Tcl_SetObjResult(in, savedObjResult);
  DECR_REF_COUNT(savedObjResult);
  return TCL_OK;
}

static int
AssertionCheckInvars(Tcl_Interp* in, XOTclObject* obj, char* method) {
  int result = TCL_OK;
  if (obj->checkoptions & CHECK_OBJINVAR && obj->assertions)
    result = AssertionCheckList(in, obj, obj->assertions->invariants, method);

  if (result != TCL_ERROR && obj->checkoptions & CHECK_CLINVAR) {
    XOTclClasses* clPtr;
    if (!obj->cl->order)
      obj->cl->order = ComputeOrder(obj->cl, Super);
    clPtr = obj->cl->order;
    while (clPtr != 0 && result != TCL_ERROR) {
      XOTclAssertionStore* aStore = clPtr->cl->assertions;
      if (aStore) 
	result = AssertionCheckList(in, obj, aStore->invariants, method);
      
      clPtr = clPtr->next;
    }
  }
  return result;
}

static int
AssertionCheck(Tcl_Interp* in, XOTclObject* obj, XOTclClass* cl,
	       char* method, int checkOption) {
  XOTclProcAssertion* procs;
  int result = TCL_OK;
  XOTclAssertionStore* aStore = cl ? cl->assertions : obj->assertions;

  if (checkOption & obj->checkoptions) {
    procs = AssertionFindProcs(aStore, method);
    if (procs) {
      switch (checkOption) {
      case CHECK_PRE: 
	result = AssertionCheckList(in, obj, procs->pre, method);
	break;
      case CHECK_POST: 
	result = AssertionCheckList(in, obj, procs->post, method);
	break;
      }
    }
    if (result != TCL_ERROR)
      result = AssertionCheckInvars(in, obj, method);
  }
  return result;
}

static int
callProcCheck(ClientData cp, Tcl_Interp* in, int objc, Tcl_Obj *CONST objv[],
	      Command *procInfo,
	      XOTclObject* obj, XOTclClass *cl, char *methodName,
	      int isFilterEntry , int isMixinEntry, int* isDestroyed) {
  int result;
  Interp *iPtr = (Interp *) in;

#if defined(PROFILE)
  long int startUsec, startSec;
  struct timeval trt;

  gettimeofday(&trt, NULL);
  startSec  = trt.tv_sec;
  startUsec = trt.tv_usec;
#endif
  assert(obj);

  if (isDestroyed != 0)
    *isDestroyed = 0;
  if (!TclIsProc(procInfo)) {
    if (obj->teardown && obj->checkoptions & CHECK_INVAR &&
	AssertionCheckInvars(in, obj, methodName) == TCL_ERROR)
      return TCL_ERROR;

    RUNTIME_STATE(in)->callIsDestroy = 0;

    result = (*procInfo->objProc)(cp, in, objc, objv);
    /*
    if (obj && obj->teardown && cl && !obj->destroyCalled) {
      fprintf(stderr, "Obj= %s ", ObjStr(obj->cmdName));
      fprintf(stderr, "CL= %s ", ObjStr(cl->object.cmdName));
      fprintf(stderr, "method=%s\n", methodName);
      }
    */

    if (!RUNTIME_STATE(in)->callIsDestroy && 
	obj->checkoptions & CHECK_INVAR &&
	AssertionCheckInvars(in, obj, methodName) == TCL_ERROR)
      return TCL_ERROR;
  } else
    if (CallStackPush(in, obj, cl, methodName, objc, objv,
		      isFilterEntry, isMixinEntry) == TCL_OK) {
      int destroyed = 0;
      if (obj->teardown && !obj->destroyCalled && 
	  obj->checkoptions != CHECK_NONE &&
	  AssertionCheck(in, obj, cl, methodName, CHECK_PRE) == TCL_ERROR) {
	CallStackPop(in);
	return TCL_ERROR;
      }
      if (iPtr->numLevels <= 2) RUNTIME_STATE(in)->returnCode=0;
#ifdef DISPATCH_TRACE
      {
	int i, j = 0;
	fprintf(stderr, "     (%d) >callProcCheck: ", iPtr->numLevels);
	if (objc <= 3) j=objc; else j=3;
	for (i=0;i<j;i++) fprintf(stderr, " %s", ObjStr(objv[i]));
	/*fprintf(stderr, " objc == %d", objc);*/
	fprintf(stderr, " returnCode %d xotcl rc %d\n",  
		iPtr->returnCode, RUNTIME_STATE(in)->returnCode);
      }
#endif

      result = (*procInfo->objProc)(cp, in, objc, objv);
      
#ifdef DISPATCH_TRACE
  {
    int i, j = 0;
    fprintf(stderr, "     (%d) <callProcCheck: ", iPtr->numLevels);
    if (objc <= 3) j=objc; else j=3;
    for (i=0;i<j;i++) fprintf(stderr, " %s", ObjStr(objv[i]));
    fprintf(stderr, " result = %d", result);
    fprintf(stderr, " returnCode %d xotcl rc %d\n",  
	    iPtr->returnCode, RUNTIME_STATE(in)->returnCode);
  }
#endif
      if (iPtr->numLevels <=2 && RUNTIME_STATE(in)->returnCode != 0)
	result = RUNTIME_STATE(in)->returnCode;
      else if (result > TCL_ERROR && RUNTIME_STATE(in)->returnCode == 0)
	RUNTIME_STATE(in)->returnCode = result;

      destroyed = CallStackIsDestroyed(in);

      /* we give the information whether the call has destroyed the
	 object back to the caller, because after CallStackPop it
	 cannot be retrieved via the call stack */
      if (isDestroyed != 0)
	*isDestroyed = destroyed;

      /* if the object is destroyed -> the assertion structs's are already
	 destroyed */
      if (!destroyed) {
	if (obj->teardown && obj->checkoptions != CHECK_NONE &&
	    AssertionCheck(in, obj, cl, methodName, CHECK_POST) == TCL_ERROR) {
	  CallStackPop(in);
	  return TCL_ERROR;
	}
      }

      CallStackPop(in);
    } else
      result = TCL_ERROR;

#if defined(PROFILE)
  if (!isDestroyed || (isDestroyed && *isDestroyed == 0)) {
    XOTclProfileEvaluateData(in, startSec, startUsec, obj, cl, methodName);
  }
#endif

  return result;
}

/*
 * Conversion from CmdPtr to Class
 */

static XOTCLINLINE XOTclClass*
GetClassFromCmdPtr(Tcl_Interp* in, Command* cmdPtr) {
  if (cmdPtr && cmdPtr->objProc == XOTclObjDispatch && !cmdPtr->cmdEpoch)
    return XOTclIsClass(in, cmdPtr->objClientData);
  else
    return  0;
}

/*
 *  Filter-Commands
 */
#define GetFilterEntry(hPtr) \
    (hPtr ? (XOTclFilterListEntry*) Tcl_GetHashValue(hPtr): NULL);

static int
FilterIsFilterFrame(Tcl_Interp* in, CallFrame* framePtr) {
  int result = 0;
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;

  if (framePtr && framePtr->isProcCallFrame && framePtr->procPtr) {
    Command* cmdPtr = framePtr->procPtr->cmdPtr;
    if (cmdPtr && !cmdPtr->cmdEpoch) {
      result = (Tcl_FindHashEntry(filterList, (char*) cmdPtr) != NULL);
    }
  }
  return result;
}

static XOTclClass*
SearchPrecedenceForFullName(char* cmdName, XOTclClass* cl) {
  XOTclClasses* pl=0;

  if (cl) {
    if (!cl->order)
      cl->order = ComputeOrder(cl, Super);
    pl = cl->order;
  }
  while (pl && cl) {
    char* clName = pl->cl->nsPtr->fullName;
    if (strcmp(cmdName, clName) == 0) {
      return pl->cl;
    }
    pl = pl->next;
  }
  return NULL;
}

static Command*
FilterSearch(Tcl_Interp* in, char* name, XOTclClass* cl) {
  /* the search order is class/superclass - meta-class */
  Command* cmd;
  Tcl_CallFrame frame;	

  while (*name == ':') name++;
  Tcl_PushCallFrame(in, &frame,
		    (Tcl_Namespace*)RUNTIME_STATE(in)->XOTclClassesNS, 0);

  SearchCMethod((XOTclObject*) NULL, cl, NULL, name, &cmd);

  /* If no filter is found -> search the meta-class */
  if (!cmd) {
    SearchCMethod((XOTclObject*) NULL, cl->object.cl, NULL, name, &cmd);
    if (!cmd) {
      cmd = (Command *) Tcl_FindCommand(in, name,(Tcl_Namespace *) NULL, 0);	
      if (cmd) {
	/* it is neither a meta-class nor found by SearchCMethod,
	   perhaps it is a full-qualified name on the precedence order of the
	   cl or meta-class */	
	char *cmdName = cmd->nsPtr->fullName;
	XOTclClass* mcl = SearchPrecedenceForFullName(cmdName, cl);

	if (!mcl)
	  mcl = SearchPrecedenceForFullName(cmdName, cl->object.cl);
	if (!mcl)
	  cmd = 0;
      }
    }
  }
  Tcl_PopCallFrame(in);

  return cmd;
}

static void
FilterInvalidateFlags(XOTclClass* cl) {
  XOTclClasses *saved = cl->order, *clPtr;
  cl->order = 0;
  clPtr = ComputeOrder(cl, Sub);

  while (clPtr != 0) {
    Tcl_HashSearch hSrch;
    Tcl_HashEntry* hPtr = &clPtr->cl->instances ?
      Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : 0;
    
    for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
      XOTclObject* obj = (XOTclObject*)
	Tcl_GetHashKey(&clPtr->cl->instances, hPtr);
      obj->filterinfo.valid = 0;
    }
    clPtr = clPtr->next;
  }
  
  XOTclRemoveClasses(cl->order);
  cl->order = saved;
}

static void
FilterSetFlags(Tcl_Interp* in, XOTclObject* obj) {
  XOTclClasses *clPtr;
  assert(obj);

  if (!obj->cl->order)
    obj->cl->order = ComputeOrder(obj->cl, Super);
  clPtr = obj->cl->order;
  obj->filterinfo.doFilters = 0;

  if (clPtr) {
    while (clPtr != 0) {
      if (!obj->filterinfo.doFilters && clPtr->cl->filters)
	obj->filterinfo.doFilters = 1;
      if (obj->filterinfo.doFilters) break;
      clPtr = clPtr->next;
    }
  }
  obj->filterinfo.valid = 1;
}

static void
FilterRemoveEntry(Tcl_Interp* in, XOTclFilter* fPtr, XOTclClass* cl) {
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  XOTclFilter* filters = cl->filters;

  if (fPtr) {
    /*
     * Each filter has an associated entry in the RUNTIME STATE
     * filter list, which contains the active object of the filter.
     * Clean it up first
     */
    Tcl_HashEntry* hPtr = Tcl_FindHashEntry(filterList, (char*)fPtr->cmdPtr);
    XOTclFilterListEntry* entry = GetFilterEntry(hPtr);
    if (entry) {
      if (entry->count > 0) {
	entry->count--;
      } else {
	while (entry->activeObjs) {
	  XOTclObjList* o = entry->activeObjs;
	  entry->activeObjs = entry->activeObjs->next;
	  ckfree((char*) o);
	}
	ckfree((char*) entry);
	Tcl_DeleteHashEntry(hPtr);
      }
    }

    /*
     * Now remove the filter from the filter list on the class
     */
    if (fPtr == filters) {
      cl->filters = fPtr->next;
    } else {
      while (filters->next != fPtr) {
	filters = filters->next;
      }
      filters->next = fPtr->next;
    }

    /*
     * Cleanup memory of filter entry
     */
    TclCleanupCommand(fPtr->cmdPtr);
    DECR_REF_COUNT(fPtr->simpleName);
    ckfree((char*) fPtr);
  }
  /*
   * Indicate filter definition changes in the filter flags of the class
   */
  FilterInvalidateFlags(cl);
}

static void
FilterRemoveList(Tcl_Interp* in, XOTclClass* cl) {
  while (cl->filters) {
    FilterRemoveEntry(in, cl->filters, cl);
  }
}

static int
FilterAdd(Tcl_Interp* in, XOTclClass* cl, char* name) {
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  XOTclFilter *fPtr = 0;
  Command* cmdPtr = FilterSearch(in, name, cl);
  int nw = 0;
  Tcl_HashEntry* hPtr;
  XOTclFilterListEntry* entry;
  char* simpleName;

  if (!cmdPtr)
    return TCL_ERROR;

  /*
   * Initialize filter structure
   */

  simpleName = Tcl_GetCommandName(in, (Tcl_Command)cmdPtr);

  fPtr = (XOTclFilter*) ckalloc(sizeof(XOTclFilter));
  fPtr->filterClass =
    GetClass(in, NSCutXOTclClasses(cmdPtr->nsPtr->fullName));

  if (!fPtr->filterClass) {
    ckfree((char*)fPtr);
    return XOTclVarErrMsg(in, "Can't find filter class ",
			  cmdPtr->nsPtr->fullName, 0);
  }

  fPtr->next = NULL;
  fPtr->cmdPtr = cmdPtr;
  fPtr->simpleName = Tcl_NewStringObj(simpleName, -1);
  INCR_REF_COUNT(fPtr->simpleName);
  fPtr->cmdPtr->refCount++;

  /*
   * Each filter has an associated entry in the RUNTIME STATE
   * filter list, which contains the active object of the filter.
   * Clean it up first
   */
  hPtr  = Tcl_FindHashEntry(filterList, (char*) fPtr->cmdPtr);
  entry = GetFilterEntry(hPtr);
  if (entry) 
    entry->count++;
  else {	
    hPtr = Tcl_CreateHashEntry(filterList, (char*) fPtr->cmdPtr, &nw);
    if (nw) {
      XOTclFilterListEntry* entry = 
	(XOTclFilterListEntry*) ckalloc(sizeof(XOTclFilterListEntry));
      entry->count = 0;
      entry->activeObjs = 0;
      Tcl_SetHashValue(hPtr, (ClientData) entry);
    } else {
      return XOTclVarErrMsg(in, "Can't create filter list entry", (char*) NULL);
    }
  }

  /*
   * Append filter structure to class filters
   */
  if (cl->filters) {
    XOTclFilter* f = cl->filters;
    while (f->next != NULL) {
      f = f->next;
    }
    f->next = fPtr;
  } else {
    cl->filters = fPtr;
  }

  /*
   * Indicate filter definition changes in the filter flags of the class
   */
  FilterInvalidateFlags(cl);
  return TCL_OK;
}

static void
FilterList(Tcl_Interp* in, XOTclFilter* fPtr) {
  Tcl_Obj *filterList = Tcl_NewListObj(0, NULL);

  for (; fPtr != NULL; fPtr = fPtr->next) {
    Tcl_ListObjAppendElement(in, filterList, fPtr->simpleName);
  }
  Tcl_SetObjResult(in, filterList);
}

static XOTCLINLINE int
FilterDoFilters(Tcl_Interp* in, XOTclObject* obj) {
  if (obj->filterinfo.valid == 0)
    FilterSetFlags(in, obj);
  return obj->filterinfo.doFilters;
}


/* FilterInfoStack */
static XOTCLINLINE void
FilterChainInfoPush(XOTclObject* obj) {
  XOTclFilterChainInfo* h =
    (XOTclFilterChainInfo *) ckalloc(sizeof(XOTclFilterChainInfo));
  h->calledProc = 0;
  h->filterPtr = 0;
  h->callingProc = 0;
  h->callingClass = 0;
  h->callingObject = 0;
  h->refCount = 1;
  h->next = obj->filterinfo.chains;
  obj->filterinfo.chains = h;
}

/*
 * returns 1 for destroyed, 0 if not
 */
static XOTCLINLINE int
FilterChainInfoCleanup(XOTclFilterChainInfo *h) {
  h->refCount--;
  if (h->refCount <= 0) {
    ckfree((char*)h);
    return 1;
  }
  return 0;
}

static XOTCLINLINE void
FilterChainInfoPop(XOTclObject* obj) {
  XOTclFilterChainInfo *h = obj->filterinfo.chains;
  if (h) {
    obj->filterinfo.chains = h->next;
    FilterChainInfoCleanup(h);
  }
}

/* List to maintain the filters currently active on an obj */

static void
FilterActiveListPrepend(Tcl_Interp* in, XOTclObject* obj, Command* c) {
  Tcl_HashTable* filterList =  &RUNTIME_STATE(in)->filterList;
  Tcl_HashEntry* hPtr = Tcl_FindHashEntry(filterList, (char*) c);
  XOTclFilterListEntry* entry = GetFilterEntry(hPtr);

  if (entry) {
    XOTclObjList* o = (XOTclObjList*) ckalloc(sizeof(XOTclObjList));
    o->next = entry->activeObjs;
    o->objPtr = obj;
    entry->activeObjs = o;
  }
}

static void
FilterActiveListDelete(Tcl_Interp* in, XOTclObject* obj, Command* cmdPtr) {
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  Tcl_HashEntry* hPtr = Tcl_FindHashEntry(filterList, (char*) cmdPtr);
  XOTclFilterListEntry* entry = GetFilterEntry(hPtr);

  if (entry) {
    XOTclObjList* c = entry->activeObjs, *del = c;
    if (!c)
      return;
    if (c->objPtr == obj) {
      entry->activeObjs = c->next;
    } else {
      while (c->next && (obj != c->next->objPtr)) {
	c = c->next;
      }
      del = c->next;
      if (del) {
	c->next = del->next;
      }
    }
    if (del) {
      ckfree((char*)del);
    }
  }
}

static void
FilterActiveDeleteObj(Tcl_Interp* in, XOTclObject* obj) {
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr = filterList ?
	  Tcl_FirstHashEntry(filterList, &hSrch) : 0;

  while (hPtr != 0) {
    XOTclFilterListEntry* entry = GetFilterEntry(hPtr);
    if (entry) {
      XOTclObjList* o = entry->activeObjs, *h = 0;
      while (o) {
	if (o->objPtr == obj) {
	  Command* cmdPtr = (Command*) Tcl_GetHashKey(filterList, hPtr);
	  h = o->next;
	  if (cmdPtr) {
	    FilterActiveListDelete(in, obj, cmdPtr);
	  }
	}
	o = h;
      }
    }
    hPtr = Tcl_NextHashEntry(&hSrch);
  }
}

static int
FilterActiveOnObj(Tcl_Interp* in, XOTclObject* obj, Command* cmdPtr) {
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  Tcl_HashEntry* hPtr = Tcl_FindHashEntry(filterList,(char*)cmdPtr);
  XOTclFilterListEntry* entry = GetFilterEntry(hPtr);

  if (entry) {
    XOTclObjList* o = entry->activeObjs;
    while (o) {
      if (o->objPtr == obj)
	return 1;
      o = o->next;
    }
  }
  return 0;
}

static XOTCLINLINE XOTclFilter*
FilterComputeNextInChain(Tcl_Interp* in, XOTclObject* obj,
			 XOTclFilter* fPtr) {
  while (fPtr) {
    if (!FilterActiveOnObj (in, obj, fPtr->cmdPtr)) {
      return fPtr;
    }
    fPtr=fPtr->next;
  }
  return 0;
}

static void
FilterComputeNext(Tcl_Interp* in, XOTclObject* obj,
		  XOTclFilter** returnFPtr,
		  XOTclClass** returnRegClass) {
  XOTclFilter* fPtr = 0;
  XOTclClasses* pl;

  /*
   * obtain current state of the filter chain
   */
  if (obj->filterinfo.chains) {
    *returnFPtr = obj->filterinfo.chains->filterPtr;
    *returnRegClass = obj->filterinfo.chains->regClass;
  } else {
    *returnFPtr = 0;
    *returnRegClass = 0;
    return;
  }

  /*
   * compute class hierarchy order
   */
  pl = ComputeOrder(obj->cl, Super);

  /*
   * if there is a filter on the chain, we have already dispatched
   * a filter & a reg class => compute next one on this chain, if
   * one is there
   */
  if (*returnFPtr && *returnRegClass &&
      (*returnRegClass)->filters) {
    fPtr = FilterComputeNextInChain(in, obj, (*returnFPtr)->next);
    if (fPtr) {
      *returnFPtr = fPtr;
      return;
    }

    /*
     * we have already dispatched a filter, but there is no
     * next filter on the current regClass => go up the class hierarchy
     */
    while (pl && pl->cl != *returnRegClass)
      pl = pl->next;
    /* proceed with next class */
    if (pl)
      pl = pl->next;
  }

  /*
   * we are either at the start of the chain or gone up the class
   * hierarchy => search hierarchy until first filter is found on a
   * class
   */
  while (pl != 0) {
    fPtr = FilterComputeNextInChain(in, obj, pl->cl->filters);
    if (fPtr) break;
    pl = pl->next;
  }
  if (fPtr && pl) {
    /*
     * found a filter
     */
    *returnFPtr = fPtr;
    *returnRegClass = pl->cl;
  } else {
    /*
     * Reached the end of the class hierarchy without finding a filter.
     * Don't set regclass to 0, otherwise "info regclass" is not available
     * after last next on this chain.
     */
    *returnFPtr = 0;
  }
  return;
}

static void
FilterCutInactiveFrames(Tcl_Interp* in, CallFrame **savedFramePtr,
                 CallFrame **savedVarFramePtr) {
  Interp *iPtr = (Interp *) in;
  CallFrame *l, *oldFrame, *lastFrame, *lastVarFrame;
  int firstFrame = 1;
  int isObj;
  int level = (iPtr->framePtr) ? iPtr->framePtr->level : 0;
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent
    *bot = cs->content,
    *csc = cs->top;

  /* we increment the frameCutRound in order to be able to determine
     which frames have been cut in this cutting round */
  cs->frameCutRound++;

  /* for the time of the actual proc we create an enviroment
     without the filter calls (e.g. for the reason that uplevel/upvar
     function correctly) */

  *savedFramePtr = oldFrame = iPtr->framePtr;
  *savedVarFramePtr = iPtr->varFramePtr;
  iPtr->framePtr = 0;
  iPtr->varFramePtr = 0;
  lastFrame = 0; lastVarFrame = 0;
  /*
   * copy all frames that aren't inactive filters
   */
  while (oldFrame != 0) {
    while (csc > bot && csc->frameCut > 0) {
      csc--;
    }

    isObj = (oldFrame->nsPtr && 
	     oldFrame->nsPtr->deleteProc == NSNamespaceDeleteProc);

    if (!isObj ||
	!FilterIsFilterFrame(in, oldFrame) ||
	(oldFrame->procPtr &&
	 FilterActiveOnObj(in, csc->self, oldFrame->procPtr->cmdPtr))) {
      CallFrame *f;

      f = (CallFrame *) ckalloc(sizeof(CallFrame));
      memcpy(f, oldFrame, sizeof(CallFrame));
      if (lastFrame)
        lastFrame->callerPtr = f;
      lastFrame = f;

      if (*savedVarFramePtr == oldFrame) {
        iPtr->varFramePtr = f;
      }
      if (firstFrame) {
        iPtr->framePtr = f;
        firstFrame = 0;
      }
    } else {
      level--;
      csc->frameCut = cs->frameCutRound;
    }

    /* determine corresponding callstack entry */
    if (isObj)
      csc--;

    oldFrame = oldFrame->callerPtr;
  }

  if (lastFrame)
    lastFrame->callerPtr = 0;

  if(iPtr->varFramePtr == 0)
    iPtr->varFramePtr = iPtr->framePtr;

  /*
   * correct callerVarPtr information
   */

  csc = cs->top;

  oldFrame = *savedFramePtr;
  l = iPtr->framePtr;
  while (oldFrame != 0) {

    /* overstep cutted frames, except frames cutted in this round */
    while (csc > bot && csc->frameCut > 0 &&
	   csc->frameCut != cs->frameCutRound)
      csc--;
    if (csc <= bot)
      break;

    if (!FilterIsFilterFrame(in, oldFrame) || csc <= bot ||
	(oldFrame->procPtr &&
	 FilterActiveOnObj(in, csc->self, oldFrame->procPtr->cmdPtr))) {
      CallFrame *h1 = oldFrame->callerPtr, *h2 = l->callerPtr;
      while (h1 && oldFrame->callerVarPtr != h1) {
	h1 = h1->callerPtr;
	if (h2 && (!FilterIsFilterFrame(in, h1) ||
	    (h1->procPtr &&
	     FilterActiveOnObj(in, csc->self, h1->procPtr->cmdPtr)))) {
	  h2 = h2->callerPtr;
	}
      }
      if (h1 && h2) {
        l->callerVarPtr = h2;
      } else {
        l->callerVarPtr = l->callerPtr;
      }
      l = l->callerPtr;
    }
    if (oldFrame->nsPtr && 
	oldFrame->nsPtr->deleteProc == NSNamespaceDeleteProc) {
      csc--;
    }
    oldFrame = oldFrame->callerPtr;
  }

  /*
   * correct level information
   */

  level = 0;

  for(l = iPtr->framePtr; l != 0; l = l->callerVarPtr)
    level++;
  for(l = iPtr->framePtr; l != 0; l = l->callerVarPtr) {
    l->level = level;
    level--;
  }
}

static void
FilterRestoreFrames(Tcl_Interp* in, CallFrame *savedFramePtr,
		    CallFrame *savedVarFramePtr) {
  Interp *iPtr = (Interp *) in;
  CallFrame* save = iPtr->framePtr, *copy = save, *original, *l;
  int level = 0;
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc = cs->top;

  /* reset to old callframes */
  iPtr->framePtr = savedFramePtr;
  original = savedFramePtr;
  iPtr->varFramePtr = savedVarFramePtr;

  while (original != 0 && copy != 0) {
    int isObj = (original->nsPtr &&
		 original->nsPtr->deleteProc == NSNamespaceDeleteProc);

    if (!(isObj && csc->frameCut)) {
      if (copy->procPtr && copy->procPtr->cmdPtr
	  && original->procPtr && original->procPtr->cmdPtr
	  && copy->procPtr->cmdPtr == original->procPtr->cmdPtr) {
	/* if local var table is created on copy -> let the original
	   use the created one */
	if (original->varTablePtr == 0)
	  original->varTablePtr = copy->varTablePtr;
	copy = copy->callerPtr;
      }
    }
    original = original->callerPtr;
    if (isObj)
      csc--;
  }
  /*
   * correct level information in original frames
   */
  level = 0;
  for(l = iPtr->framePtr; l != 0; l = l->callerVarPtr)
    level++;

  for(l = iPtr->framePtr; l != 0; l = l->callerVarPtr) {
    l->level = level;
    level--;
  }

  /* free memory */
  while (save != 0) {
    CallFrame *f= save;
    save = save->callerPtr;
    ckfree((char*)f);
  }

  /* Update the XOTcl CallStack cutted frames of this round */
  for (csc = &cs->content[1]; csc <= cs->top; csc++) {
    if (csc->frameCut == cs->frameCutRound) {
      csc->frameCut = 0;
    }
  }
  cs->frameCutRound--;
}

/* determine whether a filter is active on the current callstack on not */
static int
FilterEntryOnCallStack(Tcl_Interp* in) {
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc;
  for (csc = &cs->content[1]; csc <= cs->top; csc++) {
    if (csc->isFilterEntry) {
      return 1;
    }
  }
  return 0;
}


/* Cmd List Add/Remove */

static void
RemoveCmdList(XOTclCmdList* cl) {
  while (cl != 0) {
    XOTclCmdList* n = cl->next;
    ckfree((char*)cl); cl = n;
  }
}

static void
AddCmdList(XOTclCmdList** cList, Command* c) {
  XOTclCmdList *l = *cList,
    *new = (XOTclCmdList*)ckalloc(sizeof(XOTclCmdList));
  new->cmdPtr = c;
  new->next = NULL;
  if (l) {
    while (l->next) l = l->next;
    l->next = new;
  } else
    *cList = new;
}

/*
 * Per-Object-Mixins
 */

static void 
MixinStackPush(XOTclObject* obj) {
  XOTclMixinStack* h = (XOTclMixinStack *)ckalloc(sizeof(XOTclMixinStack));
  h->currentCmdPtr = 0;
  h->mixinChainOn = 0;
  h->mixinInit = 0;
  h->next = obj->mixinStack;
  obj->mixinStack = h;
}

static void 
MixinStackPop(XOTclObject* obj) {
  XOTclMixinStack *h = obj->mixinStack;
  obj->mixinStack = h->next;
  ckfree((char*)h);
}

/*
 * Appends XOTclClasses* containing the mixin classes and their
 * superclasses to 'mixinClasses' list from a given mixinList
 */
static void
MixinComputeOrderFullList(Tcl_Interp* in,
			  XOTclMixin** mixinList,
			  XOTclClasses** mixinClasses) {
  XOTclMixin *m = *mixinList;
  XOTclClasses *pl;
  while (m) {
    XOTclClass* mCl = GetClassFromCmdPtr(in, m->cmdPtr);
    if (mCl) {
      if (!mCl->order)
	mCl->order = ComputeOrder(mCl, Super);
      pl = mCl->order;
      while (pl) {
	/*fprintf(stderr, " %s, ", pl->cl->object.nsPtr->fullName);*/
	XOTclAddClass(mixinClasses, pl->cl);
	pl = pl->next;
      }
    }
    m = m->next;
  }
}

static void
MixinResetOrder(XOTclObject* obj) {
  RemoveCmdList(obj->mixinOrder);
  obj->mixinOrder = 0;
}

/*
 * Computes a linearized order of per-object and per-class mixins. Then
 * duplicates in the full list and with the class inheritance list of
 * 'obj' are eliminated.
 * The precendence rule is that the last occurence makes it into the
 * final list.
 */
static void
MixinComputeOrder(Tcl_Interp* in, XOTclObject* obj) {
  XOTclClasses *mixinClasses = 0, *nextCl, *pl, *checker;
  MixinResetOrder(obj);
  /*fprintf(stderr, "Mixin Order:\n First List: ");*/

  /* append per-obj mixins */
  MixinComputeOrderFullList(in, &obj->mixins, &mixinClasses);

  /* append per-class mixins */
  if (!obj->cl->order)
    obj->cl->order =ComputeOrder(obj->cl, Super);
  pl = obj->cl->order;
  while (pl) {
    if (pl->cl->instmixins != 0)
      MixinComputeOrderFullList(in, &pl->cl->instmixins, &mixinClasses);
    pl = pl->next;
  }

  /* use no duplicates & no classes of the precedence order
     on the resulting list */
  while (mixinClasses) {
    checker = nextCl = mixinClasses->next;
    while (checker) {
      if (checker->cl == mixinClasses->cl) break;
      checker = checker->next;
    }
    /* if mixinClasses has no duplicate on mixinList ->
       check obj->cl hierachy */
    if (checker == 0) {
      if (!obj->cl->order)
	obj->cl->order = ComputeOrder(obj->cl, Super);
      checker = obj->cl->order;
      while (checker) {
	if (checker->cl == mixinClasses->cl) break;
	checker = checker->next;
      }
    }
    /* if class is also not found on precedence order ->
       add it to mixinOrder list (otherwise free the memory) */
    if (checker == 0) {
      AddCmdList(&obj->mixinOrder, (Command*) mixinClasses->cl->object.id);

      /*fprintf(stderr, "  Adding %s,\n", mixinClasses->cl->object.nsPtr->fullName);*/
    }
    ckfree((char*)mixinClasses);

    mixinClasses = nextCl;
  }
}

/*
 * add a mixin class to 'mixinList' by appending it
 */
static void
MixinAdd(Tcl_Interp* in, XOTclMixin** mixinList, XOTclClass* cl) {
  XOTclMixin* nm = (XOTclMixin*)ckalloc(sizeof(XOTclMixin));
  nm->cmdPtr = (Command *) cl->object.id;
  nm->cmdPtr->refCount++;
  nm->next = 0;

  if (*mixinList) {
    XOTclMixin* m = *mixinList;
    while (m->next != NULL) {
      m = m->next;
    }
    m->next = nm;
  } else
    *mixinList = nm;
}

/*
 * free the memory of a whole 'mixinList'
 */
static void
MixinRemoveList(XOTclMixin** mixinList) {
  XOTclMixin *del;

  while (*mixinList) {
    del = *mixinList;
    *mixinList = (*mixinList)->next;
    TclCleanupCommand(del->cmdPtr);
    ckfree((char*)del);
  }
}

/*
 * if the class hierarchy or class mixins have changed ->
 * invalidate mixin entries in all dependent instances
 */
static void
MixinInvalidateObjOrders(XOTclClass* cl) {
  XOTclClasses *saved = cl->order, *clPtr;
  cl->order = 0;
  clPtr = ComputeOrder(cl, Sub);

  while (clPtr != 0) {
    Tcl_HashSearch hSrch;
    Tcl_HashEntry* hPtr = &clPtr->cl->instances ?
      Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : 0;

    for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
      XOTclObject* obj = (XOTclObject*)
	Tcl_GetHashKey(&clPtr->cl->instances, hPtr);
      MixinResetOrder(obj);
      obj->mixinDefined = XOTCL_MIXINS_INVALID;
    }
    clPtr = clPtr->next;
  }

  XOTclRemoveClasses(cl->order); cl->order = saved;
}

/*
 * remove a mixin 'dm' from a mixinList
 */
static XOTclMixin*
MixinRemoveFromList(XOTclMixin** mixinList, XOTclMixin* dm) {
  XOTclMixin* m = *mixinList, *del = 0;
  if (m == 0)
    return NULL;
  if (m == dm) {
    *mixinList = m->next;
    del = m;
  } else {
    while (m->next && m->next != dm) {
      m = m->next;
    }
    if (m->next == dm) {
      del = dm;
      m->next = dm->next;
    }
  }
  return del;
}

/*
 * remove a mixin from the mixin stack of object 'obj'
 */
static void
MixinRemoveFromMixinStack(XOTclMixin* del, XOTclObject* obj) {
  XOTclMixinStack* h = obj->mixinStack;
  if (obj->mixins == 0 && h) {
    obj->mixinStack->currentCmdPtr = 0;
  }

  /* if the current mixin is to be deleted, we make its predecessor
     current mixin */
  if (obj->mixinStack->currentCmdPtr == del->cmdPtr) {
    if (obj->mixinOrder && del->cmdPtr != obj->mixinOrder->cmdPtr) {
      XOTclCmdList* predecessor = obj->mixinOrder;
      while (predecessor->next  &&
	     predecessor->next->cmdPtr != del->cmdPtr)
	predecessor = predecessor->next;
      if (predecessor->next)
	obj->mixinStack->currentCmdPtr = predecessor->next->cmdPtr;
    } else {
      obj->mixinStack->currentCmdPtr = 0;
    }
  }
}

/*
 * remove mixin with a command ptr from the mixin list and delete it
 * if 'obj' is specified, we also remove it from the objects mixin stack
 */
static void
MixinRemoveFromCmdPtr(XOTclMixin** mixinList, Command* c, XOTclObject* obj) {
  XOTclMixin* m = *mixinList, *del;
  while (m) {
    if (m->cmdPtr == c) {
      del = MixinRemoveFromList(mixinList, m);
      if (del) {
	if (obj)
	  MixinRemoveFromMixinStack(del, obj);
	/* actually delete the mixin entry */
	TclCleanupCommand(del->cmdPtr);
	ckfree((char*)del);
      }
      break;
    }
    m = m->next;
  }
}

/*
 * remove mixin from cmd ptr with obj ... search per-object and
 * per-class mixins for the mixin command 'c'
 */
static void
MixinRemoveOnObjFromCmdPtr(XOTclObject* obj, Command* c) {
  XOTclClasses *pl;
  MixinRemoveFromCmdPtr(&obj->mixins, c, obj);
  obj->mixinDefined = XOTCL_MIXINS_INVALID;
  if (!obj->cl->order)
    obj->cl->order = ComputeOrder(obj->cl, Super);
  pl = obj->cl->order;
  while (pl) {
    MixinRemoveFromCmdPtr(&pl->cl->instmixins, c, obj);
    MixinInvalidateObjOrders(pl->cl);
    pl = pl->next;
  }
}

/*
 * the mixin order is either
 *   DEFINED (there are mixins on the instance),
 *   NONE    (there are no mixins for the instance),
 *   or INVALID (a class re-strucuturing has occured, thus it is not clear
 *               whether mixins are defined or not).
 * If it is INVALID MixinComputeDefined can be used to compute the order
 * and set the instance to DEFINE or NONE
 */
static void 
MixinComputeDefined(Tcl_Interp* in, XOTclObject* obj) {
  MixinResetOrder(obj);
  MixinComputeOrder(in, obj);
  if (obj->mixinOrder)
    obj->mixinDefined = XOTCL_MIXINS_DEFINED;
  else
    obj->mixinDefined = XOTCL_MIXINS_NONE;
}

/*
 * walk through the mixin order until the current mixin is reached.
 * then use the next mixin as current mixin.
 */
static void 
MixinSeekCurrent(Tcl_Interp* in, XOTclObject* obj,
		 XOTclCmdList** cmdList) {
  Command* currentCmdPtr = obj->mixinStack->currentCmdPtr;

  /* ensure that the mixin order is not invalid, otherwise compute order */
  if (obj->mixinDefined == XOTCL_MIXINS_INVALID)
    MixinComputeDefined(in, obj);

  *cmdList = obj->mixinOrder;

  /* go forward to current class */
  while (*cmdList && currentCmdPtr) {
    if ((*cmdList)->cmdPtr == currentCmdPtr) currentCmdPtr = 0;
    *cmdList = (*cmdList)->next;
  }
}

/*
 * before we can perform a mixin dispatch, MixinSearchProc seeks the
 * current mixin and the relevant calling information
 */
static Command*
MixinSearchProc(Tcl_Interp* in, XOTclObject* obj, char* methodName,
		XOTclClass** cl, Tcl_ObjCmdProc** proc, ClientData* cp,
		Command** currentCmdPtr) {
  Command* procInfo = NULL;
  XOTclCmdList *cmdList;
  XOTclClass* class;

  *currentCmdPtr = 0;

  MixinSeekCurrent(in, obj, &cmdList);
  while (cmdList) {
    if(cmdList->cmdPtr->cmdEpoch) {
      MixinRemoveOnObjFromCmdPtr(obj, cmdList->cmdPtr);
      /* 
       * invalidate the order & seek start class 
       */
      MixinResetOrder(obj);
      MixinSeekCurrent(in, obj, &cmdList);
    } else {
      class = GetClassFromCmdPtr(in, cmdList->cmdPtr);
      if (class) {
	procInfo = FindMethod(methodName, class->nsPtr);

	/* 
	 * on success: compute mixin call data
	 */
	if (procInfo) {
	  *cl = class;
	  *proc = procInfo->objProc;
	  *cp   = procInfo->objClientData;
	  *currentCmdPtr = cmdList->cmdPtr;
	  break;
	} else {
	  cmdList = cmdList->next;
	}
      }
    }
  }

  return procInfo;
}

/*
 * info option for mixins and instmixins
 */
static void
MixinInfo(Tcl_Interp* in, XOTclMixin* m, char* pattern) {
  if (pattern == 0) {
    Tcl_Obj *mixinList = Tcl_NewListObj(0, NULL);

    while (m) {
      XOTclClass* mixinClass = GetClassFromCmdPtr(in, m->cmdPtr);
      if (mixinClass) {
        Tcl_ListObjAppendElement(in, mixinList, mixinClass->object.cmdName);
      }
      m = m->next;
    }
    Tcl_SetObjResult(in, mixinList);
  } else {
    XOTclClass* isc = GetClass(in, pattern);
    Tcl_ResetResult(in);
    if (isc == 0)
      m = 0;
    else while (m != 0) {
      if (GetClassFromCmdPtr(in, m->cmdPtr) == isc) {
        Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
	break;
      }
      m = m->next;
    }
    if (m == 0)
      Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
  }
}

/*
 * Search default values specified through 'parameter' on one class
 */
static int 
SearchDefaultValuesOnClass(Tcl_Interp* in, XOTclObject* obj, 
                           XOTclClass* cmdCl, XOTclClass* targetClass) {
  int result = TCL_OK;
  if (targetClass->object.nsPtr) {
    register Tcl_HashEntry* entryPtr =
      Tcl_FindHashEntry(&targetClass->object.nsPtr->varTable, "__defaults");
    Var* defaults;
    if (entryPtr) {
      defaults = (Var*) Tcl_GetHashValue(entryPtr);
      /*fprintf(stderr, "+++ we have defaults for <%s>\n", 
	className(targetClass));*/
      if (TclIsVarArray(defaults)) {
	Tcl_HashTable* table = defaults->value.tablePtr;
	Tcl_HashSearch hSrch;
	Tcl_HashEntry* hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0;
	
	for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
	  char *varName        = Tcl_GetHashKey(table, hPtr);
	  Tcl_Obj *varNameObj  = Tcl_NewStringObj(varName,-1);
	  Var  *val            = (Var*)Tcl_GetHashValue(hPtr);
	  INCR_REF_COUNT(varNameObj);
	  if (TclIsVarScalar(val)) {
	    char *oldValue = Tcl_GetVar2(in, varName, 
					 NULL, TCL_NAMESPACE_ONLY);
	    /** we check whether  the variable is already set.
		if so, we do not set it again */
	    if (oldValue == NULL) {
	      char *value = ObjStr(val->value.objPtr), *v;
	      Tcl_Obj *valueObj = val->value.objPtr;
	      int doSubst = 0;
	      for (v=value; *v; v++) {
		if (*v == '[' && doSubst == 0)
		  doSubst = 1;
		else if ((doSubst == 1 && *v == ']') || *v == '$') {
		  doSubst = 2;
		  break;
		}
	      }
	      if (doSubst == 2) { /* we have to subst */
		Tcl_Obj *ov[2];
		int rc = CallStackPush(in, obj, cmdCl, varName, 1, 
				       &varNameObj, 0, 0);
		if (rc != TCL_OK) {
		  DECR_REF_COUNT(varNameObj);
		  return rc;
		}
		ov[1] = valueObj;
		Tcl_ResetResult(in);
		rc = callCommand(in, SUBST, 2, ov);
		CallStackPop(in);
		if (rc == TCL_OK) {
		  valueObj = Tcl_GetObjResult(in);
		} else {
		  DECR_REF_COUNT(varNameObj);
		  return rc;
		}
	      }
	      INCR_REF_COUNT(valueObj);
	      result = callMethodWithArg((ClientData)obj, in,
					 varNameObj, valueObj, 3, 0, 0);
	      DECR_REF_COUNT(valueObj);
	    }
	  }
	  DECR_REF_COUNT(varNameObj);
	}
      }
    }
  }
  return result;
}

/*
 * Search default values specified through 'parameter' on 
 * mixin and class hierarchy
 */
static int
SearchDefaultValues(Tcl_Interp* in,
                    XOTclObject* obj, XOTclClass* cmdCl) {
  Tcl_CallFrame frame;   
  XOTclClass *cl = obj->cl, *mixin;
  XOTclClasses *pl = 0;
  XOTclCmdList *ml = 0;
  int result = TCL_OK;

  if (obj->mixinDefined == XOTCL_MIXINS_INVALID)
    MixinComputeDefined(in, obj);
  if (obj->mixinDefined == XOTCL_MIXINS_DEFINED)
    ml = obj->mixinOrder;

  if (cl) {
    if (!cl->order)
      cl->order = ComputeOrder(cl, Super);
    pl = cl->order;
  }

  Tcl_PushCallFrame(in, &frame, (Tcl_Namespace*)obj->nsPtr,0);
  while (ml) {
    mixin = GetClassFromCmdPtr(in, ml->cmdPtr);
    result = SearchDefaultValuesOnClass(in, obj, cmdCl, mixin);
    if (result != TCL_OK)
      break;
    ml = ml->next;
  }
  while (pl) {
    result = SearchDefaultValuesOnClass(in, obj, cmdCl, pl->cl);
    if (result != TCL_OK)
      break;
    pl = pl->next;
  }
  Tcl_PopCallFrame(in);
  return result;
}

static int
ParameterSearchDefaultsMethod(ClientData cd, Tcl_Interp* in, int objc, 
			      Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclObject* defaultObj;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc != 2)
    return XOTclObjErrArgCnt(in,
                             cl->object.cmdName,
                             "searchDefaults obj");
  defaultObj = GetObject(in, ObjStr(objv[1]));

  if (!defaultObj)
    return XOTclVarErrMsg(in, "Can't find default object ",
                          ObjStr(objv[1]), 0);

  /*
   *  Search for default values for vars on superclasses
   */
  return SearchDefaultValues(in, defaultObj, defaultObj->cl);
}

static int 
callParameterMethodWithArg(XOTclObject* obj, Tcl_Interp* in, 
			   Tcl_Obj* method, Tcl_Obj* arg,
			   int objc, Tcl_Obj *CONST objv[], int flags) {
  Tcl_Obj *pcl = obj->cl->parameterClass ? 
    obj->cl->parameterClass : global_objects[PARAM_CL];
  XOTclClass *paramCl = GetClass(in, ObjStr(pcl));
  if (paramCl) 
    return callMethodWithArg((ClientData)paramCl, in,
			     method, arg, objc, objv, flags);
  else 
    return XOTclVarErrMsg(in, "create: can't find parameter class", 0);
}


/*
 * method dispacth
 */

static int
FilterDispatch(Tcl_Interp* in, XOTclObject* obj, int objc, Tcl_Obj* CONST objv[]) {
  int result, isDestroyed;
  ClientData cd;
  XOTclFilter* filterEntry;
  Command* filterCmd;

  if (!obj->filterinfo.chains) {
    return XOTclVarErrMsg(in,
			  "Tried to dispatch Filter without a chain on the stack",
			  (char*)NULL);
  }

  filterEntry = obj->filterinfo.chains->filterPtr;

  if (filterEntry->cmdPtr->cmdEpoch) {
      FilterRemoveEntry(in, obj->filterinfo.chains->filterPtr,
			obj->filterinfo.chains->regClass);
      return XOTCL_NOT_FILTERED;
    }

  cd = filterEntry->cmdPtr->objClientData;

  filterCmd = filterEntry->cmdPtr;
  filterCmd->refCount++;

  FilterActiveListPrepend(in, obj, filterCmd);
  /*fprintf(stderr,"FilterDispatch: calling\n");*/
  result = callProcCheck(cd, in, objc, objv, filterCmd,
			 obj, filterEntry->filterClass,
			 Tcl_GetCommandName(in,(Tcl_Command)filterCmd),
			 1, 0, &isDestroyed);
  /*fprintf(stderr,"FilterDispatch: done result=%d\n",result);*/

  /*** assert(isDestroyed == 0); UWE, pls check */
  /* otherwise, we have problems referencing obj */

  FilterActiveListDelete(in, obj, filterCmd);
  TclCleanupCommand(filterCmd);

  if (result >= XOTCL_UNKNOWN)
    result = TCL_ERROR;
  
  return result;
}

static int
FilterStartChain(Tcl_Interp* in, XOTclObject* obj,
		 int objc, Tcl_Obj* CONST objv[]) {
  int result;
  XOTclFilterChainInfo* chains;
  XOTclCallStackContent *csc = CallStackGetFrame(in);
  XOTclFilter* fPtr;
  XOTclClass* regClass;

  if (csc->procName && csc->cl && csc->isFilterEntry && csc->self == obj) {
    Tcl_Command cmd = Tcl_FindCommand(in, csc->procName,
				      (Tcl_Namespace *)csc->cl->nsPtr, 0);
    Command *cmdPtr= (Command *) cmd;
    if (FilterActiveOnObj(in, csc->self, cmdPtr))
      return XOTCL_NOT_FILTERED;
  }

  FilterChainInfoPush(obj);
  obj->filterinfo.chains->filterPtr = 0;
  obj->filterinfo.chains->regClass = 0;

  FilterComputeNext(in, obj, &fPtr, &regClass);
  obj->filterinfo.chains->filterPtr = fPtr;
  obj->filterinfo.chains->regClass = regClass;

  if (!obj->filterinfo.chains->filterPtr) {
    FilterChainInfoPop(obj);
    return XOTCL_NOT_FILTERED;
  }
  chains = obj->filterinfo.chains;
  chains->refCount++;

  chains->calledProc = objv[1];	
  chains->procVarFramePtr = ((Interp *)in)->varFramePtr;
  csc = CallStackGetFrame(in);

  chains->callingProc = Tcl_NewStringObj(csc->procName,-1);
  INCR_REF_COUNT(chains->callingProc);

  chains->callingClass =
    csc->cl ? csc->cl->object.cmdName : global_objects[EMPTY];
  INCR_REF_COUNT(chains->callingClass);

  chains->callingObject =
    csc->self ? csc->self->cmdName : global_objects[EMPTY];
  INCR_REF_COUNT(chains->callingObject);

  result = FilterDispatch(in, obj, objc-1, objv+1);

  DECR_REF_COUNT(chains->callingObject);
  DECR_REF_COUNT(chains->callingClass);
  DECR_REF_COUNT(chains->callingProc);

  /*
   * if the object is destroyed => pop was called already
   * Then FilterChainInfoCleanup deletes chains physically.
   * Otherwise we pop it afterwards from the
   * object (what deletes chains physically).
   */
  if (!FilterChainInfoCleanup(chains) &&
      obj->filterinfo.chains)
    FilterChainInfoPop(obj);

  return result;
}


static XOTCLINLINE int
DoDispatch(ClientData cd, Tcl_Interp* in, XOTclObject* obj,
	   int objc, Tcl_Obj *CONST objv[], int flags) {
  int result = TCL_OK, filtered = 0, isDestroyed = 0, mixinStackPushed = 0;
  char *methodName = ObjStr(objv[1]);
#ifdef AUTOVARS
  int isNext = isNextString(methodName);
#endif

#ifdef DISPATCH_TRACE
  {
    int i, j = 0;
    Interp *iPtr = (Interp *) in;
    fprintf(stderr, "     (%d) >DISPATCH: ", iPtr->numLevels);
    if (objc == 2) j=2; else j=3;
    for (i=0;i<j;i++) fprintf(stderr, " %s", ObjStr(objv[i]));
    fprintf(stderr, " objc == %d \n", objc);
  }
#endif


#ifdef OBJ_REFERENCES
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc = cs->top,
    *bot = cs->content;
  /*
   * Trace all object calls with references, except calls to [self]
   */
  if (csc > bot  && !csc->destroyedCmd && !obj->destroyCalled &&
      csc->self && csc->self != obj) {
    if (!XOTclIsReferencedBy(obj, csc->self))
	XOTclReferenceAddRef(in, csc->self, obj);
  }
#endif
  /*fprintf(stderr, "Call: %s->%s (%d)\n", ObjStr(obj->cmdName), methodName, obj->destroyCalled);*/

  /* if filters are registered for the object's classes we create a new filter
     chain and then we start a filter chain  */
#ifdef AUTOVARS
  if(!isNext) {
#endif
    if (!(flags & XOTCL_CM_NO_FILTERS) && FilterDoFilters(in, obj)) {
      result = FilterStartChain(in, obj, objc, objv);
      if (result != XOTCL_NOT_FILTERED)
	filtered = 1;
    }
#ifdef AUTOVARS
  }
#endif
   /*
    *  not filtered =>
    *  normal dispatch
    */
  if (!filtered) {
    XOTclClass     *cl = 0;
    ClientData     cp = 0;
    Tcl_ObjCmdProc *proc = 0;
    Command        *procInfo;
    Tcl_Obj        *objName = obj->cmdName;
    Tcl_Obj        *clName = 0;
    int            isMixinEntry = 0;

    INCR_REF_COUNT(objName);

    /* check if a per object mixin is to be called.
       don't use mixins on next method calls, since normally it is not
       intercepted (it is used as a primitive command).
       don't use mixins on init calls, since init is invoked on mixins
       during mixin registration (in XOTclOMixinMethod)
    */

    if (obj->mixinDefined == XOTCL_MIXINS_INVALID)
      MixinComputeDefined(in, obj);

#ifdef AUTOVARS
    if(!isNext) {
#endif
      if (obj->mixinDefined == XOTCL_MIXINS_DEFINED) {
	XOTclClass     *mcl=0;
	Tcl_ObjCmdProc *mproc = 0;
	Command        *mProcInfo =0;
	ClientData     mcp;
	Command* currentCmdPtr;
	MixinStackPush(obj);
	
	mixinStackPushed = 1;
	mProcInfo = MixinSearchProc(in, obj, methodName,
				    &mcl, &mproc, &mcp, &currentCmdPtr);

	obj->mixinStack->currentCmdPtr = currentCmdPtr;

	if (mproc) {
	  isMixinEntry = 1;
	  cl = mcl;
	  proc = mproc;
	  cp = mcp;
	  procInfo = mProcInfo;
	  obj->mixinStack->mixinChainOn = 1;
	} else {
	  MixinStackPop(obj);
	  mixinStackPushed = 0;
	}
      }
#ifdef AUTOVARS
    }
#endif

    /* if no mixin is found => do ordinary method lookup */
    if (proc == 0) {
      procInfo = FindMethod(methodName, obj->nsPtr);
      if (procInfo) {
	cl = 0;
      } else {
	cl = SearchCMethod(obj, obj->cl, NULL, methodName, &procInfo);
      }
      if (procInfo) {
	proc = procInfo->objProc;
	cp   = procInfo->objClientData;
      } else {
	proc = 0;
	cp   = 0;
      }
    }

    if (cl) {
      clName = cl->object.cmdName;
      INCR_REF_COUNT(clName);
    }

    if (proc) {
      if (cp == 0 || TclIsProc(procInfo)) {
	if (cp == 0)
	  cp = cd;
	result = callProcCheck(cp, in, objc-1, objv+1, procInfo,
			       obj, cl, methodName, 0, isMixinEntry,
			       &isDestroyed);
      } else {
	/* there is method specific client data for the method =>
	   another dispatch mechanism handles this call */

	/*
	fprintf(stderr, "Propagating Dispatch of :\n");
	{
	  int i, j = 0;
	  if (objc == 2) j=2; else j=3;
	  for (i=0;i<j;i++) fprintf(stderr, " %s", ObjStr(objv[i]));
	  fprintf(stderr, " objc == %d \n", objc);
	}
	*/
	result = callProcCheck(cp, in, objc, objv, procInfo,
			       obj, cl, methodName, 0, isMixinEntry,
			       &isDestroyed);
      }

      if (result == TCL_ERROR) {
	/*if (!isDestroyed) {*/
	  XOTclErrInProc(in, objName, clName, methodName);
	  /*} else {
	{
	  int i, j = 0;
	  if (objc == 2) j=2; else j=3;
	  for (i=0;i<j;i++) fprintf(stderr, " %s", ObjStr(objv[i]));
	  fprintf(stderr, " objc == %d \n",objc);
	}
*/

	  /*Tcl_VarEval(in, "puts \"Error Info: \n::${errorInfo} \"",0);*/
	  /*XOTclVarErrMsg(in,
			 "destroy failed (probably wrong # args?)",
			 " or object called after physical destroy\n",
			 "  ... during dispatch of method = ", methodName,
			 ", obj = ", ObjStr(objName),
			 (char*) 0);
			 }*/
      }
    } else if (XOTclIsType(obj, RUNTIME_STATE(in)->theClass) &&
	       (flags & XOTCL_CM_NO_UNKNOWN)) {
      Tcl_AppendResult(in, ObjStr(objv[0]),
		       ": unable to dispatch method '", 
		       methodName, "'", 0);
      result = TCL_ERROR;
    } else {
      result = XOTCL_UNKNOWN;
    }

    DECR_REF_COUNT(objName);
    if (clName)
      DECR_REF_COUNT(clName);
  }

  if (!isDestroyed && obj && mixinStackPushed && obj->mixinStack) {
    MixinStackPop(obj);
  }

#ifdef DISPATCH_TRACE
  {
    int i, j = 0;
    Interp *iPtr = (Interp *) in;
    fprintf(stderr, "     (%d) <DISPATCH: ", iPtr->numLevels);
    if (objc == 2) j=2; else j=3;
    for (i=0;i<j;i++) fprintf(stderr, " %s", ObjStr(objv[i]));
  }
  fprintf(stderr, " returns %d\n", result);
#endif

  return result;
}

static int
ObjDispatch(ClientData cd, Tcl_Interp* in,
	    int objc, Tcl_Obj *CONST objv[],
	    int flags) {
  XOTclObject *obj = (XOTclObject*)cd;
  char *methodName = 0;
  int result;

  if (objc < 2)
      return XOTclObjErrArgCnt(in, objv[0], "message ?args...?");

#ifdef STACK_TRACE
  XOTclStackTrace(in);
#endif

#ifdef CALLSTACK_TRACE
  XOTclCallStackTrace(in);
#endif
  /* try normal dispatch */
  result = DoDispatch(cd, in, obj, objc, objv, flags);
  if (result != XOTCL_UNKNOWN) {
    return result;
  }

  /*
   * back off and try unknown; 
   */
  {
      int oc = objc +1;
      DEFINE_NEW_TCL_OBJECTS_ON_STACK(oc, ov);

      ov[0] = objv[0];
      ov[1] = global_objects[UNKNOWN];
      memcpy(ov+2, objv+1, sizeof(Tcl_Obj *)*(objc-1));
      result = DoDispatch(cd, in, obj, oc, ov, flags);

      FREE_TCL_OBJECTS_ON_STACK(ov);

      if (result != XOTCL_UNKNOWN)
	return result;
  }
  /*
   * and if that fails too, error out
   */

  Tcl_ResetResult(in);

  if (methodName == 0 && objc > 0)
    methodName = ObjStr(objv[1]);

  Tcl_AppendResult(in, ObjStr(objv[0]),
                   ": unable to dispatch method '", methodName, "'", 0);
  return TCL_ERROR;
}

static int
XOTclObjDispatch(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *CONST objv[]) {
  return ObjDispatch(cd, in, objc, objv, 0);
}

/*
 * autoloading
 */

static void
AutoLoaderDP(ClientData cd) {
  ckfree((char*)cd);
}

static int
AutoLoader(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *CONST objv[]) {
  /*
   * cd is a script to evaluate; object context reconstructed from argv
   */
  /*
  CallStackContent *csc = CallStackGetFrame(in);
  fprintf(stderr, "Autoloader -- self %s\n", xobjName(csc->self));
  fprintf(stderr, "Autoloader -- c %s\n", className(csc->class));
  fprintf(stderr, "Autoloader -- p %s\n", csc->procName);
  */

  if (Tcl_GlobalEval(in, (char*)cd) != TCL_OK) {
    Tcl_AppendResult(in, " (during XOTcl Autoloading in proc '",
		     ObjStr(objv[0]), "')", 0);
    return TCL_ERROR;
  }
  return TCL_OK;						
}

static int
MakeAuto(Tcl_Interp* in, char* loader, char* methodName, Namespace* ns) {
  ClientData cd;
  int l;
  if (!*loader)
    return 0;
  l = strlen(loader)+1;
  if (!(cd = (ClientData)ckalloc(l)))
    return 0;
  memcpy(cd, loader, l);
  if(!NSCreateObjCmd(in, methodName, AutoLoader, cd, AutoLoaderDP, ns)) return 0;
  return 1;
}

/*
 *  Proc-Creation
 */

static int
MakeProc(Namespace* ns, XOTclAssertionStore* aStore,
	 Tcl_Interp* in, int objc, Tcl_Obj* objv[]) {
    int result, oc = objc;
    Tcl_CallFrame frame;
#ifdef AUTOVARS
    Tcl_Obj *oldBody;
    char *body;
    char *p;
    oldBody = objv[3];
    body = ObjStr(oldBody);

    objv[3] = Tcl_NewStringObj("", 0);
    INCR_REF_COUNT(objv[3]);

    if ((p = strstr(body, "self")) && p != body && *(p-1) != '[')
      Tcl_AppendStringsToObj(objv[3], "::set self [self]\n", NULL);
    if (strstr(body, "proc"))
      Tcl_AppendStringsToObj(objv[3], "::set proc [self proc]\n", NULL);
    if (strstr(body, "class"))
      Tcl_AppendStringsToObj(objv[3], "::set class [self class]\n", NULL);

    Tcl_AppendStringsToObj(objv[3], body, NULL);
#endif
    Tcl_PushCallFrame(in,&frame,(Tcl_Namespace*)ns,0);

    if (objc > 4) oc = 4;
    result = Tcl_ProcObjCmd(0, in, oc, objv) != TCL_OK;

    Tcl_PopCallFrame(in);

    if (objc == 6)
      AssertionAddProc(in, ObjStr(objv[1]), aStore, objv[4], objv[5]);

#ifdef AUTOVARS
    DECR_REF_COUNT(objv[3]);
    objv[3] = oldBody;
#endif

    return result;
}

/*
 * List-Functions for Info
 */
static void
ListInfo(Tcl_Interp* in, char* key) {
  XOTclClass* cl = GetClass(in, key);
  if (!XOTclIsClass(in, (ClientData) cl))
    cl =0;
  Tcl_ResetResult(in);
  Tcl_AppendElement(in, "vars"); Tcl_AppendElement(in, "body");
  Tcl_AppendElement(in, "default"); Tcl_AppendElement(in, "args");
  Tcl_AppendElement(in, "procs"); Tcl_AppendElement(in, "commands");
  Tcl_AppendElement(in, "class"); Tcl_AppendElement(in, "children");
  Tcl_AppendElement(in, "parent"); Tcl_AppendElement(in, "invar");
  Tcl_AppendElement(in, "pre"); Tcl_AppendElement(in, "post");
  Tcl_AppendElement(in, "mixin");
  Tcl_AppendElement(in, "info");
#ifdef OBJ_REFERENCES
  Tcl_AppendElement(in, "reference");  Tcl_AppendElement(in, "referencedby");
#endif

  if (cl) {
    Tcl_AppendElement(in, "superclass"); Tcl_AppendElement(in, "subclass");
    Tcl_AppendElement(in, "heritage"); Tcl_AppendElement(in, "instances");
    Tcl_AppendElement(in, "instcommands"); Tcl_AppendElement(in, "instprocs");
    Tcl_AppendElement(in, "instdefault"); Tcl_AppendElement(in, "instbody");
    Tcl_AppendElement(in, "instmixin");
    Tcl_AppendElement(in, "classchildren"); Tcl_AppendElement(in, "classparent");
    Tcl_AppendElement(in, "filter"); Tcl_AppendElement(in, "instinvar");
    Tcl_AppendElement(in, "instpre"); Tcl_AppendElement(in, "instpost");
    Tcl_AppendElement(in, "parameter");
  }
}

static XOTCLINLINE int
noMetaChars(char *pattern) {
  register char c, *p = pattern;
  assert(pattern);
  for (c=*p; c; c = *++p) {
    if (c == '*' || c == '[') {
      return 0;
    }
  }
  return 1;
}

static void
ListKeys(Tcl_Interp* in, Tcl_HashTable* table, char* pattern) {
  Tcl_HashEntry* hPtr;
  char *key;

  if (pattern && noMetaChars(pattern)) {
    hPtr = table ? Tcl_FindHashEntry(table, pattern) : 0;
    if (hPtr) {
      key = Tcl_GetHashKey(table, hPtr);
      Tcl_SetResult(in, key, TCL_VOLATILE);
    } else {
      Tcl_SetObjResult(in, global_objects[EMPTY]);
    }
  } else {
    Tcl_Obj *list = Tcl_NewListObj(0, NULL);
    Tcl_HashSearch hSrch;
    hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0;
    for (; hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) {
      key = Tcl_GetHashKey(table, hPtr);
      if (!pattern || Tcl_StringMatch(key, pattern)) {
	Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(key,-1));
      }
    }
    Tcl_SetObjResult(in, list);
  }
}


static void
ListObjPtrHashTable(Tcl_Interp* in, Tcl_HashTable* table, char* pattern) {
  Tcl_HashEntry* hPtr;
  if (pattern && noMetaChars(pattern)) {
    XOTclObject* childobj = GetObject(in,  pattern);
    hPtr = Tcl_FindHashEntry(table, (char*)childobj);
    if (hPtr) {
      Tcl_SetObjResult(in, childobj->cmdName);
    } else {
      Tcl_SetObjResult(in, global_objects[EMPTY]);
    }
  } else {
    Tcl_Obj *list = Tcl_NewListObj(0, NULL);
    Tcl_HashSearch hSrch;
    hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0;
    for (;  hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) {
      XOTclObject* obj = (XOTclObject*)Tcl_GetHashKey(table, hPtr);
      if (!pattern || Tcl_StringMatch(ObjStr(obj->cmdName), pattern)) {
	Tcl_ListObjAppendElement(in, list, obj->cmdName);
      }
    }
    Tcl_SetObjResult(in, list);
  }
}

static void
ListProcKeys(Tcl_Interp* in, Tcl_HashTable* table, char* pattern) {
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0;
  Tcl_ResetResult(in);
  for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
    char* key = Tcl_GetHashKey(table, hPtr);
    Tcl_ObjCmdProc* proc = ((Command*)Tcl_GetHashValue(hPtr))->objProc;
    if (pattern && !Tcl_StringMatch(key, pattern)) continue;

    /*
     * also counts anything to be autoloaded as a proc
     */

    if (proc!=AutoLoader && proc!= RUNTIME_STATE(in)->objInterpProc) continue;
    Tcl_AppendElement(in, key);
  }
}

static Proc*
FindProc(Tcl_Interp* in, Tcl_HashTable* table, char* name) {
  Tcl_HashEntry* hPtr = table ? Tcl_FindHashEntry(table, name) : 0;
  if (hPtr) {
    Command* co = (Command*)Tcl_GetHashValue(hPtr);
    if (co->objProc == RUNTIME_STATE(in)->objInterpProc)
      return (Proc*) co->objClientData;
    else if (co->proc == RUNTIME_STATE(in)->interpProc)
      return (Proc*) co->clientData;
  }
  return 0;
}

static char *
FindAutoLoadBody(Tcl_HashTable* table, char* name) {
    Tcl_HashEntry* hPtr = table ? Tcl_FindHashEntry(table, name) : 0;
    if (hPtr) {
        Command* co = (Command*) Tcl_GetHashValue(hPtr);
        if (co->objProc == AutoLoader)
            return (char *) co->objClientData;
    }
    return (char*) NULL;
}

static int
ListProcArgs(Tcl_Interp* in, Tcl_HashTable* table, char* name) {
  Proc* proc = FindProc(in, table, name);
  if (proc) {
      CompiledLocal *args = proc->firstLocalPtr;
      Tcl_ResetResult(in);
      for (;args != NULL; args = args->nextPtr) {
          if TclIsVarArgument(args)
	      Tcl_AppendElement(in, args->name);

      }
      return TCL_OK;
  }
  return XOTclErrBadVal(in, "a tcl method name", name);
}

static int
GetProcDefault(Tcl_Interp* in, Tcl_HashTable* table,
	       char* name, char* arg, Tcl_Obj** resultObj) {
  Proc* proc = FindProc(in, table, name);
  *resultObj = 0;
  if (proc) {
    CompiledLocal *ap;
    for (ap = proc->firstLocalPtr; ap != 0; ap = ap->nextPtr) {
      if (!TclIsVarArgument(ap)) continue;
      if (strcmp(arg, ap->name) != 0) continue;
	
      if (ap->defValuePtr != NULL) {
	*resultObj = ap->defValuePtr;
	return TCL_OK;
      }
      return TCL_OK;
    }
  }
  return TCL_ERROR;
}

static int
ListProcDefault(Tcl_Interp* in, Tcl_HashTable* table,
		 char* name, char* arg, char* var) {
  Tcl_Obj* defVal;
  if (GetProcDefault(in, table, name, arg, &defVal) == TCL_OK) {
    if (defVal != 0) {
      if (Tcl_SetVar2(in, var, 0, ObjStr(defVal), 0) != NULL) {
	Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
	return TCL_OK;
      }
    } else {
      if (Tcl_SetVar2(in, var, 0, "", 0) != NULL) {
	Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
	return TCL_OK;
      }
    }
    Tcl_ResetResult(in);
    Tcl_AppendResult
      (in, "couldn't store default value in variable '",
       var, "'", (char *) 0);
    return TCL_ERROR;
  }
  Tcl_ResetResult(in);
  Tcl_AppendResult(in, "procedure '", name,
		   "' doesn't exist or doesn't have an argument '",
		   arg, "'", (char *) 0);
  return TCL_ERROR;
}

static int
ListProcBody(Tcl_Interp* in, Tcl_HashTable* table, char* name) {
  Proc* proc = FindProc(in, table, name);

  if (proc) {
    Tcl_SetObjResult(in, proc->bodyPtr);
    return TCL_OK;
  } else {
    Tcl_SetResult(in, FindAutoLoadBody(table, name), TCL_VOLATILE);
    return TCL_OK;
  }
  return XOTclErrBadVal(in, "a tcl method name", name);
}

static void
ListObjChildren(Tcl_Interp* in, XOTclObject* obj, char* pattern) {
  XOTclObject* childobj;
  Tcl_HashTable* table = &obj->nsPtr->cmdTable;
  VarFrameDecls;

  if (pattern && noMetaChars(pattern)) {
    VarFrameSwitchToObj(in, obj);
    if ((childobj = GetObject(in, pattern))) {
      Tcl_SetObjResult(in, childobj->cmdName);
    } else {
      Tcl_SetObjResult(in, global_objects[EMPTY]);
    }
    VarFrameRestore(in);
  } else {
    Tcl_Obj *list = Tcl_NewListObj(0, NULL);
    Tcl_HashSearch hSrch;
    Tcl_HashEntry* hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0;
    VarFrameSwitchToObj(in, obj);
    for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
      char* key = Tcl_GetHashKey(table, hPtr);
      if (!pattern || Tcl_StringMatch(key, pattern)) {
	if ((childobj = GetObject(in, key))) {
	  Tcl_ListObjAppendElement(in, list, childobj->cmdName);
	}
      }
    }
    VarFrameRestore(in);
    Tcl_SetObjResult(in, list);
  }
}

static void
ListClassChildren(Tcl_Interp* in, XOTclClass* cl, char* pattern) {
  XOTclObject* obj = &cl->object, *childobj;
  Tcl_CallFrame frame;
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr = &obj->nsPtr->cmdTable ?
    Tcl_FirstHashEntry(&obj->nsPtr->cmdTable, &hSrch) :
    0;
  Tcl_Obj *list = Tcl_NewListObj(0, NULL);
  for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
    char* key = Tcl_GetHashKey(&obj->nsPtr->cmdTable, hPtr);
    if (!pattern || Tcl_StringMatch(key, pattern)) {
	Tcl_PushCallFrame(in, &frame, (Tcl_Namespace*)obj->nsPtr,0);
	childobj = GetObject(in, key);
	if (XOTclIsType(childobj, RUNTIME_STATE(in)->theClass)) {
	    Tcl_ListObjAppendElement(in, list, childobj->cmdName);
	}
	Tcl_PopCallFrame(in);
    }
  }
  Tcl_SetObjResult(in, list);
}

static void
ListParent(Tcl_Interp* in, Namespace* nsPtr) {
  Tcl_SetResult(in, nsPtr->parentPtr->fullName, TCL_VOLATILE);
}

static int
XOTcl_UplevelObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]);

static void
FindInCallStack(Tcl_Interp* in, Tcl_Obj* searchElt) {
  Interp *iPtr = (Interp *) in;
  int i, result = TCL_ERROR;
  Tcl_Obj* ov[2];
  ov[0] = Tcl_NewIntObj(1);
  ov[1] = searchElt;
  INCR_REF_COUNT(ov[0]);

  for (i=1; i < iPtr->numLevels && result != TCL_OK; i++) {
    Tcl_SetIntObj(ov[0], i);
    result = XOTcl_UplevelObjCmd(NULL, in, 2, ov);
  }
  DECR_REF_COUNT(ov[0]);

  if (result != TCL_OK)
    Tcl_SetObjResult(in, global_objects[EMPTY]);
}

static XOTclClass*
FindCalledClass(Tcl_Interp* in, XOTclObject* obj) {
  char* methodName;
  XOTclClass      *cl;
  Command        *procInfo = NULL;
  if (!obj->filterinfo.chains && !obj->mixinStack)
    return GetSelfClass(in);

  if (obj->filterinfo.chains && obj->filterinfo.chains->filterPtr)
    methodName = ObjStr(obj->filterinfo.chains->calledProc);
  else if (obj->mixinStack && obj->mixinStack->mixinChainOn) {
    methodName = GetSelfProc(in);
    if (!methodName) methodName = "";
  } else
    methodName = "";

  procInfo = FindMethod(methodName, obj->nsPtr);
  if (procInfo) {
    cl = 0;
  } else {
    cl = SearchCMethod(obj, obj->cl, NULL, methodName, &procInfo);
  }
  return cl;
}


/*
 * Next Primitive Handling
 */
static XOTCLINLINE void
NextSearchMethod(XOTclObject* obj, Tcl_Interp* in, 
		 XOTclClass **cl, char *method,
		 Tcl_ObjCmdProc **proc, Command **procInfo,
		 ClientData* cp, int* isMixinEntry, int* isMixinCalledProc,
		 Command** currentCmdPtr,
		 int* isFilterEntry, int* isFilterInheritance,
		 XOTclFilter** fPtr, XOTclClass** regClass) {
  XOTclClass *ncl = 0, *mcl = 0;
  XOTclClasses *pl = 0;
  Command *mprocInfo=0;
  Tcl_ObjCmdProc *mproc = 0;
  ClientData mcp = 0;

  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc = cs->top;

  /* if mixins are removed from within a mixin method ->
     reset the callstack class, otherwise cl is unnecessary,
     since mixins do their own search
     we can reset to null, since mixins are always placed at the
     beginning of the precedence order
  */
  if (csc->isMixinEntry == 1) {
    *cl = NULL;
  }

  /*
   * if we are already in the precedence ordering, then advance
   * past our last point; otherwise (if cl==0) begin from the start
   */

  pl = ComputeOrder(obj->cl, Super);
  while (pl && *cl) {
    if (pl->cl == *cl) *cl = 0;
    pl = pl->next;
  }

  /*
   * search for a further class method
   */

  ncl = SearchCMethod((XOTclObject*) NULL, NULL, pl, method, procInfo);

  if (*procInfo) {
    *proc = (*procInfo)->objProc;
    *cp   = (*procInfo)->objClientData;
  }

  /*
   *  Next in filters
   */

  if (obj->filterinfo.chains && obj->filterinfo.chains->filterPtr != 0) {
    *isFilterEntry = 1;

    if (*proc != 0) {
      /* specialization of the filter => directly return for 
         ordinary dispatch */
      *isFilterInheritance = 1;
      *cl = ncl;
      return;
    }

    /* if proc is already found the filter is specialized ->
       if not there are two possibilities:
       1. The filter is on the meta-class and may be specialized there.
          Then cl is not set to 0 in the above 'while (pl && cl)' loop,
	  because cl isn't on the precendence path
       2. if afterwards proc remains == 0 then we compute the next filter
    */
    if (*proc == 0 && cl) {
      XOTclClasses* metaPl = ComputeOrder(obj->cl->object.cl, Super);
      while (metaPl && cl) {
	if (metaPl->cl == *cl) *cl = 0;
	metaPl = metaPl->next;
      }
      ncl = SearchCMethod((XOTclObject*) NULL, NULL, metaPl, method, procInfo);

      if (*procInfo) {
	*proc = (*procInfo)->objProc;
	*cp   = (*procInfo)->objClientData;
	return;
      }
    }
	
    if (*proc == 0) {
      Command* lastFilter = obj->filterinfo.chains->filterPtr->cmdPtr;

      /* Deactivate the last filter in order to overstep 
	 active filters */
      FilterActiveListDelete(in, obj, lastFilter);
      lastFilter->refCount++;

      FilterComputeNext(in, obj, fPtr, regClass);

      /* Reactivate the last filter */
      FilterActiveListPrepend(in, obj, lastFilter);
      TclCleanupCommand(lastFilter);
      return;
    }
  }

  /*
   *  Next in Mixins
   */
  if (obj->mixinDefined == XOTCL_MIXINS_INVALID)
    MixinComputeDefined(in, obj);

  if (obj->mixinDefined == XOTCL_MIXINS_DEFINED &&
      obj->mixinStack && obj->mixinStack->currentCmdPtr) {
    mprocInfo = MixinSearchProc(in, obj, method,
				&mcl, &mproc, &mcp, currentCmdPtr);
  }

  if (mproc == 0) {
    if (obj->mixinStack && obj->mixinStack->mixinChainOn) {
      *isMixinCalledProc = 1;
      ncl = 0;
      *procInfo = FindMethod(method, obj->nsPtr);
      if (*procInfo) {
	ncl = 0;
      } else {
	ncl = SearchCMethod(obj, obj->cl, NULL, method, procInfo);
      }
      if (*procInfo) {
	*proc = (*procInfo)->objProc;
	*cp   = (*procInfo)->objClientData;
      } else {
	*proc = 0;
	*cp   = 0;
      }
    }
  } else {
    ncl = mcl;
    *procInfo = mprocInfo;
    *proc = mproc;
    *cp = mcp;
    *isMixinEntry = 1;
  }

  *cl = ncl;
  return;
}

static int
XOTclNextMethod(XOTclObject* obj, Tcl_Interp* in, XOTclClass *cl, char *method,
               int objc, Tcl_Obj * objv[]) {
  XOTclCallStackContent *csc = CallStackGetFrame(in);
  Tcl_ObjCmdProc *proc = 0;
  Command *procInfo;
  ClientData cp = 0;
  int result = TCL_OK, isMixinEntry = 0, isMixinCalledProc = 0, 
    isFilterEntry = 0, isFilterInheritance = 0;
  XOTclFilter* fPtr;
  XOTclClass* regClass;
  int nobjc; Tcl_Obj **nobjv;
  Command* currentCmdPtr = 0;

  /* if no args are given => use args from stack */
  if (objc == 1) {
    nobjc = csc->objc;
    nobjv = (Tcl_Obj **)csc->objv;

  } else {
    nobjc = objc;
    nobjv = objv;
  }

  /*
   * Search the next method & compute its method data
   */
  NextSearchMethod(obj, in, &cl, method, 
		   &proc, &procInfo, &cp, &isMixinEntry, &isMixinCalledProc,
		   &currentCmdPtr,
		   &isFilterEntry, &isFilterInheritance, &fPtr, &regClass);

#ifdef NEVER
  fprintf(stderr, "NextSearchMethod -- RETURN: method=%s", method);
  if (obj)
    fprintf(stderr, " obj=%s,", obj->nsPtr->fullName);
  if (cl)
    fprintf(stderr, " cl=%s,", cl->nsPtr->fullName);
  fprintf(stderr, " mixin=%d, filter=%d, proc=%p\n", 
	  isMixinEntry, isFilterEntry, proc);
#endif

  /*
   * if it is a filter specialization by inheritance => dispatch normal 
   * method call, otherwise handle filterEntries here
   */
  if (isFilterEntry && !isFilterInheritance) {
    Command* lastFilter = obj->filterinfo.chains->filterPtr->cmdPtr;
    /* Deactivate the last filter for the next call */
    FilterActiveListDelete(in, obj, lastFilter);
    lastFilter->refCount++;

    obj->filterinfo.chains->filterPtr = fPtr;
    obj->filterinfo.chains->regClass = regClass;
    if (fPtr != 0) {
      result = FilterDispatch(in, obj, nobjc, nobjv);
    } else {
      result = callMethod((ClientData)obj, in,
			  obj->filterinfo.chains->calledProc,
			  nobjc+1, nobjv+1, 1);
    }
    
    /* Reactivate the last filter for it's post part */
    FilterActiveListPrepend(in, obj, lastFilter);
    TclCleanupCommand(lastFilter);
    /*fprintf(stderr,"result of XOTclNextMethod %d\n",result);*/
    return result;
  }

  /*
   * if we're at the end of a mixin chain -> turn mixin chain off
   */
  if (obj->mixinStack) {
    if (isMixinCalledProc && obj->mixinStack->mixinChainOn) {
      obj->mixinStack->mixinChainOn = 0;
    }
    if (isMixinEntry) {
      obj->mixinStack->currentCmdPtr = currentCmdPtr;
    }
  }
  
  /*
   * now actually call the "next" method
   */
  if (proc != 0) {
    cp = (cp != 0) ? cp : (ClientData)obj;

    /* cut the flag, that no stdargs should be used, if it is there */
    if ((nobjc > 1) && (strcmp(ObjStr(nobjv[1]), "--noArgs") == 0)) {
      nobjc = 1;
    }
    result = callProcCheck(cp, in, nobjc, nobjv, procInfo,
			   obj, cl, method, isFilterEntry, isMixinEntry, 0);
  }
  return result;
}

static int
XOTclNextObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj * objv[]) {
  XOTclCallStackContent *csc = CallStackGetFrame(in);

  if (!csc->self)
    return XOTclVarErrMsg(in, "next: can't find self", (char*) NULL);

  if (!csc->procName)
    return XOTclErrMsg(in, "next: no executing proc", TCL_STATIC);

  return XOTclNextMethod(csc->self, in, csc->cl, csc->procName,
			 objc, objv);
}


/*
 * "self" object command
 */

static int
FindSelfNext(Tcl_Interp *in, XOTclObject* obj) {
  XOTclCallStackContent *csc = CallStackGetFrame(in);
  Tcl_ObjCmdProc *proc = 0;
  Command *procInfo;
  ClientData cp = 0;
  int isMixinEntry = 0, isMixinCalledProc = 0, 
    isFilterEntry = 0, isFilterInheritance = 0;
  XOTclFilter* fPtr;
  Command* currentCmdPtr = 0;
  XOTclClass* regClass, *cl = csc->cl;
  XOTclObject* o = csc->self;
  char* method = csc->procName;

  Tcl_ResetResult(in);

  method = GetSelfProc(in);
  if (!method)
    return TCL_OK;

  NextSearchMethod(o, in, &cl, method, 
		   &proc, &procInfo, &cp, &isMixinEntry, &isMixinCalledProc,
		   &currentCmdPtr,
		   &isFilterEntry, &isFilterInheritance, &fPtr, &regClass);

  if (isFilterEntry && !isFilterInheritance) {
    if (fPtr != 0) {
      procInfo = fPtr->cmdPtr;
    } else {
      char* methodName = ObjStr(obj->filterinfo.chains->calledProc);
      procInfo = FindMethod(methodName, obj->nsPtr);
      if (!procInfo) {
	cl = SearchCMethod(obj, obj->cl, NULL, methodName, &procInfo);
      }
    }
  }
  if (procInfo) {
    char *simpleName;
    Tcl_DString fullName;
    simpleName = Tcl_GetCommandName(in, (Tcl_Command)procInfo);
    ALLOC_NAME_NS(&fullName, procInfo->nsPtr->fullName, simpleName);
    
    Tcl_AppendResult(in, Tcl_DStringValue(&fullName), 0);
    
    Tcl_DStringFree(&fullName);
  }
  return TCL_OK;
}

static int
XOTclGetSelfObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj;
  char *option;
  Interp *iPtr = (Interp *) in;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;

  if (objc == 1) {
    if ((obj = GetSelfObj(in))) {
      /*
	fprintf(stderr, "obj=%p, cd=%p <%s> <%s>\n", obj,cd,
	  ObjStr((obj->cmdName)),
	  ObjStr(((XOTclObject*)cd)->cmdName));
      */
      Tcl_SetObjResult(in, obj->cmdName);
      return TCL_OK;
    }
    else
      return XOTclVarErrMsg(in, "Can't find self", (char*) NULL);
  } else if (objc != 2) {
    return XOTclVarErrMsg(in, "wrong # of args: self <class|proc>",
			  (char*)NULL);
  }

  option = ObjStr(objv[1]);
  if (isProcString(option)) { /* proc subcommand */
    char *procName = GetSelfProc(in);
    if (procName) {
      Tcl_SetResult(in, procName, TCL_VOLATILE);
      return TCL_OK;
    } else
      return XOTclVarErrMsg(in, "Can't find proc", (char*) NULL);
  } else if (isClassString(option)) { /* class subcommand */
    if ((obj = classXObj(GetSelfClass(in))))
      Tcl_SetObjResult(in, obj->cmdName);
    else
      Tcl_SetObjResult(in, global_objects[EMPTY]);
    return TCL_OK;
  } else {
    obj = GetSelfObj(in);
    if (!obj)
      return  XOTclVarErrMsg(in, "Can't find self during 'self ", 
			     *option, "'", (char*) NULL);
    switch (*option) { /* other callstack information */
    case 'c':
      if (!strcmp(option, "calledproc")) {
	if (!obj->filterinfo.chains || !obj->filterinfo.chains->calledProc)
	  return XOTclVarErrMsg(in,
				"self calledproc called from outside of a filter",
				(char*) NULL);
	Tcl_SetObjResult(in, obj->filterinfo.chains->calledProc);
	return TCL_OK;
      } else if (!strcmp(option, "calledclass")) {
	Tcl_ResetResult(in);
	Tcl_AppendResult(in, className(FindCalledClass(in, obj)), 
			 (char*) NULL);
	return TCL_OK;
      } else if (!strcmp(option, "callingproc")) {
	FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
	if (obj->filterinfo.chains && obj->filterinfo.chains->callingProc &&
	    FilterIsFilterFrame(in, iPtr->varFramePtr)) {
	  Tcl_SetObjResult(in, obj->filterinfo.chains->callingProc);
	} else {
	  FindInCallStack(in, global_objects[SELF_PROC]);
	}
	FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
	return TCL_OK;
      } else if (!strcmp(option, "callingclass")) {
	FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
	if (obj->filterinfo.chains && obj->filterinfo.chains->callingClass &&
	    FilterIsFilterFrame(in, iPtr->varFramePtr)) {
	  Tcl_SetObjResult(in, obj->filterinfo.chains->callingClass);
	} else {
	  FindInCallStack(in, global_objects[SELF_CLASS]);
	}
	FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
	return TCL_OK; 
      } else if (!strcmp(option, "callingobject")) {
	FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
	if (obj->filterinfo.chains && obj->filterinfo.chains->callingObject &&
	    FilterIsFilterFrame(in, iPtr->varFramePtr)) {
	  Tcl_SetObjResult(in, obj->filterinfo.chains->callingObject);
	} else {
	  FindInCallStack(in, global_objects[SELF]);
	}
	FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
	return TCL_OK;
      }
    case 'r':
      if (!strcmp(option, "regclass")) {
	if (!obj->filterinfo.chains || !obj->filterinfo.chains->regClass)
	  return XOTclVarErrMsg(in,
				"self regclass called from outside of a filter",
				(char*) NULL);
	Tcl_SetObjResult(in, obj->filterinfo.chains->regClass->object.cmdName);
	return TCL_OK;
      case 'n':
	if (!strcmp(option, "next"))
	  return FindSelfNext(in, obj);
      default:
	return XOTclVarErrMsg(in, "unknown option: self <class|proc>",
			      (char*)NULL);
      }
    }
  }
  return TCL_ERROR;
}


/*
 * object creation & destruction
 */

/*
 * mark an obj on the existing callstack, as not destroyed
 */
static void
UndestroyObj(Tcl_Interp* in, XOTclObject* obj) {
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc;

  /*
   * mark the object on the whole callstack as not destroyed
   */
  for (csc = &cs->content[1]; csc <= cs->top; csc++) {
    if (obj == csc->self && csc->destroyedCmd != 0) {
      /*
       * The ref count was incremented, when csc->destroyedCmd
       * was set. We revert this first before forgetting the
       * destroyedCmd.
       */
      if (csc->destroyedCmd->refCount > 1)
	csc->destroyedCmd->refCount--;
      csc->destroyedCmd  = 0;
    }
  }
  /*
   * mark destroyCalled as NOT CALLED (0)
   */
  obj->destroyCalled = 0;
}

/*
 * bring an object into a state, as after initialization
 */
static void
CleanupDestroyObject(Tcl_Interp* in, XOTclObject* obj) {
  XOTclClass *thecls, *theobj;


  thecls = RUNTIME_STATE(in)->theClass;
  theobj = RUNTIME_STATE(in)->theObject;
  /* remove the instance, but not for ::Class/::Object */
  if (obj != &(thecls->object)&& obj != &(theobj->object))
    (void)RemoveInstance(obj, obj->cl);
  
  NSCleanupNamespace(in, obj->nsPtr);

  NSDeleteChildren(in, obj->nsPtr);
  
  AssertionRemoveStore(obj->assertions);
  obj->assertions = NULL;

#ifdef OBJ_REFERENCES
  XOTclReferenceDestroy(in, obj);
#endif
#ifdef XOTCL_METADATA
  XOTclMetaDataDestroy(obj);
#endif

  MixinRemoveList(&obj->mixins);
  obj->mixinDefined = XOTCL_MIXINS_INVALID;
  MixinResetOrder(obj);
}

/*
 * do obj initialization & namespace creation
 */
static void
CleanupInitObject(Tcl_Interp* in, XOTclObject* obj,
		  XOTclClass* cl, char* name) {
  Tcl_DString cmd;
  Namespace *namespacePtr;

  obj->teardown = in;
  AddInstance(obj, cl);

  obj->type = RUNTIME_STATE(in)->theObject;
  obj->destroyCalled = 0;
  obj->clientData = 0;

#ifdef XOTCL_METADATA
  XOTclMetaDataInit(obj);
#endif

  obj->assertions = NULL;
  obj->checkoptions = CHECK_NONE;

#ifdef OBJ_REFERENCES
  XOTclReferenceInit(obj);
#endif
  namespacePtr = (Namespace*) Tcl_FindNamespace(in, name,
						(Tcl_Namespace *) NULL, 0);
  if (!namespacePtr)
    obj->nsPtr = (Namespace*)
      Tcl_CreateNamespace(in, name, (ClientData)obj,
			  (Tcl_NamespaceDeleteProc*) NSNamespaceDeleteProc);
  else
    obj->nsPtr = namespacePtr;

  ALLOC_NAME_NS(&cmd, obj->nsPtr->fullName, "self");
  Tcl_CreateObjCommand(in, Tcl_DStringValue(&cmd), XOTclGetSelfObjCmd, 0, 0);
  Tcl_DStringFree(&cmd);

  ALLOC_NAME_NS(&cmd, obj->nsPtr->fullName, "next");
  Tcl_CreateObjCommand(in, Tcl_DStringValue(&cmd), 
		       (Tcl_ObjCmdProc*) XOTclNextObjCmd, 0, 0);
  Tcl_DStringFree(&cmd);
}

/*
 * physical object destroy
 */
static void
PrimitiveODestroy(ClientData cd) {
  XOTclObject* obj = (XOTclObject*)cd;
  Tcl_Interp* in;
  Tcl_Command cmd;
  Command *cmdPtr;

  /*
   * check and latch against recurrent calls with obj->teardown
   */
  PRINTOBJ("PrimitiveODestroy", obj);

  if (!obj || !obj->teardown) return;
  in = obj->teardown;
  obj->teardown = 0;

  /*
   * Don't destroy, if the interpreter is destroyed already
   * e.g. TK calls Tcl_DeleteInterp directly, if the window is killed
   */
  if (Tcl_InterpDeleted(in)) return;
  NSDeleteChildren(in, obj->nsPtr);

  /*
   * call and latch user destroy with obj->id if we haven't
   */
  /*fprintf(stderr,"   PrimitiveODestroy after deleteChildren destroyCalled=%d teardown=%p\n",obj->destroyCalled, obj->teardown);*/


  if (!obj->destroyCalled) {
    callDestroyMethod(cd, in, obj, 0);
    obj->id = 0;
  }
#ifdef OBJDELETION_TRACE
  fprintf(stderr,"   physical delete of %p id=%p destroyCalled=%d '%s'\n",
	  obj, obj->id, obj->destroyCalled, ObjStr(obj->cmdName));
#endif
  /* if the command ptr in obj->id is not null CallStackDestroy
     was not able to delete the object from the callstack, because
     it is still referenced. Then we move the object to a tempory
     name, which is used as a substitute. This is deleted instead.
  cmdPtr = (Command *) obj->id;

  if (cmdPtr != NULL && obj != &(theobj->object) &&
      obj != &(thecls->object)) {
      fprintf(stderr, "move before destroy %p\n", obj);
    CallStackMoveBeforeDestroy(in, obj, cmdPtr);
    return;
  }
  */

  CleanupDestroyObject(in, obj);

  /*
   * if this is a class, callCleanupMethod is already
   * called in PrimitiveCDestroy
   */
  /*
  cl = XOTclIsClass(in, cd);
  if (!cl)
    result = callMethod(cd, in, global_objects[CLEANUP], 2,0, 0);
  */
  FilterActiveDeleteObj(in, obj);
  while (obj->filterinfo.chains != NULL)
    FilterChainInfoPop(obj);

  while (obj->mixinStack != NULL)
    MixinStackPop(obj);

  cmd = Tcl_FindCommand(in, ObjStr(obj->cmdName), 0, 0);
  cmdPtr = (Command *) cmd;
  if (cmdPtr != NULL)
    cmdPtr->deleteProc = 0;

  Tcl_DeleteNamespace((Tcl_Namespace *)obj->nsPtr);
  DECR_REF_COUNT(obj->cmdName);
  obj->cmdName = NULL;

  ckfree((char*)obj);
  return;
}

static void
PrimitiveOInit(void* mem, Tcl_Interp* in, char* name, XOTclClass* cl) {
  XOTclObject* obj = (XOTclObject*)mem;
  Namespace *namespacePtr;
  /*
   * if the command of the obj was used before, we have to clean
   * up the callstack from set "destroyedCmd" flags
   */
  UndestroyObj(in, obj);

  obj->mixins = 0;
  obj->mixinDefined = XOTCL_MIXINS_INVALID;
  obj->mixinStack = 0;
  obj->mixinOrder = 0;

  obj->filterinfo.chains = NULL;
  obj->filterinfo.doFilters = 0;
  obj->filterinfo.valid = 0;

  namespacePtr = (Namespace*) Tcl_FindNamespace(in, name,
						(Tcl_Namespace *) NULL, 0);
  if(namespacePtr)
    NSDeleteNamespace(in, namespacePtr);

  CleanupInitObject(in, obj, cl, name);
}

/*
 * Object creation: create object name (full name) and Tcl command
 */
static XOTclObject*
PrimitiveOCreate(Tcl_Interp* in, char* name, XOTclClass* cl) {
  XOTclObject* obj = (XOTclObject*)ckalloc(sizeof(XOTclObject));
  Tcl_DString fullName;
  char* fn;
  assert(obj); /* ckalloc panics, if malloc fails */

  if (*name == ':' && *(name+1) == ':') {
    fn = name;
  } else {
    Tcl_Namespace* currNsPtr = Tcl_GetCurrentNamespace(in);
    if (currNsPtr != Tcl_GetGlobalNamespace(in) &&
	!(currNsPtr->deleteProc == NSNamespaceDeleteProc)) {
      ALLOC_NAME_NS(&fullName, currNsPtr->fullName, name);
    } else {
      ALLOC_TOP_NS(&fullName, name);
    }
    fn = Tcl_DStringValue(&fullName);
  }

  if (!NSCheckForParent(in, fn, strlen(fn))) {
    if (fn != name) Tcl_DStringFree(&fullName);
    return 0;
  }
  obj->id = Tcl_CreateObjCommand(in, fn, XOTclObjDispatch,
				 (ClientData)obj, PrimitiveODestroy);
  PrimitiveOInit(obj, in, fn, cl);
  obj->cmdName = NewXOTclObjectObj(obj);
  INCR_REF_COUNT(obj->cmdName);

  if (fn != name) Tcl_DStringFree(&fullName);
  return obj;
}

/*
 * Cleanup class: remove filters, mixins, assertions, instances ...
 * and remove class from class hierarchy
 */
static void
CleanupDestroyClass(Tcl_Interp* in, XOTclClass* cl) {
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;
  XOTclClass *theobj;
  XOTclObject* obj = (XOTclObject*)cl;
  theobj = RUNTIME_STATE(in)->theObject;

  FilterRemoveList(in, cl);
  MixinRemoveList(&cl->instmixins);
  MixinInvalidateObjOrders(cl);

  NSCleanupNamespace(in, cl->nsPtr);

  NSDeleteChildren(in, cl->nsPtr);

  AssertionRemoveStore(cl->assertions);

  /* reset all instances to the class ::Object, that makes no sense
     for ::Object itself */
  if (cl != theobj) {
    hPtr = &cl->instances ? Tcl_FirstHashEntry(&cl->instances, &hSrch) : 0;
    for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
      XOTclObject* inst = (XOTclObject*)Tcl_GetHashKey(&cl->instances, hPtr);
      if (inst && (inst != (XOTclObject*)cl) && inst->id) {
	if (inst != &(theobj->object)) {
	  (void)RemoveInstance(inst, obj->cl);
	  AddInstance(inst, theobj);
	}
      }
    }
  }

  if (cl->parameterClass)
    DECR_REF_COUNT(cl->parameterClass);
  DECR_REF_COUNT(cl->parameters);

  /*
   * flush all caches, unlink superclasses
   */

  FlushPrecedences(cl);
  while (cl->sub) {
    XOTclClass* subClass = cl->sub->cl;
    (void)RemoveSuper(subClass, cl);
    /* if there are no more super classes add the Object
     * class as superclasses
     * -> don't do that for Object itself!
     */
    if (subClass->super == 0 && cl != theobj)
      AddSuper(subClass, theobj);
  }
  while (cl->super) (void)RemoveSuper(cl, cl->super->cl);
}

/*
 * do class initialization & namespace creation
 */
static void
CleanupInitClass(Tcl_Interp* in, XOTclClass* cl, XOTclObject* obj, char* name) {
  Tcl_CallFrame frame;
  Tcl_DString cmd;
  Namespace* namespacePtr;
  char* n = name;
  /*
   * during init of Object and Class the theClass value is not set
   */
  if (RUNTIME_STATE(in)->theClass != 0)
    obj->type = RUNTIME_STATE(in)->theClass;

  cl->super = 0;
  cl->sub = 0;
  AddSuper(cl, RUNTIME_STATE(in)->theObject);
  cl->parent = RUNTIME_STATE(in)->theObject;
  cl->color = WHITE;
  cl->order = 0;

  cl->clientData = 0;

  cl->filters = 0;
  cl->instmixins = 0;

  cl->parameterClass = 0;

  cl->parameters = Tcl_NewStringObj("",0);
  INCR_REF_COUNT(cl->parameters);

  Tcl_InitHashTable(&cl->instances, TCL_ONE_WORD_KEYS);
  cl->objectdata = 0;
  cl->assertions = 0;

  while (*n == ':')
    n++;

  if (Tcl_PushCallFrame(in, &frame,
			(Tcl_Namespace*)RUNTIME_STATE(in)->XOTclClassesNS,
			0)!= TCL_OK) return;

  namespacePtr = (Namespace*) Tcl_FindNamespace(in, n,
						(Tcl_Namespace *) NULL, 0);
  if(!namespacePtr)
    cl->nsPtr = (Namespace*)
      Tcl_CreateNamespace(in, n, (ClientData)cl,
			  (Tcl_NamespaceDeleteProc*) NSNamespaceDeleteProc);
  else
    cl->nsPtr = namespacePtr;
  Tcl_PopCallFrame(in);

  ALLOC_NAME_NS(&cmd, cl->nsPtr->fullName, "self");
  Tcl_CreateObjCommand(in, Tcl_DStringValue(&cmd), XOTclGetSelfObjCmd, 0, 0);
  Tcl_DStringFree(&cmd);

  ALLOC_NAME_NS(&cmd, cl->nsPtr->fullName, "next");
  Tcl_CreateObjCommand(in, Tcl_DStringValue(&cmd), 
		       (Tcl_ObjCmdProc*) XOTclNextObjCmd, 0, 0);
  Tcl_DStringFree(&cmd);

  return;
}

/*
 * class physical destruction
 */
static void
PrimitiveCDestroy(ClientData cd) {
  XOTclClass* cl = (XOTclClass*)cd;
  XOTclObject* obj = (XOTclObject*)cd;
  Tcl_Interp* in;
  Namespace* saved;

  /*
   * check and latch against recurrent calls with obj->teardown
   */
  if (!obj || !obj->teardown) return;
  in = obj->teardown;
  obj->teardown = 0;

  /*
   * Don't destroy, if the interpreted is destroyed already
   * e.g. TK calls Tcl_DeleteInterp directly, if Window is killed
   */
  if (Tcl_InterpDeleted(in)) return;
  NSDeleteChildren(in, cl->object.nsPtr);

  /*
   * call and latch user destroy with obj->id if we haven't
   */
  if (!obj->destroyCalled)
    callDestroyMethod(cd, in, obj, 0);
  /* we call cleanup here, before the instances
     hashtable is deleted

    result = callMethod(cd, in, global_objects[CLEANUP], 2,0, 0);
 */

  CleanupDestroyClass(in, cl);


  Tcl_DeleteHashTable(&cl->instances);

  if (cl->objectdata) {
    Tcl_DeleteHashTable(cl->objectdata);
    ckfree((char*)cl->objectdata);
    cl->objectdata = 0; 
  }

  /*
   * handoff the primitive teardown
   */

  saved = cl->nsPtr;
  obj->teardown = in;

  /*
   * class object destroy + physical destroy
   */
  PrimitiveODestroy(cd);

  Tcl_DeleteNamespace((Tcl_Namespace *)saved);

  return;
}

/*
 * class init
 */
static void
PrimitiveCInit(void* mem, Tcl_Interp* in, char* name, XOTclClass* class) {
  XOTclClass* cl = (XOTclClass*)mem;
  XOTclObject* obj = (XOTclObject*)mem;

  Tcl_CallFrame frame;
  Namespace* namespacePtr;
  char* n = name;

  while (*n == ':')
    n++;

  /*
   * ensure that namespace is newly created during CleanupInitClass
   * ie. kill it, if it exists already
   */
  if (Tcl_PushCallFrame(in, &frame,
			(Tcl_Namespace*)RUNTIME_STATE(in)->XOTclClassesNS,
			0)!= TCL_OK) return;

  namespacePtr = (Namespace*) Tcl_FindNamespace(in, n,
				   (Tcl_Namespace *) NULL, 0);
  if(namespacePtr) {
    NSDeleteNamespace(in, namespacePtr);
  }

  Tcl_PopCallFrame(in);

  CleanupInitClass(in, cl, obj, name);
  return;
}

/*
 * class create: creation of namespace + class full name
 * calls class object creation
 */
static XOTclClass*
PrimitiveCCreate(Tcl_Interp* in, char* name, XOTclClass* class) {
  XOTclClass* cl = (XOTclClass*)ckalloc(sizeof(XOTclClass));
  Tcl_DString fullName;
  char *fn;
  XOTclObject* obj = (XOTclObject*)cl;

  if (*name == ':' && *(name+1) == ':') {
    fn = name;
  } else {
    Tcl_Namespace * currNsPtr = Tcl_GetCurrentNamespace(in);
    if (currNsPtr != Tcl_GetGlobalNamespace(in)
	&& !(currNsPtr->deleteProc == NSNamespaceDeleteProc)) {
      ALLOC_NAME_NS(&fullName, currNsPtr->fullName, name);
    } else {
      ALLOC_TOP_NS(&fullName, name);
    }
    fn = Tcl_DStringValue(&fullName);
  }

  /*fprintf(stderr,"Class alloc %p '%s'\n", cl, fn);*/

  /* check whether Object parent NS already exists,
     otherwise: error */
  if (!NSCheckForParent(in, fn, strlen(fn))) {
    if (fn != name) Tcl_DStringFree(&fullName);
    return 0;
  }
  obj->id = Tcl_CreateObjCommand(in, fn, XOTclObjDispatch,
				 (ClientData)cl, PrimitiveCDestroy);
  
  PrimitiveOInit(obj, in, fn, class);
  obj->cmdName = NewXOTclObjectObj(obj);
  INCR_REF_COUNT(obj->cmdName);
  PrimitiveCInit(cl, in, fn+2, class);

  if (fn != name) Tcl_DStringFree(&fullName);
  return cl;
}

/*
 * Undestroy the object, reclass it, and call "cleanup" afterwards
 */
static int
doCleanup(Tcl_Interp* in, XOTclObject* newobj, XOTclObject* classobj,
	  int objc, Tcl_Obj *objv[]) {
  int destroyed = 0, result;
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc;

  /*
   * we check whether the object to be re-created is destroyed or not
   */
  for (csc = &cs->content[1]; csc <= cs->top; csc++) {
    if (newobj == csc->self && csc->destroyedCmd != 0) {
      destroyed = 1; break;
    }
  }
  
  if (destroyed)
    UndestroyObj(in, newobj);
  /*
   * object is not destroyed -> real re-create
   *
   * dispatch "class" to ensure correct class for newobj
   */
  result = callMethodWithArg((ClientData)newobj, in, 
			     global_objects[CLASS], classobj->cmdName, 
			     3, 0, 0);
  if (result != TCL_OK)
    return result;
  
  /*
   * dispatch "cleanup"
   */
  result = callMethod((ClientData) newobj, in,
		      global_objects[CLEANUP], 2, 0, 0);
  return result;
}



/*
 * Std initialization:
 *   call parameter default values
 *   apply "-" methods (call "configure" with given arguments)
 *   call constructor "init", if it was not called before
 */
static int
doObjInitialization(Tcl_Interp* in, XOTclObject* obj,
		    int objc, Tcl_Obj *objv[]) {
  int result, initCalled = 0, initArgsC = objc, i;

  /*
   * Search for default values of parameter on superclasses
   */
  result = callParameterMethodWithArg(obj, in, 
				      global_objects[SEARCH_DEFAULTS],
				      obj->cmdName, 3, 0,0);      
  if (result != TCL_OK)
    return result;

  /*
   * call init methods (starting with '-')
   */
  result = callMethod((ClientData) obj, in,
		      global_objects[CONFIGURE], objc, objv+2, 0);
  
  if (result != TCL_OK)
    return result;

  /* check, whether init was called already, and determine where the
   * configure (with '-') start (we don't send them as args to
   * "init").  */

  for (i=1; i < objc; i++) {
      char* arg = ObjStr(objv[i]);
    if (isDashArg(arg)) {
      if (initArgsC == objc)
	initArgsC = i;
      arg++;
      if (isInitString(arg)) {
	initCalled = 1;
	break;
      }
    }
  }

  if (!initCalled) {
    /*
     * Call the user-defined constructor 'init'
     */
    result = callMethod((ClientData) obj, in, global_objects[INIT], 
			initArgsC, objv+2, 0);
  }
  return result;
}


/*
 * experimental resolver implementation -> not used at the moment
 */
#ifdef NOT_USED
static int
XOTclResolveCmd(Tcl_Interp* in, char* name, Tcl_Namespace *contextNsPtr,
		int flags, Tcl_Command *rPtr) {

  Namespace *nsPtr[2], *cxtNsPtr;
  char *simpleName;
  register Tcl_HashEntry *entryPtr;
  register Command *cmdPtr;
  register int search;

  /*fprintf(stderr, "  ***%s->%s\n", contextNsPtr->fullName, name);*/

  /*
   * Find the namespace(s) that contain the command.
   */
  if ((flags & TCL_GLOBAL_ONLY) != 0) {
    cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(in);
  }
  else if (contextNsPtr != NULL) {
    cxtNsPtr = (Namespace *) contextNsPtr;
  }
  else {
    cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(in);
  }

  TclGetNamespaceForQualName(in, name, (Namespace *) contextNsPtr,
			     flags, &nsPtr[0], &nsPtr[1],
			     &cxtNsPtr, &simpleName);

  /*fprintf(stderr, "  ***Found %s, %s\n", nsPtr[0]->fullName, nsPtr[0]->fullName);*/

  /*
   * Look for the command in the command table of its namespace.
   * Be sure to check both possible search paths: from the specified
   * namespace context and from the global namespace.
   */

  cmdPtr = NULL;
  for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
    if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
      entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
				   simpleName);
      if (entryPtr != NULL) {
	cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
      }
    }
  }
  if (cmdPtr != NULL) {
    if (cxtNsPtr->deleteProc == NSNamespaceDeleteProc &&
	cmdPtr->objProc != XOTclObjDispatch &&
	cmdPtr->objProc != XOTclNextObjCmd &&
	cmdPtr->objProc != XOTclGetSelfObjCmd) {

      /*
       * the cmdPtr is defined in an XOTcl object or class namespace, but
       * not an object & not self/next -> redispatch in
       * global namespace
       */
      cmdPtr = 0;
      nsPtr[0] = (Namespace *) Tcl_GetGlobalNamespace(in);
      if ((nsPtr[0] != NULL) && (simpleName != NULL)) {
	entryPtr = Tcl_FindHashEntry(&nsPtr[0]->cmdTable,
				     simpleName);
	if (entryPtr != NULL) {
	  cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
	}
      }

      /*
      XOTclStackTrace(in);
      XOTclCallStackTrace(in);
      */
    }
    *rPtr = (Tcl_Command) cmdPtr;
    return TCL_OK;
  }

  return TCL_CONTINUE;
}
static int
XOTclResolveVar(Tcl_Interp* interp, char* name, Tcl_Namespace *context,
 	        Tcl_ResolvedVarInfo *rPtr) {
  fprintf(stderr, "Resolving %s in %s\n", name, context->fullName);

  return TCL_CONTINUE;
}
#endif

/*
 * object method implementations
 */

static int
XOTclODestroyMethod(ClientData cd, Tcl_Interp* in,
		    int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 1) return XOTclObjErrArgCnt(in, obj->cmdName, "destroy");
  PRINTOBJ("XOTclODestroyMethod", obj);

  /*
   * call instdestroy for [self]
   */
  return callMethodWithArg((ClientData)obj->cl, in,
			   global_objects[INSTDESTROY], obj->cmdName,
			   objc+2, objv+1, 0);
}

static int
XOTclOCleanupMethod(ClientData cd, Tcl_Interp* in,
		    int objc, Tcl_Obj *CONST objv[]) {
  XOTclClass *cl = XOTclIsClass(in, cd), *objsClass;
  XOTclObject* obj = (XOTclObject*)cd;
  char* fn;
  Tcl_Obj* savedNameObj;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 1) return XOTclObjErrArgCnt(in, obj->cmdName, "cleanup");
  PRINTOBJ("XOTclOCleanupMethod", obj);

  fn = ObjStr(obj->cmdName);
  savedNameObj = obj->cmdName;
  INCR_REF_COUNT(savedNameObj);

  objsClass = obj->cl;

  CleanupDestroyObject(in, obj);
  CleanupInitObject(in, obj, objsClass, fn);

  if (cl) {
    CleanupDestroyClass(in, cl);
    CleanupInitClass(in, cl, obj, fn);
  }

  DECR_REF_COUNT(savedNameObj);

  return TCL_OK;
}

static int
XOTclOIsClassMethod(ClientData cd, Tcl_Interp* in,
		     int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  char *className;
  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 1 || objc > 2) return XOTclObjErrArgCnt(in,
					  obj->cmdName,
					  "isclass ?className?");

  className = (objc == 2) ? ObjStr(objv[1]) : ObjStr(obj->cmdName);

  if (XOTclIsType(GetObject(in, className),
		  RUNTIME_STATE(in)->theClass)) {
    Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
  } else {
    Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
  }
  return TCL_OK;
}

static int
XOTclOIsObjectMethod(ClientData cd, Tcl_Interp* in,
		     int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 2) return XOTclObjErrArgCnt(in,
					       obj->cmdName,
					       "isobject <objName>");

  if (GetObject(in, ObjStr(objv[1]))) {
    Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
  } else {
    Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
  }
  return TCL_OK;
}

static int
IsMetaClass(Tcl_Interp* in, XOTclClass* cl) {
  /* check if cl is a meta-class by checking is Class is a superclass of cl*/
  XOTclClasses* pl;
  if (cl == RUNTIME_STATE(in)->theClass)
    return 1;

  pl = ComputeOrder(cl, Super);
  while (pl != 0) {
    if (pl->cl == RUNTIME_STATE(in)->theClass)
      return 1;
    pl=pl->next;
  }
  return 0;
}

static int
XOTclOIsMetaClassMethod(ClientData cd, Tcl_Interp* in,
			int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  XOTclClass* cl;
  char *className;
  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 1 || objc > 2) return XOTclObjErrArgCnt(in,
					  obj->cmdName,
					  "ismetaclass ?metaClassName?");

  className = (objc == 2) ? ObjStr(objv[1]) : ObjStr(obj->cmdName);

  if (XOTclIsType(GetObject(in, className),
		  RUNTIME_STATE(in)->theClass)) {
    cl = GetClass(in, className);
    if (cl && IsMetaClass(in, cl)) {
      Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
      return TCL_OK;
    }
  }
  Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
  return TCL_OK;
}

static int
XOTclOIsTypeMethod(ClientData cd, Tcl_Interp* in,
			int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject *obj = (XOTclObject*)cd;
  XOTclClass *cl;
  XOTclClasses *t;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 2) return XOTclObjErrArgCnt(in,
					  obj->cmdName,
					  "istype <className>");
  cl = GetClass(in, ObjStr(objv[1]));
  if (cl && obj->cl) {
    if (cl == obj->cl) {
      Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
      return TCL_OK;
    }
    t = ComputeOrder(obj->cl, Super);
    while (t && t->cl && t->cl != cl) {
      t = t->next;
    }
    if (t && t->cl == cl) {
      Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
      return TCL_OK;
    }
  }
  Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
  return TCL_OK;
}

static int
XOTclOClassMethod(ClientData cd, Tcl_Interp* in,
		  int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  XOTclClass* cl;
  char *className;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 2) return XOTclObjErrArgCnt(in, obj->cmdName, "class <class>");

  /*
   * allow a change to any class; type system enforces safety later
   */

  className = ObjStr(objv[1]);
  cl = GetClass(in, className);
  if (!cl)
    return XOTclErrBadVal(in, "a class", className);

  (void)RemoveInstance(obj, obj->cl);
  AddInstance(obj, cl);

  MixinComputeDefined(in, obj);

  return TCL_OK;
}

static int
varExists(Tcl_Interp* in, XOTclObject* obj, char *varName) {
  VarFrameDecls;
  Var *varPtr;
  int result;
#if defined(PRE83)
  Var *arrayPtr;
#endif

  VarFrameSwitchToObj(in, obj);
#if defined(PRE83)
  varPtr = TclLookupVar(in, varName, (char *) NULL, TCL_PARSE_PART1, "access",
			/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
#else
  varPtr = TclVarTraceExists(in, varName);
#endif
  result = ((varPtr != NULL) && !TclIsVarUndefined(varPtr));
  VarFrameRestore(in);
  return result;
}

static int
XOTclOExistsMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 2) return XOTclObjErrArgCnt(in, obj->cmdName, "exists var");

  Tcl_SetIntObj(Tcl_GetObjResult(in),
		varExists(in, obj, ObjStr(objv[1])));
  return TCL_OK;
}

static int XOTclCInfoMethod(ClientData d, Tcl_Interp* h, int i, Tcl_Obj *CONST v[]);

static int
XOTclOInfoMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj* CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  char *cmd, *pattern;
  Interp *iPtr = (Interp *) in;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2)
    return XOTclObjErrArgCnt(in, obj->cmdName, "info <opt> ?args?");

  cmd = ObjStr(objv[1]);
  pattern = (objc > 2) ? ObjStr(objv[2]) : 0;

  if (isClassString(cmd)) {
    if (objc > 3)
      return XOTclObjErrArgCnt(in, obj->cmdName, "info class ?class?");
    if (objc == 2) {
      Tcl_SetObjResult(in, obj->cl->object.cmdName);
      return TCL_OK;
    } else {
      int result;
      DEFINE_NEW_TCL_OBJECTS_ON_STACK(objc, ov);

      memcpy(ov, objv, sizeof(Tcl_Obj *)*objc);
      ov[1] = Tcl_NewStringObj("superclass", 10);
      INCR_REF_COUNT(ov[1]);
      result = XOTclCInfoMethod((ClientData)obj->cl, in, objc, ov);
      DECR_REF_COUNT(ov[1]);
      FREE_TCL_OBJECTS_ON_STACK(ov);
      return result;
    }
  } else switch (*cmd) {
  case 'a':
    if (isArgsString(cmd)) {
      if (objc != 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info args <proc>");
      return ListProcArgs(in, &obj->nsPtr->cmdTable, pattern);
    }
    break;

  case 'b':
    if (!strcmp(cmd, "body")) {
      if (objc != 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info body <proc>");
      return ListProcBody(in, &obj->nsPtr->cmdTable, pattern);
    }
    break;

  case 'c':
    if (!strcmp(cmd, "commands")) {
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info commands ?pat?");
      ListKeys(in, &obj->nsPtr->cmdTable, pattern);
      return TCL_OK;

    } else if (!strcmp(cmd, "children")) {
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info children ?pat?");
      ListObjChildren(in, obj, pattern);
      return TCL_OK;

    } else if (!strcmp(cmd, "callingobject")) {
      XOTclDeprecatedMsg("info callingobject", "self callingobject");
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info callingobject");
      FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
      if (obj->filterinfo.chains && obj->filterinfo.chains->callingObject &&
	  FilterIsFilterFrame(in, iPtr->varFramePtr)) {
	Tcl_SetObjResult(in, obj->filterinfo.chains->callingObject);
      } else {
	FindInCallStack(in, global_objects[SELF]);
      }
      FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
      return TCL_OK;
    } else if (!strcmp(cmd, "calledproc")) {
      XOTclDeprecatedMsg("info calledproc", "self calledproc");
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info calledproc");
      if (!obj->filterinfo.chains || !obj->filterinfo.chains->calledProc)
	return XOTclVarErrMsg(in,
			      "info calledproc called from outside of a filter",
			      (char*) NULL);
      Tcl_SetObjResult(in, obj->filterinfo.chains->calledProc);
      return TCL_OK;

    } else if (!strcmp(cmd, "calledclass")) {
      XOTclDeprecatedMsg("info calledclass", "self calledclass");
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info calledclass");
      Tcl_ResetResult(in);
      Tcl_AppendResult(in, className(FindCalledClass(in, obj)), 
		       (char*) NULL);
      return TCL_OK;
    } else if (!strcmp(cmd, "callingproc")) {
      XOTclDeprecatedMsg("info callingproc", "self callingproc");
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info callingproc");
      FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
      if (obj->filterinfo.chains && obj->filterinfo.chains->callingProc &&
	  FilterIsFilterFrame(in, iPtr->varFramePtr)) {
	Tcl_SetObjResult(in, obj->filterinfo.chains->callingProc);
      } else {
	FindInCallStack(in, global_objects[SELF_PROC]);
      }
      FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
      return TCL_OK;

    } else if (!strcmp(cmd, "callingclass")) {
      XOTclDeprecatedMsg("info callingproc", "self callingproc");
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info callingclass");
      FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
      if (obj->filterinfo.chains && obj->filterinfo.chains->callingClass &&
	  FilterIsFilterFrame(in, iPtr->varFramePtr)) {
	Tcl_SetObjResult(in, obj->filterinfo.chains->callingClass);
      } else {
	FindInCallStack(in, global_objects[SELF_CLASS]);
      }
      FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
      return TCL_OK;
    } else if (!strcmp(cmd, "check")) {
      if (objc != 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info check");
      AssertionListCheckOption(in, obj);
      return TCL_OK;
    }

    break;

  case 'd':
    if (!strcmp(cmd, "default")) {
      if (objc != 5)
	return XOTclObjErrArgCnt(in,
				 obj->cmdName,
				 "info default <proc> <arg> <var>");
      return ListProcDefault(in,  &obj->nsPtr->cmdTable, pattern,
			     ObjStr(objv[3]), ObjStr(objv[4]));
    }
    break;

  case 'i':
    if (!strcmp(cmd, "invar")) {
      if (objc != 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info invar");
      if (obj->assertions)
	Tcl_SetObjResult(in, AssertionList(in, obj->assertions->invariants));
      else
	Tcl_ResetResult(in);
      return TCL_OK;
    } else if (!strcmp(cmd, "info")) {
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info info");
      ListInfo(in, ObjStr(obj->cmdName));
      return TCL_OK;
    }
    break;

  case 'm':
    if (!strcmp(cmd, "mixin")) {
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info mixin ?class?");
      MixinInfo(in, obj->mixins, pattern);
      return TCL_OK;
    } else if (!strcmp(cmd, "mixins")) {
      XOTclDeprecatedMsg("info mixins", "info mixin");
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info mixin ?class?");
      MixinInfo(in, obj->mixins, pattern);
      return TCL_OK;
    }
#ifdef XOTCL_METADATA
     else  if (!strcmp(cmd, "metadata")) {
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info metadata ?pat?");
      ListKeys(in, &obj->metaData, pattern);
      return TCL_OK;
    }
#endif
    break;
  case 'p':
    if (!strcmp(cmd, "procs")) {
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info procs ?pat?");
      ListProcKeys(in, &obj->nsPtr->cmdTable, pattern);
      return TCL_OK;
    } else if (!strcmp(cmd, "parent")) {
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info parent");
      ListParent(in, obj->nsPtr);
      return TCL_OK;
    } else if (!strcmp(cmd, "pre")) {
      XOTclProcAssertion* procs;
      if (objc != 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info pre <proc>");
      procs = AssertionFindProcs(obj->assertions, ObjStr(objv[2]));
      if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->pre));
      return TCL_OK;
    } else if (!strcmp(cmd, "post")) {
      XOTclProcAssertion* procs;
      if (objc != 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info post <proc>");
      procs = AssertionFindProcs(obj->assertions, ObjStr(objv[2]));
      if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->post));
      return TCL_OK;
    }
    break;

  case 'r':
    if (!strcmp(cmd, "regclass")) {
      XOTclDeprecatedMsg("info regclass", "self regclass");
      if (objc > 2)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info regclass");
      if (!obj->filterinfo.chains || !obj->filterinfo.chains->regClass)
	return XOTclVarErrMsg(in,
			      "info regclass called from outside of a filter",
			      (char*) NULL);
      Tcl_SetObjResult(in, obj->filterinfo.chains->regClass->object.cmdName);
      return TCL_OK;
#ifdef OBJ_REFERENCES
    } else if (!strcmp(cmd, "reference")) {
      if (objc != 2) return XOTclObjErrArgCnt(in, obj->cmdName,
					      "info reference");
      ListObjPtrHashTable(in, &obj->references, 0);
      return TCL_OK;
    } else if (!strcmp(cmd, "referencedby")) {
      if (objc != 2) return XOTclObjErrArgCnt(in, obj->cmdName,
					      "info referencedby");
      ListObjPtrHashTable(in, &obj->referencedBy, 0);
      return TCL_OK;
#endif
    }
    break;

  case 'v':
    if (!strcmp(cmd, "vars")) {
            Tcl_Obj *varlist, *okList, *element;
      int i, length;
      if (objc > 3)
	return XOTclObjErrArgCnt(in, obj->cmdName, "info vars ?pat?");
      ListKeys(in, &obj->nsPtr->varTable, pattern);
      varlist = Tcl_GetObjResult(in);
      Tcl_ListObjLength(in, varlist, &length);
      okList = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
      for (i=0; i<length; i++) {
         Tcl_ListObjIndex(in, varlist, i, &element);
	 if (varExists(in, obj, ObjStr(element))) {
 	    Tcl_ListObjAppendElement(in, okList, element);
	 } else {
	   /*fprintf(stderr,"must ignore '%s' %d\n", ObjStr(element),i);*/
	    /*Tcl_ListObjReplace(in, varlist, i, 1, 0, NULL);*/
	 }
      }
      /*DECR_REF_COUNT(varlist);*/
      Tcl_SetObjResult(in, okList);
      return TCL_OK;
    }
    break;
  }
  return XOTclErrBadVal
    (in, "an info option (use 'info info' to list all info options)", cmd);
  return TCL_OK;
}

static int
XOTclMakeFailure(Tcl_Interp* in, Tcl_Obj * CONST objv[], char *msg) {
  int i;
  Tcl_ResetResult(in);
  Tcl_AppendResult(in, msg, 0);
  for(i=0;i<=4;i++) Tcl_AppendResult(in, " ", ObjStr(objv[i]), 0 );
  for(;i<=6;i++) Tcl_AppendResult(in, " {", ObjStr(objv[i]), "}", 0 );
  Tcl_AppendResult(in, "\n", 0);
  return TCL_ERROR;
}

static int
XOTclOProcMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj * CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  char *argStr, *bdyStr, *name;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 4 && objc != 6)
      return XOTclObjErrArgCnt(in,
				    obj->cmdName,
				    "proc name args body ?preAssertion postAssertion?");

  /*
   * if the args list is "auto", the body is a script to load the proc
   */
  argStr = ObjStr(objv[2]);
  bdyStr = ObjStr(objv[3]);
  name = ObjStr(objv[1]);

  if (isAutoString(argStr)) {
      if (!MakeAuto(in, bdyStr, name, obj->nsPtr))
	return XOTclMakeFailure(in,
				objv,
				"Tcl_CreateObjCommand for autoloading failed in XOTclOProcMethod\n");
  } else if (*argStr == 0 && *bdyStr == 0) {
      AssertionRemoveProc(obj->assertions, name);
      NSDeleteCmd(in, obj->nsPtr, name);
  } else {
    if (!obj->assertions)
      obj->assertions = AssertionCreateStore();
    MakeProc(obj->nsPtr, obj->assertions, in, objc, (Tcl_Obj **) objv);
  }

  return TCL_OK;
}

static int
XOTclOIncrMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj * CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  VarFrameDecls;
  int result;

  if (!obj)
    return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2)
    return XOTclObjErrArgCnt(in, obj->cmdName, "incr <varName> ?increment?");

  VarFrameSwitchToObj(in, obj);
  result = XOTcl_IncrObjCmd(cd, in, objc, objv);
  VarFrameRestore(in);

  return result;
}

Tcl_Obj*
XOTclOSetInstVar(XOTclObject* obj, Tcl_Interp* in,
		 Tcl_Obj* name, Tcl_Obj* value, int flgs) {
  return XOTclOSetInstVar2(obj, in, name, (Tcl_Obj *) NULL, value, flgs);
}

Tcl_Obj*
XOTclOGetInstVar(XOTclObject* obj, Tcl_Interp* in, Tcl_Obj* name, int flgs) {
    return XOTclOGetInstVar2(obj, in, name, (Tcl_Obj *)NULL, flgs);
}

int
XOTclUnsetInstVar(XOTclObject* obj, Tcl_Interp* in, char* name, int flgs) {
    return XOTclUnsetInstVar2 (obj, in, name,(char*)NULL, flgs);
}

extern int
XOTclCreateObject(Tcl_Interp* in, Tcl_Obj* name, XOTclClass* cl) {
  int result;
  INCR_REF_COUNT(name);
  result = callMethodWithArg((ClientData)cl, in, 
			     global_objects[CREATE], name, 3, 0, 0);
  DECR_REF_COUNT(name);
  return result;
}

extern int
XOTclCreateClass(Tcl_Interp* in, Tcl_Obj* name, XOTclClass* cl) {
  int result;
  INCR_REF_COUNT(name);
  result = callMethodWithArg((ClientData)cl, in, 
			     global_objects[CREATE], name, 3, 0, 0);
  DECR_REF_COUNT(name);
  return result;
}

int
XOTclDeleteObject(Tcl_Interp* in, XOTclObject* obj) {
  return callMethod((ClientData)obj, in, global_objects[DESTROY],2,0,0);
}

int
XOTclDeleteClass(Tcl_Interp* in, XOTclClass* cl) {
  return callMethod((ClientData)cl, in, global_objects[DESTROY],2,0,0);
}

extern Tcl_Obj*
XOTclOSetInstVar2(XOTclObject* obj, Tcl_Interp* in, 
		  Tcl_Obj* name1, Tcl_Obj* name2,
		  Tcl_Obj* value, int flgs) {
  Tcl_Obj* result;
  VarFrameDecls;

  VarFrameSwitchToObj(in, obj);
  result = Tcl_ObjSetVar2(in, name1, name2, value,
			  flgs|TCL_PARSE_PART1|TCL_NAMESPACE_ONLY);
  VarFrameRestore(in);

  return result;
}

extern int
XOTclUnsetInstVar2(XOTclObject* obj, Tcl_Interp* in, char* name1, char *name2,
        int flgs) {
  int result;
  Tcl_DString fullName;
  ALLOC_NAME_NS(&fullName, obj->nsPtr->fullName, name1);
  result = Tcl_UnsetVar2(in, Tcl_DStringValue(&fullName), name2, flgs);
  Tcl_DStringFree(&fullName);
  return result;
}

/*
 * We need NewVar from tclVar.c ... but its not exported
 */
static Var *NewVar() {
  register Var *varPtr;

  varPtr = (Var *) ckalloc(sizeof(Var));
  varPtr->value.objPtr = NULL;
  varPtr->name = NULL;
  varPtr->nsPtr = NULL;
  varPtr->hPtr = NULL;
  varPtr->refCount = 0;
  varPtr->tracePtr = NULL;
  varPtr->searchPtr = NULL;
  varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
  return varPtr;
}

/*
 * Provide functionality similar to Tcl's VariableObjCmd for instvared
 * vars with alias (VariableObjCmd does not accept aliases)
 *
 * We have to copy a lot of code from MakeUpvar, because Tcl does not
 * export it (sigh)
 */
static int
GetInstVarAliasIntoCurrentScope(Tcl_Interp* in, char* varName, char* newName) {
  Interp *iPtr = (Interp *) in;
  Var *varPtr, *otherPtr, *arrayPtr;
  int new;
  CallFrame *varFramePtr;
  Tcl_HashEntry *hPtr;
  Tcl_HashTable *tablePtr;

  /* Look up var in the current namespace context, creating
   * it if necessary. */
  otherPtr = TclLookupVar(in, varName, (char *) NULL,
			  (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
			  /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);

  if (newName == NULL) {
    return XOTclVarErrMsg(in, "can't define alias to ",
			  varName, ": alias not given.", NULL);
  }
  if (otherPtr == NULL) {
    return XOTclVarErrMsg(in, "can't define alias to ",
			  varName, ": can't find variable.", NULL);
  }
  /*
   * Mark the variable as a namespace variable
   */
  if (!(otherPtr->flags & VAR_NAMESPACE_VAR)) {
    otherPtr->flags |= VAR_NAMESPACE_VAR;
  }

  varFramePtr = iPtr->varFramePtr;

  /*
   * If we are executing inside a Tcl procedure, create a local
   * variable linked to the new namespace variable "varName".
   */
  if ((iPtr->varFramePtr != NULL)
      && iPtr->varFramePtr->isProcCallFrame) {
    Proc *procPtr = varFramePtr->procPtr;
    int localCt = procPtr->numCompiledLocals;
    CompiledLocal *localPtr = procPtr->firstLocalPtr;
    Var *localVarPtr = varFramePtr->compiledLocals;
    int nameLen = strlen(newName);
    int i;

    varPtr = NULL;
    for (i = 0;  i < localCt;  i++) {    /* look in compiled locals */
      if (!TclIsVarTemporary(localPtr)) {
	char *localName = localVarPtr->name;
	if ((newName[0] == localName[0])
	    && (nameLen == localPtr->nameLength)
	    && (strcmp(newName, localName) == 0)) {
	  varPtr = localVarPtr;
	  new = 0;
	  break;
	}
      }

      localVarPtr++;
      localPtr = localPtr->nextPtr;
    }

    if (varPtr == NULL) {	/* look in frame's local var hashtable */
      tablePtr = varFramePtr->varTablePtr;
      if (tablePtr == NULL) {
	tablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
	varFramePtr->varTablePtr = tablePtr;
      }
      hPtr = Tcl_CreateHashEntry(tablePtr, newName, &new);
      if (new) {
	varPtr = NewVar();
	Tcl_SetHashValue(hPtr, varPtr);
	varPtr->hPtr = hPtr;
	varPtr->nsPtr = varFramePtr->nsPtr;
      } else {
	varPtr = (Var *) Tcl_GetHashValue(hPtr);
      }
    }

    if (!new) {
      if ((varPtr == otherPtr) || TclIsVarLink(varPtr) ||
	  !TclIsVarUndefined(varPtr) || (varPtr->tracePtr != NULL)) {
	return XOTclVarErrMsg(in, "can't set variable alias ", newName,
			      ": name already exists", 0);
      }
    }
    TclSetVarLink(varPtr);
    TclClearVarUndefined(varPtr);
    varPtr->value.linkPtr = otherPtr;
    otherPtr->refCount++;
  }
  return TCL_OK;
}

static int
XOTclInstVarDS(XOTclObject* obj, Tcl_Interp* in, Tcl_DString* ds, char *destName) {
  int result;
  Tcl_Obj* ov[2];
  char* name = Tcl_DStringValue(ds);
  int filterFrameCutOff = 0;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;

  if (obj  && obj->filterinfo.chains) {
    filterFrameCutOff = 1;
    FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
   }

  ov[1] = Tcl_NewStringObj(name,
			   Tcl_DStringLength(ds));
  INCR_REF_COUNT(ov[1]);
  if (destName == NULL) {
    result = XOTcl_VariableObjCmd((ClientData)obj, in, 2, ov);
  } else {
    /* UpVar for compatibility to OTcl (alias names)*/
     result = GetInstVarAliasIntoCurrentScope(in, name, destName);
  }

  if (filterFrameCutOff)
    FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);

  DECR_REF_COUNT(ov[1]);
  return result;
}

extern int
XOTclInstVar(XOTclObject* obj, Tcl_Interp* in, char* name, char *destName) {
  int result;
  Tcl_DString ds, *dsp=&ds;

  ALLOC_NAME_NS(dsp, obj->nsPtr->fullName, name);

  result = XOTclInstVarDS(obj, in, dsp, destName);

  Tcl_DStringFree(dsp);
  return result;
}

int
XOTclRemovePMethod(Tcl_Interp* in, XOTclObject* obj, char* nm) {
  return NSDeleteCmd(in, obj->nsPtr, nm);
}

extern int
XOTclRemoveIMethod(Tcl_Interp* in, XOTclClass* cl, char* nm) {
  return NSDeleteCmd(in, cl->nsPtr, nm);
}

extern void
XOTclSetObjectData(XOTclObject* obj, XOTclClass* cl, ClientData data) {
  Tcl_HashEntry *hPtr;
  int nw;

  if (!cl->objectdata) {
    cl->objectdata = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(cl->objectdata, TCL_ONE_WORD_KEYS);
  }
  hPtr = Tcl_CreateHashEntry(cl->objectdata, (char*)obj, &nw);
  Tcl_SetHashValue(hPtr, data);
}

extern int
XOTclGetObjectData(XOTclObject* obj, XOTclClass* cl, ClientData* data) {
  Tcl_HashEntry *hPtr;

  if (!cl->objectdata) return 0;
  hPtr = Tcl_FindHashEntry(cl->objectdata, (char*)obj);
  if (data) *data = hPtr ? Tcl_GetHashValue(hPtr) : 0;
  return hPtr != 0;
}

extern int
XOTclUnsetObjectData(XOTclObject* obj, XOTclClass* cl) {
  Tcl_HashEntry *hPtr;

  if (!cl->objectdata) return 0;
  hPtr = Tcl_FindHashEntry(cl->objectdata, (char*)obj);
  if (hPtr) Tcl_DeleteHashEntry(hPtr);
  return hPtr != 0;
}

static int
XOTclOSetMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  Tcl_Obj *result;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");

  if (objc == 2) 
    result = XOTclOGetInstVar2(obj, in, objv[1], NULL, 
			       TCL_LEAVE_ERR_MSG);
  else if (objc == 3) 
    result = XOTclOSetInstVar2(obj, in, objv[1], NULL, objv[2], 
			       TCL_LEAVE_ERR_MSG);
  else
    return XOTclObjErrArgCnt(in, obj->cmdName, "set var ?value?");
  
  if (result) {
    Tcl_SetObjResult(in, result);
    return TCL_OK;
  } else {
    return XOTclVarErrMsg(in, "Can't find result of set ",
			  ObjStr(objv[1]), 0);
  }
}

static int
XOTclSetterMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  Tcl_Obj *result;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");

  if (objc == 1) 
    result = XOTclOGetInstVar2(obj, in, objv[0], NULL, 
			       TCL_LEAVE_ERR_MSG);
  else if (objc == 2) 
    result = XOTclOSetInstVar2(obj, in, objv[0], NULL, objv[1], 
			       TCL_LEAVE_ERR_MSG);
  else
    return XOTclObjErrArgCnt(in, obj->cmdName, "<parameter> ?value?");
  
  if (result) {
    Tcl_SetObjResult(in, result);
    return TCL_OK;
  } else {
    return XOTclVarErrMsg(in, "Can't find result of parameter ",
			  ObjStr(objv[0]), 0);
  }
}

static int
XOTclOUnsetMethod(ClientData cd, Tcl_Interp* in, 
		  int objc, Tcl_Obj * CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  int i, result = TCL_ERROR;
  VarFrameDecls;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2) return XOTclObjErrArgCnt(in, obj->cmdName, "unset ?vars?");
  VarFrameSwitchToObj(in, obj);
  for (i=1; i<objc; i++) {
    result =  Tcl_UnsetVar2(in, ObjStr(objv[i]), (char *) NULL,
			    (TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1));
    if (result != TCL_OK) break;
  }
  VarFrameRestore(in);
  return result;
}

static int
XOTclOInstVarMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject  *obj   = (XOTclObject*)cd;
  Namespace    *nsPtr;
  Tcl_Obj      **ov;
  int          i, oc, result = TCL_OK;
  Interp       *iPtr = (Interp *) in;
  int filterFrameCutOff = 0;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2) return XOTclObjErrArgCnt(in, obj->cmdName, "instvar ?vars?");

  if (obj  && obj->filterinfo.chains) {
    filterFrameCutOff = 1;
    FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
  }

  if (!iPtr->varFramePtr)
    return XOTclVarErrMsg(in, "instvar used on ", ObjStr(obj->cmdName),
			  ", but callstack is not in procedure scope",
			  (char*) 0);

  nsPtr = iPtr->varFramePtr->nsPtr;
  iPtr->varFramePtr->nsPtr = obj->nsPtr;

  for (i=1; i<objc; i++) {
    if ((result = Tcl_ListObjGetElements(in, objv[i], &oc, &ov)) == TCL_OK) {
      if (oc == 1) {
	result = XOTcl_VariableObjCmd(cd, in, 2, &ov[-1]);
	if (result != TCL_OK)
	  break;
      } else if (oc == 2) {
	/*result = Tcl_VariableObjCmd((ClientData)NULL, in, 2, &ov[-1]);
	  if (result == TCL_OK)*/
	  result = GetInstVarAliasIntoCurrentScope(in, ObjStr(ov[0]),
						   ObjStr(ov[1]));
	if (result != TCL_OK)
	  break;
      } else
	break;
    }
  }

  iPtr->varFramePtr->nsPtr=nsPtr;

  if (filterFrameCutOff)
    FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);

  return result;
}

static int
XOTclOInvariantsMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 2)
      return XOTclObjErrArgCnt(in, obj->cmdName, "invar <invariantList>");

  if (obj->assertions)
    AssertionDeleteList(obj->assertions->invariants);
  else
    obj->assertions = AssertionCreateStore();

  obj->assertions->invariants = AssertionNewList(in, objv[1]);
  return TCL_OK;
}

static int
XOTclOAutonameMethod(ClientData cd, Tcl_Interp* in,
		     int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  int instanceOpt = 0, resetOpt = 0;
  Tcl_Obj* autoname;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc == 3) {
    instanceOpt = (strcmp(ObjStr(objv[1]), "-instance") == 0);
    resetOpt = (strcmp(ObjStr(objv[1]), "-reset") == 0);
  }
  if ((objc < 2 || objc > 3) || (objc == 3 && !instanceOpt && !resetOpt))
    return XOTclObjErrArgCnt(in, obj->cmdName,
			     "autoname [-instance | -reset] name");
  autoname = AutonameIncr(in, objv[objc-1], obj, instanceOpt, resetOpt);
  if (autoname)
    Tcl_SetObjResult(in, autoname);
  else
    return XOTclVarErrMsg(in,
      "Autoname failed. Probably format string (with %) was not well-formed", 0);

  return TCL_OK;
}

static int
XOTclOCheckMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  int ocArgs; Tcl_Obj** ovArgs;
  int i;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc != 2)
    return XOTclObjErrArgCnt(in, obj->cmdName,
			     "check (?all? ?pre? ?post? ?invar? ?instinvar?)");
  obj->checkoptions = CHECK_NONE;
  if (Tcl_ListObjGetElements(in, objv[1], &ocArgs, &ovArgs) == TCL_OK
      && ocArgs > 0) {
    for (i = 0; i < ocArgs; i++) {
      char* option = ObjStr(ovArgs[i]);
      if (option != 0) {
	switch (*option) {
	case 'i':
	  if (strcmp(option, "instinvar") == 0) {
	    optionSet(obj->checkoptions, CHECK_CLINVAR);
	  } else if (strcmp(option, "invar") == 0) {
	    optionSet(obj->checkoptions, CHECK_OBJINVAR);
	  }
	  break;
	case 'p':
	  if (strcmp(option, "pre") == 0) {
	    optionSet(obj->checkoptions, CHECK_PRE);
	  } else if (strcmp(option, "post") == 0) {
	    optionSet(obj->checkoptions, CHECK_POST);
	  }
	  break;
	case 'a':
	  if (strcmp(option, "all") == 0) {
	    optionSet(obj->checkoptions, CHECK_ALL);
	  }
	  break;	
	}
      }
    }
  }
  if (obj->checkoptions == CHECK_NONE && ocArgs>0) {
    return XOTclVarErrMsg(in, "Unknown check option in command '",
			  ObjStr(obj->cmdName), " ", ObjStr(objv[0]),
			  " ", ObjStr(objv[1]),
			  "', valid: all pre post invar instinvar",
			  (char*) NULL);
  }

  Tcl_ResetResult(in);
  return TCL_OK;
}

static int
XOTclOMixinMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  int oc; Tcl_Obj** ov;
  XOTclObject* obj = (XOTclObject*)cd;
  int i, result = TCL_OK;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2)
    return XOTclObjErrArgCnt(in, obj->cmdName, "mixin <classes> ?args?");

  if (Tcl_ListObjGetElements(in, objv[1], &oc, &ov)!= TCL_OK)
    return TCL_ERROR;

  MixinRemoveList(&obj->mixins);
  obj->mixinDefined = XOTCL_MIXINS_INVALID;

  for (i = 0; i < oc; i++) {
    char* av = ObjStr(ov[i]);
    XOTclClass* mixin = GetClass(in, av);
    if (!mixin)
      return XOTclErrBadVal(in, "a list of classes", ObjStr(objv[1]));
    MixinAdd(in, &obj->mixins, mixin);
  }

  MixinComputeDefined(in, obj);
  return result;
}

static int
XOTclOProcSearchMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  XOTclClass* cl=0;
  Command *cmdPtr;
  char *simpleName, *methodName;
  Tcl_DString fullName;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2) return XOTclObjErrArgCnt(in, obj->cmdName,
    "procsearch name");

  Tcl_ResetResult(in);

  methodName = ObjStr(objv[1]);

  cmdPtr = FindMethod(methodName, obj->nsPtr);
  if (!cmdPtr) {
    cl = SearchCMethod(obj, obj->cl, NULL, methodName, &cmdPtr);
  }
  if (cmdPtr) {
    simpleName = Tcl_GetCommandName(in, (Tcl_Command)cmdPtr);
    ALLOC_NAME_NS(&fullName, cmdPtr->nsPtr->fullName, simpleName);
    Tcl_AppendElement(in, Tcl_DStringValue(&fullName));
    Tcl_DStringFree(&fullName);
  }
  return TCL_OK;
}

static int
XOTclOConfigureMethod(ClientData cd, Tcl_Interp* in,
			int objc, Tcl_Obj *objv[]) {
  XOTclObject* obj = (XOTclObject*)cd;
  int i, result = TCL_OK;

  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 1) return XOTclObjErrArgCnt(in, obj->cmdName,
					 "configure ?args?");
  /*
   * Check Args for '-' followed by an alpha character
   * these arguments are called as methods
   */
  for (i=1; i < objc; i++) {
    char *flag = ObjStr(objv[i]);
    if (isDashArg(flag)) {
      int j, nrArgs;
      char* methodName = flag+1;
      Tcl_Obj *method = Tcl_NewStringObj(methodName,-1);
      INCR_REF_COUNT(method);

      for (j = i+1, nrArgs = 0; j < objc; j++, nrArgs++) {
	if (isDashArg(ObjStr(objv[j])))
	  break;
      }
      result = callMethod((ClientData)obj, in,
			  method, nrArgs+2, objv+i+1,
			  XOTCL_CM_NO_UNKNOWN);
      DECR_REF_COUNT(method);
      if (result != TCL_OK) {
	Tcl_AppendResult(in, " during '", ObjStr(obj->cmdName), " ",
			 flag, "'", 0);
	return result;
      }

      i += nrArgs;
    }
  }

  return result;
}


/*
 * class method implementations
 */

static int
XOTclCInstDestroyMethod(ClientData cd, Tcl_Interp* in,
		    int objc, Tcl_Obj *CONST objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclObject* delobj;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2)
      return XOTclObjErrArgCnt(in, cl->object.cmdName,
			       "instdestroy <obj/cl>");

  delobj = GetObject(in, ObjStr(objv[1]));
  if (!delobj)
    return XOTclVarErrMsg(in, "Can't destroy object ",
			  ObjStr(objv[1]), " that does not exist.",
			  0);
  /*
   * latch, and call delete command if not already in progress
   */
  delobj->destroyCalled = 1;
  RUNTIME_STATE(in)->callIsDestroy = 1;

  if (RUNTIME_STATE(in)->exitHandlerDestroyRound !=
      XOTCL_EXITHANDLER_ON_SOFT_DESTROY) {
    CallStackDestroyObject(in, delobj);
  }

  return TCL_OK;
}

static int
XOTclCAllocMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclObject* obj = &cl->object;
  XOTclClass* newcl;
  XOTclObject* newobj;
  int result;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2)
      return XOTclObjErrArgCnt(in, cl->object.cmdName,
			       "alloc <obj/cl> ?args?");
  /*
   * if the lookup via GetObject for the object succeeds, 
   * the object exists already,
   * and we do not overwrite it, but re-create it
   */
  newobj = GetObject(in, ObjStr(objv[1]));
  if (newobj != 0) {
    result = doCleanup(in, newobj, obj, objc, objv);

    if (result != TCL_OK)
      return result;

    Tcl_ResetResult(in);
    return TCL_OK;
  } else {
    /*
     * create a new object from scratch
     */
    if (IsMetaClass(in, cl)) {
      /*
       * if the base class is a meta-class, we create a class
       */
      newcl = PrimitiveCCreate(in, ObjStr(objv[1]), cl);
      if (newcl == 0)
	return XOTclVarErrMsg(in, "Class alloc failed for '",ObjStr(objv[1]),
			      "' (possibly parent namespace does not exist)",NULL);

    } else {
      /*
       * if the base class is an ordinary class, we create an object
       */
      newobj = PrimitiveOCreate(in, ObjStr(objv[1]), cl);
      if (newobj == 0)
	return XOTclVarErrMsg(in, "Object alloc failed for '",ObjStr(objv[1]),
			      "' (possibly parent namespace does not exist)",NULL);
    }
  }
  Tcl_ResetResult(in);
  return TCL_OK;
}


static int
XOTclCCreateMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclObject* obj = &cl->object;
  XOTclObject* newobj;

  int result, nameLength;
  char *objName;
  Tcl_Obj* nameObj;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2)
    return XOTclObjErrArgCnt(in, cl->object.cmdName, "create <obj> ?args?");

  nameObj = objv[1];
  objName = Tcl_GetStringFromObj(nameObj,&nameLength);
  if (!NSCheckColons(objName, nameLength))
    return XOTclVarErrMsg(in, "Cannot create object -- illegal name '",
                          objName, "'", 0);

  /*
   * Check whether we have to call recreate (i.e. when the 
   * object exists already)
   */
  newobj = GetObject(in, ObjStr(objv[1]));
  if (newobj) {
    /* cleanup */
    /*fprintf(stderr, "cleanup ... %s\n", ObjStr(objv[1]));*/
    result = doCleanup(in, newobj, obj, objc, objv);
    if (result != TCL_OK) 
      return result;

    /* call recreate --> initialization */
    result = callMethod((ClientData) obj, in,
                         global_objects[RECREATE], objc+1, objv+1, 0);
    if (result != TCL_OK) 
      return result;

    nameObj = newobj->cmdName;
    INCR_REF_COUNT(nameObj);
  } else {
    /*
     * call "alloc"
     */
    /* fprintf(stderr, "alloc ... %s\n", ObjStr(objv[1]));*/
    result = callMethod((ClientData) obj, in,
                         global_objects[ALLOC], objc+1, objv+1, 0);
    if (result != TCL_OK) 
      return result;

    newobj = GetObject(in, objName);

    if (newobj == 0)
      return XOTclErrMsg(in, "couldn't find result of alloc", TCL_STATIC);
    nameObj = newobj->cmdName;
    INCR_REF_COUNT(nameObj);

    (void)RemoveInstance(newobj, newobj->cl);
    AddInstance(newobj, cl);
    result = doObjInitialization(in, newobj, objc, objv);
  }
  /* fprintf(stderr, "alloc -- end ... %s\n", ObjStr(objv[1]));*/
  if (result == TCL_OK) {
    Tcl_SetObjResult(in, nameObj);
  }
  
  DECR_REF_COUNT(nameObj);

  return result;
}

static int
XOTclCRecreateMethod(ClientData cd, Tcl_Interp* in,
		     int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclObject* obj = &cl->object, *newobj;
  int result;
  
  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (!obj) return XOTclObjErrType(in, objv[0], "Object");
  if (objc < 2)
    return XOTclObjErrArgCnt(in, cl->object.cmdName, "recreate <obj> ?args?");

  newobj = GetObject(in, ObjStr(objv[1]));

  if (newobj == 0)
    return XOTclVarErrMsg(in, "can't recreate not existing obj ",
			  ObjStr(objv[1]), 0);

  INCR_REF_COUNT(objv[1]);

  result = doObjInitialization(in, newobj, objc, objv);

  if (result == TCL_OK)
    Tcl_SetObjResult(in, objv[1]);

  DECR_REF_COUNT(objv[1]);

  return result;
}

static int
XOTclCSuperClassMethod(ClientData cd, Tcl_Interp* in,
                      int objc, Tcl_Obj *objv[])
{
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclClasses* osl = 0;
  int oc; Tcl_Obj** ov;
  XOTclClass** scl = 0;
  int reversed = 0;
  int i, j;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc != 2)
    return XOTclObjErrArgCnt(in, cl->object.cmdName, "superclass <classes>");

  if (Tcl_ListObjGetElements(in, objv[1], &oc, &ov)!= TCL_OK)
    return TCL_ERROR;

  scl = (XOTclClass**)ckalloc(oc*sizeof(XOTclClass*));
  for (i = 0; i < oc; i++) {
    char* av = ObjStr(ov[i]);
    scl[i] = GetClass(in, av);

    if (!scl[i]) {

      /*
       * try to force autoloading if we can't resolve a class name
       */

      int loaded = 0;
      char* args = (char*)ckalloc(strlen("auto_load ")+strlen(av)+1);
      (void)strcpy(args, "auto_load ");
      (void) strcat(args, av);
      if (Tcl_GlobalEval(in, args) == TCL_OK) {
        scl[i] = GetClass(in, av);
        loaded = (scl[i] != 0);
      }
      ckfree((char*)args);
      if (!loaded) {
        ckfree((char*)scl);
        return XOTclErrBadVal(in, "a list of classes", ObjStr(objv[1]));
      }
    }
  }

  /*
   * check that superclasses don't precede their classes
   */

  for (i = 0; i < oc; i++) {
    if (reversed != 0) break;
    for (j = i+1; j < oc; j++) {
      XOTclClasses* dl = ComputeOrder(scl[j], Super);
      if (reversed != 0) break;
      while (dl != 0) {
        if (dl->cl == scl[i]) break;
        dl = dl->next;
      }
      if (dl != 0) reversed = 1;
    }
  }

  if (reversed != 0) {
    ckfree((char*)scl);
    return XOTclErrBadVal(in, "classes in dependence order", ObjStr(objv[1]));
  }

  while (cl->super != 0) {

    /*
     * build up an old superclass list in case we need to revert
     */

    XOTclClass* sc = cl->super->cl;
    XOTclClasses* l = osl;
    osl = (XOTclClasses*)ckalloc(sizeof(XOTclClasses));
    osl->cl = sc;
    osl->next = l;
    (void)RemoveSuper(cl, cl->super->cl);
  }
  for (i = 0; i < oc; i++)
    AddSuper(cl, scl[i]);
  ckfree((char*)scl);
  FlushPrecedences(cl);

  if (!ComputeOrder(cl, Super)) {

    /*
     * cycle in the superclass graph, backtrack
     */

    XOTclClasses* l;
    while (cl->super != 0) (void)RemoveSuper(cl, cl->super->cl);
    for (l = osl; l != 0; l = l->next) AddSuper(cl, l->cl);
    XOTclRemoveClasses(osl);
    return XOTclErrBadVal(in, "a cycle-free graph", ObjStr(objv[1]));
  }
  XOTclRemoveClasses(osl);

  /* if there are no more super classes add the Object
     class as superclasses */
  if (cl->super == 0)
    AddSuper(cl, RUNTIME_STATE(in)->theObject);

  /* invalidate all mixin order of instances of this
     and of all depended classes */
  MixinInvalidateObjOrders(cl);

  Tcl_ResetResult(in);
  return TCL_OK;
}

static int
XOTclCInfoMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj * CONST objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  char *pattern, *cmd;

  if (!cl)
    return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2)
    return XOTclObjErrArgCnt(in, cl->object.cmdName, "info <opt> ?args?");

  cmd = ObjStr(objv[1]);
  pattern = (objc > 2) ? ObjStr(objv[2]) : 0;

  if (!strcmp(cmd, "superclass")) {
    if (objc > 3)
        return XOTclObjErrArgCnt(in,
				      cl->object.cmdName,
				      "info superclass ?class?");
    if (objc == 2) {
      XOTclClasses* sl = cl->super;
      XOTclClasses* sc = 0;

      /*
       * reverse the list to obtain presentation order
       */

      Tcl_ResetResult(in);
      while (sc != sl) {
        XOTclClasses* nl = sl;
        while (nl->next != sc) nl = nl->next;
        Tcl_AppendElement(in, className(nl->cl));
        sc = nl;
      }
    } else {
      XOTclClass* isc = GetClass(in, pattern);
      XOTclClasses* pl;
      if (isc == 0) return XOTclErrBadVal(in, "a class", pattern);
      pl = ComputeOrder(cl, Super);

      /*
       * search precedence to see if we're related or not
       */

      while (pl != 0) {
        if (pl->cl == isc) {
	  Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
          break;
        }
        pl = pl->next;
      }
      if (pl == 0)
	Tcl_SetIntObj(Tcl_GetObjResult(in), 0);
    }
  } else if (!strcmp(cmd, "subclass")) {
    if (objc > 3)
      return XOTclObjErrArgCnt(in,
				    cl->object.cmdName,
				    "info subclass ?class?");
    if (objc == 2) {
      XOTclClasses* sl = cl->sub;
      XOTclClasses* sc = 0;

      /*
       * order unimportant
       */
      Tcl_ResetResult(in);
      for (sc = sl; sc != 0; sc = sc->next)
        Tcl_AppendElement(in, className(sc->cl));
    } else {
      XOTclClass* isc = GetClass(in, pattern);
      XOTclClasses* pl;
      XOTclClasses* saved;
      if (isc == 0) return XOTclErrBadVal(in, "a class", pattern);
      saved = cl->order; cl->order = 0;
      pl = ComputeOrder(cl, Sub);

      /*
       * search precedence to see if we're related or not
       */

      while (pl != 0) {
        if (pl->cl == isc) {
	  Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
          break;
        }
        pl = pl->next;
      }
      if (pl == 0)
	  Tcl_SetIntObj(Tcl_GetObjResult(in), 0);

      XOTclRemoveClasses(cl->order); cl->order = saved;
    }
  } else if (!strcmp(cmd, "heritage")) {
    XOTclClasses* pl = ComputeOrder(cl, Super);

    if (objc > 3)
      return XOTclObjErrArgCnt(in,
				    cl->object.cmdName,
				    "info heritage ?pat?");
    if (pl) pl = pl->next;
    Tcl_ResetResult(in);
    for (; pl != 0; pl = pl->next) {
      char* name = className(pl->cl);
      if (pattern && !Tcl_StringMatch(name, pattern)) continue;
      Tcl_AppendElement(in, name);
    }
  } else if (!strcmp(cmd, "instances")) {
    if (objc > 3)
        return XOTclObjErrArgCnt(in, cl->object.cmdName,
				 "info instances ?pat?");
    ListObjPtrHashTable(in, &cl->instances, pattern);
  } else if (!strcmp(cmd, "instcommands")) {
    if (objc > 3)
        return XOTclObjErrArgCnt(in, cl->object.cmdName,
				 "info instcommands ?pat?");
    ListKeys(in, &cl->nsPtr->cmdTable, pattern);
  } else if (!strcmp(cmd, "instprocs")) {
    if (objc > 3) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					   "info instprocs ?pat?");
    ListProcKeys(in, &cl->nsPtr->cmdTable, pattern);
  } else if (!strcmp(cmd, "instmixin")) {
    if (objc > 3)
	return XOTclObjErrArgCnt(in, cl->object.cmdName, "info instmixin ?class?");
    MixinInfo(in, cl->instmixins, pattern);
    return TCL_OK;
  } else if (!strcmp(cmd, "instargs")) {
    if (objc != 3)
      return XOTclObjErrArgCnt(in, cl->object.cmdName,
			       "info instargs <instproc>");
    return ListProcArgs(in, &cl->nsPtr->cmdTable, pattern);
  } else if (!strcmp(cmd, "instdefault")) {
    if (objc != 5)
      return XOTclObjErrArgCnt(in, cl->object.cmdName,
			       "info instdefault <instproc> <arg> <var>");
    return ListProcDefault(in, &cl->nsPtr->cmdTable, pattern,
                           ObjStr(objv[3]), ObjStr(objv[4]));
  } else if (!strcmp(cmd, "instbody")) {
    if (objc != 3)
        return XOTclObjErrArgCnt(in, cl->object.cmdName,
				 "info instbody <instproc>");
    return ListProcBody(in, &cl->nsPtr->cmdTable, pattern);
  } else if (!strcmp(cmd, "classchildren")) {
    if (objc > 3) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					   "info classchildren ?pat?");
    ListClassChildren(in, cl, pattern);
  } else if (!strcmp(cmd, "classparent")) {
    if (objc > 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					   "info classparent");
    ListParent(in, cl->nsPtr);
  } else if (!strcmp(cmd, "filter")) {
    if (objc != 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					    "info filter");
    FilterList(in, cl->filters);
  } else if (!strcmp(cmd, "filters")) {
    XOTclDeprecatedMsg("info filters", "info filter");
    if (objc != 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					    "info filter");
    FilterList(in, cl->filters);
  } else if (!strcmp(cmd, "instinvar")) {
    if (objc != 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					    "info instinvar");
    if (cl->assertions && cl->assertions->invariants)
      Tcl_SetObjResult(in, AssertionList(in, cl->assertions->invariants));
  } else if (!strcmp(cmd, "instpre")) {
    XOTclProcAssertion* procs;
    if (objc != 3) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					    "info instpre <proc>");
    if (cl->assertions) {
      procs = AssertionFindProcs(cl->assertions, ObjStr(objv[2]));
      if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->pre));
    }
  } else if (!strcmp(cmd, "instpost")) {
    XOTclProcAssertion* procs;
    if (objc != 3) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					    "info instpost <proc>");
    if (cl->assertions) {
      procs = AssertionFindProcs(cl->assertions, ObjStr(objv[2]));
      if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->post));
    }
  } else if (!strcmp(cmd, "parameterclass")) {
    if (cl->parameterClass) {
      Tcl_SetObjResult(in, cl->parameterClass);
    } else {
      Tcl_SetObjResult(in, global_objects[PARAM_CL]);
    }
  } else if (!strcmp(cmd, "parameter")) {
    Tcl_SetObjResult(in, cl->parameters);
  } else {
    int result = XOTclOInfoMethod(cd, in, objc, (Tcl_Obj **)objv);
    return result;
  }
  return TCL_OK;
}

static int
XOTclCParameterMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  XOTclObject* obj = &cl->object;
  Tcl_Obj     **pv=0;
  Tcl_Obj     **ov=0;
  int         elts, pc, oc, result;
  
  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc != 2)
    return XOTclObjErrArgCnt(in, cl->object.cmdName,
			     "parameter ?params?");
  
  DECR_REF_COUNT(cl->parameters);
  cl->parameters = objv[1];
  INCR_REF_COUNT(cl->parameters);

  result = Tcl_ListObjGetElements(in, objv[1], &pc, &pv);
  if (result == TCL_OK) {
    for (elts = 0; elts < pc; elts++) {
      result = Tcl_ListObjGetElements(in, pv[elts], &oc, &ov);
      if (result == TCL_OK && oc > 0 ) {
	result = callParameterMethodWithArg(obj, in, 
			    global_objects[MKGETTERSETTER],
			    cl->object.cmdName, 3+oc, ov,0);
      }
      if (result != TCL_OK)
	return result;
    }
  }
  return result;
}

static int
XOTclCParameterClassMethod(ClientData cd, Tcl_Interp* in,
			   int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  char* paramClStr;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc != 2)
    return XOTclObjErrArgCnt(in, cl->object.cmdName, 
			     "parameterclass cl");

  paramClStr = ObjStr(objv[1]);
  if (cl->parameterClass)
    DECR_REF_COUNT(cl->parameterClass);

  if ((paramClStr == NULL) || (*paramClStr == '\0')) {
    cl->parameterClass = 0;
  } else {
    cl->parameterClass = objv[1];
    INCR_REF_COUNT(cl->parameterClass);
  }
  return TCL_OK;
}

static int
XOTclCParameterAddMethod(ClientData cd, Tcl_Interp* in, 
		      int objc, Tcl_Obj * CONST objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  
  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2) return XOTclObjErrArgCnt(in, cl->object.cmdName, 
					 "parameteradd name");
  XOTclAddIMethod(in, cl, ObjStr(objv[1]), 
		  (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0);
  return TCL_OK;
}


static int
XOTclCInstProcMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  char *argStr, *bdyStr, *name;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc != 4 && objc != 6)
    return XOTclObjErrArgCnt(in, cl->object.cmdName, 
			     "instproc name args body ?preAssertion postAssertion?");

  /*
   * if the args list is "auto", the body is a script to load the proc
   */
  argStr = ObjStr(objv[2]);
  bdyStr = ObjStr(objv[3]);
  name = ObjStr(objv[1]);

  if ((cl == RUNTIME_STATE(in)->theObject && isDestroyString(name)) ||
      (cl == RUNTIME_STATE(in)->theClass && isInstDestroyString(name)) ||
      (cl == RUNTIME_STATE(in)->theClass && isAllocString(name)) ||
      (cl == RUNTIME_STATE(in)->theClass && isCreateString(name)))
    return XOTclVarErrMsg(in, className(cl), " instproc: '", name, "' of ",
			  className(cl), " can not be overwritten. Derive a ",
			  "sub-class", (char*) 0);

  if (isAutoString(argStr)) {
    /*
      CallStackContent *csc = CallStackGetFrame(in);
      fprintf(stderr, "Instpr -- self %s\n",xobjName(csc->self));
      fprintf(stderr, "Instpr -- c %s\n",ClassName(csc->cl));
      fprintf(stderr, "Instpr -- p %s\n",csc->procName);
    */
    if (!MakeAuto(in,  bdyStr, name, cl->nsPtr))
      return XOTclMakeFailure(in, objv,
				   "MakeAuto failed in XOTclCProcMethod\n");
  }
  else if (*argStr == 0 && *bdyStr == 0) {
    AssertionRemoveProc(cl->assertions, name);
    NSDeleteCmd(in, cl->nsPtr, name);
  } else {
    if (!cl->assertions)
      cl->assertions = AssertionCreateStore();
    MakeProc(cl->nsPtr, cl->assertions, in, objc, (Tcl_Obj **) objv);
  }
    return TCL_OK;
}

static int
XOTclCFilterMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);
  int i, result = TCL_OK;
  Tcl_Obj **ov; int oc;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
    "filter filterNameList");

  if (Tcl_ListObjGetElements(in, objv[1], &oc,&ov) != TCL_OK)
    return TCL_ERROR;
  FilterRemoveList(in, cl);
  for (i = 0; i < oc; i ++) {
    result = FilterAdd(in, cl, ObjStr(ov[i]));
    if (result == TCL_ERROR) {
      return XOTclVarErrMsg(in,
       "filter: can't find filterproc or filterproc is not an instproc - Class: ",
       className(cl), " - Proc: ",
       ObjStr(ov[i]), (char*) NULL);
    }
  }
  return result;
}


static int
XOTclCInstMixinMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  int oc; Tcl_Obj** ov;
  XOTclClass* cl = XOTclIsClass(in, cd);
  int i, result = TCL_OK;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
    "instmixin classList");

  if (Tcl_ListObjGetElements(in, objv[1], &oc, &ov)!= TCL_OK)
    return TCL_ERROR;

  MixinRemoveList(&cl->instmixins);
  MixinInvalidateObjOrders(cl);

  for (i = 0; i < oc; i++) {
    char* av = ObjStr(ov[i]);
    XOTclClass* mixin = GetClass(in, av);
    if (!mixin)
      return XOTclErrBadVal(in, "a list of classes", ObjStr(objv[1]));
    MixinAdd(in, &cl->instmixins, mixin);
  }
  return result;
}

/*
 *  Searches for filter on [self] and returns fully qualified name
 *  if it is not found it returns an empty string
 */
static int
XOTclCFilterSearchMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  XOTclClass* cl = XOTclIsClass(in, cd);
  Command *cmdPtr;

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc < 2) return XOTclObjErrArgCnt(in, cl->object.cmdName,
					 "filtersearch filterName");
  Tcl_ResetResult(in);

  cmdPtr = FilterSearch(in, ObjStr(objv[1]), cl);
  if (cmdPtr && Tcl_FindHashEntry(filterList, (char*)cmdPtr)) {
    Tcl_DString fullNameDS;
    char *fullName;
    char *simpleName = Tcl_GetCommandName(in, (Tcl_Command)cmdPtr);

    ALLOC_NAME_NS(&fullNameDS, cmdPtr->nsPtr->fullName, simpleName);
    fullName = Tcl_DStringValue(&fullNameDS);
    Tcl_AppendElement(in, fullName);
    Tcl_DStringFree(&fullNameDS);
  }
  
  return TCL_OK;
}

static int
XOTclCInvariantsMethod(ClientData cd, Tcl_Interp* in, int objc, Tcl_Obj *objv[]) {
  XOTclClass* cl = XOTclIsClass(in, cd);

  if (!cl) return XOTclObjErrType(in, objv[0], "Class");
  if (objc != 2)
      return XOTclObjErrArgCnt(in, cl->object.cmdName,
			       "instinvar <invariantList>");
  
  if (cl->assertions)
    AssertionDeleteList(cl->assertions->invariants);
  else 
    cl->assertions = AssertionCreateStore();

  cl->assertions->invariants = AssertionNewList(in, objv[1]);
  return TCL_OK;
}

static int
XOTclCUnknownMethod(ClientData cd, Tcl_Interp *in,
		    int objc, Tcl_Obj *CONST objv[]) {
  XOTclObject* obj = (XOTclObject*) cd;
  char *self = ObjStr(obj->cmdName);

  if (objc < 2) return XOTclObjErrArgCnt(in, objv[0], "unknown args");
  if (isCreateString(self))
    return XOTclVarErrMsg(in, "error ", self, ": unable to dispatch '",
			  ObjStr(objv[1]), "'", (char*)NULL);

  return callMethod(cd, in, global_objects[CREATE], objc+1, objv+1, 0);
}

/*
 * New Tcl Commands
 */
static int
XOTcl_NSCopyCmds(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  Interp *iPtr = (Interp *) in;
  Tcl_Command cmd;
  Command *cmdPtr;
  Tcl_Obj* newFullCmdName, *oldFullCmdName;
  char* newName, *oldName, *name;
  Namespace *nsPtr, *newNsPtr;
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;

  if (objc != 3)
    return XOTclObjErrArgCnt(in, NULL, "namespace_copycmds fromNs toNs");

  nsPtr = (Namespace*) Tcl_FindNamespace(in, ObjStr(objv[1]),
					 (Tcl_Namespace *) NULL, 0);
  if (!nsPtr)
    return XOTclVarErrMsg(in, "CopyCmds: Origin namespace ", ObjStr(objv[1]),
			  " does not exist",0);
  newNsPtr = (Namespace*) Tcl_FindNamespace(in, ObjStr(objv[2]),
					    (Tcl_Namespace *) NULL, 0);
  if (!newNsPtr)
    return XOTclVarErrMsg(in, "CopyCmds: Destination namespace ",
			  ObjStr(objv[2]), " does not exist",0);
  /*
   * copy all procs & commands in the ns
   */
  hPtr = &nsPtr->cmdTable ?
    Tcl_FirstHashEntry(&nsPtr->cmdTable, &hSrch) : 0;
  while (hPtr != NULL) {
    name = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
    
    /*
     * construct full cmd names
     */
    newFullCmdName = Tcl_NewStringObj(newNsPtr->fullName,-1);
    oldFullCmdName = Tcl_NewStringObj(nsPtr->fullName,-1);

    INCR_REF_COUNT(newFullCmdName); INCR_REF_COUNT(oldFullCmdName);
    Tcl_AppendStringsToObj(newFullCmdName, "::", name, (char*)NULL);
    Tcl_AppendStringsToObj(oldFullCmdName, "::", name, (char*)NULL);
    newName = ObjStr(newFullCmdName);
    oldName = ObjStr(oldFullCmdName);

    /*
     * Make sure that the destination command does not already exist.
     * Otherwise: do not copy
     */
    cmd = Tcl_FindCommand(in, newName, 0, 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr != NULL) {
      /*fprintf(stderr, "%s already exists\n", newName);*/
      if (!GetObject(in, newName)) {
	/* command or instproc will be deleted & than copied */
	Tcl_DeleteCommandFromToken(in, cmd);
      } else {
	/* don't overwrite objects -> will be recreated */
	hPtr = Tcl_NextHashEntry(&hSrch);
	DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName);
	continue;
      }
    }

    /*
     * Find the existing command. An error is returned if simpleName can't
     * be found
     */
    cmd = Tcl_FindCommand(in, oldName, 0, 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
      Tcl_AppendStringsToObj(Tcl_GetObjResult(in), "can't copy ", " \"",
			     oldName, "\": command doesn't exist", (char *) NULL);
      DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName);
      return TCL_ERROR;
    }
    /*
     * Do not copy Objects or Classes
     */
    if (!GetObject(in, oldName)) {
      if (TclIsProc(cmdPtr)) {
	Proc *procPtr = TclFindProc(iPtr, oldName);
	Tcl_Obj *arglistObj;
	CompiledLocal *localPtr;

	/*
	 * Build a list containing the arguments of the proc
	 */

	arglistObj = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
	INCR_REF_COUNT(arglistObj);
	for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	     localPtr = localPtr->nextPtr) {
	  if (TclIsVarArgument(localPtr)) {
	    Tcl_Obj *defVal, *defStringObj = Tcl_NewStringObj(localPtr->name, -1);
	    INCR_REF_COUNT(defStringObj);
	    /* check for default values */
	    if ((GetProcDefault(in, &nsPtr->cmdTable, name,
				localPtr->name, &defVal) == TCL_OK) &&
		(defVal != 0)) {
	      Tcl_AppendStringsToObj(defStringObj, " ",
				     ObjStr(defVal), 0);
	    }
	    Tcl_ListObjAppendElement(in, arglistObj, defStringObj);
	    DECR_REF_COUNT(defStringObj);
	  }
	}
	
	if (cmdPtr->objProc == RUNTIME_STATE(in)->objInterpProc) {
	  Tcl_DString ds, *dsPtr = &ds; 
	  char *clObjName = NSCutXOTclClasses(nsPtr->fullName);

	  if (clObjName != nsPtr->fullName) {
	    /* it started with ::XOTclClasses */
	    XOTclClass* cl = GetClass(in, clObjName);
	    XOTclProcAssertion* procs;

	    if (cl)
	      procs = AssertionFindProcs(cl->assertions, name);
	    else {
	      DECR_REF_COUNT(newFullCmdName); 
	      DECR_REF_COUNT(oldFullCmdName);
	      DECR_REF_COUNT(arglistObj);
	      return XOTclVarErrMsg(in, "No class for inst - assertions", 0);
	    }

	    /* XOTcl InstProc */
	    Tcl_DStringInit(dsPtr);
	    Tcl_DStringAppendElement(dsPtr, NSCutXOTclClasses(newNsPtr->fullName));
	    Tcl_DStringAppendElement(dsPtr, "instproc");
	    Tcl_DStringAppendElement(dsPtr, name);
	    Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj));
	    Tcl_DStringAppendElement(dsPtr, ObjStr(procPtr->bodyPtr));
	    AssertionAppendPrePost(in, dsPtr, procs);
	    Tcl_Eval(in, Tcl_DStringValue(dsPtr));
	    Tcl_DStringFree(dsPtr);
	  } else {
	    XOTclObject *obj = GetObject(in, nsPtr->fullName);
	    XOTclProcAssertion* procs;
	    if (obj)
	      procs = AssertionFindProcs(obj->assertions, name);
	    else {
	      DECR_REF_COUNT(newFullCmdName); 
	      DECR_REF_COUNT(oldFullCmdName);
	      DECR_REF_COUNT(arglistObj);
	      return XOTclVarErrMsg(in, "No object for assertions", 0);
	    }

	    /* XOTcl Proc */
	    Tcl_DStringInit(dsPtr);
	    Tcl_DStringAppendElement(dsPtr, newNsPtr->fullName);
	    Tcl_DStringAppendElement(dsPtr, "proc");
	    Tcl_DStringAppendElement(dsPtr, name);
	    Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj));
	    Tcl_DStringAppendElement(dsPtr, ObjStr(procPtr->bodyPtr));
	    AssertionAppendPrePost(in, dsPtr, procs);
	    Tcl_Eval(in, Tcl_DStringValue(dsPtr));
	    Tcl_DStringFree(dsPtr);
	  }
	  DECR_REF_COUNT(arglistObj);
	} else {
	  /* Tcl Proc */
	  Tcl_VarEval(in, "proc ", newName, " {", ObjStr(arglistObj),"} {\n",
		      ObjStr(procPtr->bodyPtr), "}", 0);
	}
      } else {
	/*
	 * Otherwise copy command
	 */
	if (cmdPtr->objProc) {
	  Tcl_CreateObjCommand(in, newName, cmdPtr->objProc,
			       cmdPtr->objClientData, cmdPtr->deleteProc);
	} else {
	  Tcl_CreateCommand(in, newName, cmdPtr->proc,
			    cmdPtr->clientData, cmdPtr->deleteProc);
	}
      }
    }
    hPtr = Tcl_NextHashEntry(&hSrch);
    DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName);
  }
  return TCL_OK;
}

static int
XOTcl_NSCopyVars(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  Namespace *nsPtr, *newNsPtr;
  Var *varPtr=0;
  Tcl_DString ds, *dsPtr = &ds; 
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;
  int rc = TCL_OK;
  char* varName;
  XOTclObject* obj;

  if (objc != 3)
    return XOTclObjErrArgCnt(in, NULL, "namespace_copyvars fromNs toNs");

  nsPtr = (Namespace*) Tcl_FindNamespace(in, ObjStr(objv[1]),
					 (Tcl_Namespace *) NULL, 0);
  if (!nsPtr)
    return XOTclVarErrMsg(in, "CopyVars: Origin namespace ", ObjStr(objv[1]),
			  " does not exist",0);
  newNsPtr = (Namespace*) Tcl_FindNamespace(in, ObjStr(objv[2]),
					    (Tcl_Namespace *) NULL, 0);
  if (!newNsPtr)
    return XOTclVarErrMsg(in, "CopyVars: Destination namespace ",
			  ObjStr(objv[2]), " does not exist",0);

  obj = GetObject(in, nsPtr->fullName);

  /* copy all vars in the ns */
  hPtr = &nsPtr->varTable ?
    Tcl_FirstHashEntry(&nsPtr->varTable, &hSrch) : 0;
  while (hPtr != NULL) {
    varPtr = (Var *) Tcl_GetHashValue(hPtr);
    if (!TclIsVarUndefined(varPtr) && !TclIsVarLink(varPtr)) {
      varName = Tcl_GetHashKey(&nsPtr->varTable, hPtr);

      if (TclIsVarScalar(varPtr)) {
	/* it may seem odd that we do not copy obj vars with the
	 * same SetVar2 as normal vars, but we want to dispatch it in order to
	 * be able to intercept the copying */
	if (obj) {
	  Tcl_DStringInit(dsPtr);
	  Tcl_DStringAppendElement(dsPtr, newNsPtr->fullName);
	  Tcl_DStringAppendElement(dsPtr, "set");
	  Tcl_DStringAppendElement(dsPtr, varName);
	  Tcl_DStringAppendElement(dsPtr, ObjStr(varPtr->value.objPtr));
	  rc = Tcl_Eval(in, Tcl_DStringValue(dsPtr));
	  Tcl_DStringFree(dsPtr);
	} else {
	  ALLOC_NAME_NS(&ds, newNsPtr->fullName, varName);
	  Tcl_SetVar2(in, Tcl_DStringValue(&ds), 0,
		      ObjStr(varPtr->value.objPtr), TCL_GLOBAL_ONLY);
	  Tcl_DStringFree(&ds);
	}
      } else {
	if (TclIsVarArray(varPtr)) {
	  Tcl_HashTable* aTable = varPtr->value.tablePtr;
	  Tcl_HashSearch ahSrch;
	  Tcl_HashEntry* ahPtr = aTable ? Tcl_FirstHashEntry(aTable, &ahSrch) : 0;
	
	  for (; ahPtr != 0; ahPtr = Tcl_NextHashEntry(&ahSrch)) {
	    char *eltName = Tcl_GetHashKey(aTable, ahPtr);
	    Var  *eltVar  = (Var*) Tcl_GetHashValue(ahPtr);
	
	    if (TclIsVarScalar(eltVar)) {
	      if (obj) {
		Tcl_DString ds2, *ds2Ptr = &ds2; 
		Tcl_DStringInit(dsPtr);
		Tcl_DStringAppendElement(dsPtr, newNsPtr->fullName);
		Tcl_DStringAppendElement(dsPtr, "set");
		Tcl_DStringInit(ds2Ptr);
		Tcl_DStringAppend(ds2Ptr, varName, -1);
		Tcl_DStringAppend(ds2Ptr, "(", 1);
		Tcl_DStringAppend(ds2Ptr, eltName, -1);
		Tcl_DStringAppend(ds2Ptr, ")", 1);
		Tcl_DStringAppendElement(dsPtr,Tcl_DStringValue(ds2Ptr));
		Tcl_DStringAppendElement(dsPtr, 
					 ObjStr(eltVar->value.objPtr));
		rc = Tcl_Eval(in, Tcl_DStringValue(dsPtr));
		Tcl_DStringFree(dsPtr);
		Tcl_DStringFree(ds2Ptr);
	      } else {
		ALLOC_NAME_NS(&ds, newNsPtr->fullName, varName);
		Tcl_SetVar2(in, Tcl_DStringValue(&ds), eltName,
			    ObjStr(eltVar->value.objPtr), TCL_GLOBAL_ONLY);
		Tcl_DStringFree(&ds);
	      }
	    }
	  }
	}
      }
    }
    hPtr = Tcl_NextHashEntry(&hSrch);
  }
  return rc;
}

static int
XOTcl_InfoObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  int result, filterFrameCutOff = 0;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;
  if (objc > 1 && isLevelString(ObjStr(objv[1])) &&
      FilterEntryOnCallStack(in)) {
    filterFrameCutOff = 1;
    FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
  }
  result = callCommand(in, INFO, objc, objv);
  if (filterFrameCutOff)
    FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
  return result;
}

static int
XOTcl_IncrObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  int result; 
#ifdef USE_TCL_STUBS
  result = callCommand(in, INCR, objc, objv);
#else
# if !defined(PRE82)
  result = Tcl_IncrObjCmd(cd, in, objc, objv);
# else
  char *argv[3];
  argv[0] = global_strings[INCR];
  argv[1] = ObjStr(objv[1]);
  if (objc == 3)
    argv[2] = ObjStr(objv[2]);
 
  result = Tcl_IncrCmd(cd, in, objc, argv);
# endif
#endif
  return result;
}

static int
XOTcl_SubstObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  return callCommand(in, SUBST, objc, objv);
}
static int
XOTcl_VariableObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  int result;
#ifdef USE_TCL_STUBS
  result = callCommand(in, VARIABLE, objc, objv);
#else
  result = Tcl_VariableObjCmd((ClientData) NULL, in, objc, objv); 
#endif
  return result;
}

static int
XOTcl_UplevelObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  int result, filterFrameCutOff = 0;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  /* invalidate the top frame cache */
  cs->topFrameCache = 0;

  if (FilterEntryOnCallStack(in)) {
    filterFrameCutOff = 1;
    FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
  }
  result = callCommand(in, UPLEVEL, objc, objv);
  if (filterFrameCutOff)
    FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
  /* invalidate the top frame cache */
  cs->topFrameCache = 0;
  return result;
}

static int
XOTcl_UpvarObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  int result, filterFrameCutOff = 0;
  CallFrame *savedFramePtr = 0, *savedVarFramePtr = 0;
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  /* invalidate the top frame cache */
  cs->topFrameCache = 0;

  if (FilterEntryOnCallStack(in)) {
    filterFrameCutOff = 1;
    FilterCutInactiveFrames(in, &savedFramePtr, &savedVarFramePtr);
  }
  result = callCommand(in, UPVAR, objc, objv);
  if (filterFrameCutOff)
    FilterRestoreFrames(in, savedFramePtr, savedVarFramePtr);
  /* invalidate the top frame cache */
  cs->topFrameCache = 0;
  return result;
}
/*
static int
XOTcl_ExitObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  return Tcl_ExitObjCmd(cd, in, objc, objv);
}
*/

static int
XOTcl_RenameObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  /* this call the Tcl_RenameObjCmd, but it ensures before that
     the renamed obj, functions, etc. are not part of XOTcl */
  XOTclObject* obj; XOTclClass* cl;
  Tcl_Command cmd;
  Command *cmdPtr;
  int result;
  char *oldName, *newName;
  char* oldSimpleCmdName=0, *newSimpleCmdName;
  Tcl_DString oldDS;

  /* wrong # args => normal Tcl ErrMsg*/
  if (objc != 3) 
    return callCommand(in, RENAME, objc, objv);

  oldName = ObjStr(objv[1]);
  newName = ObjStr(objv[2]);

  /* if an obj/cl should be rename => call the XOTcl-rename command */
  cmd = Tcl_FindCommand(in, oldName, (Tcl_Namespace *) NULL,0);
  cmdPtr = (Command *) cmd;

  obj = GetObject(in, oldName);
  cl = GetClass(in, NSCutXOTclClasses(oldName));

  Tcl_DStringInit(&oldDS);

  if (cmdPtr != NULL) {
    if (obj || cl) {
      ClientData clientData = obj ? (ClientData)obj : (ClientData)cl;
      return callMethodWithArg(clientData, in, 
			       global_objects[MOVE], objv[2], 3, 0, 0);
    }

    /* Save the SimpleName */
    Tcl_DStringAppend(&oldDS, Tcl_GetCommandName(in, cmd), -1);
    oldSimpleCmdName = Tcl_DStringValue(&oldDS);

    /* saving obj/cl for proc's; they could be destroyed */

    if (cmdPtr->objProc == XOTclObjDispatch) {
      obj = (XOTclObject*)cmdPtr->objClientData;
      cl = XOTclIsClass(in, cmdPtr->objClientData);
    } else {
      obj = 0;
      cl = 0;
    }
  }
  /* Do the rename */

  result = callCommand(in, RENAME, objc, objv);

  /* has a XOTcl Proc/Instproc been renamed */
  if (result == TCL_OK && cmdPtr != NULL && (obj || cl)) {
    if ((newName != NULL) && (*newName != '\0')) {
      /* it was renamed -> correct the assertion lists*/
      Tcl_Obj* pre; Tcl_Obj* post;
      XOTclAssertionStore *as = (obj ? obj->assertions : cl->assertions);
      XOTclProcAssertion *pa = AssertionFindProcs(as, oldSimpleCmdName);

      if (pa) {
	newSimpleCmdName = Tcl_GetCommandName(in, cmd);	
	pre = AssertionList(in, pa->pre);
	post = AssertionList(in, pa->post);
	AssertionRemoveProc(as, oldSimpleCmdName);
	AssertionAddProc(in, newSimpleCmdName, as, pre, post);
      }
    }
  }
  Tcl_DStringFree(&oldDS);
  return result;
}

/* create a slave interp that calls XOTcl Init */
static int
XOTcl_InterpObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *objv[]) {
  Tcl_Interp* slave;
  Tcl_Obj* evalCmd;
  int i;

  if (objc < 1)
      return XOTclObjErrArgCnt(in, NULL, "xotcl_interp name ?args?");

  evalCmd = Tcl_NewStringObj("::interp ", -1);
  INCR_REF_COUNT(evalCmd);
  for (i = 1; i < objc; i ++)
    Tcl_AppendStringsToObj(evalCmd, ObjStr(objv[i]), " ", (char*) 0);
  if (Tcl_EvalObj(in, evalCmd) != TCL_OK) {
    DECR_REF_COUNT(evalCmd);
    return TCL_ERROR;
  }

  DECR_REF_COUNT(evalCmd);

  slave = Tcl_GetSlave(in, ObjStr(objv[2]));
  if (!slave)
      return XOTclVarErrMsg(in, "Creation of slave interpreter failed",
			    (char*)NULL);

  if (Xotcl_Init(slave) == TCL_ERROR) {
      return TCL_ERROR;
  }
  return TCL_OK;
}

/*
 * C interface routines for manipulating objects and classes
 */

extern XOTclObject*
XOTclGetObject(Tcl_Interp* in, char* name) {
  return GetObject(in, name);
}


static XOTclObject*
GetObject(Tcl_Interp* in, char* name) {
  register Command *cmdPtr;
  assert(name);
  cmdPtr = (Command*)Tcl_FindCommand(in, name, NULL,0);
  if (cmdPtr && cmdPtr->objProc == XOTclObjDispatch) {
    assert(XOTclIsType((XOTclObject*)cmdPtr->objClientData, 
		       RUNTIME_STATE(in)->theObject));
    return (XOTclObject*)cmdPtr->objClientData;
  }
  return 0;
}

extern XOTclClass*
XOTclGetClass(Tcl_Interp* in, char* name) {
  return GetClass(in, name);
}

static XOTclClass*
GetClass(Tcl_Interp* in, char* name) {
  Command *cmdPtr;
  assert(name);
  cmdPtr = (Command*) Tcl_FindCommand(in, name, NULL,0);
  if (cmdPtr && cmdPtr->objProc == XOTclObjDispatch &&
      XOTclIsType((XOTclObject*)cmdPtr->objClientData, 
		  RUNTIME_STATE(in)->theClass)) {
    return (XOTclClass*) cmdPtr->objClientData;
  }
  return 0;
}

void
XOTclAddPMethod(Tcl_Interp* in, XOTclObject* obj, char* nm, Tcl_ObjCmdProc* proc,
               ClientData cd, Tcl_CmdDeleteProc* dp) {
  Tcl_DString newCmd;
  ALLOC_NAME_NS(&newCmd, obj->nsPtr->fullName, nm);
  Tcl_CreateObjCommand(in, Tcl_DStringValue(&newCmd), proc, cd, dp);
  Tcl_DStringFree(&newCmd);
}

void
XOTclAddIMethod(Tcl_Interp* in, XOTclClass *cl, char* nm,
		Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc* dp) {
  Tcl_DString newCmd;
  ALLOC_NAME_NS(&newCmd, cl->nsPtr->fullName, nm);
  Tcl_CreateObjCommand(in, Tcl_DStringValue(&newCmd), proc, cd, dp);
  Tcl_DStringFree(&newCmd);
}


extern Tcl_Obj*
XOTclOGetInstVar2(XOTclObject* obj, Tcl_Interp* in, Tcl_Obj* name1, Tcl_Obj *name2,
        int flgs) {

  Tcl_Obj* result;
  VarFrameDecls;

  VarFrameSwitchToObj(in, obj);
#if defined(V81)
  result =
    Tcl_GetObjVar2(in, ObjStr(name1),
		   ((name2==NULL) ? (char*)NULL: ObjStr(name2)),
		   flgs|TCL_PARSE_PART1|TCL_NAMESPACE_ONLY);
#else
  result =
    Tcl_ObjGetVar2(in, name1, name2,
		   flgs|TCL_PARSE_PART1|TCL_NAMESPACE_ONLY);
#endif
  VarFrameRestore(in);

  return result;
}

/*
 *  Exit Handler
 */
static void
ExitHandler(ClientData cd) {
  Tcl_Interp* in = (Tcl_Interp*) cd;
  Interp* iPtr = (Interp*) in;

  XOTclObject* obj;
  XOTclClass* thecls;
  XOTclClass* theobj;

  int i, round, flags;

  Tcl_Obj *exitHandler;
  Tcl_HashSearch hSrch;
  Tcl_HashEntry* hPtr;

  Tcl_HashTable* filterList = &RUNTIME_STATE(in)->filterList;
  Tcl_HashTable* commandTable = &iPtr->globalNsPtr->cmdTable;

#if defined(PROFILE)
  XOTclProfilePrintData(in);
#endif
  /*
   * Don't use exit handler, if the interpreted is destroyed already
   * Call to exit handler comes after freeing namespaces, commands, etc.
   * e.g. TK calls Tcl_DeleteInterp directly, if Window is killed
   */

  /* 
   * Ahem ...
   *
   * Since we *must* be sure that our destroy methods will run
   * we must *cheat* (I mean CHEAT) here: we flip the interp
   * flag, saying, "hey boy, you're not deleted any more". 
   * After our handlers are done, we restore the old state...
   * All this is needed so we can do an eval in the interp which
   * is potentially marked for delete when we start working here.
   *
   * I know, I know, this is not realy elegant. But...  I'd need a
   * standard way of invoking some code at interpreter delete time
   * but JUST BEFORE the actual deletion process starts. Sadly,
   * there is no such hook in Tcl as of Tcl8.3.2, that I know of.
   *
   * So, for the rest of procedure, assume the interp is alive !
   */

  /*fprintf(stderr,"+++ EXIT handler\n");*/
  TclCommands(in, 0);

  flags = iPtr->flags;
  iPtr->flags &= ~DELETED;

  thecls = RUNTIME_STATE(in)->theClass;
  theobj = RUNTIME_STATE(in)->theObject;

#if defined(V81)
  exitHandler = Tcl_GetObjVar2(in, global_strings[EXIT_HANDLER], NULL, 0);
#else
  exitHandler = Tcl_ObjGetVar2(in, global_objects[EXIT_HANDLER], NULL, 0);
#endif /*  V81 */
  if (exitHandler) {
    int result = EvalObj(in, exitHandler);
    if (result != TCL_OK) {
      panic("User defined exit handler contains errors! "
            "(line-info: %d)\n Execution interruted.\n",
            in->errorLine);
    }
  }
    
  for (round = XOTCL_EXITHANDLER_ON_SOFT_DESTROY;
       round <= XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY; round++) {
    RUNTIME_STATE(in)->exitHandlerDestroyRound = round;
	
    /* delete objects */
    hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
    for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
      char* key = Tcl_GetHashKey(commandTable, hPtr);
      obj = GetObject(in, key);
      if (obj && !XOTclIsType(obj, thecls)) {
        if (round == XOTCL_EXITHANDLER_ON_SOFT_DESTROY)
          callDestroyMethod((ClientData)obj, in, obj, 0);
	    else
          Tcl_DeleteCommandFromToken(in, obj->id);
	  }
	}
	
	/* delete classes */
	hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
	for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
	  char* key = Tcl_GetHashKey(commandTable, hPtr);
	  XOTclClass* cl = GetClass(in, key);
	  obj = GetObject(in, key);
	  if (obj && cl && cl != theobj && cl != thecls &&
	      XOTclIsClass(in, (ClientData) cl) &&
	      !IsMetaClass(in, cl)) {
	    if (round == XOTCL_EXITHANDLER_ON_SOFT_DESTROY)
	      callDestroyMethod((ClientData)obj, in, obj, 0);
	    else
          Tcl_DeleteCommandFromToken(in, obj->id);
	  }
	}
	
	/* delete meta-classes */
	hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
	for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) {
	  char* key = Tcl_GetHashKey(commandTable, hPtr);
	  XOTclClass* cl = GetClass(in, key);
	  obj = GetObject(in, key);
	  if (obj &&
	      obj != &(thecls->object) &&
	      obj != &(theobj->object) &&
	      XOTclIsClass(in, (ClientData) cl) && IsMetaClass(in, cl)) {
	    if (round == XOTCL_EXITHANDLER_ON_SOFT_DESTROY)
	      callDestroyMethod((ClientData)obj, in, obj, 0);
	    else
          Tcl_DeleteCommandFromToken(in, obj->id);
	  }
	}
  }

  RUNTIME_STATE(in)->callDestroy = 0;

  RemoveSuper(thecls, theobj);
  RemoveInstance((XOTclObject*)thecls, thecls);
  RemoveInstance((XOTclObject*)theobj, thecls);

  Tcl_DeleteCommandFromToken(in, theobj->object.id);
  RUNTIME_STATE(in)->theObject = NULL;

  Tcl_DeleteCommandFromToken(in, thecls->object.id);
  RUNTIME_STATE(in)->theClass = NULL;

  Tcl_DeleteHashTable(filterList);

  for (i = 0; i < nr_elements(global_strings); i++) {
    DECR_REF_COUNT(global_objects[i]);
  }
  ckfree((char*)global_objects);
  ckfree((char*)RUNTIME_STATE(in));

#if defined(TCL_MEM_DEBUG)
  TclDumpMemoryInfo (stderr);
  Tcl_DumpActiveMemory ("./xotclActiveMem");
  /* Tcl_GlobalEval(in, "puts {checkmem to checkmemFile}; checkmem checkmemFile"); */
#endif

  /* 
   * See comment above
   */
  iPtr->flags = flags;
  Tcl_Release((ClientData) in);
}

#ifdef TCL_THREADS
/*
 * Gets activated at the thread-exit 
 */
static void
XOTcl_ThreadExitProc(ClientData cd) {
  /*fprintf(stderr,"+++ ThreadExit\n");*/
  ExitHandler(cd);
}
#endif

/*
 * Gets activated at the application-exit 
 */
static void
XOTcl_ExitProc(ClientData cd) {
  /* if main exit handler advances to this point -> don't call thread 
     exit handler again since we'll panic in Tcl_Release ! */
  /*fprintf(stderr,"+++ ExitProc\n");*/

#ifdef TCL_THREADS
# if !defined(PRE83)
  Tcl_DeleteThreadExitHandler(XOTcl_ThreadExitProc, cd);
# endif
#else
  /* In threaded applications, the final exit handler is a no-no.
     The main thread already terminated and invoked the 
     XOTcl_ThreadExitProc so there is no need to do it again...*/
  ExitHandler(cd);
#endif
}

/*
 * Registers thread/appl exit handlers
 * to keep the table clean when we exit.
 */
static void
RegisterExitHandlers(ClientData cd) {
#if !defined(PRE83)
  static int initialized = 0;
  static XOTclMutex initMutex = 0;
  Tcl_Preserve(cd);
  if (initialized == 0) {
    XOTclMutexLock(&initMutex);
    if (initialized == 0) {
      Tcl_CreateExitHandler(XOTcl_ExitProc, cd);
      initialized = 1;
    }
    XOTclMutexUnlock(&initMutex);
  }
# if defined(TCL_THREADS)
  Tcl_CreateThreadExitHandler(XOTcl_ThreadExitProc, cd);
# endif
#else
  Tcl_Preserve(cd);
  Tcl_CreateExitHandler(XOTcl_ExitProc, cd);
#endif /*!defined(PRE83)*/
}

/*
 * Tcl extension initialization routine
 */
static int
XOTclReplaceCommandCleanup(Tcl_Interp* in, global_names name,
			   Tcl_ObjCmdProc* tclProc
			   ) {
  Command *cmdPtr;
  int result = TCL_OK;

  cmdPtr = (Command *)Tcl_GetCommandFromObj(in, global_objects[name]); 
  if (cmdPtr != NULL) {
    /*
    fprintf(stderr,"CLEANUP: %s: old %p, new %p, ", 
	    global_strings[name], cmdPtr->objProc, tcl_commands[name]);
    if (cmdPtr->objProc == tcl_commands[name]) 
      fprintf(stderr," fishy\n");
    else
      fprintf(stderr," reasonable\n");
    */

    if (tclProc) 
      cmdPtr->objProc = tclProc;
    else
      cmdPtr->objProc = tcl_commands[name];
  }
  return result;
}

static int
XOTclReplaceCommand(Tcl_Interp* in, global_names name, 
		    Tcl_ObjCmdProc* proc,
		    Tcl_ObjCmdProc* tclProc
		    ) {
  Command *cmdPtr;
  int result = TCL_OK;

  cmdPtr = (Command *)Tcl_GetCommandFromObj(in, global_objects[name]); 
  if (cmdPtr != NULL) {
    /*
    fprintf(stderr,"%s: new %p, proc %p, info %p\n", 
	    global_strings[name],
	    cmdPtr->objProc,
	    proc, Tcl_InfoObjCmd
	    );
    */
    if (proc != cmdPtr->objProc) {
      if (tclProc) 
	tcl_commands[name] = tclProc;
      else
	tcl_commands[name] = cmdPtr->objProc;

      cmdPtr->objProc = proc;
      /*Tcl_CreateObjCommand(in, global_strings[name], proc, 0, 0);*/
    } else {
      /* fprintf(stderr,"!!! fishy replace\n");*/
    }
  } else {
    result = TCL_ERROR;
  }
 
  return result;
}
/*
 * Ohtain the names of the tcl commands
 * not available through our the stub interface
 */
static int
TclCommands(Tcl_Interp* in, int load) {
  static int initialized = 0;
  int i = TCL_OK;
#if !defined(PRE83)
  static XOTclMutex initMutex = 0;
  XOTclMutexLock(&initMutex);
#endif
  if (load) {
    if (initialized == 0) {
      i|= XOTclReplaceCommand(in, INFO,     XOTcl_InfoObjCmd, 0);
      i|= XOTclReplaceCommand(in, UPLEVEL,  XOTcl_UplevelObjCmd, 0);
      i|= XOTclReplaceCommand(in, UPVAR,    XOTcl_UpvarObjCmd, 0);
      i|= XOTclReplaceCommand(in, INCR,     XOTcl_IncrObjCmd, 0);
      i|= XOTclReplaceCommand(in, VARIABLE, XOTcl_VariableObjCmd, 0);
      i|= XOTclReplaceCommand(in, RENAME,   XOTcl_RenameObjCmd, 0);
      i|= XOTclReplaceCommand(in, SUBST,    XOTcl_SubstObjCmd, SUBST_CMD);
    }
    initialized++;
  } else {
    initialized --;

    if (initialized == 0) {
      XOTclReplaceCommandCleanup(in, INFO, 0);
      XOTclReplaceCommandCleanup(in, UPLEVEL, 0);
      XOTclReplaceCommandCleanup(in, UPVAR, 0);
      XOTclReplaceCommandCleanup(in, INCR, 0);
      XOTclReplaceCommandCleanup(in, VARIABLE, 0);
      XOTclReplaceCommandCleanup(in, RENAME, 0);
      XOTclReplaceCommandCleanup(in, SUBST, SUBST_CMD);
    }
  }
#if !defined(PRE83)
  XOTclMutexLock(&initMutex);
#endif
  return i;
}





extern int
Xotcl_Init(Tcl_Interp* in) {
  XOTclClass* theobj = 0;
  XOTclClass* thecls = 0;
  XOTclClass* paramCl = 0;
  int i;

#ifndef PRE81
# ifdef USE_TCL_STUBS
  if (Tcl_InitStubs(in, "8.1", 0) == NULL) {
    return TCL_ERROR;
  }
# endif
#endif

#if defined(TCL_MEM_DEBUG)
  TclDumpMemoryInfo(stderr);
#endif

  /*
   * Runtime State stored in the client data of the Interp's global
   * Namespace in order to avoid global state information
   */
  ((Interp*) in)->globalNsPtr->clientData =
    (ClientData) ckalloc(sizeof(XOTclRuntimeState));
  /* CallStack initialization */
  memset(((Interp*) in)->globalNsPtr->clientData,
         0, sizeof(XOTclRuntimeState));

  memset(RUNTIME_STATE(in)->cs.content,
	 0, sizeof(XOTclCallStackContent));

  RUNTIME_STATE(in)->cs.top = RUNTIME_STATE(in)->cs.content;
  /* RUNTIME_STATE(in)->cs.frameCutRound = 0; */
  RUNTIME_STATE(in)->callDestroy = 1;

  /* XOTcl Filter list initialization*/
  Tcl_InitHashTable(&RUNTIME_STATE(in)->filterList,TCL_ONE_WORD_KEYS);

  /* XOTclClasses in separate Namespace / Objects in globalNS */

  RUNTIME_STATE(in)->XOTclClassesNS = (Namespace*)
      Tcl_CreateNamespace(in, "XOTclClasses",
			  (ClientData)NULL,(Tcl_NamespaceDeleteProc*)NULL);


  /* cache interpreters proc interpretation functions */
  RUNTIME_STATE(in)->objInterpProc = TclGetObjInterpProc();
  RUNTIME_STATE(in)->interpProc = TclGetInterpProc();
  RUNTIME_STATE(in)->exitHandlerDestroyRound = XOTCL_EXITHANDLER_OFF;

  RegisterObjTypes();
  RegisterExitHandlers((ClientData)in);

  /* initialize global Tcl_Obj*/
  global_objects =
    (Tcl_Obj**)ckalloc(nr_elements(global_strings) * sizeof(Tcl_Obj*));

  for (i = 0; i < nr_elements(global_strings); i++) {
    global_objects[i] = Tcl_NewStringObj(global_strings[i],-1);
    INCR_REF_COUNT(global_objects[i]);
  }

  /* create Object and Class, and store them in the RUNTIME STATE */
  theobj = PrimitiveCCreate(in, "Object", 0);
  RUNTIME_STATE(in)->theObject = theobj;

  thecls = PrimitiveCCreate(in, "Class", 0);
  RUNTIME_STATE(in)->theClass = thecls;

  theobj->object.type = thecls;
  theobj->parent = 0;
  thecls->object.type = thecls;
  thecls->parent = theobj;

  /*Tcl_AddInterpResolvers(in, "XOTcl", XOTclResolveCmd, 0, 0);*/

#if defined(PROFILE)
  XOTclProfileInit(in);
#endif

  /* test Object and Class creation */
  if (!theobj || !thecls) {
    RUNTIME_STATE(in)->callDestroy = 0;

    if (thecls) PrimitiveCDestroy((ClientData) thecls);
    if (theobj) PrimitiveCDestroy((ClientData) theobj);

    for (i = 0; i < nr_elements(global_strings); i++) {
      DECR_REF_COUNT(global_objects[i]);
    }
    ckfree((char*)global_objects);
    ckfree((char*)RUNTIME_STATE(in));

    return XOTclErrMsg(in, "Object/Class failed", TCL_STATIC);
  }

  AddInstance((XOTclObject*)theobj, thecls);
  AddInstance((XOTclObject*)thecls, thecls);
  AddSuper(thecls, theobj);

  /*
   * and fill them with functionality
   */
  XOTclAddIMethod(in, theobj, "info", XOTclOInfoMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "destroy", XOTclODestroyMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "cleanup", XOTclOCleanupMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "class", XOTclOClassMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "unset", XOTclOUnsetMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "proc", XOTclOProcMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "isobject", XOTclOIsObjectMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "isclass", XOTclOIsClassMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "ismetaclass", XOTclOIsMetaClassMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "istype", XOTclOIsTypeMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "set",  (Tcl_ObjCmdProc*)XOTclOSetMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "exists",  (Tcl_ObjCmdProc*)XOTclOExistsMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "instvar", (Tcl_ObjCmdProc*)XOTclOInstVarMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "invar", (Tcl_ObjCmdProc*)XOTclOInvariantsMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "check", (Tcl_ObjCmdProc*)XOTclOCheckMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "autoname", XOTclOAutonameMethod, 0, 0);
#ifdef XOTCL_METADATA
  XOTclAddIMethod(in, theobj, "metadata", (Tcl_ObjCmdProc*)XOTclOMetaDataMethod, 0, 0);
#endif
  XOTclAddIMethod(in, theobj, "mixin", (Tcl_ObjCmdProc*)XOTclOMixinMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "procsearch", (Tcl_ObjCmdProc*)XOTclOProcSearchMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "incr", (Tcl_ObjCmdProc*)XOTclOIncrMethod, 0, 0);
  XOTclAddIMethod(in, theobj, "configure", (Tcl_ObjCmdProc*) XOTclOConfigureMethod, 0, 0);
 
  XOTclAddIMethod(in, thecls, "alloc", (Tcl_ObjCmdProc*)XOTclCAllocMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "superclass", (Tcl_ObjCmdProc*)XOTclCSuperClassMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "info", XOTclCInfoMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "parameter", (Tcl_ObjCmdProc*)XOTclCParameterMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "parameterclass", (Tcl_ObjCmdProc*)XOTclCParameterClassMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "parameteradd", (Tcl_ObjCmdProc*)XOTclCParameterAddMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "create", (Tcl_ObjCmdProc*)XOTclCCreateMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "recreate", (Tcl_ObjCmdProc*) XOTclCRecreateMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "instproc", (Tcl_ObjCmdProc*)XOTclCInstProcMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "instinvar", (Tcl_ObjCmdProc*)XOTclCInvariantsMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "filter", (Tcl_ObjCmdProc*)XOTclCFilterMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "instmixin", (Tcl_ObjCmdProc*)XOTclCInstMixinMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "filtersearch", (Tcl_ObjCmdProc*)XOTclCFilterSearchMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "unknown", (Tcl_ObjCmdProc*) XOTclCUnknownMethod, 0, 0);
  XOTclAddIMethod(in, thecls, "instdestroy", XOTclCInstDestroyMethod, 0, 0);


  /* create xotcl object */
  (void) PrimitiveOCreate(in, "xotcl", theobj);

  /*
   * overwritten tcl objs
   */
  /*Tcl_CreateObjCommand(in, "exit", XOTcl_ExitObjCmd, 0, 0);*/

  i = TclCommands(in, 1);
  if (i != TCL_OK)
    return i;
  
  /*
   * new tcl cmds
   */
  Tcl_CreateObjCommand(in, "::xotcl::interp", (Tcl_ObjCmdProc*)XOTcl_InterpObjCmd, 0, 0);
  Tcl_CreateObjCommand(in, "::xotcl::trace", XOTcl_TraceObjCmd, 0, 0);
  Tcl_CreateObjCommand(in, "::xotcl::namespace_copyvars", XOTcl_NSCopyVars, 0, 0);
  Tcl_CreateObjCommand(in, "::xotcl::namespace_copycmds", XOTcl_NSCopyCmds, 0, 0);
  Tcl_CreateObjCommand(in, "::xotcl::deprecated", XOTcl_DeprecatedCmd, 0, 0);

  /*
   *  Parameter Class
   */
  paramCl = PrimitiveCCreate(in, global_strings[PARAM_CL], thecls);
  XOTclAddPMethod(in, &paramCl->object, global_strings[SEARCH_DEFAULTS],
		  (Tcl_ObjCmdProc*) ParameterSearchDefaultsMethod, 0, 0);

  Tcl_SetVar(in, "::xotcl::version", XOTCLVERSION, TCL_GLOBAL_ONLY);

  /*
   * with some methods and library procs in tcl - they could go in a
   * xotcl.tcl file, but they're embedded here with Tcl_GlobalEval 
   * to avoid the need to carry around a separate file at runtime.
   */
  {
#include "predefined.h"
    /*fprintf(stderr, "predefined=<<%s>>\n",cmd);*/
    if (Tcl_GlobalEval(in, cmd) != TCL_OK) return TCL_ERROR;
  }

#ifndef AOL_SERVER  
  /* the AOL server uses a different package loading mechanism */
  {
    /* set xotcl_lib to the compiled in default value */
    Tcl_SetVar(in, "::xotcl::lib", XOLIBPKG, TCL_GLOBAL_ONLY);
    /* search for the location of the xotcl library */
    if (Tcl_GlobalEval(in, "::xotcl::check_library_path") != TCL_OK)
      return TCL_ERROR;
  }
  Tcl_PkgProvide(in, "XOTcl", XOTCLVERSION);
  Tcl_ResetResult(in);
  Tcl_SetIntObj(Tcl_GetObjResult(in), 1);
#endif

  return TCL_OK;
}

#if 0
extern int
Xotcl_SafeInit(interp)
    Tcl_Interp *interp;
{
  return Xotcl_Init(interp);
}
#endif

