Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.394
diff -u -r1.394 tclBasic.c
--- generic/tclBasic.c	8 May 2009 08:48:19 -0000	1.394
+++ generic/tclBasic.c	7 Jun 2009 10:15:13 -0000
@@ -795,6 +795,13 @@
     Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRTailcallObjCmd,
 	    NULL, NULL);
 
+    /*
+     * Create an unsupported command for debugging objects.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::unsupported::debugobj",
+	    Tcl_DebugObjObjCmd, NULL, NULL);
+
 #ifdef USE_DTRACE
     /*
      * Register the tcl::dtrace command.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.423
diff -u -r1.423 tclInt.h
--- generic/tclInt.h	8 May 2009 08:48:19 -0000	1.423
+++ generic/tclInt.h	7 Jun 2009 10:15:19 -0000
@@ -2959,6 +2959,10 @@
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_DebugObjObjCmd(ClientData dummy,
+			    Tcl_Interp *interp,
+			    int objc,
+			    Tcl_Obj *CONST objv[]);
 MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.152
diff -u -r1.152 tclObj.c
--- generic/tclObj.c	8 May 2009 02:21:09 -0000	1.152
+++ generic/tclObj.c	7 Jun 2009 10:15:23 -0000
@@ -3831,6 +3831,41 @@
     return TCL_OK;
 }
 
+static void DebugObj(Tcl_Obj *ob)
+{
+  printf("Obj:0x%X(%d) ",
+	 (int)ob,
+	 ob->refCount);
+  if (!ob->typePtr)
+    printf("(null) ");
+  else
+    printf("(%s):0x%X-0x%X ",
+	   ob->typePtr->name,
+	   (int)ob->internalRep.twoPtrValue.ptr1,
+	   (int)ob->internalRep.twoPtrValue.ptr2);
+  printf("<<<%s>>>\n",(ob->bytes?ob->bytes:"?"));
+  fflush(stdout);
+}
+
+int
+Tcl_DebugObjObjCmd(
+		   ClientData dummy,		/* Not used. */
+		   Tcl_Interp *interp,		/* Current interpreter. */
+		   int objc,			/* Number of arguments. */
+		   Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+  Tcl_Obj *ob;
+  
+  if (objc != 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "object");
+    return TCL_ERROR;
+  }
+  ob=objv[1];
+  DebugObj(ob);
+  Tcl_SetObjResult(interp, ob);
+  return TCL_OK;
+}
+
 /*
  * Local Variables:
  * mode: c
