Created branch dgp-refactor-merge-syntheticdgp_refactor_mergedgp_refactor_merge_synthetic

5 files changed, 4095 insertions, 0 deletions

diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h
new file mode 100644
index 0000000..18b8cb7
--- /dev/null
+++ b/generic/tclInitScript.h
@@ -0,0 +1,111 @@
+/* 
+ * tclInitScript.h --
+ *
+ *	This file contains Unix & Windows common init script
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ * Copyright (c) 1999 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id: tclInitScript.h,v 1.15 2004/03/17 18:14:13 das Exp $
+ */
+
+/*
+ * In order to find init.tcl during initialization, the following script
+ * is invoked by Tcl_Init().  It looks in several different directories:
+ *
+ *	$tcl_library		- can specify a primary location, if set
+ *				  no other locations will be checked
+ *
+ *	$env(TCL_LIBRARY)	- highest priority so user can always override
+ *				  the search path unless the application has
+ *				  specified an exact directory above
+ *
+ *	$tclDefaultLibrary	- this value is initialized by TclPlatformInit
+ *				  from a static C variable that was set at
+ *				  compile time
+ *
+ *	$tcl_libPath		- this value is initialized by a call to
+ *				  TclGetLibraryPath called from Tcl_Init.
+ *
+ * The first directory on this path that contains a valid init.tcl script
+ * will be set as the value of tcl_library.
+ *
+ * Note that this entire search mechanism can be bypassed by defining an
+ * alternate tclInit procedure before calling Tcl_Init().
+ */
+
+static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
+  proc tclInit {} {\n\
+    global tcl_libPath tcl_library errorInfo\n\
+    global env tclDefaultLibrary\n\
+    rename tclInit {}\n\
+    set errors {}\n\
+    set dirs {}\n\
+    if {[info exists tcl_library]} {\n\
+	lappend dirs $tcl_library\n\
+    } else {\n\
+	if {[info exists env(TCL_LIBRARY)]} {\n\
+	    lappend dirs $env(TCL_LIBRARY)\n\
+	}\n\
+	catch {\n\
+	    lappend dirs $tclDefaultLibrary\n\
+	    unset tclDefaultLibrary\n\
+	}\n\
+        set dirs [concat $dirs $tcl_libPath]\n\
+    }\n\
+    foreach i $dirs {\n\
+	set tcl_library $i\n\
+	set tclfile [file join $i init.tcl]\n\
+	if {[file exists $tclfile]} {\n\
+	    if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
+		return\n\
+	    } else {\n\
+		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
+	    }\n\
+	}\n\
+    }\n\
+    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
+    append msg \"    $dirs\n\n\"\n\
+    append msg \"$errors\n\n\"\n\
+    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
+    error $msg\n\
+  }\n\
+}\n\
+tclInit";
+
+
+/*
+ * A pointer to a string that holds an initialization script that if non-NULL
+ * is evaluated in Tcl_Init() prior to the built-in initialization script
+ * above.  This variable can be modified by the procedure below.
+ */
+ 
+static char *          tclPreInitScript = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetPreInitScript --
+ *
+ *	This routine is used to change the value of the internal
+ *	variable, tclPreInitScript.
+ *
+ * Results:
+ *	Returns the current value of tclPreInitScript.
+ *
+ * Side effects:
+ *	Changes the way Tcl_Init() routine behaves.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclSetPreInitScript (string)
+    char *string;		/* Pointer to a script. */
+{
+    char *prevString = tclPreInitScript;
+    tclPreInitScript = string;
+    return(prevString);
+}
diff --git a/generic/tclMath.h b/generic/tclMath.h
new file mode 100644
index 0000000..69c0f9f
--- /dev/null
+++ b/generic/tclMath.h
@@ -0,0 +1,20 @@
+/*
+ * tclMath.h --
+ *
+ *	This file used to be necessary on the Macintosh.
+ *	It is only kept for backward compatibility purposes.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclMath.h,v 1.3 2004/03/17 18:14:14 das Exp $
+ */
+
+#ifndef _TCLMATH
+#define _TCLMATH
+
+#include <math.h>
+
+#endif /* _TCLMATH */
diff --git a/generic/tclMathOp.c b/generic/tclMathOp.c
new file mode 100644
index 0000000..9858c00
--- /dev/null
+++ b/generic/tclMathOp.c
@@ -0,0 +1,2884 @@
+/*
+ * tclMathOp.c --
+ *
+ *	This file contains normal command versions of the contents of the
+ *	tcl::mathop namespace.
+ *
+ * Copyright (c) 2006 by Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclMathOp.c,v 1.8 2006/12/12 17:21:42 dgp Exp $
+ */
+
+/*
+ * NOTE: None of the routines in this file are currently in use.
+ * The file itself may be removed, but remains in place for now in
+ * case its routine may be useful during performance testing.
+ */
+
+#if 0
+
+#include "tclInt.h"
+#include "tclCompile.h"
+#include "tommath.h"
+#include <math.h>
+#include <float.h>
+
+/*
+ * Hack to determine whether we may expect IEEE floating point. The hack is
+ * formally incorrect in that non-IEEE platforms might have the same precision
+ * and range, but VAX, IBM, and Cray do not; are there any other floating
+ * point units that we might care about?
+ */
+
+#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
+#define IEEE_FLOATING_POINT
+#endif
+
+/*
+ * The stuff below is a bit of a hack so that this file can be used in
+ * environments that include no UNIX.
+ * TODO: Does this serve any purpose anymore?
+ */
+
+#ifdef TCL_GENERIC_ONLY
+#   ifndef NO_FLOAT_H
+#	include <float.h>
+#   else /* NO_FLOAT_H */
+#	ifndef NO_VALUES_H
+#	    include <values.h>
+#	endif /* !NO_VALUES_H */
+#   endif /* !NO_FLOAT_H */
+#endif /* !TCL_GENERIC_ONLY */
+
+/*
+ * Prototypes for helper functions defined in this file:
+ */
+
+static Tcl_Obj *	CombineIntFloat(Tcl_Interp *interp, Tcl_Obj *valuePtr,
+			    int opcode, Tcl_Obj *value2Ptr);
+static Tcl_Obj *	CombineIntOnly(Tcl_Interp *interp, Tcl_Obj *valuePtr,
+			    int opcode, Tcl_Obj *value2Ptr);
+static int		CompareNumbers(Tcl_Interp *interp, Tcl_Obj *numObj1,
+			    Tcl_Obj *numObj2, int *resultPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CombineIntFloat --
+ *
+ *	Parses and combines two numbers (either entier() or double())
+ *	according to the specified operation.
+ *
+ * Results:
+ * 	Returns the resulting number object (or NULL on failure).
+ *
+ * Side effects:
+ *	None.
+ *
+ * Notes:
+ *	This code originally extracted from tclExecute.c.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+CombineIntFloat(
+    Tcl_Interp *interp,		/* Place to write error messages. */
+    Tcl_Obj *valuePtr,		/* First value to combine. */
+    int opcode,			/* Operation to use to combine the
+				 * values. Must be one of INST_ADD, INST_SUB,
+				 * INST_MULT, INST_DIV or INST_EXPON. */
+    Tcl_Obj *value2Ptr)		/* Second value to combine. */
+{
+    ClientData ptr1, ptr2;
+    int type1, type2;
+    Tcl_Obj *errPtr;
+
+    if ((TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+#ifndef ACCEPT_NAN
+	    || (type1 == TCL_NUMBER_NAN)
+#endif
+	    ) {
+	errPtr = valuePtr;
+	goto illegalOperand;
+    }
+
+#ifdef ACCEPT_NAN
+    if (type1 == TCL_NUMBER_NAN) {
+	/* NaN first argument -> result is also NaN */
+	NEXT_INST_F(1, 1, 0);
+    }
+#endif
+
+    if ((TclGetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
+#ifndef ACCEPT_NAN
+	    || (type2 == TCL_NUMBER_NAN)
+#endif
+	    ) {
+	errPtr = value2Ptr;
+	goto illegalOperand;
+    }
+
+#ifdef ACCEPT_NAN
+    if (type2 == TCL_NUMBER_NAN) {
+	/* NaN second argument -> result is also NaN */
+	return value2Ptr;
+	NEXT_INST_F(1, 2, 1);
+    }
+#endif
+
+    if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
+	/*
+	 * At least one of the values is floating-point, so perform floating
+	 * point calculations.
+	 */
+
+	double d1, d2, dResult;
+	Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
+	Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
+
+	switch (opcode) {
+	case INST_ADD:
+	    dResult = d1 + d2;
+	    break;
+	case INST_SUB:
+	    dResult = d1 - d2;
+	    break;
+	case INST_MULT:
+	    dResult = d1 * d2;
+	    break;
+	case INST_DIV:
+#ifndef IEEE_FLOATING_POINT
+	    if (d2 == 0.0) {
+		goto divideByZero;
+	    }
+#endif
+	    /*
+	     * We presume that we are running with zero-divide unmasked if
+	     * we're on an IEEE box. Otherwise, this statement might cause
+	     * demons to fly out our noses.
+	     */
+
+	    dResult = d1 / d2;
+	    break;
+	case INST_EXPON:
+	    if (d1==0.0 && d2<0.0) {
+		goto exponOfZero;
+	    }
+	    dResult = pow(d1, d2);
+	    break;
+	default:
+	    /* Unused, here to silence compiler warning. */
+	    dResult = 0;
+	}
+
+#ifndef ACCEPT_NAN
+	/*
+	 * Check now for IEEE floating-point error.
+	 */
+
+	if (TclIsNaN(dResult)) {
+	    TclExprFloatError(interp, dResult);
+	    return NULL;
+	}
+#endif
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewDoubleObj(dResult);
+	}
+	Tcl_SetDoubleObj(valuePtr, dResult);
+	return valuePtr;
+    }
+
+    if ((sizeof(long) >= 2*sizeof(int)) && (opcode == INST_MULT)
+	    && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	long l1 = *((CONST long *)ptr1);
+	long l2 = *((CONST long *)ptr2);
+	if ((l1 <= INT_MAX) && (l1 >= INT_MIN)
+		&& (l2 <= INT_MAX) && (l2 >= INT_MIN)) {
+	    long lResult = l1 * l2;
+
+	    if (Tcl_IsShared(valuePtr)) {
+		return Tcl_NewLongObj(lResult);
+	    }
+	    Tcl_SetLongObj(valuePtr, lResult);
+	    return valuePtr;
+	}
+    }
+
+    if ((sizeof(Tcl_WideInt) >= 2*sizeof(long)) && (opcode == INST_MULT)
+	    && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
+	Tcl_WideInt w1, w2, wResult;
+	Tcl_GetWideIntFromObj(NULL, valuePtr, &w1);
+	Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+
+	wResult = w1 * w2;
+
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewWideIntObj(wResult);
+	}
+	Tcl_SetWideIntObj(valuePtr, wResult);
+	return valuePtr;
+    }
+
+    /* TODO: Attempts to re-use unshared operands on stack */
+    if (opcode == INST_EXPON) {
+	long l1, l2 = 0;
+	int oddExponent = 0, negativeExponent = 0;
+	if (type2 == TCL_NUMBER_LONG) {
+	    l2 = *((CONST long *)ptr2);
+	    if (l2 == 0) {
+		/* Anything to the zero power is 1 */
+		return Tcl_NewIntObj(1);
+	    }
+	}
+	switch (type2) {
+	case TCL_NUMBER_LONG: {
+	    negativeExponent = (l2 < 0);
+	    oddExponent = (int) (l2 & 1);
+	    break;
+	}
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE: {
+	    Tcl_WideInt w2 = *((CONST Tcl_WideInt *)ptr2);
+	    negativeExponent = (w2 < 0);
+	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
+	    break;
+	}
+#endif
+	case TCL_NUMBER_BIG: {
+	    mp_int big2;
+	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+	    negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
+	    mp_mod_2d(&big2, 1, &big2);
+	    oddExponent = !mp_iszero(&big2);
+	    mp_clear(&big2);
+	    break;
+	}
+	}
+
+	if (negativeExponent) {
+	    if (type1 == TCL_NUMBER_LONG) {
+		l1 = *((CONST long *)ptr1);
+		switch (l1) {
+		case 0:
+		    /* zero to a negative power is div by zero error */
+		    goto exponOfZero;
+		case -1:
+		    if (oddExponent) {
+			return Tcl_NewIntObj(-1);
+		    } else {
+			return Tcl_NewIntObj(1);
+		    }
+		case 1:
+		    /* 1 to any power is 1 */
+		    return Tcl_NewIntObj(1);
+		}
+	    }
+	    /*
+	     * Integers with magnitude greater than 1 raise to a negative
+	     * power yield the answer zero (see TIP 123)
+	     */
+	    return Tcl_NewIntObj(0);
+	}
+
+	if (type1 == TCL_NUMBER_LONG) {
+	    l1 = *((CONST long *)ptr1);
+	    switch (l1) {
+	    case 0:
+		/* zero to a positive power is zero */
+		return Tcl_NewIntObj(0);
+	    case 1:
+		/* 1 to any power is 1 */
+		return Tcl_NewIntObj(1);
+	    case -1:
+		if (oddExponent) {
+		    return Tcl_NewIntObj(-1);
+		} else {
+		    return Tcl_NewIntObj(1);
+		}
+	    }
+	}
+	if (type2 == TCL_NUMBER_BIG) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("exponent too large", -1));
+	    return NULL;
+	}
+	/* TODO: Perform those computations that fit in native types */
+	goto overflow;
+    }
+
+    if ((opcode != INST_MULT)
+	    && (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+	Tcl_WideInt w1, w2, wResult;
+	Tcl_GetWideIntFromObj(NULL, valuePtr, &w1);
+	Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+
+	switch (opcode) {
+	case INST_ADD:
+	    wResult = w1 + w2;
+#ifndef NO_WIDE_TYPE
+	    if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+#endif
+	    {
+		/* Check for overflow */
+		if (((w1 < 0) && (w2 < 0) && (wResult >= 0))
+			|| ((w1 > 0) && (w2 > 0) && (wResult < 0))) {
+		    goto overflow;
+		}
+	    }
+	    break;
+
+	case INST_SUB:
+	    wResult = w1 - w2;
+#ifndef NO_WIDE_TYPE
+	    if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+#endif
+	    {
+		/* Must check for overflow */
+		if (((w1 < 0) && (w2 > 0) && (wResult > 0))
+			|| ((w1 >= 0) && (w2 < 0) && (wResult < 0))) {
+		    goto overflow;
+		}
+	    }
+	    break;
+
+	case INST_DIV:
+	    if (w2 == 0) {
+		goto divideByZero;
+	    }
+
+	    /* Need a bignum to represent (LLONG_MIN / -1) */
+	    if ((w1 == LLONG_MIN) && (w2 == -1)) {
+		goto overflow;
+	    }
+	    wResult = w1 / w2;
+
+	    /* Force Tcl's integer division rules */
+	    /* TODO: examine for logic simplification */
+	    if (((wResult < 0) || ((wResult == 0) &&
+		    ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+		    ((wResult * w2) != w1)) {
+		wResult -= 1;
+	    }
+	    break;
+	default:
+	    /* Unused, here to silence compiler warning. */
+	    wResult = 0;
+	}
+
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewWideIntObj(wResult);
+	}
+	Tcl_SetWideIntObj(valuePtr, wResult);
+	return valuePtr;
+    }
+
+  overflow:
+    {
+	mp_int big1, big2, bigResult, bigRemainder;
+	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+	mp_init(&bigResult);
+	switch (opcode) {
+	case INST_ADD:
+	    mp_add(&big1, &big2, &bigResult);
+	    break;
+	case INST_SUB:
+	    mp_sub(&big1, &big2, &bigResult);
+	    break;
+	case INST_MULT:
+	    mp_mul(&big1, &big2, &bigResult);
+	    break;
+	case INST_DIV:
+	    if (mp_iszero(&big2)) {
+		mp_clear(&big1);
+		mp_clear(&big2);
+		goto divideByZero;
+	    }
+	    mp_init(&bigRemainder);
+	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
+	    /* TODO: internals intrusion */
+	    if (!mp_iszero(&bigRemainder)
+		    && (bigRemainder.sign != big2.sign)) {
+		/* Convert to Tcl's integer division rules */
+		mp_sub_d(&bigResult, 1, &bigResult);
+		mp_add(&bigRemainder, &big2, &bigRemainder);
+	    }
+	    mp_clear(&bigRemainder);
+	    break;
+	case INST_EXPON:
+	    if (big2.used > 1) {
+		Tcl_SetObjResult(interp,
+			Tcl_NewStringObj("exponent too large", -1));
+		mp_clear(&big1);
+		mp_clear(&big2);
+		return NULL;
+	    }
+	    mp_expt_d(&big1, big2.dp[0], &bigResult);
+	    break;
+	}
+	mp_clear(&big1);
+	mp_clear(&big2);
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewBignumObj(&bigResult);
+	}
+	Tcl_SetBignumObj(valuePtr, &bigResult);
+	return valuePtr;
+    }
+
+    {
+	const char *description, *operator;
+
+    illegalOperand:
+	switch (opcode) {
+	case INST_ADD:	 operator = "+";  break;
+	case INST_SUB:	 operator = "-";  break;
+	case INST_MULT:	 operator = "*";  break;
+	case INST_DIV:	 operator = "/";  break;
+	case INST_EXPON: operator = "**"; break;
+	default:
+	    operator = "???";
+	}
+
+	if (TclGetNumberFromObj(NULL, errPtr, &ptr1, &type1) != TCL_OK) {
+	    int numBytes;
+	    CONST char *bytes = Tcl_GetStringFromObj(errPtr, &numBytes);
+	    if (numBytes == 0) {
+		description = "empty string";
+	    } else if (TclCheckBadOctal(NULL, bytes)) {
+		description = "invalid octal number";
+	    } else {
+		description = "non-numeric string";
+	    }
+	} else if (type1 == TCL_NUMBER_NAN) {
+	    description = "non-numeric floating-point value";
+	} else if (type1 == TCL_NUMBER_DOUBLE) {
+	    description = "floating-point value";
+	} else {
+	    /* TODO: No caller needs this.  Eliminate? */
+	    description = "(big) integer";
+	}
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't use %s as operand of \"%s\"", description, operator));
+	return NULL;
+    }
+
+  divideByZero:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+    Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
+    return NULL;
+
+  exponOfZero:
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "exponentiation of zero by negative power", -1));
+    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
+	    "exponentiation of zero by negative power", NULL);
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CombineIntOnly --
+ *
+ *	Parses and combines two numbers (must be entier()) according to the
+ *	specified operation.
+ *
+ * Results:
+ * 	Returns the resulting number object (or NULL on failure).
+ *
+ * Side effects:
+ *	None.
+ *
+ * Notes:
+ *	This code originally extracted from tclExecute.c.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+CombineIntOnly(
+    Tcl_Interp *interp,		/* Place to write error messages. */
+    Tcl_Obj *valuePtr,		/* First value to combine. */
+    int opcode,			/* Operation to use to combine the
+				 * values. Must be one of INST_BITAND,
+				 * INST_BITOR or INST_BITXOR. */
+    Tcl_Obj *value2Ptr)		/* Second value to combine. */
+{
+    ClientData ptr1, ptr2;
+    int type1, type2;
+    Tcl_Obj *errPtr;
+
+    if ((TclGetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
+	    || (type1 == TCL_NUMBER_NAN) || (type1 == TCL_NUMBER_DOUBLE)) {
+	errPtr = valuePtr;
+	goto illegalOperand;
+    }
+    if ((TclGetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
+	    || (type2 == TCL_NUMBER_NAN) || (type2 == TCL_NUMBER_DOUBLE)) {
+	errPtr = value2Ptr;
+	goto illegalOperand;
+    }
+
+    if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
+	mp_int big1, big2, bigResult;
+	mp_int *First, *Second;
+	int numPos;
+
+
+	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
+	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
+
+	/*
+	 * Count how many positive arguments we have. If only one of the
+	 * arguments is negative, store it in 'Second'.
+	 */
+
+	if (mp_cmp_d(&big1, 0) != MP_LT) {
+	    numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
+	    First  = &big1;
+	    Second = &big2;
+	} else {
+	    First  = &big2;
+	    Second = &big1;
+	    numPos = (mp_cmp_d(First, 0) != MP_LT);
+	}
+	mp_init(&bigResult);
+
+	switch (opcode) {
+	case INST_BITAND:
+	    switch (numPos) {
+	    case 2:
+		/* Both arguments positive, base case */
+		mp_and(First, Second, &bigResult);
+		break;
+	    case 1:
+		/* First is positive; Second negative
+		 * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1)) */
+		mp_neg(Second, Second);
+		mp_sub_d(Second, 1, Second);
+		mp_xor(First, Second, &bigResult);
+		mp_and(First, &bigResult, &bigResult);
+		break;
+	    case 0:
+		/* Both arguments negative
+		 * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1 */
+		mp_neg(First, First);
+		mp_sub_d(First, 1, First);
+		mp_neg(Second, Second);
+		mp_sub_d(Second, 1, Second);
+		mp_or(First, Second, &bigResult);
+		mp_neg(&bigResult, &bigResult);
+		mp_sub_d(&bigResult, 1, &bigResult);
+		break;
+	    }
+	    break;
+
+	case INST_BITOR:
+	    switch (numPos) {
+	    case 2:
+		/* Both arguments positive, base case */
+		mp_or(First, Second, &bigResult);
+		break;
+	    case 1:
+		/* First is positive; Second negative
+		 * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1 */
+		mp_neg(Second, Second);
+		mp_sub_d(Second, 1, Second);
+		mp_xor(First, Second, &bigResult);
+		mp_and(Second, &bigResult, &bigResult);
+		mp_neg(&bigResult, &bigResult);
+		mp_sub_d(&bigResult, 1, &bigResult);
+		break;
+	    case 0:
+		/* Both arguments negative
+		 * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1 */
+		mp_neg(First, First);
+		mp_sub_d(First, 1, First);
+		mp_neg(Second, Second);
+		mp_sub_d(Second, 1, Second);
+		mp_and(First, Second, &bigResult);
+		mp_neg(&bigResult, &bigResult);
+		mp_sub_d(&bigResult, 1, &bigResult);
+		break;
+	    }
+	    break;
+
+	case INST_BITXOR:
+	    switch (numPos) {
+	    case 2:
+		/* Both arguments positive, base case */
+		mp_xor(First, Second, &bigResult);
+		break;
+	    case 1:
+		/* First is positive; Second negative
+		 * P^N = ~(P^~N) = -(P^(-N-1))-1 */
+		mp_neg(Second, Second);
+		mp_sub_d(Second, 1, Second);
+		mp_xor(First, Second, &bigResult);
+		mp_neg(&bigResult, &bigResult);
+		mp_sub_d(&bigResult, 1, &bigResult);
+		break;
+	    case 0:
+		/* Both arguments negative
+		 * a ^ b = (~a ^ ~b) = (-a-1^-b-1) */
+		mp_neg(First, First);
+		mp_sub_d(First, 1, First);
+		mp_neg(Second, Second);
+		mp_sub_d(Second, 1, Second);
+		mp_xor(First, Second, &bigResult);
+		break;
+	    }
+	    break;
+	}
+
+	mp_clear(&big1);
+	mp_clear(&big2);
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewBignumObj(&bigResult);
+	}
+	Tcl_SetBignumObj(valuePtr, &bigResult);
+	return valuePtr;
+    }
+#ifndef NO_WIDE_TYPE
+    else if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
+	Tcl_WideInt wResult, w1, w2;
+	Tcl_GetWideIntFromObj(NULL, valuePtr, &w1);
+	Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+
+	switch (opcode) {
+	case INST_BITAND:
+	    wResult = w1 & w2;
+	    break;
+	case INST_BITOR:
+	    wResult = w1 | w2;
+	    break;
+	case INST_BITXOR:
+	    wResult = w1 ^ w2;
+	    break;
+	default:
+	    /* Unused, here to silence compiler warning. */
+	    wResult = 0;
+	}
+
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewWideIntObj(wResult);
+	}
+	Tcl_SetWideIntObj(valuePtr, wResult);
+	return valuePtr;
+    }
+#endif
+    else {
+	long lResult, l1 = *((const long *)ptr1);
+	long l2 = *((const long *)ptr2);
+
+	switch (opcode) {
+	case INST_BITAND:
+	    lResult = l1 & l2;
+	    break;
+	case INST_BITOR:
+	    lResult = l1 | l2;
+	    break;
+	case INST_BITXOR:
+	    lResult = l1 ^ l2;
+	    break;
+	default:
+	    /* Unused, here to silence compiler warning. */
+	    lResult = 0;
+	}
+
+	if (Tcl_IsShared(valuePtr)) {
+	    return Tcl_NewLongObj(lResult);
+	}
+	TclSetLongObj(valuePtr, lResult);
+	return valuePtr;
+    }
+
+    {
+	const char *description, *operator;
+
+    illegalOperand:
+	switch (opcode) {
+	case INST_BITAND: operator = "&";  break;
+	case INST_BITOR:  operator = "|";  break;
+	case INST_BITXOR: operator = "^";  break;
+	default:
+	    operator = "???";
+	}
+
+	if (TclGetNumberFromObj(NULL, errPtr, &ptr1, &type1) != TCL_OK) {
+	    int numBytes;
+	    CONST char *bytes = Tcl_GetStringFromObj(errPtr, &numBytes);
+	    if (numBytes == 0) {
+		description = "empty string";
+	    } else if (TclCheckBadOctal(NULL, bytes)) {
+		description = "invalid octal number";
+	    } else {
+		description = "non-numeric string";
+	    }
+	} else if (type1 == TCL_NUMBER_NAN) {
+	    description = "non-numeric floating-point value";
+	} else if (type1 == TCL_NUMBER_DOUBLE) {
+	    description = "floating-point value";
+	} else {
+	    /* TODO: No caller needs this.  Eliminate? */
+	    description = "(big) integer";
+	}
+
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't use %s as operand of \"%s\"", description, operator));
+	return NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompareNumbers --
+ *
+ *	Parses and compares two numbers (may be either entier() or double()).
+ *
+ * Results:
+ * 	TCL_OK if the numbers parse correctly, TCL_ERROR if one is not numeric
+ * 	at all, and TCL_BREAK if one or the other is "NaN". The resultPtr
+ * 	argument is used to update a variable with how the numbers relate to
+ * 	each other in the TCL_OK case.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Notes:
+ *	This code originally extracted from tclExecute.c.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompareNumbers(
+    Tcl_Interp *interp,		/* Where to write error messages if any. */
+    Tcl_Obj *numObj1,		/* First number to compare. */
+    Tcl_Obj *numObj2,		/* Second number to compare. */
+    int *resultPtr)		/* Pointer to a variable to write the outcome
+				 * of the comparison into. Must not be
+				 * NULL. */
+{
+    ClientData ptr1, ptr2;
+    int type1, type2;
+    double d1, d2, tmp;
+    long l1, l2;
+    mp_int big1, big2;
+#ifndef NO_WIDE_TYPE
+    Tcl_WideInt w1, w2;
+#endif
+
+    if (TclGetNumberFromObj(interp, numObj1, &ptr1, &type1) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (TclGetNumberFromObj(interp, numObj2, &ptr2, &type2) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Selected special cases. NaNs are not equal to *everything*, otherwise
+     * objects are equal to themselves.
+     */
+
+    if (type1 == TCL_NUMBER_NAN) {
+	/* NaN first arg: NaN != to everything, other compares are false */
+	return TCL_BREAK;
+    }
+    if (numObj1 == numObj2) {
+	*resultPtr = MP_EQ;
+	return TCL_OK;
+    }
+    if (type2 == TCL_NUMBER_NAN) {
+	/* NaN 2nd arg: NaN != to everything, other compares are false */
+	return TCL_BREAK;
+    }
+
+    /*
+     * Big switch to pick apart the type rules and choose how to compare the
+     * two numbers. Also handles a few special cases along the way.
+     */
+
+    switch (type1) {
+    case TCL_NUMBER_LONG:
+	l1 = *((CONST long *)ptr1);
+	switch (type2) {
+	case TCL_NUMBER_LONG:
+	    l2 = *((CONST long *)ptr2);
+	    goto longCompare;
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE:
+	    w2 = *((CONST Tcl_WideInt *)ptr2);
+	    w1 = (Tcl_WideInt)l1;
+	    goto wideCompare;
+#endif
+	case TCL_NUMBER_DOUBLE:
+	    d2 = *((CONST double *)ptr2);
+	    d1 = (double) l1;
+
+	    /*
+	     * If the double has a fractional part, or if the long can be
+	     * converted to double without loss of precision, then compare as
+	     * doubles.
+	     */
+
+	    if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
+		    || (l1 == (long) d1) || (modf(d2, &tmp) != 0.0)) {
+		goto doubleCompare;
+	    }
+
+	    /*
+	     * Otherwise, to make comparision based on full precision, need to
+	     * convert the double to a suitably sized integer.
+	     *
+	     * Need this to get comparsions like
+	     *	    expr 20000000000000003 < 20000000000000004.0
+	     * right. Converting the first argument to double will yield two
+	     * double values that are equivalent within double precision.
+	     * Converting the double to an integer gets done exactly, then
+	     * integer comparison can tell the difference.
+	     */
+
+	    if (d2 < (double)LONG_MIN) {
+		*resultPtr = MP_GT;
+		return TCL_OK;
+	    }
+	    if (d2 > (double)LONG_MAX) {
+		*resultPtr = MP_LT;
+		return TCL_OK;
+	    }
+	    l2 = (long) d2;
+	    goto longCompare;
+	case TCL_NUMBER_BIG:
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
+	    if (mp_cmp_d(&big2, 0) == MP_LT) {
+		*resultPtr = MP_GT;
+	    } else {
+		*resultPtr = MP_LT;
+	    }
+	    mp_clear(&big2);
+	}
+	return TCL_OK;
+
+#ifndef NO_WIDE_TYPE
+    case TCL_NUMBER_WIDE:
+	w1 = *((CONST Tcl_WideInt *)ptr1);
+	switch (type2) {
+	case TCL_NUMBER_WIDE:
+	    w2 = *((CONST Tcl_WideInt *)ptr2);
+	    goto wideCompare;
+	case TCL_NUMBER_LONG:
+	    l2 = *((CONST long *)ptr2);
+	    w2 = (Tcl_WideInt)l2;
+	    goto wideCompare;
+	case TCL_NUMBER_DOUBLE:
+	    d2 = *((CONST double *)ptr2);
+	    d1 = (double) w1;
+	    if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt))
+		    || (w1 == (Tcl_WideInt) d1) || (modf(d2, &tmp) != 0.0)) {
+		goto doubleCompare;
+	    }
+	    if (d2 < (double)LLONG_MIN) {
+		*resultPtr = MP_GT;
+		return TCL_OK;
+	    }
+	    if (d2 > (double)LLONG_MAX) {
+		*resultPtr = MP_LT;
+		return TCL_OK;
+	    }
+	    w2 = (Tcl_WideInt) d2;
+	    goto wideCompare;
+	case TCL_NUMBER_BIG:
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
+	    if (mp_cmp_d(&big2, 0) == MP_LT) {
+		*resultPtr = MP_GT;
+	    } else {
+		*resultPtr = MP_LT;
+	    }
+	    mp_clear(&big2);
+	}
+	return TCL_OK;
+#endif
+
+    case TCL_NUMBER_DOUBLE:
+	d1 = *((CONST double *)ptr1);
+	switch (type2) {
+	case TCL_NUMBER_DOUBLE:
+	    d2 = *((CONST double *)ptr2);
+	    goto doubleCompare;
+	case TCL_NUMBER_LONG:
+	    l2 = *((CONST long *)ptr2);
+	    d2 = (double) l2;
+
+	    if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
+		    || (l2 == (long) d2) || (modf(d1, &tmp) != 0.0)) {
+		goto doubleCompare;
+	    }
+	    if (d1 < (double)LONG_MIN) {
+		*resultPtr = MP_LT;
+		return TCL_OK;
+	    }
+	    if (d1 > (double)LONG_MAX) {
+		*resultPtr = MP_GT;
+		return TCL_OK;
+	    }
+	    l1 = (long) d1;
+	    goto longCompare;
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE:
+	    w2 = *((CONST Tcl_WideInt *)ptr2);
+	    d2 = (double) w2;
+	    if ((DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt))
+		    || (w2 == (Tcl_WideInt) d2) || (modf(d1, &tmp) != 0.0)) {
+		goto doubleCompare;
+	    }
+	    if (d1 < (double)LLONG_MIN) {
+		*resultPtr = MP_LT;
+		return TCL_OK;
+	    }
+	    if (d1 > (double)LLONG_MAX) {
+		*resultPtr = MP_GT;
+		return TCL_OK;
+	    }
+	    w1 = (Tcl_WideInt) d1;
+	    goto wideCompare;
+#endif
+	case TCL_NUMBER_BIG:
+	    if (TclIsInfinite(d1)) {
+		*resultPtr = (d1 > 0.0) ? MP_GT : MP_LT;
+		return TCL_OK;
+	    }
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
+	    if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
+		if (mp_cmp_d(&big2, 0) == MP_LT) {
+		    *resultPtr = MP_GT;
+		} else {
+		    *resultPtr = MP_LT;
+		}
+		mp_clear(&big2);
+		return TCL_OK;
+	    }
+	    if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
+		    && (modf(d1, &tmp) != 0.0)) {
+		d2 = TclBignumToDouble(&big2);
+		mp_clear(&big2);
+		goto doubleCompare;
+	    }
+	    Tcl_InitBignumFromDouble(NULL, d1, &big1);
+	    goto bigCompare;
+	}
+	return TCL_OK;
+
+    case TCL_NUMBER_BIG:
+	Tcl_TakeBignumFromObj(NULL, numObj1, &big1);
+	switch (type2) {
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE:
+#endif
+	case TCL_NUMBER_LONG:
+	    *resultPtr = mp_cmp_d(&big1, 0);
+	    mp_clear(&big1);
+	    return TCL_OK;
+	case TCL_NUMBER_DOUBLE:
+	    d2 = *((CONST double *)ptr2);
+	    if (TclIsInfinite(d2)) {
+		*resultPtr = (d2 > 0.0) ? MP_LT : MP_GT;
+		mp_clear(&big1);
+		return TCL_OK;
+	    }
+	    if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
+		*resultPtr = mp_cmp_d(&big1, 0);
+		mp_clear(&big1);
+		return TCL_OK;
+	    }
+	    if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long))
+		    && (modf(d2, &tmp) != 0.0)) {
+		d1 = TclBignumToDouble(&big1);
+		mp_clear(&big1);
+		goto doubleCompare;
+	    }
+	    Tcl_InitBignumFromDouble(NULL, d2, &big2);
+	    goto bigCompare;
+	case TCL_NUMBER_BIG:
+	    Tcl_TakeBignumFromObj(NULL, numObj2, &big2);
+	    goto bigCompare;
+	}
+    }
+
+    /*
+     * Should really be impossible to get here
+     */
+
+    return TCL_OK;
+
+    /*
+     * The real core comparison rules.
+     */
+
+  longCompare:
+    *resultPtr = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+    return TCL_OK;
+#ifndef NO_WIDE_TYPE
+  wideCompare:
+    *resultPtr = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
+    return TCL_OK;
+#endif
+  doubleCompare:
+    *resultPtr = (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
+    return TCL_OK;
+  bigCompare:
+    *resultPtr = mp_cmp(&big1, &big2);
+    mp_clear(&big1);
+    mp_clear(&big2);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvertOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::~" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvertOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    ClientData val;
+    int type;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "number");
+	return TCL_ERROR;
+    }
+    if (TclGetNumberFromObj(NULL, objv[1], &val, &type) != TCL_OK) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"can't use non-numeric string as operand of \"~\"", -1));
+	return TCL_ERROR;
+    }
+    switch (type) {
+    case TCL_NUMBER_NAN:
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't use %s as operand of \"~\"",
+		"non-numeric floating-point value"));
+	return TCL_ERROR;
+    case TCL_NUMBER_DOUBLE:
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't use %s as operand of \"~\"", "floating-point value"));
+	return TCL_ERROR;
+    case TCL_NUMBER_LONG: {
+	long l = *((const long *) val);
+
+	Tcl_SetLongObj(Tcl_GetObjResult(interp), ~l);
+	return TCL_OK;
+    }
+#ifndef NO_WIDE_TYPE
+    case TCL_NUMBER_WIDE: {
+	Tcl_WideInt w = *((const Tcl_WideInt *) val);
+
+	Tcl_SetWideIntObj(Tcl_GetObjResult(interp), ~w);
+	return TCL_OK;
+    }
+#endif
+    default: {
+	mp_int big;
+
+	Tcl_TakeBignumFromObj(NULL, objv[1], &big);
+	/* ~a = - a - 1 */
+	mp_neg(&big, &big);
+	mp_sub_d(&big, 1, &big);
+	if (Tcl_IsShared(objv[1])) {
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
+	} else {
+	    Tcl_SetBignumObj(objv[1], &big);
+	    Tcl_SetObjResult(interp, objv[1]);
+	}
+	return TCL_OK;
+    }
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNotOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::!" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNotOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int b;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetBooleanFromObj(NULL, objv[1], &b) != TCL_OK) {
+	int type;
+	ClientData val;
+	if (TclGetNumberFromObj(NULL, objv[1], &val, &type) == TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric floating-point value as operand of \"!\"", -1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"!\"", -1));
+	}
+	return TCL_ERROR;
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), !b);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAddOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::+" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAddOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	return TCL_OK;
+    } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"+\"",-1));
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1], INST_ADD, objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *sumPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(sumPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntFloat(interp, sumPtr, INST_ADD,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(sumPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(sumPtr);
+	    sumPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, sumPtr);
+	Tcl_DecrRefCount(sumPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMulOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::*" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMulOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+	return TCL_OK;
+    } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"*\"",-1));
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1],INST_MULT,objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *prodPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(prodPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntFloat(interp, prodPtr, INST_MULT,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(prodPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(prodPtr);
+	    prodPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, prodPtr);
+	Tcl_DecrRefCount(prodPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAndOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::&" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAndOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), -1);
+	return TCL_OK;
+    } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"&\"",-1));
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntOnly(interp, objv[1],INST_BITAND,objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *accumPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(accumPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntOnly(interp, accumPtr, INST_BITAND,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(accumPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(accumPtr);
+	    accumPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, accumPtr);
+	Tcl_DecrRefCount(accumPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclOrOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::|" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOrOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	return TCL_OK;
+    } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"|\"",-1));
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntOnly(interp, objv[1],INST_BITOR,objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *accumPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(accumPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntOnly(interp, accumPtr, INST_BITOR,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(accumPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(accumPtr);
+	    accumPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, accumPtr);
+	Tcl_DecrRefCount(accumPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclXorOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::^" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclXorOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	return TCL_OK;
+    } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"^\"",-1));
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntOnly(interp, objv[1],INST_BITXOR,objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *accumPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(accumPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntOnly(interp, accumPtr, INST_BITXOR,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(accumPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(accumPtr);
+	    accumPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, accumPtr);
+	Tcl_DecrRefCount(accumPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPowOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::**" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPowOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+	return TCL_OK;
+    } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"**\"",-1));
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, objv[1]);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1],INST_EXPON,objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *powPtr = objv[objc-1];
+	int i;
+
+	Tcl_IncrRefCount(powPtr);
+	for (i=objc-2 ; i>=1 ; i--) {
+	    Tcl_Obj *resPtr = CombineIntFloat(interp, objv[i], INST_EXPON,
+		    powPtr);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(powPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(powPtr);
+	    powPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, powPtr);
+	Tcl_DecrRefCount(powPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMinusOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::-" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMinusOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value ?value ...?");
+	return TCL_ERROR;
+    } else if (objc == 2) {
+	/*
+	 * Only a single argument, so we compute the negation.
+	 */
+
+	Tcl_Obj *zeroPtr = Tcl_NewIntObj(0);
+	Tcl_Obj *resPtr;
+
+	Tcl_IncrRefCount(zeroPtr);
+	resPtr = CombineIntFloat(interp, zeroPtr, INST_SUB, objv[1]);
+	if (resPtr == NULL) {
+	    TclDecrRefCount(zeroPtr);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	TclDecrRefCount(zeroPtr);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1], INST_SUB, objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *diffPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(diffPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntFloat(interp, diffPtr, INST_SUB,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(diffPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(diffPtr);
+	    diffPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, diffPtr);
+	Tcl_DecrRefCount(diffPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDivOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::/" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclDivOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value ?value ...?");
+	return TCL_ERROR;
+    } else if (objc == 2) {
+	/*
+	 * Only a single argument, so we compute the reciprocal.
+	 */
+
+	Tcl_Obj *onePtr = Tcl_NewDoubleObj(1.0);
+	Tcl_Obj *resPtr;
+
+	Tcl_IncrRefCount(onePtr);
+	resPtr = CombineIntFloat(interp, onePtr, INST_DIV, objv[1]);
+	if (resPtr == NULL) {
+	    TclDecrRefCount(onePtr);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	TclDecrRefCount(onePtr);
+	return TCL_OK;
+    } else if (objc == 3) {
+	/*
+	 * This is a special case of the version with the loop that allows for
+	 * better memory management of objects in some cases.
+	 */
+
+	Tcl_Obj *resPtr = CombineIntFloat(interp, objv[1], INST_DIV, objv[2]);
+	if (resPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, resPtr);
+	return TCL_OK;
+    } else {
+	Tcl_Obj *numeratorPtr = objv[1];
+	int i;
+
+	Tcl_IncrRefCount(numeratorPtr);
+	for (i=2 ; i<objc ; i++) {
+	    Tcl_Obj *resPtr = CombineIntFloat(interp, numeratorPtr, INST_DIV,
+		    objv[i]);
+
+	    if (resPtr == NULL) {
+		TclDecrRefCount(numeratorPtr);
+		return TCL_ERROR;
+	    }
+	    Tcl_IncrRefCount(resPtr);
+	    TclDecrRefCount(numeratorPtr);
+	    numeratorPtr = resPtr;
+	}
+	Tcl_SetObjResult(interp, numeratorPtr);
+	Tcl_DecrRefCount(numeratorPtr);	/* Public form since we know we won't
+					 * be freeing this object now. */
+	return TCL_OK;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLshiftOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::<<" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLshiftOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    ClientData ptr1, ptr2;
+    int invalid, shift, type1, type2, idx;
+    const char *description;
+    long l1;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value value");
+	return TCL_ERROR;
+    }
+
+    if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK)
+	    || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
+	idx = 1;
+	goto illegalOperand;
+    }
+    if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK)
+	    || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
+	idx = 2;
+	goto illegalOperand;
+    }
+
+    /* reject negative shift argument */
+    switch (type2) {
+    case TCL_NUMBER_LONG:
+	invalid = (*((const long *)ptr2) < (long)0);
+	break;
+#ifndef NO_WIDE_TYPE
+    case TCL_NUMBER_WIDE:
+	invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
+	break;
+#endif
+    case TCL_NUMBER_BIG:
+	/* TODO: const correctness ? */
+	invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT);
+	break;
+    default:
+	/* Unused, here to silence compiler warning */
+	invalid = 0;
+    }
+    if (invalid) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("negative shift argument", -1));
+	return TCL_ERROR;
+    }
+
+    /* Zero shifted any number of bits is still zero */
+    if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	return TCL_OK;
+    }
+
+    /* Large left shifts create integer overflow */
+    if ((type2 != TCL_NUMBER_LONG)
+	    || (*((const long *)ptr2) > (long) INT_MAX)) {
+	/*
+	 * Technically, we could hold the value (1 << (INT_MAX+1)) in an
+	 * mp_int, but since we're using mp_mul_2d() to do the work, and it
+	 * takes only an int argument, that's a good place to draw the line.
+	 */
+
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"integer value too large to represent", -1));
+	return TCL_ERROR;
+    }
+    shift = (int)(*((const long *)ptr2));
+
+    /* Handle shifts within the native long range */
+    if ((type1 == TCL_NUMBER_LONG) && ((size_t)shift < CHAR_BIT*sizeof(long))
+	    && (l1 = *((CONST long *)ptr1)) &&
+	    !(((l1>0) ? l1 : ~l1) & -(1L<<(CHAR_BIT*sizeof(long)-1-shift)))) {
+	Tcl_SetObjResult(interp, Tcl_NewLongObj(l1<<shift));
+	return TCL_OK;
+    }
+
+    /* Handle shifts within the native wide range */
+    if ((type1 != TCL_NUMBER_BIG)
+	    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
+	Tcl_WideInt w;
+
+	Tcl_GetWideIntFromObj(NULL, objv[1], &w);
+	if (!(((w>0) ? w : ~w) & -(((Tcl_WideInt)1)
+		<< (CHAR_BIT*sizeof(Tcl_WideInt)-1-shift)))) {
+	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w<<shift));
+	    return TCL_OK;
+	}
+    }
+
+    {
+	mp_int big, bigResult;
+
+	Tcl_TakeBignumFromObj(NULL, objv[1], &big);
+
+	mp_init(&bigResult);
+	mp_mul_2d(&big, shift, &bigResult);
+	mp_clear(&big);
+
+	if (!Tcl_IsShared(objv[1])) {
+	    Tcl_SetBignumObj(objv[1], &bigResult);
+	    Tcl_SetObjResult(interp, objv[1]);
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult));
+	}
+    }
+    return TCL_OK;
+
+  illegalOperand:
+    if (TclGetNumberFromObj(NULL, objv[idx], &ptr1, &type1) != TCL_OK) {
+	int numBytes;
+	const char *bytes = Tcl_GetStringFromObj(objv[idx], &numBytes);
+	if (numBytes == 0) {
+	    description = "empty string";
+	} else if (TclCheckBadOctal(NULL, bytes)) {
+	    description = "invalid octal number";
+	} else {
+	    description = "non-numeric string";
+	}
+    } else if (type1 == TCL_NUMBER_NAN) {
+	description = "non-numeric floating-point value";
+    } else {
+	description = "floating-point value";
+    }
+
+    Tcl_SetObjResult(interp,
+	    Tcl_ObjPrintf("can't use %s as operand of \"<<\"", description));
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRshiftOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::>>" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRshiftOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    ClientData ptr1, ptr2;
+    int invalid, shift, type1, type2, idx;
+    const char *description;
+    long l1;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value value");
+	return TCL_ERROR;
+    }
+
+    if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK)
+	    || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
+	idx = 1;
+	goto illegalOperand;
+    }
+    if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK)
+	    || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
+	idx = 2;
+	goto illegalOperand;
+    }
+
+    /* reject negative shift argument */
+    switch (type2) {
+    case TCL_NUMBER_LONG:
+	invalid = (*((const long *)ptr2) < (long)0);
+	break;
+#ifndef NO_WIDE_TYPE
+    case TCL_NUMBER_WIDE:
+	invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
+	break;
+#endif
+    case TCL_NUMBER_BIG:
+	/* TODO: const correctness ? */
+	invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT);
+	break;
+    default:
+	/* Unused, here to silence compiler warning */
+	invalid = 0;
+    }
+    if (invalid) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("negative shift argument", -1));
+	return TCL_ERROR;
+    }
+
+    /* Zero shifted any number of bits is still zero */
+    if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	return TCL_OK;
+    }
+
+    /* Quickly force large right shifts to 0 or -1 */
+    if ((type2 != TCL_NUMBER_LONG)
+	    || (*((const long *)ptr2) > INT_MAX)) {
+	/*
+	 * Again, technically, the value to be shifted could be an mp_int so
+	 * huge that a right shift by (INT_MAX+1) bits could not take us to
+	 * the result of 0 or -1, but since we're using mp_div_2d to do the
+	 * work, and it takes only an int argument, we draw the line there.
+	 */
+
+	int zero;
+
+	switch (type1) {
+	case TCL_NUMBER_LONG:
+	    zero = (*((const long *)ptr1) > (long)0);
+	    break;
+#ifndef NO_WIDE_TYPE
+	case TCL_NUMBER_WIDE:
+	    zero = (*((const Tcl_WideInt *)ptr1) > (Tcl_WideInt)0);
+	    break;
+#endif
+	case TCL_NUMBER_BIG:
+	    /* TODO: const correctness ? */
+	    zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT);
+	    break;
+	default:
+	    /* Unused, here to silence compiler warning. */
+	    zero = 0;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(zero ? 0 : -1));
+	return TCL_OK;
+    }
+
+    shift = (int)(*((const long *)ptr2));
+    /* Handle shifts within the native long range */
+    if (type1 == TCL_NUMBER_LONG) {
+	l1 = *((const long *)ptr1);
+	if ((size_t)shift >= CHAR_BIT*sizeof(long)) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(l1 >= (long)0 ? 0 : -1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(l1 >> shift));
+	}
+	return TCL_OK;
+    }
+
+#ifndef NO_WIDE_TYPE
+    /* Handle shifts within the native wide range */
+    if (type1 == TCL_NUMBER_WIDE) {
+	Tcl_WideInt w = *((const Tcl_WideInt *)ptr1);
+	if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewIntObj(w >= (Tcl_WideInt)0 ? 0 : -1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(w >> shift));
+	}
+	return TCL_OK;
+    }
+#endif
+
+    {
+	mp_int big, bigResult, bigRemainder;
+
+	Tcl_TakeBignumFromObj(NULL, objv[1], &big);
+
+	mp_init(&bigResult);
+	mp_init(&bigRemainder);
+	mp_div_2d(&big, shift, &bigResult, &bigRemainder);
+	if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
+	    /* Convert to Tcl's integer division rules */
+	    mp_sub_d(&bigResult, 1, &bigResult);
+	}
+	mp_clear(&bigRemainder);
+	mp_clear(&big);
+
+	if (!Tcl_IsShared(objv[1])) {
+	    Tcl_SetBignumObj(objv[1], &bigResult);
+	    Tcl_SetObjResult(interp, objv[1]);
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult));
+	}
+    }
+    return TCL_OK;
+
+  illegalOperand:
+    if (TclGetNumberFromObj(NULL, objv[idx], &ptr1, &type1) != TCL_OK) {
+	int numBytes;
+	const char *bytes = Tcl_GetStringFromObj(objv[idx], &numBytes);
+	if (numBytes == 0) {
+	    description = "empty string";
+	} else if (TclCheckBadOctal(NULL, bytes)) {
+	    description = "invalid octal number";
+	} else {
+	    description = "non-numeric string";
+	}
+    } else if (type1 == TCL_NUMBER_NAN) {
+	description = "non-numeric floating-point value";
+    } else {
+	description = "floating-point value";
+    }
+
+    Tcl_SetObjResult(interp,
+	    Tcl_ObjPrintf("can't use %s as operand of \">>\"", description));
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclModOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::%" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclModOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *argObj;
+    ClientData ptr1, ptr2;
+    int type1, type2;
+    long l1, l2 = 0;
+    const char *description;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value value");
+	return TCL_ERROR;
+    }
+
+    if ((TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK)
+	    || (type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
+	argObj = objv[1];
+	goto badArg;
+    }
+    if ((TclGetNumberFromObj(NULL, objv[2], &ptr2, &type2) != TCL_OK)
+	    || (type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
+	argObj = objv[2];
+	goto badArg;
+    }
+
+    if (type2 == TCL_NUMBER_LONG) {
+	l2 = *((CONST long *)ptr2);
+	if (l2 == 0) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
+		    NULL);
+	    return TCL_ERROR;
+	}
+	if ((l2 == 1) || (l2 == -1)) {
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	    return TCL_OK;
+	}
+    }
+    if (type1 == TCL_NUMBER_LONG) {
+	l1 = *((CONST long *)ptr1);
+	if (l1 == 0) {
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	    return TCL_OK;
+	}
+	if (type2 == TCL_NUMBER_LONG) {
+	    /* Both operands are long; do native calculation */
+	    long lRemainder, lQuotient = l1 / l2;
+
+	    /* Force Tcl's integer division rules */
+	    /* TODO: examine for logic simplification */
+	    if (((lQuotient < 0) || ((lQuotient == 0) &&
+		    ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
+		    ((lQuotient * l2) != l1)) {
+		lQuotient -= 1;
+	    }
+	    lRemainder = l1 - l2*lQuotient;
+	    Tcl_SetLongObj(Tcl_GetObjResult(interp), lRemainder);
+	    return TCL_OK;
+	}
+	/*
+	 * First operand fits in long; second does not, so the second has
+	 * greater magnitude than first. No need to divide to determine the
+	 * remainder.
+	 */
+#ifndef NO_WIDE_TYPE
+	if (type2 == TCL_NUMBER_WIDE) {
+	    Tcl_WideInt w2 = *((CONST Tcl_WideInt *)ptr2);
+
+	    if ((l1 > 0) ^ (w2 > (Tcl_WideInt)0)) {
+		/* Arguments are opposite sign; remainder is sum */
+		Tcl_SetObjResult(interp,
+			Tcl_NewWideIntObj(w2+(Tcl_WideInt)l1));
+		return TCL_OK;
+	    }
+	    /* Arguments are same sign; remainder is first operand */
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
+	}
+#endif
+	{
+	    mp_int big2;
+	    Tcl_TakeBignumFromObj(NULL, objv[2], &big2);
+
+	    /* TODO: internals intrusion */
+	    if ((l1 > 0) ^ (big2.sign == MP_ZPOS)) {
+		/* Arguments are opposite sign; remainder is sum */
+		mp_int big1;
+		TclBNInitBignumFromLong(&big1, l1);
+		mp_add(&big2, &big1, &big2);
+		Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big2));
+	    } else {
+		/* Arguments are same sign; remainder is first operand */
+		Tcl_SetObjResult(interp, objv[1]);
+		/* TODO: free big2? */
+	    }
+	}
+	return TCL_OK;
+    }
+#ifndef NO_WIDE_TYPE
+    if (type1 == TCL_NUMBER_WIDE) {
+	Tcl_WideInt w1 = *((CONST Tcl_WideInt *)ptr1);
+	if (type2 != TCL_NUMBER_BIG) {
+	    Tcl_WideInt w2, wQuotient, wRemainder;
+
+	    Tcl_GetWideIntFromObj(NULL, objv[2], &w2);
+	    wQuotient = w1 / w2;
+
+	    /* Force Tcl's integer division rules */
+	    /* TODO: examine for logic simplification */
+	    if (((wQuotient < ((Tcl_WideInt) 0))
+		    || ((wQuotient == ((Tcl_WideInt) 0)) && (
+			(w1 < ((Tcl_WideInt) 0) && w2 > ((Tcl_WideInt) 0))
+		    || (w1 > ((Tcl_WideInt) 0) && w2 < ((Tcl_WideInt) 0)))
+		    )) && ((wQuotient * w2) != w1)) {
+		wQuotient -= (Tcl_WideInt) 1;
+	    }
+	    wRemainder = w1 - w2*wQuotient;
+	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wRemainder));
+	} else {
+	    mp_int big2;
+	    Tcl_TakeBignumFromObj(NULL, objv[2], &big2);
+
+	    /* TODO: internals intrusion */
+	    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
+		/* Arguments are opposite sign; remainder is sum */
+		mp_int big1;
+		TclBNInitBignumFromWideInt(&big1, w1);
+		mp_add(&big2, &big1, &big2);
+		Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big2));
+	    } else {
+		/* Arguments are same sign; remainder is first operand */
+		Tcl_SetObjResult(interp, objv[1]);
+	    }
+	}
+	return TCL_OK;
+    }
+#endif
+    {
+	mp_int big1, big2, bigResult, bigRemainder;
+
+	Tcl_GetBignumFromObj(NULL, objv[1], &big1);
+	Tcl_GetBignumFromObj(NULL, objv[2], &big2);
+	mp_init(&bigResult);
+	mp_init(&bigRemainder);
+	mp_div(&big1, &big2, &bigResult, &bigRemainder);
+	if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
+	    /* Convert to Tcl's integer division rules */
+	    mp_sub_d(&bigResult, 1, &bigResult);
+	    mp_add(&bigRemainder, &big2, &bigRemainder);
+	}
+	mp_copy(&bigRemainder, &bigResult);
+	mp_clear(&bigRemainder);
+	mp_clear(&big1);
+	mp_clear(&big2);
+	if (Tcl_IsShared(objv[1])) {
+	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&bigResult));
+	} else {
+	    Tcl_SetBignumObj(objv[1], &bigResult);
+	    Tcl_SetObjResult(interp, objv[1]);
+	}
+	return TCL_OK;
+    }
+
+  badArg:
+    if (TclGetNumberFromObj(NULL, argObj, &ptr1, &type1) != TCL_OK) {
+	int numBytes;
+	CONST char *bytes = Tcl_GetStringFromObj(argObj, &numBytes);
+	if (numBytes == 0) {
+	    description = "empty string";
+	} else if (TclCheckBadOctal(NULL, bytes)) {
+	    description = "invalid octal number";
+	} else {
+	    description = "non-numeric string";
+	}
+    } else if (type1 == TCL_NUMBER_NAN) {
+	description = "non-numeric floating-point value";
+    } else {
+	description = "floating-point value";
+    }
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "can't use %s as operand of \"%%\"", description));
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNeqOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::!=" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNeqOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1, cmp, len1, len2;
+    const char *str1, *str2;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value value");
+	return TCL_ERROR;
+    }
+
+    switch (CompareNumbers(NULL, objv[1], objv[2], &cmp)) {
+    case TCL_ERROR:
+	/*
+	 * Got a string
+	 */
+	str1 = Tcl_GetStringFromObj(objv[1], &len1);
+	str2 = Tcl_GetStringFromObj(objv[2], &len2);
+	if (len1 == len2 && !strcmp(str1, str2)) {
+	    result = 0;
+	}
+    case TCL_BREAK:			/* Deliberate fallthrough */
+	break;
+    case TCL_OK:
+	/*
+	 * Got proper numbers
+	 */
+	if (cmp == MP_EQ) {
+	    result = 0;
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStrneqOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::ne" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStrneqOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char *s1, *s2;
+    int s1len, s2len;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value value");
+	return TCL_ERROR;
+    }
+
+    s1 = Tcl_GetStringFromObj(objv[1], &s1len);
+    s2 = Tcl_GetStringFromObj(objv[2], &s2len);
+    if (s1len == s2len && !strcmp(s1, s2)) {
+	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
+    } else {
+	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1);
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::in" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char *s1, *s2;
+    int s1len, s2len, i, len;
+    Tcl_Obj **listObj;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value list");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_ListObjGetElements(interp, objv[2], &len, &listObj) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    s1 = Tcl_GetStringFromObj(objv[1], &s1len);
+    for (i=0 ; i<len ; i++) {
+	s2 = Tcl_GetStringFromObj(listObj[i], &s2len);
+	if (s1len == s2len && !strcmp(s1, s2)) {
+	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1);
+	    return TCL_OK;
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNiOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::ni" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclNiOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const char *s1, *s2;
+    int s1len, s2len, i, len;
+    Tcl_Obj **listObj;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value list");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_ListObjGetElements(interp, objv[2], &len, &listObj) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    s1 = Tcl_GetStringFromObj(objv[1], &s1len);
+    for (i=0 ; i<len ; i++) {
+	s2 = Tcl_GetStringFromObj(listObj[i], &s2len);
+	if (s1len == s2len && !strcmp(s1, s2)) {
+	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
+	    return TCL_OK;
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLessOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::<" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLessOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1;
+
+    if (objc > 2) {
+	int i, cmp, len1, len2;
+	const char *str1, *str2;
+
+	for (i=1 ; i<objc-1 ; i++) {
+	    switch (CompareNumbers(NULL, objv[i], objv[i+1], &cmp)) {
+	    case TCL_ERROR:
+		/*
+		 * Got a string
+		 */
+		str1 = Tcl_GetStringFromObj(objv[i], &len1);
+		str2 = Tcl_GetStringFromObj(objv[i+1], &len2);
+		if (TclpUtfNcmp2(str1, str2,
+			(size_t) ((len1 < len2) ? len1 : len2)) >= 0) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_OK:
+		/*
+		 * Got proper numbers
+		 */
+		if (cmp != MP_LT) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_BREAK:
+		/*
+		 * Got a NaN (which is different from everything, including
+		 * itself)
+		 */
+		result = 0;
+		i = objc;
+		continue;
+	    }
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLeqOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::<=" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLeqOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1;
+
+    if (objc > 2) {
+	int i, cmp, len1, len2;
+	const char *str1, *str2;
+
+	for (i=1 ; i<objc-1 ; i++) {
+	    switch (CompareNumbers(NULL, objv[i], objv[i+1], &cmp)) {
+	    case TCL_ERROR:
+		/*
+		 * Got a string
+		 */
+		str1 = Tcl_GetStringFromObj(objv[i], &len1);
+		str2 = Tcl_GetStringFromObj(objv[i+1], &len2);
+		if (TclpUtfNcmp2(str1, str2,
+			(size_t) ((len1 < len2) ? len1 : len2)) > 0) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_OK:
+		/*
+		 * Got proper numbers
+		 */
+		if (cmp == MP_GT) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_BREAK:
+		/*
+		 * Got a NaN (which is different from everything, including
+		 * itself)
+		 */
+		result = 0;
+		i = objc;
+		continue;
+	    }
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGreaterOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::>" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGreaterOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1;
+
+    if (objc > 2) {
+	int i, cmp, len1, len2;
+	const char *str1, *str2;
+
+	for (i=1 ; i<objc-1 ; i++) {
+	    switch (CompareNumbers(NULL, objv[i], objv[i+1], &cmp)) {
+	    case TCL_ERROR:
+		/*
+		 * Got a string
+		 */
+		str1 = Tcl_GetStringFromObj(objv[i], &len1);
+		str2 = Tcl_GetStringFromObj(objv[i+1], &len2);
+		if (TclpUtfNcmp2(str1, str2,
+			(size_t) ((len1 < len2) ? len1 : len2)) <= 0) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_OK:
+		/*
+		 * Got proper numbers
+		 */
+		if (cmp != MP_GT) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_BREAK:
+		/*
+		 * Got a NaN (which is different from everything, including
+		 * itself)
+		 */
+		result = 0;
+		i = objc;
+		continue;
+	    }
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGeqOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::>=" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGeqOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1;
+
+    if (objc > 2) {
+	int i, cmp, len1, len2;
+	const char *str1, *str2;
+
+	for (i=1 ; i<objc-1 ; i++) {
+	    switch (CompareNumbers(NULL, objv[i], objv[i+1], &cmp)) {
+	    case TCL_ERROR:
+		/*
+		 * Got a string
+		 */
+		str1 = Tcl_GetStringFromObj(objv[i], &len1);
+		str2 = Tcl_GetStringFromObj(objv[i+1], &len2);
+		if (TclpUtfNcmp2(str1, str2,
+			(size_t) ((len1 < len2) ? len1 : len2)) < 0) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_OK:
+		/*
+		 * Got proper numbers
+		 */
+		if (cmp == MP_LT) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_BREAK:
+		/*
+		 * Got a NaN (which is different from everything, including
+		 * itself)
+		 */
+		result = 0;
+		i = objc;
+		continue;
+	    }
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEqOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::==" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclEqOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1;
+
+    if (objc > 2) {
+	int i, cmp, len1, len2;
+	const char *str1, *str2;
+
+	for (i=1 ; i<objc-1 ; i++) {
+	    switch (CompareNumbers(NULL, objv[i], objv[i+1], &cmp)) {
+	    case TCL_ERROR:
+		/*
+		 * Got a string
+		 */
+		str1 = Tcl_GetStringFromObj(objv[i], &len1);
+		str2 = Tcl_GetStringFromObj(objv[i+1], &len2);
+		if (len1 != len2 || strcmp(str1, str2)) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_OK:
+		/*
+		 * Got proper numbers
+		 */
+		if (cmp != MP_EQ) {
+		    result = 0;
+		    i = objc;
+		}
+		continue;
+	    case TCL_BREAK:
+		/*
+		 * Got a NaN (which is different from everything, including
+		 * itself)
+		 */
+		result = 0;
+		i = objc;
+		continue;
+	    }
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStreqOpCmd --
+ *
+ *	This procedure is invoked to process the "::tcl::mathop::eq" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStreqOpCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    int result = 1;
+
+    if (objc > 2) {
+	int i, len1, len2;
+	const char *str1, *str2;
+
+	for (i=1 ; i<objc-1 ; i++) {
+	    str1 = Tcl_GetStringFromObj(objv[i], &len1);
+	    str2 = Tcl_GetStringFromObj(objv[i+1], &len2);
+	    if (len1 != len2 || strcmp(str1, str2)) {
+		result = 0;
+		break;
+	    }
+	}
+    }
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), result);
+    return TCL_OK;
+}
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclNRE.h b/generic/tclNRE.h
new file mode 100755
index 0000000..e69de29
--- /dev/null
+++ b/generic/tclNRE.h
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
new file mode 100644
index 0000000..c6471a2
--- /dev/null
+++ b/generic/tclParseExpr.c
@@ -0,0 +1,1080 @@
+/*
+ * tclParseExpr.c --
+ *
+ *	This file contains functions that parse Tcl expressions. They do so in
+ *	a general-purpose fashion that can be used for many different
+ *	purposes, including compilation, direct execution, code analysis, etc.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Contributions from Don Porter, NIST, 2006.  (not subject to US copyright)
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.44 2006/08/30 20:46:20 dgp Exp $
+ */
+
+#include "tclInt.h"
+
+/*
+ * The ExprNode structure represents one node of the parse tree produced
+ * as an interim structure by the expression parser.
+ */
+
+typedef struct ExprNode {
+    unsigned char lexeme;	/* Code that identifies the type of this node */
+    int left;		/* Index of the left operand of this operator node */
+    int right;		/* Index of the right operand of this operator node */
+    int parent;		/* Index of the operator of this operand node */
+    int token;		/* Index of the Tcl_Tokens of this leaf node */
+} ExprNode;
+
+/*
+ * Set of lexeme codes stored in ExprNode structs to label and categorize
+ * the lexemes found.
+ */
+
+#define LEAF		(1<<7)
+#define UNARY		(1<<6)
+#define BINARY		(1<<5)
+
+#define NODE_TYPE	( LEAF | UNARY | BINARY)
+
+#define PLUS		1
+#define MINUS		2
+#define BAREWORD	3
+#define INCOMPLETE	4
+#define INVALID		5
+
+#define NUMBER		( LEAF | 1)
+#define SCRIPT		( LEAF | 2)
+#define BOOLEAN		( LEAF | BAREWORD)
+#define BRACED		( LEAF | 4)
+#define VARIABLE	( LEAF | 5)
+#define QUOTED		( LEAF | 6)
+#define EMPTY		( LEAF | 7)
+
+#define UNARY_PLUS	( UNARY | PLUS)
+#define UNARY_MINUS	( UNARY | MINUS)
+#define FUNCTION	( UNARY | BAREWORD)
+#define START		( UNARY | 4)
+#define OPEN_PAREN	( UNARY | 5)
+#define NOT		( UNARY | 6)
+#define BIT_NOT		( UNARY | 7)
+
+#define BINARY_PLUS	( BINARY |  PLUS)
+#define BINARY_MINUS	( BINARY |  MINUS)
+#define COMMA		( BINARY |  3)
+#define MULT		( BINARY |  4)
+#define DIVIDE		( BINARY |  5)
+#define MOD		( BINARY |  6)
+#define LESS		( BINARY |  7)
+#define GREATER		( BINARY |  8)
+#define BIT_AND		( BINARY |  9)
+#define BIT_XOR		( BINARY | 10)
+#define BIT_OR		( BINARY | 11)
+#define QUESTION	( BINARY | 12)
+#define COLON		( BINARY | 13)
+#define LEFT_SHIFT	( BINARY | 14)
+#define RIGHT_SHIFT	( BINARY | 15)
+#define LEQ		( BINARY | 16)
+#define GEQ		( BINARY | 17)
+#define EQUAL		( BINARY | 18)
+#define NEQ		( BINARY | 19)
+#define AND		( BINARY | 20)
+#define OR		( BINARY | 21)
+#define STREQ		( BINARY | 22)
+#define STRNEQ		( BINARY | 23)
+#define EXPON		( BINARY | 24)
+#define IN_LIST		( BINARY | 25)
+#define NOT_IN_LIST	( BINARY | 26)
+#define CLOSE_PAREN	( BINARY | 27)
+#define END		( BINARY | 28)
+
+/*
+ * Declarations for local functions to this file:
+ */
+
+static void		GenerateTokens(ExprNode *nodes, Tcl_Parse *scratchPtr,
+				Tcl_Parse *parsePtr);
+static int		ParseLexeme(CONST char *start, int numBytes,
+				unsigned char *lexemePtr);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ParseExpr --
+ *
+ *	Given a string, the numBytes bytes starting at start, this function
+ *	parses it as a Tcl expression and stores information about the
+ *	structure of the expression in the Tcl_Parse struct indicated by the
+ *	caller.
+ *
+ * Results:
+ * 	If the string is successfully parsed as a valid Tcl expression,
+ *	TCL_OK is returned, and data about the expression structure is
+ *	written to *parsePtr.  If the string cannot be parsed as a valid
+ *	Tcl expression, TCL_ERROR is returned, and if interp is non-NULL,
+ *	an error message is written to interp.
+ *
+ * Side effects:
+ *	If there is insufficient space in parsePtr to hold all the information
+ *	about the expression, then additional space is malloc-ed. If the
+ *	function returns TCL_OK then the caller must eventually invoke
+ *	Tcl_FreeParse to release any additional space that was allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ParseExpr(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    CONST char *start,		/* Start of source string to parse. */
+    int numBytes,		/* Number of bytes in string. If < 0, the
+				 * string consists of all bytes up to the
+				 * first null character. */
+    Tcl_Parse *parsePtr)	/* Structure to fill with information about
+				 * the parsed expression; any previous
+				 * information in the structure is ignored. */
+{
+#define NUM_STATIC_NODES 64
+    ExprNode staticNodes[NUM_STATIC_NODES];
+    ExprNode *lastOrphanPtr, *nodes = staticNodes;
+    int nodesAvailable = NUM_STATIC_NODES;
+    int nodesUsed = 0;
+    Tcl_Parse scratch;		/* Parsing scratch space */
+    Tcl_Obj *msg = NULL, *post = NULL;
+    int scanned = 0, code = TCL_OK, insertMark = 0;
+    CONST char *mark = "_@_";
+    CONST int limit = 25;
+    static CONST unsigned char prec[80] = {
+	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,
+	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,	0,  0,
+	0,  15,	15, 5,	16, 16,	16, 13,	13, 11,	10, 9,	6,  6,	14, 14,
+	13, 13, 12, 12,	8,  7,	12, 12,	17, 12,	12, 3,	1,  0,	0,  0,
+	0,  18,	18, 18,	2,  4,	18, 18,	0,  0,	0,  0,	0,  0,	0,  0,
+    };
+
+    if (numBytes < 0) {
+	numBytes = (start ? strlen(start) : 0);
+    }
+
+    TclParseInit(interp, start, numBytes, &scratch);
+    TclParseInit(interp, start, numBytes, parsePtr);
+
+    /* Initialize the parse tree with the special "START" node */
+
+    nodes->lexeme = START;
+    nodes->left = -1;
+    nodes->right = -1;
+    nodes->parent = -1;
+    nodes->token = -1;
+    lastOrphanPtr = nodes;
+    nodesUsed++;
+
+    while ((code == TCL_OK) && (lastOrphanPtr->lexeme != END)) {
+	ExprNode *nodePtr, *lastNodePtr;
+	Tcl_Token *tokenPtr;
+
+	/*
+	 * Each pass through this loop adds one more ExprNode.
+	 * Allocate space for one if required.
+	 */
+	if (nodesUsed >= nodesAvailable) {
+	    int lastOrphanIdx = lastOrphanPtr - nodes;
+	    int size = nodesUsed * 2;
+	    ExprNode *newPtr;
+
+	    if (nodes == staticNodes) {
+		nodes = NULL;
+	    }
+	    do {
+		newPtr = (ExprNode *) attemptckrealloc( (char *) nodes,
+			(unsigned int) (size * sizeof(ExprNode)) );
+	    } while ((newPtr == NULL)
+		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
+	    if (newPtr == NULL) {
+		msg = Tcl_NewStringObj(
+			"not enough memory to parse expression", -1);
+		code = TCL_ERROR;
+		continue;
+	    }
+	    nodesAvailable = size;
+	    if (nodes == NULL) {
+		memcpy((VOID *) newPtr, (VOID *) staticNodes,
+			(size_t) (nodesUsed * sizeof(ExprNode)));
+	    }
+	    nodes = newPtr;
+	    lastOrphanPtr = nodes + lastOrphanIdx;
+	}
+	nodePtr = nodes + nodesUsed;
+	lastNodePtr = nodePtr - 1;
+
+	/* Skip white space between lexemes */
+
+	scanned = TclParseAllWhiteSpace(start, numBytes);
+	start += scanned;
+	numBytes -= scanned;
+
+	scanned = ParseLexeme(start, numBytes, &(nodePtr->lexeme));
+
+	/* Use context to categorize the lexemes that are ambiguous */
+
+	if ((NODE_TYPE & nodePtr->lexeme) == 0) {
+	    switch (nodePtr->lexeme) {
+	    case INVALID:
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg,
+			"invalid character \"%.*s\"", scanned, start);
+		code = TCL_ERROR;
+		continue;
+	    case INCOMPLETE:
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg,
+			"incomplete operator \"%.*s\"", scanned, start);
+		code = TCL_ERROR;
+		continue;
+	    case BAREWORD:
+		if (start[scanned+TclParseAllWhiteSpace(
+			start+scanned, numBytes-scanned)] == '(') {
+		    nodePtr->lexeme = FUNCTION;
+		} else {
+		    Tcl_Obj *objPtr = Tcl_NewStringObj(start, scanned);
+		    Tcl_IncrRefCount(objPtr);
+		    code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
+		    Tcl_DecrRefCount(objPtr);
+		    if (code == TCL_OK) {
+			nodePtr->lexeme = BOOLEAN;
+		    } else {
+			msg = Tcl_NewObj();
+			TclObjPrintf(NULL, msg, "invalid bareword \"%.*s%s\"",
+				(scanned < limit) ? scanned : limit - 3, start,
+				(scanned < limit) ? "" : "...");
+			post = Tcl_NewObj();
+			TclObjPrintf(NULL, post,
+				"should be \"$%.*s%s\" or \"{%.*s%s}\"",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...");
+			TclObjPrintf(NULL, post, " or \"%.*s%s(...)\" or ...",
+				(scanned < limit) ? scanned : limit - 3,
+				start, (scanned < limit) ? "" : "...");
+			continue;
+		    }
+		}
+		break;
+	    case PLUS:
+	    case MINUS:
+		if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
+		    nodePtr->lexeme |= BINARY;
+		} else {
+		    nodePtr->lexeme |= UNARY;
+		}
+	    }
+	}
+
+	/* Add node to parse tree based on category */
+
+	switch (NODE_TYPE & nodePtr->lexeme) {
+	case LEAF: {
+	    CONST char *end;
+
+	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
+		CONST char *operand =
+			scratch.tokenPtr[lastNodePtr->token].start;
+
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg, "missing operator at %s", mark);
+		if (operand[0] == '0') {
+		    Tcl_Obj *copy = Tcl_NewStringObj(operand,
+			    start + scanned - operand);
+		    if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
+			post = Tcl_NewStringObj(
+				"looks like invalid octal number", -1);
+		    }
+		    Tcl_DecrRefCount(copy);
+		}
+		scanned = 0;
+		insertMark = 1;
+		code = TCL_ERROR;
+		continue;
+	    }
+
+	    if (scratch.numTokens+1 >= scratch.tokensAvailable) {
+		TclExpandTokenArray(&scratch);
+	    }
+	    nodePtr->token = scratch.numTokens;
+	    tokenPtr = scratch.tokenPtr + nodePtr->token;
+	    tokenPtr->type = TCL_TOKEN_SUB_EXPR;
+	    tokenPtr->start = start;
+	    scratch.numTokens++;
+
+	    switch (nodePtr->lexeme) {
+	    case NUMBER:
+	    case BOOLEAN:
+		tokenPtr = scratch.tokenPtr + scratch.numTokens;
+		tokenPtr->type = TCL_TOKEN_TEXT;
+		tokenPtr->start = start;
+		tokenPtr->size = scanned;
+		tokenPtr->numComponents = 0;
+		scratch.numTokens++;
+
+		break;
+
+	    case QUOTED:
+		code = Tcl_ParseQuotedString(interp, start, numBytes,
+			&scratch, 1, &end);
+		if (code != TCL_OK) {
+		    scanned = scratch.term - start;
+		    scanned += (scanned < numBytes);
+		    continue;
+		}
+		scanned = end - start;
+		break;
+
+	    case BRACED:
+		code = Tcl_ParseBraces(interp, start, numBytes,
+			&scratch, 1, &end);
+		if (code != TCL_OK) {
+		    continue;
+		}
+		scanned = end - start;
+		break;
+
+	    case VARIABLE:
+		code = Tcl_ParseVarName(interp, start, numBytes, &scratch, 1);
+		if (code != TCL_OK) {
+		    scanned = scratch.term - start;
+		    scanned += (scanned < numBytes);
+		    continue;
+		}
+		tokenPtr = scratch.tokenPtr + nodePtr->token + 1;
+		if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
+		    msg = Tcl_NewStringObj("invalid character \"$\"", -1);
+		    code = TCL_ERROR;
+		    continue;
+		}
+		scanned = tokenPtr->size;
+		break;
+
+	    case SCRIPT:
+		tokenPtr = scratch.tokenPtr + scratch.numTokens;
+		tokenPtr->type = TCL_TOKEN_COMMAND;
+		tokenPtr->start = start;
+		tokenPtr->numComponents = 0;
+
+		end = start + numBytes;
+		start++;
+		while (1) {
+		    Tcl_Parse nested;
+		    code = Tcl_ParseCommand(interp,
+			    start, (end - start), 1, &nested);
+		    if (code != TCL_OK) {
+			parsePtr->term = nested.term;
+			parsePtr->errorType = nested.errorType;
+			parsePtr->incomplete = nested.incomplete;
+			break;
+		    }
+		    start = (nested.commandStart + nested.commandSize);
+		    Tcl_FreeParse(&nested);
+		    if ((nested.term < end) && (*nested.term == ']')
+			    && !nested.incomplete) {
+			break;
+		    }
+
+		    if (start == end) {
+			msg = Tcl_NewStringObj("missing close-bracket", -1);
+			parsePtr->term = tokenPtr->start;
+			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
+			parsePtr->incomplete = 1;
+			code = TCL_ERROR;
+			break;
+		    }
+		}
+		end = start;
+		start = tokenPtr->start;
+		if (code != TCL_OK) {
+		    scanned = parsePtr->term - start;
+		    scanned += (scanned < numBytes);
+		    continue;
+		}
+		scanned = end - start;
+		tokenPtr->size = scanned;
+		scratch.numTokens++;
+		break;
+	    }
+
+	    tokenPtr = scratch.tokenPtr + nodePtr->token;
+	    tokenPtr->size = scanned;
+	    tokenPtr->numComponents = scratch.numTokens - nodePtr->token - 1;
+
+	    nodePtr->left = -1;
+	    nodePtr->right = -1;
+	    nodePtr->parent = -1;
+	    lastOrphanPtr = nodePtr;
+	    nodesUsed++;
+	    break;
+	}
+
+	case UNARY:
+	    if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg, "missing operator at %s", mark);
+		scanned = 0;
+		insertMark = 1;
+		code = TCL_ERROR;
+		continue;
+	    }
+	    nodePtr->left = -1;
+	    nodePtr->right = -1;
+	    nodePtr->parent = -1;
+
+	    if (scratch.numTokens >= scratch.tokensAvailable) {
+		TclExpandTokenArray(&scratch);
+	    }
+	    nodePtr->token = scratch.numTokens;
+	    tokenPtr = scratch.tokenPtr + nodePtr->token;
+	    tokenPtr->type = TCL_TOKEN_OPERATOR;
+	    tokenPtr->start = start;
+	    tokenPtr->size = scanned;
+	    tokenPtr->numComponents = 0;
+	    scratch.numTokens++;
+
+	    lastOrphanPtr = nodePtr;
+	    nodesUsed++;
+	    break;
+
+	case BINARY: {
+	    ExprNode *otherPtr = NULL;
+	    unsigned char precedence = prec[nodePtr->lexeme];
+
+	    if ((nodePtr->lexeme == CLOSE_PAREN)
+		    && (lastNodePtr->lexeme == OPEN_PAREN)) {
+		if (lastNodePtr[-1].lexeme == FUNCTION) {
+		    /* Normally, "()" is a syntax error, but as a special
+		     * case accept it as an argument list for a function */
+		    scanned = 0;
+		    nodePtr->lexeme = EMPTY;
+		    nodePtr->left = -1;
+		    nodePtr->right = -1;
+		    nodePtr->parent = -1;
+		    nodePtr->token = -1;
+
+		    lastOrphanPtr = nodePtr;
+		    nodesUsed++;
+		    break;
+
+		}
+		msg = Tcl_NewObj();
+		TclObjPrintf(NULL, msg, "empty subexpression at %s", mark);
+		scanned = 0;
+		insertMark = 1;
+		code = TCL_ERROR;
+		continue;
+	    }
+
+
+	    if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
+		if (prec[lastNodePtr->lexeme] > precedence) {
+		    if (lastNodePtr->lexeme == OPEN_PAREN) {
+			msg = Tcl_NewStringObj("unbalanced open paren", -1);
+		    } else if (lastNodePtr->lexeme == COMMA) {
+			msg = Tcl_NewObj();
+			TclObjPrintf(NULL, msg,
+				"missing function argument at %s", mark);
+			scanned = 0;
+			insertMark = 1;
+		    } else if (lastNodePtr->lexeme == START) {
+			msg = Tcl_NewStringObj("empty expression", -1);
+		    }
+		} else {
+		    if (nodePtr->lexeme == CLOSE_PAREN) {
+			msg = Tcl_NewStringObj("unbalanced close paren", -1);
+		    } else if ((nodePtr->lexeme == COMMA)
+			    && (lastNodePtr->lexeme == OPEN_PAREN)
+			    && (lastNodePtr[-1].lexeme == FUNCTION)) {
+			msg = Tcl_NewObj();
+			TclObjPrintf(NULL, msg,
+				"missing function argument at %s", mark);
+			scanned = 0;
+			insertMark = 1;
+		    }
+		}
+		if (msg == NULL) {
+		    msg = Tcl_NewObj();
+		    TclObjPrintf(NULL, msg, "missing operand at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
+		}
+		code = TCL_ERROR;
+		continue;
+	    }
+
+	    while (1) {
+
+		if (lastOrphanPtr->parent >= 0) {
+		    otherPtr = nodes + lastOrphanPtr->parent;
+		} else if (lastOrphanPtr->left >= 0) {
+		    Tcl_Panic("Tcl_ParseExpr: left closure programming error");
+		} else {
+		    lastOrphanPtr->parent = lastOrphanPtr - nodes;
+		    otherPtr = lastOrphanPtr;
+		}
+		otherPtr--;
+
+		if (prec[otherPtr->lexeme] < precedence) {
+		    break;
+		}
+
+		/* Special association rules for the ternary operators */
+		if (prec[otherPtr->lexeme] == precedence) {
+		    if ((otherPtr->lexeme == QUESTION) 
+			    && (lastOrphanPtr->lexeme != COLON)) {
+			break;
+		    }
+		    if ((otherPtr->lexeme == COLON)
+			    && (nodePtr->lexeme == QUESTION)) {
+			break;
+		    }
+		}
+
+		/* Some checks before linking */
+		if ((otherPtr->lexeme == OPEN_PAREN)
+			&& (nodePtr->lexeme != CLOSE_PAREN)) {
+		    lastOrphanPtr = otherPtr;
+		    msg = Tcl_NewStringObj("unbalanced open paren", -1);
+		    code = TCL_ERROR;
+		    break;
+		}
+		if ((otherPtr->lexeme == QUESTION)
+			&& (lastOrphanPtr->lexeme != COLON)) {
+		    msg = Tcl_NewObj();
+		    TclObjPrintf(NULL, msg,
+			    "missing operator \":\" at %s", mark);
+		    scanned = 0;
+		    insertMark = 1;
+		    code = TCL_ERROR;
+		    break;
+		}
+		if ((lastOrphanPtr->lexeme == COLON)
+			&& (otherPtr->lexeme != QUESTION)) {
+		    msg = Tcl_NewStringObj(
+			    "unexpected operator \":\" without preceding \"?\"",
+			    -1);
+		    code = TCL_ERROR;
+		    break;
+		}
+
+		/* Link orphan as right operand of otherPtr */
+		otherPtr->right = lastOrphanPtr - nodes;
+		lastOrphanPtr->parent = otherPtr - nodes;
+		lastOrphanPtr = otherPtr;
+
+		if (otherPtr->lexeme == OPEN_PAREN) {
+		    /* CLOSE_PAREN can only close one OPEN_PAREN */
+		    tokenPtr = scratch.tokenPtr + otherPtr->token;
+		    tokenPtr->size = start + scanned - tokenPtr->start;
+		    break;
+		}
+		if (otherPtr->lexeme == START) {
+		    /* Don't backtrack beyond the start */
+		    break;
+		}
+	    }
+	    if (code != TCL_OK) {
+		continue;
+	    }
+
+	    if (nodePtr->lexeme == CLOSE_PAREN) {
+		if (otherPtr->lexeme == START) {
+		    msg = Tcl_NewStringObj("unbalanced close paren", -1);
+		    code = TCL_ERROR;
+		    continue;
+		}
+		/* Create no node for a CLOSE_PAREN lexeme */
+		break;
+	    }
+
+	    if ((nodePtr->lexeme == COMMA) && ((otherPtr->lexeme != OPEN_PAREN)
+		    || (otherPtr[-1].lexeme != FUNCTION))) {
+		msg = Tcl_NewStringObj(
+			"unexpected \",\" outside function argument list", -1);
+		code = TCL_ERROR;
+		continue;
+	    }
+
+	    if (lastOrphanPtr->lexeme == COLON) {
+		msg = Tcl_NewStringObj(
+			"unexpected operator \":\" without preceding \"?\"",
+			-1);
+		code = TCL_ERROR;
+		continue;
+	    }
+
+	    /* Link orphan as left operand of new node */
+	    nodePtr->right = -1;
+
+	    if (scratch.numTokens >= scratch.tokensAvailable) {
+		TclExpandTokenArray(&scratch);
+	    }
+	    nodePtr->token = scratch.numTokens;
+	    tokenPtr = scratch.tokenPtr + nodePtr->token;
+	    tokenPtr->type = TCL_TOKEN_OPERATOR;
+	    tokenPtr->start = start;
+	    tokenPtr->size = scanned;
+	    tokenPtr->numComponents = 0;
+	    scratch.numTokens++;
+
+	    nodePtr->left = lastOrphanPtr - nodes;
+	    nodePtr->parent = lastOrphanPtr->parent;
+	    lastOrphanPtr->parent = nodePtr - nodes;
+	    lastOrphanPtr = nodePtr;
+	    nodesUsed++;
+	    break;
+	}
+	}
+
+	start += scanned;
+	numBytes -= scanned;
+    }
+
+    if (code == TCL_OK) {
+	/* Shift tokens from scratch space to caller space */
+	GenerateTokens(nodes, &scratch, parsePtr);
+    } else {
+	if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
+	    parsePtr->errorType = TCL_PARSE_SYNTAX;
+	    parsePtr->term = start;
+	}
+	if (interp == NULL) {
+	    if (msg) {
+		Tcl_DecrRefCount(msg);
+	    }
+	} else {
+	    if (msg == NULL) {
+		msg = Tcl_GetObjResult(interp);
+	    }
+	    TclObjPrintf(NULL, msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
+		    ((start - limit) < scratch.string) ? "" : "...",
+		    ((start - limit) < scratch.string)
+		    ? (start - scratch.string) : limit - 3,
+		    ((start - limit) < scratch.string) 
+		    ? scratch.string : start - limit + 3,
+		    (scanned < limit) ? scanned : limit - 3, start,
+		    (scanned < limit) ? "" : "...",
+		    insertMark ? mark : "",
+		    (start + scanned + limit > scratch.end)
+		    ? scratch.end - (start + scanned) : limit-3, 
+		    start + scanned,
+		    (start + scanned + limit > scratch.end) ? "" : "..."
+		    );
+	    if (post != NULL) {
+		Tcl_AppendToObj(msg, ";\n", -1);
+		Tcl_AppendObjToObj(msg, post);
+		Tcl_DecrRefCount(post);
+	    }
+	    Tcl_SetObjResult(interp, msg);
+	    numBytes = scratch.end - scratch.string;
+	    TclFormatToErrorInfo(interp,
+		    "\n    (parsing expression \"%.*s%s\")",
+		    (numBytes < limit) ? numBytes : limit - 3,
+		    scratch.string, (numBytes < limit) ? "" : "...");
+	}
+    }
+
+    if (nodes != staticNodes) {
+	ckfree((char *)nodes);
+    }
+    Tcl_FreeParse(&scratch);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateTokens --
+ *
+ * 	Routine that generates Tcl_Tokens that represent a Tcl expression
+ * 	and writes them to *parsePtr.  The parse tree of the expression
+ * 	is in the array of ExprNodes, nodes.  Some of the Tcl_Tokens are
+ *	copied from scratch space at *scratchPtr, where the parsing pass
+ *	that constructed the parse tree left them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateTokens(
+    ExprNode *nodes,
+    Tcl_Parse *scratchPtr,
+    Tcl_Parse *parsePtr)
+{
+    ExprNode *nodePtr = nodes + nodes->right;
+    Tcl_Token *sourcePtr, *destPtr, *tokenPtr = scratchPtr->tokenPtr;
+    int toCopy;
+    CONST char *end = tokenPtr->start + tokenPtr->size;
+
+    while (nodePtr->lexeme != START) {
+	switch (NODE_TYPE & nodePtr->lexeme) {
+	case BINARY:
+	    if (nodePtr->left >= 0) {
+		if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) {
+		    sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
+		    if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) {
+			TclExpandTokenArray(parsePtr);
+		    }
+		    destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		    nodePtr->token = parsePtr->numTokens;
+		    destPtr->type = TCL_TOKEN_SUB_EXPR;
+		    destPtr->start = tokenPtr->start;
+		    destPtr++;
+		    *destPtr = *sourcePtr;
+		    parsePtr->numTokens += 2;
+		}
+		nodePtr = nodes + nodePtr->left;
+		nodes[nodePtr->parent].left = -1;
+	    } else if (nodePtr->right >= 0) {
+		tokenPtr += tokenPtr->numComponents + 1;
+		nodePtr = nodes + nodePtr->right;
+		nodes[nodePtr->parent].right = -1;
+	    } else {
+		if ((nodePtr->lexeme != COMMA) && (nodePtr->lexeme != COLON)) {
+		    destPtr = parsePtr->tokenPtr + nodePtr->token;
+		    destPtr->size = end - destPtr->start;
+		    destPtr->numComponents =
+			    parsePtr->numTokens - nodePtr->token - 1;
+		}
+		nodePtr = nodes + nodePtr->parent;
+	    }
+	    break;
+
+	case UNARY:
+	    if (nodePtr->right >= 0) {
+		sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
+		if (nodePtr->lexeme != OPEN_PAREN) {
+		    if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) {
+			TclExpandTokenArray(parsePtr);
+		    }
+		    destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		    nodePtr->token = parsePtr->numTokens;
+		    destPtr->type = TCL_TOKEN_SUB_EXPR;
+		    destPtr->start = tokenPtr->start;
+		    destPtr++;
+		    *destPtr = *sourcePtr;
+		    parsePtr->numTokens += 2;
+		}
+		if (tokenPtr == sourcePtr) {
+		    tokenPtr += tokenPtr->numComponents + 1;
+		}
+		nodePtr = nodes + nodePtr->right;
+		nodes[nodePtr->parent].right = -1;
+	    } else {
+		if (nodePtr->lexeme != OPEN_PAREN) {
+		    destPtr = parsePtr->tokenPtr + nodePtr->token;
+		    destPtr->size = end - destPtr->start;
+		    destPtr->numComponents =
+			    parsePtr->numTokens - nodePtr->token - 1;
+		} else {
+		    sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
+		    end = sourcePtr->start + sourcePtr->size;
+		}
+		nodePtr = nodes + nodePtr->parent;
+	    }
+	    break;
+
+	case LEAF:
+	    switch (nodePtr->lexeme) {
+	    case EMPTY:
+		break;
+
+	    case BRACED:
+	    case QUOTED:
+		sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
+		end = sourcePtr->start + sourcePtr->size;
+		if (sourcePtr->numComponents > 1) {
+		    toCopy = sourcePtr->numComponents;
+		    if (tokenPtr == sourcePtr) {
+			tokenPtr += toCopy + 1;
+		    }
+		    sourcePtr->numComponents++;
+		    while (parsePtr->numTokens + toCopy + 1
+			    >= parsePtr->tokensAvailable) {
+			TclExpandTokenArray(parsePtr);
+		    }
+		    destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		    *destPtr++ = *sourcePtr;
+		    *destPtr = *sourcePtr++;
+		    destPtr->type = TCL_TOKEN_WORD;
+		    destPtr->numComponents = toCopy;
+		    destPtr++;
+		    memcpy((VOID *) destPtr, (VOID *) sourcePtr,
+			    (size_t) (toCopy * sizeof(Tcl_Token)));
+		    parsePtr->numTokens += toCopy + 2;
+		    break;
+		}
+
+	    default:
+		sourcePtr = scratchPtr->tokenPtr + nodePtr->token;
+		end = sourcePtr->start + sourcePtr->size;
+		toCopy = sourcePtr->numComponents + 1;
+		if (tokenPtr == sourcePtr) {
+		    tokenPtr += toCopy;
+		}
+		while (parsePtr->numTokens + toCopy - 1
+			>= parsePtr->tokensAvailable) {
+		    TclExpandTokenArray(parsePtr);
+		}
+		destPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+		memcpy((VOID *) destPtr, (VOID *) sourcePtr,
+			(size_t) (toCopy * sizeof(Tcl_Token)));
+		parsePtr->numTokens += toCopy;
+		break;
+
+	    }
+	    nodePtr = nodes + nodePtr->parent;
+	    break;
+
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseLexeme --
+ *
+ *	Parse a single lexeme from the start of a string, scanning no
+ *	more than numBytes bytes.  
+ *
+ * Results:
+ *	Returns the number of bytes scanned to produce the lexeme.
+ *
+ * Side effects:
+ *	Code identifying lexeme parsed is writen to *lexemePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseLexeme(
+    CONST char *start,		/* Start of lexeme to parse. */
+    int numBytes,		/* Number of bytes in string. */
+    unsigned char *lexemePtr)	/* Write code of parsed lexeme to this
+				 * storage. */
+{
+    CONST char *end;
+    int scanned;
+    Tcl_UniChar ch;
+
+    if (numBytes == 0) {
+	*lexemePtr = END;
+	return 0;
+    }
+    switch (*start) {
+    case '[':
+	*lexemePtr = SCRIPT;
+	return 1;
+
+    case '{':
+	*lexemePtr = BRACED;
+	return 1;
+
+    case '(':
+	*lexemePtr = OPEN_PAREN;
+	return 1;
+
+    case ')':
+	*lexemePtr = CLOSE_PAREN;
+	return 1;
+
+    case '$':
+	*lexemePtr = VARIABLE;
+	return 1;
+
+    case '\"':
+	*lexemePtr = QUOTED;
+	return 1;
+
+    case ',':
+	*lexemePtr = COMMA;
+	return 1;
+
+    case '/':
+	*lexemePtr = DIVIDE;
+	return 1;
+
+    case '%':
+	*lexemePtr = MOD;
+	return 1;
+
+    case '+':
+	*lexemePtr = PLUS;
+	return 1;
+
+    case '-':
+	*lexemePtr = MINUS;
+	return 1;
+
+    case '?':
+	*lexemePtr = QUESTION;
+	return 1;
+
+    case ':':
+	*lexemePtr = COLON;
+	return 1;
+
+    case '^':
+	*lexemePtr = BIT_XOR;
+	return 1;
+
+    case '~':
+	*lexemePtr = BIT_NOT;
+	return 1;
+
+    case '*':
+	if ((numBytes > 1) && (start[1] == '*')) {
+	    *lexemePtr = EXPON;
+	    return 2;
+	}
+	*lexemePtr = MULT;
+	return 1;
+
+    case '=':
+	if ((numBytes > 1) && (start[1] == '=')) {
+	    *lexemePtr = EQUAL;
+	    return 2;
+	}
+	*lexemePtr = INCOMPLETE;
+	return 1;
+
+    case '!':
+	if ((numBytes > 1) && (start[1] == '=')) {
+	    *lexemePtr = NEQ;
+	    return 2;
+	}
+	*lexemePtr = NOT;
+	return 1;
+
+    case '&':
+	if ((numBytes > 1) && (start[1] == '&')) {
+	    *lexemePtr = AND;
+	    return 2;
+	}
+	*lexemePtr = BIT_AND;
+	return 1;
+
+    case '|':
+	if ((numBytes > 1) && (start[1] == '|')) {
+	    *lexemePtr = OR;
+	    return 2;
+	}
+	*lexemePtr = BIT_OR;
+	return 1;
+
+    case '<':
+	if (numBytes > 1) {
+	    switch (start[1]) {
+	    case '<':
+		*lexemePtr = LEFT_SHIFT;
+		return 2;
+	    case '=':
+		*lexemePtr = LEQ;
+		return 2;
+	    }
+	}
+	*lexemePtr = LESS;
+	return 1;
+
+    case '>':
+	if (numBytes > 1) {
+	    switch (start[1]) {
+	    case '>':
+		*lexemePtr = RIGHT_SHIFT;
+		return 2;
+	    case '=':
+		*lexemePtr = GEQ;
+		return 2;
+	    }
+	}
+	*lexemePtr = GREATER;
+	return 1;
+
+    case 'i':
+	if ((numBytes > 1) && (start[1] == 'n')
+		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+	    /*
+	     * Must make this check so we can tell the difference between
+	     * the "in" operator and the "int" function name and the
+	     * "infinity" numeric value.
+	     */
+	    *lexemePtr = IN_LIST;
+	    return 2;
+	}
+	break;
+
+    case 'e':
+	if ((numBytes > 1) && (start[1] == 'q')
+		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+	    *lexemePtr = STREQ;
+	    return 2;
+	}
+	break;
+
+    case 'n':
+	if ((numBytes > 1) && ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+	    switch (start[1]) {
+	    case 'e':
+		*lexemePtr = STRNEQ;
+		return 2;
+	    case 'i':
+		*lexemePtr = NOT_IN_LIST;
+		return 2;
+	    }
+	}
+    }
+
+    if (TclParseNumber(NULL, NULL, NULL, start, numBytes, &end,
+	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
+	*lexemePtr = NUMBER;
+	return (end-start);
+    }
+
+    if (Tcl_UtfCharComplete(start, numBytes)) {
+	scanned = Tcl_UtfToUniChar(start, &ch);
+    } else {
+	char utfBytes[TCL_UTF_MAX];
+	memcpy(utfBytes, start, (size_t) numBytes);
+	utfBytes[numBytes] = '\0';
+	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
+    }
+    if (!isalpha(UCHAR(ch))) {
+	*lexemePtr = INVALID;
+	return scanned;
+    }
+    end = start;
+    while (isalnum(UCHAR(ch)) || (UCHAR(ch) == '_')) {
+	end += scanned;
+	numBytes -= scanned;
+	if (Tcl_UtfCharComplete(end, numBytes)) {
+	    scanned = Tcl_UtfToUniChar(end, &ch);
+	} else {
+	    char utfBytes[TCL_UTF_MAX];
+	    memcpy(utfBytes, end, (size_t) numBytes);
+	    utfBytes[numBytes] = '\0';
+	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
+	}
+    }
+    *lexemePtr = BAREWORD;
+    return (end-start);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */