Index: generic/xotcl.c
===================================================================
diff -u -r0037211cd9632cbb418f9f8ca40a001a51d1598d -rbd830707f07944cae84e3657dde237f5bc8fbb36
--- generic/xotcl.c	(.../xotcl.c)	(revision 0037211cd9632cbb418f9f8ca40a001a51d1598d)
+++ generic/xotcl.c	(.../xotcl.c)	(revision bd830707f07944cae84e3657dde237f5bc8fbb36)
@@ -1556,6 +1556,7 @@
 
   /* fprintf(stderr," obj %p flags %.4x %d\n", obj, obj->flags,
      RUNTIME_STATE(interp)->callDestroy);*/
+
   /* we don't call destroy, if we're in the exit handler
      during destruction of Object and Class */
   if (!RUNTIME_STATE(interp)->callDestroy) {
@@ -12572,7 +12573,7 @@
 
 static void 
 freeAllXOTclObjectsAndClasses(Tcl_Interp *interp, Tcl_HashTable *commandTable) {
-  Tcl_HashEntry *hPtr, *hDel;
+  Tcl_HashEntry *hPtr;
   Tcl_HashSearch hSrch;
   XOTclObject *obj;
   XOTclClass  *thecls, *theobj, *cl;
@@ -12585,31 +12586,24 @@
   RUNTIME_STATE(interp)->exitHandlerDestroyRound = XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY;
   while (1) {
     int deleted = 0;
-    hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
-    while (hPtr) {
+    for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) {
       char *key = Tcl_GetHashKey(commandTable, hPtr);
       obj = XOTclpGetObject(interp, key);
       if (obj && !XOTclObjectIsClass(obj) && !ObjectHasChildren(interp, obj)) {
         /* fprintf(stderr,"  ... delete object %s %p, class=%s\n", key, obj, 
            ObjStr(obj->cl->object.cmdName));*/
         freeUnsetTraceVariable(interp, obj);
         Tcl_DeleteCommandFromToken(interp, obj->id);
-        hDel = hPtr;
+        Tcl_DeleteHashEntry(hPtr);
         deleted++;
-      } else {
-        hDel = NULL;
       }
-      hPtr = Tcl_NextHashEntry(&hSrch);
-      if (hDel)
-        Tcl_DeleteHashEntry(hDel);
     }
     /* fprintf(stderr, "deleted %d Objects\n", deleted);*/
-    if (deleted>0)
+    if (deleted > 0) {
       continue;
+    }
 
-
-    hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
-    while (hPtr) {
+    for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) {
       char *key = Tcl_GetHashKey(commandTable, hPtr);
       cl = XOTclpGetClass(interp, key);
       /* fprintf(stderr,"cl key = %s %p\n", key, cl); */
@@ -12623,14 +12617,9 @@
         /* fprintf(stderr,"  ... delete class %s %p\n", key, cl); */
         freeUnsetTraceVariable(interp, &cl->object);
         Tcl_DeleteCommandFromToken(interp, cl->object.id);
-        hDel = hPtr;
+        Tcl_DeleteHashEntry(hPtr);
         deleted++;
-      } else {
-        hDel = NULL;
       }
-      hPtr = Tcl_NextHashEntry(&hSrch);
-      if (hDel)
-        Tcl_DeleteHashEntry(hDel);
     }
     /* fprintf(stderr, "deleted %d Classes\n", deleted);*/
     if (deleted == 0) {
@@ -12660,48 +12649,20 @@
 }
 #endif /* DO_CLEANUP */
 
-
-/*
- *  Exit Handler
+/* 
+ * ::xotcl::finalize command
  */
-static void
-ExitHandler(ClientData cd) {
-  Tcl_Interp *interp = (Tcl_Interp *) cd;
+static int
+XOTclFinalizeObjCmd(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
   XOTclObject *obj;
   XOTclClass *cl;
-  int result, flags, i;
+  int result;
   Tcl_HashSearch hSrch;
   Tcl_HashEntry *hPtr;
   Tcl_HashTable objTable, *commandTable = &objTable;
-  XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs;
 
-  /*
-   * 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
-   */
+  /* fprintf(stderr,"+++ call EXIT handler\n");  */
 
-  /*
-   * 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 really 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"); */
-  flags = Tcl_Interp_flags(interp);
-  Tcl_Interp_flags(interp) &= ~DELETED;
 #if defined(PROFILE)
   XOTclProfilePrintData(interp);
 #endif
@@ -12715,21 +12676,7 @@
             "Error in line %d: %s\nExecution interrupted.\n",
             interp->errorLine, ObjStr(Tcl_GetObjResult(interp)));
   }
-  /*
-   * Pop any callstack entry that is still alive (e.g.
-   * if "exit" is called and we were jumping out of the
-   * callframe
-   */
-  while (cs->top > cs->content)
-    CallStackPop(interp);
 
-  while (1) {
-    Tcl_CallFrame *f = Tcl_Interp_framePtr(interp);
-    if (!f) break;
-    if (Tcl_CallFrame_level(f) == 0) break;
-    Tcl_PopCallFrame(interp);
-  }
-
   /* deleting in two rounds:
    *  (a) SOFT DESTROY: call all user-defined destroys
    *  (b) PHYSICAL DESTROY: delete the commands, user-defined
@@ -12746,43 +12693,99 @@
   /***** SOFT DESTROY *****/
   RUNTIME_STATE(interp)->exitHandlerDestroyRound = XOTCL_EXITHANDLER_ON_SOFT_DESTROY;
 
-  hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
-  while (hPtr) {
+  for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) {
     char *key = Tcl_GetHashKey(commandTable, hPtr);
     obj = XOTclpGetObject(interp, key);
     /* fprintf(stderr,"key = %s %p %d\n",
        key, obj, obj && !XOTclObjectIsClass(obj)); */
     if (obj && !XOTclObjectIsClass(obj)
-        && !(obj->flags & XOTCL_DESTROY_CALLED))
+        && !(obj->flags & XOTCL_DESTROY_CALLED)) {
       callDestroyMethod((ClientData)obj, interp, obj, 0);
-    hPtr = Tcl_NextHashEntry(&hSrch);
+    }
   }
-  hPtr = Tcl_FirstHashEntry(commandTable, &hSrch);
-  while (hPtr) {
+
+  for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) {
     char *key = Tcl_GetHashKey(commandTable, hPtr);
     cl = XOTclpGetClass(interp, key);
-    if (cl
-        && !(cl->object.flags & XOTCL_DESTROY_CALLED))
-      callDestroyMethod((ClientData)cl, interp, (XOTclObject*)cl, 0);
-    hPtr = Tcl_NextHashEntry(&hSrch);
+    if (cl && !(cl->object.flags & XOTCL_DESTROY_CALLED)) {
+      callDestroyMethod((ClientData)cl, interp, (XOTclObject *)cl, 0);
+    }
   }
+
 #ifdef DO_CLEANUP
   freeAllXOTclObjectsAndClasses(interp, commandTable);
 #endif
 
-  /* must be before freeing of XOTclGlobalObjects */
+  MEM_COUNT_FREE("Tcl_InitHashTable", commandTable);
+  Tcl_DeleteHashTable(commandTable);
+
+  return TCL_OK;
+}
+
+
+/*
+ *  Exit Handler
+ */
+static void
+ExitHandler(ClientData cd) {
+  Tcl_Interp *interp = (Tcl_Interp *) cd;
+  int i, flags;
+  XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs;
+
+  /*
+   * 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 really 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 !
+   */
+  flags = Tcl_Interp_flags(interp);
+  Tcl_Interp_flags(interp) &= ~DELETED;
+
+  if (RUNTIME_STATE(interp)->exitHandlerDestroyRound == XOTCL_EXITHANDLER_OFF) {
+    XOTclFinalizeObjCmd(NULL, interp, 0, NULL);
+  }
+
+  /*
+   * Pop any callstack entry that is still alive (e.g.
+   * if "exit" is called and we were jumping out of the
+   * callframe
+   */
+  while (cs->top > cs->content)
+    CallStackPop(interp);
+
+  while (1) {
+    Tcl_CallFrame *f = Tcl_Interp_framePtr(interp);
+    if (!f) break;
+    if (Tcl_CallFrame_level(f) == 0) break;
+    Tcl_PopCallFrame(interp);
+  }
+
+   /* must be before freeing of XOTclGlobalObjects */
   XOTclShadowTclCommands(interp, SHADOW_UNLOAD);
+
   /* free global objects */
   for (i = 0; i < nr_elements(XOTclGlobalStrings); i++) {
     DECR_REF_COUNT(XOTclGlobalObjects[i]);
   }
   XOTclStringIncrFree(&RUNTIME_STATE(interp)->iss);
-  FREE(Tcl_Obj**, XOTclGlobalObjects);
-  FREE(XOTclRuntimeState, RUNTIME_STATE(interp));
 
-  MEM_COUNT_FREE("Tcl_InitHashTable", commandTable);
-  Tcl_DeleteHashTable(commandTable);
-
 #if defined(TCL_MEM_DEBUG)
   TclDumpMemoryInfo (stderr);
   Tcl_DumpActiveMemory ("./xotclActiveMem");
@@ -12791,6 +12794,9 @@
 #endif
   MEM_COUNT_DUMP();
 
+  FREE(Tcl_Obj**, XOTclGlobalObjects);
+  FREE(XOTclRuntimeState, RUNTIME_STATE(interp));
+
   Tcl_Interp_flags(interp) = flags;
   Tcl_Release((ClientData) interp);
 }
@@ -13131,6 +13137,7 @@
   Tcl_CreateObjCommand(interp, "::xotcl::alias", XOTclAliasCommand, 0, 0);
   Tcl_CreateObjCommand(interp, "::xotcl::configure", XOTclConfigureCommand, 0, 0);
   Tcl_CreateObjCommand(interp, "::xotcl::deprecated", XOTcl_DeprecatedCmd, 0, 0);
+  Tcl_CreateObjCommand(interp, "::xotcl::finalize", XOTclFinalizeObjCmd, 0, 0);
 #ifdef XOTCL_BYTECODE
   instructions[INST_INITPROC].cmdPtr = (Command *)
 #endif