merge 8.7

10 files changed, 239 insertions, 198 deletions

diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 46012c5..6ea3397 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -1622,7 +1622,7 @@ Tcl_DisassembleObjCmd(
 		"BYTECODE", NULL);
 	return TCL_ERROR;
     }
-    if (PTR2INT(clientData)) {
+    if (clientData) {
 	Tcl_SetObjResult(interp,
 		DisassembleByteCodeAsDicts(interp, codeObjPtr));
     } else {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 334ae20..453c10f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -120,19 +120,19 @@ typedef int ptrdiff_t;
 #if !defined(INT2PTR) && !defined(PTR2INT)
 #   if defined(HAVE_INTPTR_T) || defined(intptr_t)
 #	define INT2PTR(p) ((void *)(intptr_t)(p))
-#	define PTR2INT(p) ((int)(intptr_t)(p))
+#	define PTR2INT(p) ((intptr_t)(p))
 #   else
 #	define INT2PTR(p) ((void *)(p))
-#	define PTR2INT(p) ((int)(p))
+#	define PTR2INT(p) ((long)(p))
 #   endif
 #endif
 #if !defined(UINT2PTR) && !defined(PTR2UINT)
 #   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
 #	define UINT2PTR(p) ((void *)(uintptr_t)(p))
-#	define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
+#	define PTR2UINT(p) ((uintptr_t)(p))
 #   else
 #	define UINT2PTR(p) ((void *)(p))
-#	define PTR2UINT(p) ((unsigned int)(p))
+#	define PTR2UINT(p) ((unsigned long)(p))
 #   endif
 #endif
 
diff --git a/generic/tclOO.c b/generic/tclOO.c
index c8471d5..2491c2f 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -59,7 +59,6 @@ static const struct {
  * Function declarations for things defined in this file.
  */
 
-static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
 static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
 			    Namespace *nsPtr, const char *nsNameStr);
 static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
@@ -84,8 +83,6 @@ static void		ObjectNamespaceDeleted(ClientData clientData);
 static void		ObjectRenamedTrace(ClientData clientData,
 			    Tcl_Interp *interp, const char *oldName,
 			    const char *newName, int flags);
-static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
-static void		DeleteDescendants(Tcl_Interp *interp,Object *oPtr);
 static inline void	RemoveClass(Class **list, int num, int idx);
 static inline void	RemoveObject(Object **list, int num, int idx);
 static inline void	SquelchCachedName(Object *oPtr);
@@ -451,10 +448,10 @@ InitClassSystemRoots(
 
     /* Stand up a phony class for bootstrapping. */
     fPtr->objectCls = &fakeCls;
-    /* referenced in AllocClass to increment the refCount. */
+    /* referenced in TclOOAllocClass to increment the refCount. */
     fakeCls.thisPtr = &fakeObject;
 
-    fPtr->objectCls = AllocClass(interp,
+    fPtr->objectCls = TclOOAllocClass(interp,
 	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
     /* Corresponding TclOODecrRefCount in KillFoudation */
     AddRef(fPtr->objectCls->thisPtr);
@@ -470,7 +467,7 @@ InitClassSystemRoots(
     fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
     fPtr->objectCls->flags |= ROOT_OBJECT;
 
-    fPtr->classCls = AllocClass(interp,
+    fPtr->classCls = TclOOAllocClass(interp,
 	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
     /* Corresponding TclOODecrRefCount in KillFoudation */
     AddRef(fPtr->classCls->thisPtr);
@@ -839,15 +836,15 @@ ObjectRenamedTrace(
 /*
  * ----------------------------------------------------------------------
  *
- * DeleteDescendants --
+ * TclOODeleteDescendants --
  *
  *	Delete all descendants of a particular class.
  *
  * ----------------------------------------------------------------------
  */
 
-static void
-DeleteDescendants(
+void
+TclOODeleteDescendants(
     Tcl_Interp *interp,		/* The interpreter containing the class. */
     Object *oPtr)		/* The object representing the class. */
 {
@@ -864,7 +861,8 @@ DeleteDescendants(
 	    /* This condition also covers the case where mixinSubclassPtr ==
 	     * clsPtr
 	     */
-	    if (!Deleted(mixinSubclassPtr->thisPtr)) {
+	    if (!Deleted(mixinSubclassPtr->thisPtr)
+		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp,
 			mixinSubclassPtr->thisPtr->command);
 	    }
@@ -883,8 +881,10 @@ DeleteDescendants(
     if (clsPtr->subclasses.num > 0) {
 	while (clsPtr->subclasses.num > 0) {
 	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
-	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
-		Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
+	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
+		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
+		Tcl_DeleteCommandFromToken(interp,
+			subclassPtr->thisPtr->command);
 	    }
 	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
 	}
@@ -906,7 +906,8 @@ DeleteDescendants(
 	     * This condition also covers the case where instancePtr == oPtr
 	     */
 
-	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
+	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
+		    !(instancePtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
 	    }
 	    TclOORemoveFromInstances(instancePtr, clsPtr);
@@ -922,7 +923,7 @@ DeleteDescendants(
 /*
  * ----------------------------------------------------------------------
  *
- * ReleaseClassContents --
+ * TclOOReleaseClassContents --
  *
  *	Tear down the special class data structure, including deleting all
  *	dependent classes and objects.
@@ -930,8 +931,8 @@ DeleteDescendants(
  * ----------------------------------------------------------------------
  */
 
-static void
-ReleaseClassContents(
+void
+TclOOReleaseClassContents(
     Tcl_Interp *interp,		/* The interpreter containing the class. */
     Object *oPtr)		/* The object representing the class. */
 {
@@ -954,9 +955,6 @@ ReleaseClassContents(
 	} else if (IsRootObject(oPtr)) {
 	    Tcl_Panic("deleting class structure for non-deleted %s",
 		    "::oo::object");
-	} else {
-	    Tcl_Panic("deleting class structure for non-deleted %s",
-		    "general object");
 	}
     }
 
@@ -1059,6 +1057,7 @@ ReleaseClassContents(
     if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
 	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
     }
+    oPtr->classPtr = NULL;
 }
 
 /*
@@ -1108,7 +1107,7 @@ ObjectNamespaceDeleted(
 
     /* Let the dominoes fall */
     if (oPtr->classPtr) {
-	DeleteDescendants(interp, oPtr);
+	TclOODeleteDescendants(interp, oPtr);
     }
 
     /*
@@ -1237,8 +1236,8 @@ ObjectNamespaceDeleted(
 
     /*
      * Because an object can be a class that is an instance of itself, the
-     * class object's class structure should only be cleaned after most of the
-     * cleanup on the object is done.
+     * class object's class structure should only be cleaned after most of
+     * the cleanup on the object is done.
      *
      * The class of objects needs some special care; if it is deleted (and
      * we're not killing the whole interpreter) we force the delete of the
@@ -1253,7 +1252,7 @@ ObjectNamespaceDeleted(
     }
 
     if (oPtr->classPtr != NULL) {
-	ReleaseClassContents(interp, oPtr);
+	TclOOReleaseClassContents(interp, oPtr);
     }
 
     /*
@@ -1360,6 +1359,37 @@ TclOOAddToInstances(
 /*
  * ----------------------------------------------------------------------
  *
+ * TclOORemoveFromMixins --
+ *
+ *	Utility function to remove a class from the list of mixins within an
+ *	object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOORemoveFromMixins(
+    Class *mixinPtr,		/* The mixin to remove. */
+    Object *oPtr)		/* The object (possibly) containing the
+				 * reference to the mixin. */
+{
+    int i, res = 0;
+    Class *mixPtr;
+
+    FOREACH(mixPtr, oPtr->mixins) {
+	if (mixinPtr == mixPtr) {
+	    RemoveItem(Class, oPtr->mixins, i);
+	    TclOODecrRefCount(mixPtr->thisPtr);
+	    res++;
+	    break;
+	}
+    }
+    return res;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * TclOORemoveFromSubclasses --
  *
  *	Utility function to remove a class from the list of subclasses within
@@ -1489,10 +1519,10 @@ TclOOAddToMixinSubs(
 /*
  * ----------------------------------------------------------------------
  *
- * AllocClass --
+ * TclOOAllocClass --
  *
- *	Allocate a basic class. Does not add class to its
- *	class's instance list.
+ *	Allocate a basic class. Does not add class to its class's instance
+ *	list.
  *
  * ----------------------------------------------------------------------
  */
@@ -1516,8 +1546,8 @@ InitClassPath(
     }
 }
 
-static Class *
-AllocClass(
+Class *
+TclOOAllocClass(
     Tcl_Interp *interp,		/* Interpreter within which to allocate the
 				 * class. */
     Object *useThisObj)		/* Object that is to act as the class
@@ -1758,13 +1788,13 @@ TclNewObjectInstanceCommon(
 
     if (TclOOIsReachable(fPtr->classCls, classPtr)) {
 	/*
-	 * Is a class, so attach a class structure. Note that the AllocClass
-	 * function splices the structure into the object, so we don't have
-	 * to. Once that's done, we need to repatch the object to have the
-	 * right class since AllocClass interferes with that.
+	 * Is a class, so attach a class structure. Note that the
+	 * TclOOAllocClass function splices the structure into the object, so
+	 * we don't have to. Once that's done, we need to repatch the object
+	 * to have the right class since TclOOAllocClass interferes with that.
 	 */
 
-	AllocClass(interp, oPtr);
+	TclOOAllocClass(interp, oPtr);
 	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
     } else {
 	oPtr->classPtr = NULL;
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 1b4f587..50a9c80 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -1703,7 +1703,6 @@ AddSimpleClassChainToCallContext(
     if (flags & CONSTRUCTOR) {
 	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
 		filterDecl, flags);
-
     } else if (flags & DESTRUCTOR) {
 	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
 		filterDecl, flags);
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 17680a0..b4ff283 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -1375,6 +1375,8 @@ TclOODefineClassObjCmd(
 {
     Object *oPtr;
     Class *clsPtr;
+    Foundation *fPtr = TclOOGetFoundation(interp);
+    int wasClass, willBeClass;
 
     /*
      * Parse the context to get the object to operate on.
@@ -1410,12 +1412,20 @@ TclOODefineClassObjCmd(
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
-
+    if (oPtr == clsPtr->thisPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"may not change classes into an instance of themselves", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
 
     /*
      * Set the object's class.
      */
 
+    wasClass = (oPtr->classPtr != NULL);
+    willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));
+
     if (oPtr->selfCls != clsPtr) {
 	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
 	TclOODecrRefCount(oPtr->selfCls->thisPtr);
@@ -1423,6 +1433,26 @@ TclOODefineClassObjCmd(
 	AddRef(oPtr->selfCls->thisPtr);
 	TclOOAddToInstances(oPtr, oPtr->selfCls);
 
+	/*
+	 * Create or delete the class guts if necessary.
+	 */
+
+	if (wasClass && !willBeClass) {
+	    /*
+	     * This is the most global of all epochs. Bump it! No cache can be
+	     * trusted!
+	     */
+
+	    TclOORemoveFromMixins(oPtr->classPtr, oPtr);
+	    oPtr->fPtr->epoch++;
+	    oPtr->flags |= DONT_DELETE;
+	    TclOODeleteDescendants(interp, oPtr);
+	    oPtr->flags &= ~DONT_DELETE;
+	    TclOOReleaseClassContents(interp, oPtr);
+	} else if (!wasClass && willBeClass) {
+	    TclOOAllocClass(interp, oPtr);
+	}
+
 	if (oPtr->classPtr != NULL) {
 	    BumpGlobalEpoch(interp, oPtr->classPtr);
 	} else {
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 1f30fed..47e5cf0 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -242,6 +242,10 @@ typedef struct Object {
 				/* Object/class has (or had) private methods,
 				 * and so shouldn't be cached so
 				 * aggressively. */
+#define DONT_DELETE 0x40000	/* Inhibit deletion of this object. Used
+				 * during fundamental object type mutation to
+				 * make sure that the object actually survives
+				 * to the end of the operation. */
 
 /*
  * And the definition of a class. Note that every class also has an associated
@@ -526,6 +530,8 @@ MODULE_SCOPE int	TclOO_Object_VarName(ClientData clientData,
 MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
 MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
 MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
+MODULE_SCOPE Class *	TclOOAllocClass(Tcl_Interp *interp,
+			    Object *useThisObj);
 MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
 			    Tcl_Class cls, const char *nameStr,
 			    const char *nsNameStr, int objc,
@@ -540,6 +546,8 @@ MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
 MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
 MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
 MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
+MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
+			    Object *oPtr);
 MODULE_SCOPE void	TclOODelMethodRef(Method *method);
 MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
 			    Tcl_Obj *methodNameObj, int flags,
@@ -567,7 +575,10 @@ MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
 MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
 			    const DeclaredClassMethod *dcm);
 MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
+MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
+			    Object *oPtr);
 MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
+MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
 MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
 			    Class *mixinPtr);
 MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,
diff --git a/generic/tclScan.c b/generic/tclScan.c
index da6a52f..745f05b 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -932,8 +932,7 @@ Tcl_ScanObjCmd(
 		    }
 		}
 		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
-		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
-			    (Tcl_WideUInt)wideValue);
+		    sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue);
 		    Tcl_SetStringObj(objPtr, buf, -1);
 		} else {
 		    TclSetIntObj(objPtr, wideValue);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f680ff5..fb8857c 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2394,7 +2394,7 @@ ExitProcOdd(
     char buf[16 + TCL_INTEGER_SPACE];
     size_t len;
 
-    sprintf(buf, "odd %d\n", PTR2INT(clientData));
+    sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
     len = strlen(buf);
     if (len != (size_t) write(1, buf, len)) {
 	Tcl_Panic("ExitProcOdd: unable to write to stdout");
@@ -2408,7 +2408,7 @@ ExitProcEven(
     char buf[16 + TCL_INTEGER_SPACE];
     size_t len;
 
-    sprintf(buf, "even %d\n", PTR2INT(clientData));
+    sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
     len = strlen(buf);
     if (len != (size_t) write(1, buf, len)) {
 	Tcl_Panic("ExitProcEven: unable to write to stdout");
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index e0f8497..fbf0d35 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -9,8 +9,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://math.libtomcrypt.com
  */
 #ifndef BN_H_
 #define BN_H_
@@ -27,14 +25,20 @@ extern "C" {
 #endif
 
 /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
-#if defined(_MSC_VER) || defined(__LLP64__)
+#if defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)
 #   define MP_32BIT
 #endif
 
 /* detect 64-bit mode if possible */
 #if defined(NEVER)
-#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT) || defined(_MSC_VER))
-#      define MP_64BIT
+#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
+#      if defined(__GNUC__)
+/* we support 128bit integers only via: __attribute__((mode(TI))) */
+#         define MP_64BIT
+#      else
+/* otherwise we fall back to MP_32BIT even on 64bit platforms */
+#         define MP_32BIT
+#      endif
 #   endif
 #endif
 
@@ -48,11 +52,11 @@ extern "C" {
  */
 #ifdef MP_8BIT
 #ifndef MP_DIGIT_DECLARED
-typedef uint8_t              mp_digit;
+typedef unsigned char        mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
 #ifndef MP_WORD_DECLARED
-typedef uint16_t             mp_word;
+typedef unsigned short       mp_word;
 #define MP_WORD_DECLARED
 #endif
 #   define MP_SIZEOF_MP_DIGIT 1
@@ -61,11 +65,11 @@ typedef uint16_t             mp_word;
 #   endif
 #elif defined(MP_16BIT)
 #ifndef MP_DIGIT_DECLARED
-typedef uint16_t             mp_digit;
+typedef unsigned short       mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
 #ifndef MP_WORD_DECLARED
-typedef uint32_t             mp_word;
+typedef unsigned int         mp_word;
 #define MP_WORD_DECLARED
 #endif
 #   define MP_SIZEOF_MP_DIGIT 2
@@ -75,31 +79,21 @@ typedef uint32_t             mp_word;
 #elif defined(MP_64BIT)
 /* for GCC only on supported platforms */
 #ifndef MP_DIGIT_DECLARED
-typedef uint64_t mp_digit;
+typedef unsigned long long   mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
-#   if defined(__GNUC__)
 typedef unsigned long        mp_word __attribute__((mode(TI)));
-#   else
-/* it seems you have a problem
- * but we assume you can somewhere define your own uint128_t */
-#ifndef MP_WORD_DECLARED
-typedef uint128_t            mp_word;
-#define MP_WORD_DECLARED
-#endif
-#   endif
-
 #   define DIGIT_BIT 60
 #else
 /* this is the default case, 28-bit digits */
 
 /* this is to make porting into LibTomCrypt easier :-) */
 #ifndef MP_DIGIT_DECLARED
-typedef uint32_t             mp_digit;
+typedef unsigned int         mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
 #ifndef MP_WORD_DECLARED
-typedef uint64_t             mp_word;
+typedef unsigned long long   mp_word;
 #define MP_WORD_DECLARED
 #endif
 
@@ -116,23 +110,11 @@ typedef uint64_t             mp_word;
 /* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
 #ifndef DIGIT_BIT
 #   define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1))  /* bits per digit */
-typedef uint_least32_t mp_min_u32;
+typedef unsigned long mp_min_u32;
 #else
 typedef mp_digit mp_min_u32;
 #endif
 
-/* use arc4random on platforms that support it */
-#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
-#   define MP_GEN_RANDOM()    arc4random()
-#   define MP_GEN_RANDOM_MAX  0xffffffffu
-#endif
-
-/* use rand() as fall-back if there's no better rand function */
-#ifndef MP_GEN_RANDOM
-#   define MP_GEN_RANDOM()    rand()
-#   define MP_GEN_RANDOM_MAX  RAND_MAX
-#endif
-
 #define MP_DIGIT_BIT     DIGIT_BIT
 #define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
 #define MP_DIGIT_MAX     MP_MASK
@@ -271,9 +253,9 @@ int mp_set_int(mp_int *a, unsigned long b);
 int mp_set_long(mp_int *a, unsigned long b);
 */
 
-/* set a platform dependent Tcl_WideUInt value */
+/* set a platform dependent unsigned long long value */
 /*
-int mp_set_long_long(mp_int *a, Tcl_WideUInt b);
+int mp_set_long_long(mp_int *a, unsigned long long b);
 */
 
 /* get a 32-bit value */
@@ -286,9 +268,9 @@ unsigned long mp_get_int(const mp_int *a);
 unsigned long mp_get_long(const mp_int *a);
 */
 
-/* get a platform dependent Tcl_WideUInt value */
+/* get a platform dependent unsigned long long value */
 /*
-Tcl_WideUInt mp_get_long_long(const mp_int *a);
+unsigned long long mp_get_long_long(const mp_int *a);
 */
 
 /* initialize and set a digit */
@@ -380,6 +362,14 @@ int mp_cnt_lsb(const mp_int *a);
 int mp_rand(mp_int *a, int digits);
 */
 
+#ifdef MP_PRNG_ENABLE_LTM_RNG
+/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
+ * in case you don't use libtomcrypt or use it w/o rng_get_bytes()
+ * you have to implement it somewhere else, as it's required */
+extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
+extern void (*ltm_rng_callback)(void);
+#endif
+
 /* ---> binary operations <--- */
 /* c = a XOR b  */
 /*
@@ -396,8 +386,33 @@ int mp_or(const mp_int *a, const mp_int *b, mp_int *c);
 int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
 */
 
+/* c = a XOR b (two complement) */
+/*
+int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c);
+*/
+
+/* c = a OR b (two complement) */
+/*
+int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);
+*/
+
+/* c = a AND b (two complement) */
+/*
+int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);
+*/
+
+/* right shift (two complement) */
+/*
+int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
+*/
+
 /* ---> Basic arithmetic <--- */
 
+/* b = ~a */
+/*
+int mp_complement(const mp_int *a, mp_int *b);
+*/
+
 /* b = -a */
 /*
 int mp_neg(const mp_int *a, mp_int *b);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 97ddea7..af63822 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -113,8 +113,6 @@ static int		GetEndOffsetFromObj(Tcl_Obj *objPtr,
 static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
 static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    Tcl_WideInt endValue, Tcl_WideInt *widePtr);
-static int		SetEndOffsetFromAny(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
 static int		FindElement(Tcl_Interp *interp, const char *string,
 			    int stringLength, const char *typeStr,
 			    const char *typeCode, const char **elementPtr,
@@ -127,7 +125,8 @@ static int		FindElement(Tcl_Interp *interp, const char *string,
  * stored directly in the wideValue, so no memory management is required
  * for it. This is a caching intrep, keeping the result of a parse
  * around. This type is only created from a pre-existing string, so an
- * updateStringProc will never be called and need not exist.
+ * updateStringProc will never be called and need not exist. The type
+ * is unregistered, so has no need of a setFromAnyProc either.
  */
 
 static const Tcl_ObjType endOffsetType = {
@@ -135,7 +134,7 @@ static const Tcl_ObjType endOffsetType = {
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
     NULL,				/* updateStringProc */
-    NULL
+    NULL				/* setFromAnyProc */
 };
 
 /*
@@ -3660,10 +3659,12 @@ TclFormatInt(
  * GetWideForIndex --
  *
  *	This function produces a wide integer value corresponding to the
- *	list index held in *objPtr. The parsing supports all values 
+ *	index value held in *objPtr. The parsing supports all values
  *	recognized as any size of integer, and the syntaxes end[-+]$integer
  *	and $integer[-+]$integer. The argument endValue is used to give
- *	the meaning of the literal index value "end".
+ *	the meaning of the literal index value "end". Index arithmetic
+ *	on arguments outside the wide integer range are only accepted
+ *	when interp is a working interpreter, not NULL.
  *
  * Results:
  *	When parsing of *objPtr successfully recognizes an index value,
@@ -3927,131 +3928,87 @@ GetEndOffsetFromObj(
     Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                  * representing an index. */
 {
-    if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
-        Tcl_WideInt offset = objPtr->internalRep.wideValue;
+    Tcl_ObjIntRep *irPtr;
+    Tcl_WideInt offset = 0;	/* Offset in the "end-offset" expression */
 
-        if ((endValue ^ offset) < 0) {
-            /* Different signs, sum cannot overflow */
-            *widePtr = endValue + offset;
-        } else if (endValue >= 0) {
-            if (endValue < LLONG_MAX - offset) {
-                *widePtr = endValue + offset;
-            } else {
-                *widePtr = LLONG_MAX;
-            }
-	} else {
-            if (endValue > LLONG_MIN - offset) {
-                *widePtr = endValue + offset;
-            } else {
-                *widePtr = LLONG_MIN;
-            }
+    while ((irPtr = Tcl_FetchIntRep(objPtr, &endOffsetType)) == NULL) {
+	Tcl_ObjIntRep ir;
+	int length;
+	const char *bytes = TclGetStringFromObj(objPtr, &length);
+
+	if ((length < 3) || (length == 4)) {
+	    /* Too short to be "end" or to be "end-$integer" */
+	    return TCL_ERROR;
+	}
+	if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) {
+	    /* Value doesn't start with "end" */
+	    return TCL_ERROR;
 	}
-	return TCL_OK;
-    }
-    return TCL_ERROR;
-}
 
-/*
- *----------------------------------------------------------------------
- *
- * SetEndOffsetFromAny --
- *
- *	Look for a string of the form "end[+-]offset" and convert it to an
- *	internal representation holding the offset.
- *
- * Results:
- *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
- *
- * Side effects:
- *	If interp is not NULL, stores an error message in the interpreter
- *	result.
- *
- *----------------------------------------------------------------------
- */
+	if (length > 4) {
+	    ClientData cd;
+	    int t;
 
-static int
-SetEndOffsetFromAny(
-    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
-    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
-{
-    Tcl_WideInt offset;			/* Offset in the "end-offset" expression */
-    register const char *bytes;	/* String rep of the object */
-    int length;			/* Length of the object's string rep */
+	    /* Parse for the "end-..." or "end+..." formats */
 
-    /*
-     * If it's already the right type, we're fine.
-     */
+	    if ((bytes[3] != '-') && (bytes[3] != '+')) {
+		/* No operator where we need one */
+		return TCL_ERROR;
+	    }
+	    if (TclIsSpaceProc(bytes[4])) {
+		/* Space after + or - not permitted. */
+		return TCL_ERROR;
+	    }
 
-    if (objPtr->typePtr == &endOffsetType) {
-	return TCL_OK;
-    }
+	    /* Parse the integer offset */
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
+			bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
+		/* Not a recognized integer format */
+		return TCL_ERROR;
+	    }
 
-    /*
-     * Check for a string rep of the right form.
-     */
+	    /* Got an integer offset; pull it from where parser left it. */
+	    TclGetNumberFromObj(NULL, objPtr, &cd, &t);
 
-    bytes = TclGetStringFromObj(objPtr, &length);
-    if ((*bytes != 'e') || (strncmp(bytes, "end",
-	    (size_t)((length > 3) ? 3 : length)) != 0)) {
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "bad index \"%s\": must be end?[+-]integer?", bytes));
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+	    if (t == TCL_NUMBER_BIG) {
+		/* Truncate to the signed wide range. */
+		if (mp_isneg((mp_int *)cd)) {
+		    offset = (bytes[3] == '-') ? LLONG_MAX : LLONG_MIN;
+		} else {
+		    offset = (bytes[3] == '-') ? LLONG_MIN : LLONG_MAX;
+		}
+	    } else {
+		/* assert (t == TCL_NUMBER_INT); */
+		offset = (*(Tcl_WideInt *)cd);
+		if (bytes[3] == '-') {
+		    offset = (offset == LLONG_MIN) ? LLONG_MAX : -offset;
+		}
+	    }
 	}
-	return TCL_ERROR;
-    }
 
-    /*
-     * Convert the string rep.
-     */
+	/* Success. Store the new internal rep. */
+	ir.wideValue = offset;
+	Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
+    }
 
-    if (length <= 3) {
-	offset = 0;
-    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
-	/*
-	 * This is our limited string expression evaluator. Pass everything
-	 * after "end-" to TclParseNumber.
-	 */
+    offset = irPtr->wideValue;
 
-	if (TclIsSpaceProc(bytes[4])) {
-	    goto badIndexFormat;
-	}
-	if (TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL,
-		TCL_PARSE_INTEGER_ONLY) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-        if (objPtr->typePtr != &tclIntType) {
-                goto badIndexFormat;
-        }
-        offset = objPtr->internalRep.wideValue;
-        if (bytes[3] == '-') {
-
-            /* TODO: Review overflow concerns here! */
-            offset = -offset;
+    if ((endValue ^ offset) < 0) {
+        /* Different signs, sum cannot overflow */
+        *widePtr = endValue + offset;
+    } else if (endValue >= 0) {
+        if (endValue < LLONG_MAX - offset) {
+            *widePtr = endValue + offset;
+        } else {
+            *widePtr = LLONG_MAX;
         }
     } else {
-        /*
-         * Conversion failed. Report the error.
-         */
-
-    badIndexFormat:
-        if (interp != NULL) {
-            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "bad index \"%s\": must be end?[+-]integer?", bytes));
-            Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+        if (endValue > LLONG_MIN - offset) {
+            *widePtr = endValue + offset;
+        } else {
+            *widePtr = LLONG_MIN;
         }
-        return TCL_ERROR;
     }
-
-    /*
-     * The conversion succeeded. Free the old internal rep and set the new
-     * one.
-     */
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.wideValue = offset;
-    objPtr->typePtr = &endOffsetType;
-
     return TCL_OK;
 }