vendor/tcl/8.0

21 files changed, 0 insertions, 3502 deletions

diff --git a/contrib/tcl/README.FreeBSD b/contrib/tcl/README.FreeBSD
deleted file mode 100644
index a2436d739f5e..000000000000
--- a/contrib/tcl/README.FreeBSD
+++ /dev/null
@@ -1,4 +0,0 @@
-Tcl 7.5
-	originals can be found at: ftp://ftp.smli.com/pub/tcl 
-	removed subdirectories "win", "mac", "compat"
-	phk@FreeBSD.org
diff --git a/contrib/tcl/doc/CrtModalTmt.3 b/contrib/tcl/doc/CrtModalTmt.3
deleted file mode 100644
index 85f079fc85cc..000000000000
--- a/contrib/tcl/doc/CrtModalTmt.3
+++ /dev/null
@@ -1,71 +0,0 @@
-'\"
-'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
-'\"
-'\" See the file "license.terms" for information on usage and redistribution
-'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\" 
-'\" SCCS: @(#) CrtModalTmt.3 1.3 96/03/25 20:00:19
-'\" 
-.so man.macros
-.TH Tcl_CreateModalTimeout 3 7.5 Tcl "Tcl Library Procedures"
-.BS
-.SH NAME
-Tcl_CreateModalTimeout, Tcl_DeleteModalTimeout \- special timer for modal operations
-.SH SYNOPSIS
-.nf
-\fB#include <tcl.h>\fR
-.sp
-\fBTcl_CreateModalTimeout\fR(\fImilliseconds, proc, clientData\fR)
-.sp
-\fBTcl_DeleteModalTimeout\fR(\fIproc, clientData\fR)
-.SH ARGUMENTS
-.AS Tcl_TimerToken milliseconds
-.AP int milliseconds  in
-How many milliseconds to wait before invoking \fIproc\fR.
-.AP Tcl_TimerProc *proc in
-Procedure to invoke after \fImilliseconds\fR have elapsed.
-.AP ClientData clientData in
-Arbitrary one-word value to pass to \fIproc\fR.
-.BE
-
-.SH DESCRIPTION
-.PP
-\fBTcl_CreateModalTimeout\fR provides an alternate form of timer
-from those provided by \fBTcl_CreateTimerHandler\fR.
-These timers are called ``modal'' because they are typically
-used in situations where a particular operation must be completed
-before the application does anything else.
-If such an operation needs a timeout, it cannot use normal timer
-events:  if normal timer events were processed, arbitrary Tcl scripts
-might be invoked via other event handlers, which could interfere with
-the completion of the modal operation.
-The purpose of modal timers is to allow a single timeout to occur
-without allowing any normal timer events to occur.
-.PP
-\fBTcl_CreateModalTimeout\fR behaves just like \fBTcl_CreateTimerHandler\fR
-except that it creates a modal timeout.
-Its arguments have the same meaning as for \fBTcl_CreateTimerHandler\fR
-and \fIproc\fR is invoked just as for \fBTcl_CreateTimerHandler\fR.
-\fBTcl_DeleteModalTimeout\fR deletes the most recently created
-modal timeout;  its arguments must match the corresponding arguments
-to the most recent call to \fBTcl_CreateModalTimeout\fR.
-.PP
-Modal timeouts differ from a normal timers in three ways.  First,
-they will trigger regardless of whether the TCL_TIMER_EVENTS flag
-has been passed to \fBTcl_DoOneEvent\fR.
-Typically modal timers are used with the TCL_TIMER_EVENTS flag
-off so that normal timers don't fire but modal ones do.
-Second, if several modal timers have been created they stack:
-only the top timer on the stack (the most recently created one)
-is active at any point in time.
-Modal timeouts must be deleted in inverse order from their creation.
-Third, modal timeouts are not deleted when they fire:  once a modal
-timeout has fired, it will continue firing every time \fBTcl_DoOneEvent\fR
-is called, until the timeout is deleted by calling
-\fBTcl_DeleteModalTimeout\fR.
-.PP
-Modal timeouts are only needed in a few special situations, and they
-should be used with caution.
-
-.SH KEYWORDS
-callback, clock, handler, modal timeout
diff --git a/contrib/tcl/doc/GetFile.3 b/contrib/tcl/doc/GetFile.3
deleted file mode 100644
index 68ffd219a8ac..000000000000
--- a/contrib/tcl/doc/GetFile.3
+++ /dev/null
@@ -1,130 +0,0 @@
-'\"
-'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
-'\"
-'\" See the file "license.terms" for information on usage and redistribution
-'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\" 
-'\" SCCS: @(#) GetFile.3 1.8 96/03/25 20:03:31
-'\" 
-.so man.macros
-.TH Tcl_GetFile 3 7.5 Tcl "Tcl Library Procedures"
-.BS
-.SH NAME
-Tcl_GetFile, Tcl_FreeFile, Tcl_GetFileInfo \- procedures to manipulate generic file handles
-.SH SYNOPSIS
-.nf
-\fB#include <tcl.h>\fR
-.sp
-Tcl_File
-\fBTcl_GetFile\fR(\fIosHandle, type\fR)
-.sp
-\fBTcl_FreeFile\fR(\fIhandle\fR)
-.sp
-ClientData
-\fBTcl_GetFileInfo\fR(\fIhandle, typePtr\fR)
-.sp
-ClientData
-\fBTcl_GetNotifierData\fR(\fIhandle, freeProcPtr\fR)
-.sp
-\fBTcl_SetNotifierData\fR(\fIhandle, freeProc, clientData\fR)
-.SH ARGUMENTS
-.AS Tcl_FileFreeProc **freeProcPtr
-.AP ClientData osHandle  in
-Platform-specific file handle to be associated with the generic file handle.
-.AP int type in
-The type of platform-specific file handle associated with the generic file
-handle.  See below for a list of valid types.
-.AP Tcl_File handle in
-Generic file handle associated with platform-specific file information.
-.AP int *typePtr in/out
-If \fI*typePtr\fR is not NULL, then the specified word is set to
-contain the type associated with \fIhandle\fR.
-.AP Tcl_FileFreeProc *freeProc in
-Procedure to call when \fIhandle\fR is deleted.
-.AP Tcl_FileFreeProc **freeProcPtr in/out
-Pointer to location in which to store address of current free procedure
-for file handle.  Ignored if NULL.
-.AP ClientData clientData in
-Arbitrary one-word value associated with the given file handle. This
-data is owned by the caller.
-.BE
-
-.SH DESCRIPTION
-.PP
-A \fBTcl_File\fR is an opaque handle used to refer to files in a
-platform independent way in Tcl routines like
-\fBTcl_CreateFileHandler\fR.  A file handle has an associated
-platform-dependent \fIosHandle\fR, a \fItype\fR and additional private
-data used by the notifier to generate events for the file.  The type
-is an integer that determines how the platform-specific drivers will
-interpret the \fIosHandle\fR.  The types that are defined by the core
-are:
-.TP 22
-\fBTCL_UNIX_FD\fR
-The \fIosHandle\fR is a Unix file descriptor.
-.TP 22
-\fBTCL_MAC_FILE\fR
-The file is a Macintosh file handle.
-.TP 22
-\fBTCL_WIN_FILE\fR
-The \fIosHandle\fR is a Windows normal file \fBHANDLE\fR.
-.TP 22
-\fBTCL_WIN_PIPE\fR
-The \fIosHandle\fR is a Windows anonymous pipe \fBHANDLE\fR.
-.TP 22
-\fBTCL_WIN_SOCKET\fR
-The \fIosHandle\fR is a Windows \fBSOCKET\fR.
-.TP 22
-\fBTCL_WIN_CONSOLE\fR
-The \fIosHandle\fR is a Windows console buffer \fBHANDLE\fR.
-.PP
-\fBTcl_GetFile\fR locates the file handle corresponding to a particular
-\fIosHandle\fR and a \fItype\fR.  If a file handle already existed for the
-given file, then that handle will be returned.  If this is the first time that
-the file handle for a particular file is being retrieved, then a new file
-handle will be allocated and returned.
-.PP
-When a file handle is no longer in use, it should be deallocated with
-a call to \fBTcl_FreeFile\fR.  A call to this function will invoke the
-notifier free procedure \fIproc\fR, if there is one.  After the
-notifier has cleaned up, any resources used by the file handle will be
-deallocated.  \fBTcl_FreeFile\fR will not close the platform-specific
-\fIosHandle\fR.
-.PP
-\fBTcl_GetFileInfo\fR may be used to retrieve the platform-specific
-\fIosHandle\fR and type associated with a file handle.  If
-\fItypePtr\fR is not NULL, then the word at \fI*typePtr\fR is set to
-the type of the file handle.  The return value of the function is the
-associated platform-specific \fIosHandle\fR.  Note that this function
-may be used to extract the platform-specific file handle from a
-\fBTcl_File\fR so that it may be used in external interfaces.
-However, programs written using this interface will be
-platform-specific.
-.PP
-The \fBTcl_SetNotifierData\fR and \fBTcl_GetNotifierData\fR procedures are
-intended to be used only by notifier writers.  See the
-\fITcl_CreateEventSource(3)\fR manual entry for more information on
-the notifier.
-.PP
-\fBTcl_SetNotifierData\fR may be used by notifier writers to associate
-notifier-specific information with a \fBTcl_File\fR.  The \fIdata\fR
-argument specifies a word that may be retrieved with a later call to
-\fBTcl_GetNotifierData\fR.  If the \fIfreeProc\fR argument is non-NULL
-it specifies the address of a procedure to invoke when the
-\fBTcl_File\fR is deleted.  \fIfreeProc\fR should have arguments and
-result that match the type \fBTcl_FileFreeProc\fR:
-.CS
-typedef void Tcl_FileFreeProc(
-	ClientData \fIclientData\fR);
-.CE
-When \fIfreeProc\fR is invoked the \fIclientData\fR argument will be
-the same as the corresponding argument passed to
-\fBTcl_SetNotifierData\fR.
-.PP
-\fBTcl_GetNotifierData\fR returns the \fIclientData\fR associated with
-the given \fBTcl_File\fR, and if the \fIfreeProcPtr\fR field is
-non-\fBNULL\fR, the address indicated by it gets the address of the
-free procedure stored with this file.
-
-.SH KEYWORDS
-generic file handle, file type, file descriptor, notifier
diff --git a/contrib/tcl/generic/patchlevel.h b/contrib/tcl/generic/patchlevel.h
deleted file mode 100644
index c755edec4901..000000000000
--- a/contrib/tcl/generic/patchlevel.h
+++ /dev/null
@@ -1,23 +0,0 @@
-/*
- * patchlevel.h --
- *
- * This file does nothing except define a "patch level" for Tcl.
- * The patch level has the form "X.YpZ" where X.Y is the base
- * release, and Z is a serial number that is used to sequence
- * patches for a given release.  Thus 7.4p1 is the first patch
- * to release 7.4, 7.4p2 is the patch that follows 7.4p1, and
- * so on.  The "pZ" is omitted in an original new release, and
- * it is replaced with "bZ" for beta releases or "aZ for alpha
- * releases.  The patch level ensures that patches are applied
- * in the correct order and only to appropriate sources.
- *
- * Copyright (c) 1993-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) patchlevel.h 1.18 96/07/17 14:17:33
- */
-
-#define TCL_PATCH_LEVEL "7.5p1"
diff --git a/contrib/tcl/generic/tclExpr.c b/contrib/tcl/generic/tclExpr.c
deleted file mode 100644
index 13d020fa49c2..000000000000
--- a/contrib/tcl/generic/tclExpr.c
+++ /dev/null
@@ -1,2055 +0,0 @@
-/* 
- * tclExpr.c --
- *
- *	This file contains the code to evaluate expressions for
- *	Tcl.
- *
- *	This implementation of floating-point support was modelled
- *	after an initial implementation by Bill Carpenter.
- *
- * Copyright (c) 1987-1994 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclExpr.c 1.91 96/02/15 11:42:44
- */
-
-#include "tclInt.h"
-#ifdef NO_FLOAT_H
-#   include "../compat/float.h"
-#else
-#   include <float.h>
-#endif
-#ifndef TCL_NO_MATH
-#include <math.h>
-#endif
-
-/*
- * The stuff below is a bit of a hack so that this file can be used
- * in environments that include no UNIX, i.e. no errno.  Just define
- * errno here.
- */
-
-#ifndef TCL_GENERIC_ONLY
-#include "tclPort.h"
-#else
-#define NO_ERRNO_H
-#endif
-
-#ifdef NO_ERRNO_H
-int errno;
-#define EDOM 33
-#define ERANGE 34
-#endif
-
-/*
- * The data structure below is used to describe an expression value,
- * which can be either an integer (the usual case), a double-precision
- * floating-point value, or a string.  A given number has only one
- * value at a time.
- */
-
-#define STATIC_STRING_SPACE 150
-
-typedef struct {
-    long intValue;		/* Integer value, if any. */
-    double  doubleValue;	/* Floating-point value, if any. */
-    ParseValue pv;		/* Used to hold a string value, if any. */
-    char staticSpace[STATIC_STRING_SPACE];
-				/* Storage for small strings;  large ones
-				 * are malloc-ed. */
-    int type;			/* Type of value:  TYPE_INT, TYPE_DOUBLE,
-				 * or TYPE_STRING. */
-} Value;
-
-/*
- * Valid values for type:
- */
-
-#define TYPE_INT	0
-#define TYPE_DOUBLE	1
-#define TYPE_STRING	2
-
-/*
- * The data structure below describes the state of parsing an expression.
- * It's passed among the routines in this module.
- */
-
-typedef struct {
-    char *originalExpr;		/* The entire expression, as originally
-				 * passed to Tcl_ExprString et al. */
-    char *expr;			/* Position to the next character to be
-				 * scanned from the expression string. */
-    int token;			/* Type of the last token to be parsed from
-				 * expr.  See below for definitions.
-				 * Corresponds to the characters just
-				 * before expr. */
-} ExprInfo;
-
-/*
- * The token types are defined below.  In addition, there is a table
- * associating a precedence with each operator.  The order of types
- * is important.  Consult the code before changing it.
- */
-
-#define VALUE		0
-#define OPEN_PAREN	1
-#define CLOSE_PAREN	2
-#define COMMA		3
-#define END		4
-#define UNKNOWN		5
-
-/*
- * Binary operators:
- */
-
-#define MULT		8
-#define DIVIDE		9
-#define MOD		10
-#define PLUS		11
-#define MINUS		12
-#define LEFT_SHIFT	13
-#define RIGHT_SHIFT	14
-#define LESS		15
-#define GREATER		16
-#define LEQ		17
-#define GEQ		18
-#define EQUAL		19
-#define NEQ		20
-#define BIT_AND		21
-#define BIT_XOR		22
-#define BIT_OR		23
-#define AND		24
-#define OR		25
-#define QUESTY		26
-#define COLON		27
-
-/*
- * Unary operators:
- */
-
-#define	UNARY_MINUS	28
-#define UNARY_PLUS	29
-#define NOT		30
-#define BIT_NOT		31
-
-/*
- * Precedence table.  The values for non-operator token types are ignored.
- */
-
-static int precTable[] = {
-    0, 0, 0, 0, 0, 0, 0, 0,
-    12, 12, 12,				/* MULT, DIVIDE, MOD */
-    11, 11,				/* PLUS, MINUS */
-    10, 10,				/* LEFT_SHIFT, RIGHT_SHIFT */
-    9, 9, 9, 9,				/* LESS, GREATER, LEQ, GEQ */
-    8, 8,				/* EQUAL, NEQ */
-    7,					/* BIT_AND */
-    6,					/* BIT_XOR */
-    5,					/* BIT_OR */
-    4,					/* AND */
-    3,					/* OR */
-    2,					/* QUESTY */
-    1,					/* COLON */
-    13, 13, 13, 13			/* UNARY_MINUS, UNARY_PLUS, NOT,
-					 * BIT_NOT */
-};
-
-/*
- * Mapping from operator numbers to strings;  used for error messages.
- */
-
-static char *operatorStrings[] = {
-    "VALUE", "(", ")", ",", "END", "UNKNOWN", "6", "7",
-    "*", "/", "%", "+", "-", "<<", ">>", "<", ">", "<=",
-    ">=", "==", "!=", "&", "^", "|", "&&", "||", "?", ":",
-    "-", "+", "!", "~"
-};
-
-/*
- * The following slight modification to DBL_MAX is needed because of
- * a compiler bug on Sprite (4/15/93).
- */
-
-#ifdef sprite
-#undef DBL_MAX
-#define DBL_MAX 1.797693134862316e+307
-#endif
-
-/*
- * Macros for testing floating-point values for certain special
- * cases.  Test for not-a-number by comparing a value against
- * itself;  test for infinity by comparing against the largest
- * floating-point value.
- */
-
-#define IS_NAN(v) ((v) != (v))
-#ifdef DBL_MAX
-#   define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
-#else
-#   define IS_INF(v) 0
-#endif
-
-/*
- * The following global variable is use to signal matherr that Tcl
- * is responsible for the arithmetic, so errors can be handled in a
- * fashion appropriate for Tcl.  Zero means no Tcl math is in
- * progress;  non-zero means Tcl is doing math.
- */
-
-int tcl_MathInProgress = 0;
-
-/*
- * The variable below serves no useful purpose except to generate
- * a reference to matherr, so that the Tcl version of matherr is
- * linked in rather than the system version.  Without this reference
- * the need for matherr won't be discovered during linking until after
- * libtcl.a has been processed, so Tcl's version won't be used.
- */
-
-#ifdef NEED_MATHERR
-extern int matherr();
-int (*tclMatherrPtr)() = matherr;
-#endif
-
-/*
- * Declarations for local procedures to this file:
- */
-
-static int		ExprAbsFunc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		ExprBinaryFunc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		ExprDoubleFunc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		ExprGetValue _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExprInfo *infoPtr, int prec, Value *valuePtr));
-static int		ExprIntFunc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		ExprLex _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExprInfo *infoPtr, Value *valuePtr));
-static int		ExprLooksLikeInt _ANSI_ARGS_((char *p));
-static void		ExprMakeString _ANSI_ARGS_((Tcl_Interp *interp,
-			    Value *valuePtr));
-static int		ExprMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
-			    ExprInfo *infoPtr, Value *valuePtr));
-static int		ExprParseString _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *string, Value *valuePtr));
-static int		ExprRoundFunc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-static int		ExprTopLevel _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *string, Value *valuePtr));
-static int		ExprUnaryFunc _ANSI_ARGS_((ClientData clientData,
-			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr));
-
-/*
- * Built-in math functions:
- */
-
-typedef struct {
-    char *name;			/* Name of function. */
-    int numArgs;		/* Number of arguments for function. */
-    Tcl_ValueType argTypes[MAX_MATH_ARGS];
-				/* Acceptable types for each argument. */
-    Tcl_MathProc *proc;		/* Procedure that implements this function. */
-    ClientData clientData;	/* Additional argument to pass to the function
-				 * when invoking it. */
-} BuiltinFunc;
-
-static BuiltinFunc funcTable[] = {
-#ifndef TCL_NO_MATH
-    {"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
-    {"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
-    {"atan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) atan},
-    {"atan2", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) atan2},
-    {"ceil", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) ceil},
-    {"cos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cos},
-    {"cosh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) cosh},
-    {"exp", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) exp},
-    {"floor", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) floor},
-    {"fmod", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) fmod},
-    {"hypot", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) hypot},
-    {"log", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log},
-    {"log10", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) log10},
-    {"pow", 2, {TCL_DOUBLE, TCL_DOUBLE}, ExprBinaryFunc, (ClientData) pow},
-    {"sin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sin},
-    {"sinh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sinh},
-    {"sqrt", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) sqrt},
-    {"tan", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tan},
-    {"tanh", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) tanh},
-#endif
-    {"abs", 1, {TCL_EITHER}, ExprAbsFunc, 0},
-    {"double", 1, {TCL_EITHER}, ExprDoubleFunc, 0},
-    {"int", 1, {TCL_EITHER}, ExprIntFunc, 0},
-    {"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
-
-    {0},
-};
-
-/*
- *--------------------------------------------------------------
- *
- * ExprParseString --
- *
- *	Given a string (such as one coming from command or variable
- *	substitution), make a Value based on the string.  The value
- *	will be a floating-point or integer, if possible, or else it
- *	will just be a copy of the string.
- *
- * Results:
- *	TCL_OK is returned under normal circumstances, and TCL_ERROR
- *	is returned if a floating-point overflow or underflow occurred
- *	while reading in a number.  The value at *valuePtr is modified
- *	to hold a number, if possible.
- *
- * Side effects:
- *	None.
- *
- *--------------------------------------------------------------
- */
-
-static int
-ExprParseString(interp, string, valuePtr)
-    Tcl_Interp *interp;		/* Where to store error message. */
-    char *string;		/* String to turn into value. */
-    Value *valuePtr;		/* Where to store value information. 
-				 * Caller must have initialized pv field. */
-{
-    char *term, *p, *start;
-
-    if (*string != 0) {
-	if (ExprLooksLikeInt(string)) {
-	    valuePtr->type = TYPE_INT;
-	    errno = 0;
-    
-	    /*
-	     * Note: use strtoul instead of strtol for integer conversions
-	     * to allow full-size unsigned numbers, but don't depend on
-	     * strtoul to handle sign characters;  it won't in some
-	     * implementations.
-	     */
-    
-	    for (p = string; isspace(UCHAR(*p)); p++) {
-		/* Empty loop body. */
-	    }
-	    if (*p == '-') {
-		start = p+1;
-		valuePtr->intValue = -((int)strtoul(start, &term, 0));
-	    } else if (*p == '+') {
-		start = p+1;
-		valuePtr->intValue = strtoul(start, &term, 0);
-	    } else {
-		start = p;
-		valuePtr->intValue = strtoul(start, &term, 0);
-	    }
-	    if (*term == 0) {
-		if (errno == ERANGE) {
-		    /*
-		     * This procedure is sometimes called with string in
-		     * interp->result, so we have to clear the result before
-		     * logging an error message.
-		     */
-	
-		    Tcl_ResetResult(interp);
-		    interp->result = "integer value too large to represent";
-		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			    interp->result, (char *) NULL);
-		    return TCL_ERROR;
-		} else {
-		    return TCL_OK;
-		}
-	    }
-	} else {
-	    errno = 0;
-	    valuePtr->doubleValue = strtod(string, &term);
-	    if ((term != string) && (*term == 0)) {
-		if (errno != 0) {
-		    Tcl_ResetResult(interp);
-		    TclExprFloatError(interp, valuePtr->doubleValue);
-		    return TCL_ERROR;
-		}
-		valuePtr->type = TYPE_DOUBLE;
-		return TCL_OK;
-	    }
-	}
-    }
-
-    /*
-     * Not a valid number.  Save a string value (but don't do anything
-     * if it's already the value).
-     */
-
-    valuePtr->type = TYPE_STRING;
-    if (string != valuePtr->pv.buffer) {
-	int length, shortfall;
-
-	length = strlen(string);
-	valuePtr->pv.next = valuePtr->pv.buffer;
-	shortfall = length - (valuePtr->pv.end - valuePtr->pv.buffer);
-	if (shortfall > 0) {
-	    (*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
-	}
-	strcpy(valuePtr->pv.buffer, string);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExprLex --
- *
- *	Lexical analyzer for expression parser:  parses a single value,
- *	operator, or other syntactic element from an expression string.
- *
- * Results:
- *	TCL_OK is returned unless an error occurred while doing lexical
- *	analysis or executing an embedded command.  In that case a
- *	standard Tcl error is returned, using interp->result to hold
- *	an error message.  In the event of a successful return, the token
- *	and field in infoPtr is updated to refer to the next symbol in
- *	the expression string, and the expr field is advanced past that
- *	token;  if the token is a value, then the value is stored at
- *	valuePtr.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprLex(interp, infoPtr, valuePtr)
-    Tcl_Interp *interp;			/* Interpreter to use for error
-					 * reporting. */
-    register ExprInfo *infoPtr;		/* Describes the state of the parse. */
-    register Value *valuePtr;		/* Where to store value, if that is
-					 * what's parsed from string.  Caller
-					 * must have initialized pv field
-					 * correctly. */
-{
-    register char *p;
-    char *var, *term;
-    int result;
-
-    p = infoPtr->expr;
-    while (isspace(UCHAR(*p))) {
-	p++;
-    }
-    if (*p == 0) {
-	infoPtr->token = END;
-	infoPtr->expr = p;
-	return TCL_OK;
-    }
-
-    /*
-     * First try to parse the token as an integer or floating-point number.
-     * Don't want to check for a number if the first character is "+"
-     * or "-".  If we do, we might treat a binary operator as unary by
-     * mistake, which will eventually cause a syntax error.
-     */
-
-    if ((*p != '+')  && (*p != '-')) {
-	if (ExprLooksLikeInt(p)) {
-	    errno = 0;
-	    valuePtr->intValue = strtoul(p, &term, 0);
-	    if (errno == ERANGE) {
-		interp->result = "integer value too large to represent";
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			interp->result, (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    infoPtr->token = VALUE;
-	    infoPtr->expr = term;
-	    valuePtr->type = TYPE_INT;
-	    return TCL_OK;
-	} else {
-	    errno = 0;
-	    valuePtr->doubleValue = strtod(p, &term);
-	    if (term != p) {
-		if (errno != 0) {
-		    TclExprFloatError(interp, valuePtr->doubleValue);
-		    return TCL_ERROR;
-		}
-		infoPtr->token = VALUE;
-		infoPtr->expr = term;
-		valuePtr->type = TYPE_DOUBLE;
-		return TCL_OK;
-	    }
-	}
-    }
-
-    infoPtr->expr = p+1;
-    switch (*p) {
-	case '$':
-
-	    /*
-	     * Variable.  Fetch its value, then see if it makes sense
-	     * as an integer or floating-point number.
-	     */
-
-	    infoPtr->token = VALUE;
-	    var = Tcl_ParseVar(interp, p, &infoPtr->expr);
-	    if (var == NULL) {
-		return TCL_ERROR;
-	    }
-	    Tcl_ResetResult(interp);
-	    if (((Interp *) interp)->noEval) {
-		valuePtr->type = TYPE_INT;
-		valuePtr->intValue = 0;
-		return TCL_OK;
-	    }
-	    return ExprParseString(interp, var, valuePtr);
-
-	case '[':
-	    infoPtr->token = VALUE;
-	    ((Interp *) interp)->evalFlags = TCL_BRACKET_TERM;
-	    result = Tcl_Eval(interp, p+1);
-	    infoPtr->expr = ((Interp *) interp)->termPtr;
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    infoPtr->expr++;
-	    if (((Interp *) interp)->noEval) {
-		valuePtr->type = TYPE_INT;
-		valuePtr->intValue = 0;
-		Tcl_ResetResult(interp);
-		return TCL_OK;
-	    }
-	    result = ExprParseString(interp, interp->result, valuePtr);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    Tcl_ResetResult(interp);
-	    return TCL_OK;
-
-	case '"':
-	    infoPtr->token = VALUE;
-	    result = TclParseQuotes(interp, infoPtr->expr, '"', 0,
-		    &infoPtr->expr, &valuePtr->pv);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    Tcl_ResetResult(interp);
-	    return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
-
-	case '{':
-	    infoPtr->token = VALUE;
-	    result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr,
-		    &valuePtr->pv);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    Tcl_ResetResult(interp);
-	    return ExprParseString(interp, valuePtr->pv.buffer, valuePtr);
-
-	case '(':
-	    infoPtr->token = OPEN_PAREN;
-	    return TCL_OK;
-
-	case ')':
-	    infoPtr->token = CLOSE_PAREN;
-	    return TCL_OK;
-
-	case ',':
-	    infoPtr->token = COMMA;
-	    return TCL_OK;
-
-	case '*':
-	    infoPtr->token = MULT;
-	    return TCL_OK;
-
-	case '/':
-	    infoPtr->token = DIVIDE;
-	    return TCL_OK;
-
-	case '%':
-	    infoPtr->token = MOD;
-	    return TCL_OK;
-
-	case '+':
-	    infoPtr->token = PLUS;
-	    return TCL_OK;
-
-	case '-':
-	    infoPtr->token = MINUS;
-	    return TCL_OK;
-
-	case '?':
-	    infoPtr->token = QUESTY;
-	    return TCL_OK;
-
-	case ':':
-	    infoPtr->token = COLON;
-	    return TCL_OK;
-
-	case '<':
-	    switch (p[1]) {
-		case '<':
-		    infoPtr->expr = p+2;
-		    infoPtr->token = LEFT_SHIFT;
-		    break;
-		case '=':
-		    infoPtr->expr = p+2;
-		    infoPtr->token = LEQ;
-		    break;
-		default:
-		    infoPtr->token = LESS;
-		    break;
-	    }
-	    return TCL_OK;
-
-	case '>':
-	    switch (p[1]) {
-		case '>':
-		    infoPtr->expr = p+2;
-		    infoPtr->token = RIGHT_SHIFT;
-		    break;
-		case '=':
-		    infoPtr->expr = p+2;
-		    infoPtr->token = GEQ;
-		    break;
-		default:
-		    infoPtr->token = GREATER;
-		    break;
-	    }
-	    return TCL_OK;
-
-	case '=':
-	    if (p[1] == '=') {
-		infoPtr->expr = p+2;
-		infoPtr->token = EQUAL;
-	    } else {
-		infoPtr->token = UNKNOWN;
-	    }
-	    return TCL_OK;
-
-	case '!':
-	    if (p[1] == '=') {
-		infoPtr->expr = p+2;
-		infoPtr->token = NEQ;
-	    } else {
-		infoPtr->token = NOT;
-	    }
-	    return TCL_OK;
-
-	case '&':
-	    if (p[1] == '&') {
-		infoPtr->expr = p+2;
-		infoPtr->token = AND;
-	    } else {
-		infoPtr->token = BIT_AND;
-	    }
-	    return TCL_OK;
-
-	case '^':
-	    infoPtr->token = BIT_XOR;
-	    return TCL_OK;
-
-	case '|':
-	    if (p[1] == '|') {
-		infoPtr->expr = p+2;
-		infoPtr->token = OR;
-	    } else {
-		infoPtr->token = BIT_OR;
-	    }
-	    return TCL_OK;
-
-	case '~':
-	    infoPtr->token = BIT_NOT;
-	    return TCL_OK;
-
-	default:
-	    if (isalpha(UCHAR(*p))) {
-		infoPtr->expr = p;
-		return ExprMathFunc(interp, infoPtr, valuePtr);
-	    }
-	    infoPtr->expr = p+1;
-	    infoPtr->token = UNKNOWN;
-	    return TCL_OK;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExprGetValue --
- *
- *	Parse a "value" from the remainder of the expression in infoPtr.
- *
- * Results:
- *	Normally TCL_OK is returned.  The value of the expression is
- *	returned in *valuePtr.  If an error occurred, then interp->result
- *	contains an error message and TCL_ERROR is returned.
- *	InfoPtr->token will be left pointing to the token AFTER the
- *	expression, and infoPtr->expr will point to the character just
- *	after the terminating token.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprGetValue(interp, infoPtr, prec, valuePtr)
-    Tcl_Interp *interp;			/* Interpreter to use for error
-					 * reporting. */
-    register ExprInfo *infoPtr;		/* Describes the state of the parse
-					 * just before the value (i.e. ExprLex
-					 * will be called to get first token
-					 * of value). */
-    int prec;				/* Treat any un-parenthesized operator
-					 * with precedence <= this as the end
-					 * of the expression. */
-    Value *valuePtr;			/* Where to store the value of the
-					 * expression.   Caller must have
-					 * initialized pv field. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Value value2;			/* Second operand for current
-					 * operator.  */
-    int operator;			/* Current operator (either unary
-					 * or binary). */
-    int badType;			/* Type of offending argument;  used
-					 * for error messages. */
-    int gotOp;				/* Non-zero means already lexed the
-					 * operator (while picking up value
-					 * for unary operator).  Don't lex
-					 * again. */
-    int result;
-
-    /*
-     * There are two phases to this procedure.  First, pick off an initial
-     * value.  Then, parse (binary operator, value) pairs until done.
-     */
-
-    gotOp = 0;
-    value2.pv.buffer = value2.pv.next = value2.staticSpace;
-    value2.pv.end = value2.pv.buffer + STATIC_STRING_SPACE - 1;
-    value2.pv.expandProc = TclExpandParseValue;
-    value2.pv.clientData = (ClientData) NULL;
-    result = ExprLex(interp, infoPtr, valuePtr);
-    if (result != TCL_OK) {
-	goto done;
-    }
-    if (infoPtr->token == OPEN_PAREN) {
-
-	/*
-	 * Parenthesized sub-expression.
-	 */
-
-	result = ExprGetValue(interp, infoPtr, -1, valuePtr);
-	if (result != TCL_OK) {
-	    goto done;
-	}
-	if (infoPtr->token != CLOSE_PAREN) {
-	    Tcl_AppendResult(interp, "unmatched parentheses in expression \"",
-		    infoPtr->originalExpr, "\"", (char *) NULL);
-	    result = TCL_ERROR;
-	    goto done;
-	}
-    } else {
-	if (infoPtr->token == MINUS) {
-	    infoPtr->token = UNARY_MINUS;
-	}
-	if (infoPtr->token == PLUS) {
-	    infoPtr->token = UNARY_PLUS;
-	}
-	if (infoPtr->token >= UNARY_MINUS) {
-
-	    /*
-	     * Process unary operators.
-	     */
-
-	    operator = infoPtr->token;
-	    result = ExprGetValue(interp, infoPtr, precTable[infoPtr->token],
-		    valuePtr);
-	    if (result != TCL_OK) {
-		goto done;
-	    }
-	    if (!iPtr->noEval) {
-		switch (operator) {
-		    case UNARY_MINUS:
-			if (valuePtr->type == TYPE_INT) {
-			    valuePtr->intValue = -valuePtr->intValue;
-			} else if (valuePtr->type == TYPE_DOUBLE){
-			    valuePtr->doubleValue = -valuePtr->doubleValue;
-			} else {
-			    badType = valuePtr->type;
-			    goto illegalType;
-			} 
-			break;
-		    case UNARY_PLUS:
-			if ((valuePtr->type != TYPE_INT)
-				&& (valuePtr->type != TYPE_DOUBLE)) {
-			    badType = valuePtr->type;
-			    goto illegalType;
-			} 
-			break;
-		    case NOT:
-			if (valuePtr->type == TYPE_INT) {
-			    valuePtr->intValue = !valuePtr->intValue;
-			} else if (valuePtr->type == TYPE_DOUBLE) {
-			    /*
-			     * Theoretically, should be able to use
-			     * "!valuePtr->intValue", but apparently some
-			     * compilers can't handle it.
-			     */
-			    if (valuePtr->doubleValue == 0.0) {
-				valuePtr->intValue = 1;
-			    } else {
-				valuePtr->intValue = 0;
-			    }
-			    valuePtr->type = TYPE_INT;
-			} else {
-			    badType = valuePtr->type;
-			    goto illegalType;
-			}
-			break;
-		    case BIT_NOT:
-			if (valuePtr->type == TYPE_INT) {
-			    valuePtr->intValue = ~valuePtr->intValue;
-			} else {
-			    badType  = valuePtr->type;
-			    goto illegalType;
-			}
-			break;
-		}
-	    }
-	    gotOp = 1;
-	} else if (infoPtr->token != VALUE) {
-	    goto syntaxError;
-	}
-    }
-
-    /*
-     * Got the first operand.  Now fetch (operator, operand) pairs.
-     */
-
-    if (!gotOp) {
-	result = ExprLex(interp, infoPtr, &value2);
-	if (result != TCL_OK) {
-	    goto done;
-	}
-    }
-    while (1) {
-	operator = infoPtr->token;
-	value2.pv.next = value2.pv.buffer;
-	if ((operator < MULT) || (operator >= UNARY_MINUS)) {
-	    if ((operator == END) || (operator == CLOSE_PAREN)
-		    || (operator == COMMA)) {
-		result = TCL_OK;
-		goto done;
-	    } else {
-		goto syntaxError;
-	    }
-	}
-	if (precTable[operator] <= prec) {
-	    result = TCL_OK;
-	    goto done;
-	}
-
-	/*
-	 * If we're doing an AND or OR and the first operand already
-	 * determines the result, don't execute anything in the
-	 * second operand:  just parse.  Same style for ?: pairs.
-	 */
-
-	if ((operator == AND) || (operator == OR) || (operator == QUESTY)) {
-	    if (valuePtr->type == TYPE_DOUBLE) {
-		valuePtr->intValue = valuePtr->doubleValue != 0;
-		valuePtr->type = TYPE_INT;
-	    } else if (valuePtr->type == TYPE_STRING) {
-		if (!iPtr->noEval) {
-		    badType = TYPE_STRING;
-		    goto illegalType;
-		}
-
-		/*
-		 * Must set valuePtr->intValue to avoid referencing
-		 * uninitialized memory in the "if" below;  the atual
-		 * value doesn't matter, since it will be ignored.
-		 */
-
-		valuePtr->intValue = 0;
-	    }
-	    if (((operator == AND) && !valuePtr->intValue)
-		    || ((operator == OR) && valuePtr->intValue)) {
-		iPtr->noEval++;
-		result = ExprGetValue(interp, infoPtr, precTable[operator],
-			&value2);
-		iPtr->noEval--;
-		if (operator == OR) {
-		    valuePtr->intValue = 1;
-		}
-		continue;
-	    } else if (operator == QUESTY) {
-		/*
-		 * Special note:  ?: operators must associate right to
-		 * left.  To make this happen, use a precedence one lower
-		 * than QUESTY when calling ExprGetValue recursively.
-		 */
-
-		if (valuePtr->intValue != 0) {
-		    valuePtr->pv.next = valuePtr->pv.buffer;
-		    result = ExprGetValue(interp, infoPtr,
-			    precTable[QUESTY] - 1, valuePtr);
-		    if (result != TCL_OK) {
-			goto done;
-		    }
-		    if (infoPtr->token != COLON) {
-			goto syntaxError;
-		    }
-		    value2.pv.next = value2.pv.buffer;
-		    iPtr->noEval++;
-		    result = ExprGetValue(interp, infoPtr,
-			    precTable[QUESTY] - 1, &value2);
-		    iPtr->noEval--;
-		} else {
-		    iPtr->noEval++;
-		    result = ExprGetValue(interp, infoPtr,
-			    precTable[QUESTY] - 1, &value2);
-		    iPtr->noEval--;
-		    if (result != TCL_OK) {
-			goto done;
-		    }
-		    if (infoPtr->token != COLON) {
-			goto syntaxError;
-		    }
-		    valuePtr->pv.next = valuePtr->pv.buffer;
-		    result = ExprGetValue(interp, infoPtr,
-			    precTable[QUESTY] - 1, valuePtr);
-		}
-		continue;
-	    } else {
-		result = ExprGetValue(interp, infoPtr, precTable[operator],
-			&value2);
-	    }
-	} else {
-	    result = ExprGetValue(interp, infoPtr, precTable[operator],
-		    &value2);
-	}
-	if (result != TCL_OK) {
-	    goto done;
-	}
-	if ((infoPtr->token < MULT) && (infoPtr->token != VALUE)
-		&& (infoPtr->token != END) && (infoPtr->token != COMMA)
-		&& (infoPtr->token != CLOSE_PAREN)) {
-	    goto syntaxError;
-	}
-
-	if (iPtr->noEval) {
-	    continue;
-	}
-
-	/*
-	 * At this point we've got two values and an operator.  Check
-	 * to make sure that the particular data types are appropriate
-	 * for the particular operator, and perform type conversion
-	 * if necessary.
-	 */
-
-	switch (operator) {
-
-	    /*
-	     * For the operators below, no strings are allowed and
-	     * ints get converted to floats if necessary.
-	     */
-
-	    case MULT: case DIVIDE: case PLUS: case MINUS:
-		if ((valuePtr->type == TYPE_STRING)
-			|| (value2.type == TYPE_STRING)) {
-		    badType = TYPE_STRING;
-		    goto illegalType;
-		}
-		if (valuePtr->type == TYPE_DOUBLE) {
-		    if (value2.type == TYPE_INT) {
-			value2.doubleValue = value2.intValue;
-			value2.type = TYPE_DOUBLE;
-		    }
-		} else if (value2.type == TYPE_DOUBLE) {
-		    if (valuePtr->type == TYPE_INT) {
-			valuePtr->doubleValue = valuePtr->intValue;
-			valuePtr->type = TYPE_DOUBLE;
-		    }
-		}
-		break;
-
-	    /*
-	     * For the operators below, only integers are allowed.
-	     */
-
-	    case MOD: case LEFT_SHIFT: case RIGHT_SHIFT:
-	    case BIT_AND: case BIT_XOR: case BIT_OR:
-		 if (valuePtr->type != TYPE_INT) {
-		     badType = valuePtr->type;
-		     goto illegalType;
-		 } else if (value2.type != TYPE_INT) {
-		     badType = value2.type;
-		     goto illegalType;
-		 }
-		 break;
-
-	    /*
-	     * For the operators below, any type is allowed but the
-	     * two operands must have the same type.  Convert integers
-	     * to floats and either to strings, if necessary.
-	     */
-
-	    case LESS: case GREATER: case LEQ: case GEQ:
-	    case EQUAL: case NEQ:
-		if (valuePtr->type == TYPE_STRING) {
-		    if (value2.type != TYPE_STRING) {
-			ExprMakeString(interp, &value2);
-		    }
-		} else if (value2.type == TYPE_STRING) {
-		    if (valuePtr->type != TYPE_STRING) {
-			ExprMakeString(interp, valuePtr);
-		    }
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    if (value2.type == TYPE_INT) {
-			value2.doubleValue = value2.intValue;
-			value2.type = TYPE_DOUBLE;
-		    }
-		} else if (value2.type == TYPE_DOUBLE) {
-		     if (valuePtr->type == TYPE_INT) {
-			valuePtr->doubleValue = valuePtr->intValue;
-			valuePtr->type = TYPE_DOUBLE;
-		    }
-		}
-		break;
-
-	    /*
-	     * For the operators below, no strings are allowed, but
-	     * no int->double conversions are performed.
-	     */
-
-	    case AND: case OR:
-		if (valuePtr->type == TYPE_STRING) {
-		    badType = valuePtr->type;
-		    goto illegalType;
-		}
-		if (value2.type == TYPE_STRING) {
-		    badType = value2.type;
-		    goto illegalType;
-		}
-		break;
-
-	    /*
-	     * For the operators below, type and conversions are
-	     * irrelevant:  they're handled elsewhere.
-	     */
-
-	    case QUESTY: case COLON:
-		break;
-
-	    /*
-	     * Any other operator is an error.
-	     */
-
-	    default:
-		interp->result = "unknown operator in expression";
-		result = TCL_ERROR;
-		goto done;
-	}
-
-	/*
-	 * Carry out the function of the specified operator.
-	 */
-
-	switch (operator) {
-	    case MULT:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue = valuePtr->intValue * value2.intValue;
-		} else {
-		    valuePtr->doubleValue *= value2.doubleValue;
-		}
-		break;
-	    case DIVIDE:
-	    case MOD:
-		if (valuePtr->type == TYPE_INT) {
-		    long divisor, quot, rem;
-		    int negative;
-
-		    if (value2.intValue == 0) {
-			divideByZero:
-			interp->result = "divide by zero";
-			Tcl_SetErrorCode(interp, "ARITH", "DIVZERO",
-				interp->result, (char *) NULL);
-			result = TCL_ERROR;
-			goto done;
-		    }
-
-		    /*
-		     * The code below is tricky because C doesn't guarantee
-		     * much about the properties of the quotient or
-		     * remainder, but Tcl does:  the remainder always has
-		     * the same sign as the divisor and a smaller absolute
-		     * value.
-		     */
-
-		    divisor = value2.intValue;
-		    negative = 0;
-		    if (divisor < 0) {
-			divisor = -divisor;
-			valuePtr->intValue = -valuePtr->intValue;
-			negative = 1;
-		    }
-		    quot = valuePtr->intValue / divisor;
-		    rem = valuePtr->intValue % divisor;
-		    if (rem < 0) {
-			rem += divisor;
-			quot -= 1;
-		    }
-		    if (negative) {
-			rem = -rem;
-		    }
-		    valuePtr->intValue = (operator == DIVIDE) ? quot : rem;
-		} else {
-		    if (value2.doubleValue == 0.0) {
-			goto divideByZero;
-		    }
-		    valuePtr->doubleValue /= value2.doubleValue;
-		}
-		break;
-	    case PLUS:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue = valuePtr->intValue + value2.intValue;
-		} else {
-		    valuePtr->doubleValue += value2.doubleValue;
-		}
-		break;
-	    case MINUS:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue = valuePtr->intValue - value2.intValue;
-		} else {
-		    valuePtr->doubleValue -= value2.doubleValue;
-		}
-		break;
-	    case LEFT_SHIFT:
-		valuePtr->intValue <<= value2.intValue;
-		break;
-	    case RIGHT_SHIFT:
-		/*
-		 * The following code is a bit tricky:  it ensures that
-		 * right shifts propagate the sign bit even on machines
-		 * where ">>" won't do it by default.
-		 */
-
-		if (valuePtr->intValue < 0) {
-		    valuePtr->intValue =
-			    ~((~valuePtr->intValue) >> value2.intValue);
-		} else {
-		    valuePtr->intValue >>= value2.intValue;
-		}
-		break;
-	    case LESS:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue =
-			valuePtr->intValue < value2.intValue;
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    valuePtr->intValue =
-			valuePtr->doubleValue < value2.doubleValue;
-		} else {
-		    valuePtr->intValue =
-			    strcmp(valuePtr->pv.buffer, value2.pv.buffer) < 0;
-		}
-		valuePtr->type = TYPE_INT;
-		break;
-	    case GREATER:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue =
-			valuePtr->intValue > value2.intValue;
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    valuePtr->intValue =
-			valuePtr->doubleValue > value2.doubleValue;
-		} else {
-		    valuePtr->intValue =
-			    strcmp(valuePtr->pv.buffer, value2.pv.buffer) > 0;
-		}
-		valuePtr->type = TYPE_INT;
-		break;
-	    case LEQ:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue =
-			valuePtr->intValue <= value2.intValue;
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    valuePtr->intValue =
-			valuePtr->doubleValue <= value2.doubleValue;
-		} else {
-		    valuePtr->intValue =
-			    strcmp(valuePtr->pv.buffer, value2.pv.buffer) <= 0;
-		}
-		valuePtr->type = TYPE_INT;
-		break;
-	    case GEQ:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue =
-			valuePtr->intValue >= value2.intValue;
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    valuePtr->intValue =
-			valuePtr->doubleValue >= value2.doubleValue;
-		} else {
-		    valuePtr->intValue =
-			    strcmp(valuePtr->pv.buffer, value2.pv.buffer) >= 0;
-		}
-		valuePtr->type = TYPE_INT;
-		break;
-	    case EQUAL:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue =
-			valuePtr->intValue == value2.intValue;
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    valuePtr->intValue =
-			valuePtr->doubleValue == value2.doubleValue;
-		} else {
-		    valuePtr->intValue =
-			    strcmp(valuePtr->pv.buffer, value2.pv.buffer) == 0;
-		}
-		valuePtr->type = TYPE_INT;
-		break;
-	    case NEQ:
-		if (valuePtr->type == TYPE_INT) {
-		    valuePtr->intValue =
-			valuePtr->intValue != value2.intValue;
-		} else if (valuePtr->type == TYPE_DOUBLE) {
-		    valuePtr->intValue =
-			valuePtr->doubleValue != value2.doubleValue;
-		} else {
-		    valuePtr->intValue =
-			    strcmp(valuePtr->pv.buffer, value2.pv.buffer) != 0;
-		}
-		valuePtr->type = TYPE_INT;
-		break;
-	    case BIT_AND:
-		valuePtr->intValue &= value2.intValue;
-		break;
-	    case BIT_XOR:
-		valuePtr->intValue ^= value2.intValue;
-		break;
-	    case BIT_OR:
-		valuePtr->intValue |= value2.intValue;
-		break;
-
-	    /*
-	     * For AND and OR, we know that the first value has already
-	     * been converted to an integer.  Thus we need only consider
-	     * the possibility of int vs. double for the second value.
-	     */
-
-	    case AND:
-		if (value2.type == TYPE_DOUBLE) {
-		    value2.intValue = value2.doubleValue != 0;
-		    value2.type = TYPE_INT;
-		}
-		valuePtr->intValue = valuePtr->intValue && value2.intValue;
-		break;
-	    case OR:
-		if (value2.type == TYPE_DOUBLE) {
-		    value2.intValue = value2.doubleValue != 0;
-		    value2.type = TYPE_INT;
-		}
-		valuePtr->intValue = valuePtr->intValue || value2.intValue;
-		break;
-
-	    case COLON:
-		interp->result = "can't have : operator without ? first";
-		result = TCL_ERROR;
-		goto done;
-	}
-    }
-
-    done:
-    if (value2.pv.buffer != value2.staticSpace) {
-	ckfree(value2.pv.buffer);
-    }
-    return result;
-
-    syntaxError:
-    Tcl_AppendResult(interp, "syntax error in expression \"",
-	    infoPtr->originalExpr, "\"", (char *) NULL);
-    result = TCL_ERROR;
-    goto done;
-
-    illegalType:
-    Tcl_AppendResult(interp, "can't use ", (badType == TYPE_DOUBLE) ?
-	    "floating-point value" : "non-numeric string",
-	    " as operand of \"", operatorStrings[operator], "\"",
-	    (char *) NULL);
-    result = TCL_ERROR;
-    goto done;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * ExprMakeString --
- *
- *	Convert a value from int or double representation to
- *	a string.
- *
- * Results:
- *	The information at *valuePtr gets converted to string
- *	format, if it wasn't that way already.
- *
- * Side effects:
- *	None.
- *
- *--------------------------------------------------------------
- */
-
-static void
-ExprMakeString(interp, valuePtr)
-    Tcl_Interp *interp;			/* Interpreter to use for precision
-					 * information. */
-    register Value *valuePtr;		/* Value to be converted. */
-{
-    int shortfall;
-
-    shortfall = 150 - (valuePtr->pv.end - valuePtr->pv.buffer);
-    if (shortfall > 0) {
-	(*valuePtr->pv.expandProc)(&valuePtr->pv, shortfall);
-    }
-    if (valuePtr->type == TYPE_INT) {
-	sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue);
-    } else if (valuePtr->type == TYPE_DOUBLE) {
-	Tcl_PrintDouble(interp, valuePtr->doubleValue, valuePtr->pv.buffer);
-    }
-    valuePtr->type = TYPE_STRING;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * ExprTopLevel --
- *
- *	This procedure provides top-level functionality shared by
- *	procedures like Tcl_ExprInt, Tcl_ExprDouble, etc.
- *
- * Results:
- *	The result is a standard Tcl return value.  If an error
- *	occurs then an error message is left in interp->result.
- *	The value of the expression is returned in *valuePtr, in
- *	whatever form it ends up in (could be string or integer
- *	or double).  Caller may need to convert result.  Caller
- *	is also responsible for freeing string memory in *valuePtr,
- *	if any was allocated.
- *
- * Side effects:
- *	None.
- *
- *--------------------------------------------------------------
- */
-
-static int
-ExprTopLevel(interp, string, valuePtr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    char *string;			/* Expression to evaluate. */
-    Value *valuePtr;			/* Where to store result.  Should
-					 * not be initialized by caller. */
-{
-    ExprInfo info;
-    int result;
-
-    /*
-     * Create the math functions the first time an expression is
-     * evaluated.
-     */
-
-    if (!(((Interp *) interp)->flags & EXPR_INITIALIZED)) {
-	BuiltinFunc *funcPtr;
-
-	((Interp *) interp)->flags |= EXPR_INITIALIZED;
-	for (funcPtr = funcTable; funcPtr->name != NULL;
-		funcPtr++) {
-	    Tcl_CreateMathFunc(interp, funcPtr->name, funcPtr->numArgs,
-		    funcPtr->argTypes, funcPtr->proc, funcPtr->clientData);
-	}
-    }
-
-    info.originalExpr = string;
-    info.expr = string;
-    valuePtr->pv.buffer = valuePtr->pv.next = valuePtr->staticSpace;
-    valuePtr->pv.end = valuePtr->pv.buffer + STATIC_STRING_SPACE - 1;
-    valuePtr->pv.expandProc = TclExpandParseValue;
-    valuePtr->pv.clientData = (ClientData) NULL;
-
-    result = ExprGetValue(interp, &info, -1, valuePtr);
-    if (result != TCL_OK) {
-	return result;
-    }
-    if (info.token != END) {
-	Tcl_AppendResult(interp, "syntax error in expression \"",
-		string, "\"", (char *) NULL);
-	return TCL_ERROR;
-    }
-    if ((valuePtr->type == TYPE_DOUBLE) && (IS_NAN(valuePtr->doubleValue)
-	    || IS_INF(valuePtr->doubleValue))) {
-	/*
-	 * IEEE floating-point error.
-	 */
-
-	TclExprFloatError(interp, valuePtr->doubleValue);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
- *
- *	Procedures to evaluate an expression and return its value
- *	in a particular form.
- *
- * Results:
- *	Each of the procedures below returns a standard Tcl result.
- *	If an error occurs then an error message is left in
- *	interp->result.  Otherwise the value of the expression,
- *	in the appropriate form, is stored at *resultPtr.  If
- *	the expression had a result that was incompatible with the
- *	desired form then an error is returned.
- *
- * Side effects:
- *	None.
- *
- *--------------------------------------------------------------
- */
-
-int
-Tcl_ExprLong(interp, string, ptr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    char *string;			/* Expression to evaluate. */
-    long *ptr;				/* Where to store result. */
-{
-    Value value;
-    int result;
-
-    result = ExprTopLevel(interp, string, &value);
-    if (result == TCL_OK) {
-	if (value.type == TYPE_INT) {
-	    *ptr = value.intValue;
-	} else if (value.type == TYPE_DOUBLE) {
-	    *ptr = (long) value.doubleValue;
-	} else {
-	    interp->result = "expression didn't have numeric value";
-	    result = TCL_ERROR;
-	}
-    }
-    if (value.pv.buffer != value.staticSpace) {
-	ckfree(value.pv.buffer);
-    }
-    return result;
-}
-
-int
-Tcl_ExprDouble(interp, string, ptr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    char *string;			/* Expression to evaluate. */
-    double *ptr;			/* Where to store result. */
-{
-    Value value;
-    int result;
-
-    result = ExprTopLevel(interp, string, &value);
-    if (result == TCL_OK) {
-	if (value.type == TYPE_INT) {
-	    *ptr = value.intValue;
-	} else if (value.type == TYPE_DOUBLE) {
-	    *ptr = value.doubleValue;
-	} else {
-	    interp->result = "expression didn't have numeric value";
-	    result = TCL_ERROR;
-	}
-    }
-    if (value.pv.buffer != value.staticSpace) {
-	ckfree(value.pv.buffer);
-    }
-    return result;
-}
-
-int
-Tcl_ExprBoolean(interp, string, ptr)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    char *string;			/* Expression to evaluate. */
-    int *ptr;				/* Where to store 0/1 result. */
-{
-    Value value;
-    int result;
-
-    result = ExprTopLevel(interp, string, &value);
-    if (result == TCL_OK) {
-	if (value.type == TYPE_INT) {
-	    *ptr = value.intValue != 0;
-	} else if (value.type == TYPE_DOUBLE) {
-	    *ptr = value.doubleValue != 0.0;
-	} else {
-	    result = Tcl_GetBoolean(interp, value.pv.buffer, ptr);
-	}
-    }
-    if (value.pv.buffer != value.staticSpace) {
-	ckfree(value.pv.buffer);
-    }
-    return result;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_ExprString --
- *
- *	Evaluate an expression and return its value in string form.
- *
- * Results:
- *	A standard Tcl result.  If the result is TCL_OK, then the
- *	interpreter's result is set to the string value of the
- *	expression.  If the result is TCL_OK, then interp->result
- *	contains an error message.
- *
- * Side effects:
- *	None.
- *
- *--------------------------------------------------------------
- */
-
-int
-Tcl_ExprString(interp, string)
-    Tcl_Interp *interp;			/* Context in which to evaluate the
-					 * expression. */
-    char *string;			/* Expression to evaluate. */
-{
-    Value value;
-    int result;
-
-    result = ExprTopLevel(interp, string, &value);
-    if (result == TCL_OK) {
-	if (value.type == TYPE_INT) {
-	    sprintf(interp->result, "%ld", value.intValue);
-	} else if (value.type == TYPE_DOUBLE) {
-	    Tcl_PrintDouble(interp, value.doubleValue, interp->result);
-	} else {
-	    if (value.pv.buffer != value.staticSpace) {
-		interp->result = value.pv.buffer;
-		interp->freeProc = TCL_DYNAMIC;
-		value.pv.buffer = value.staticSpace;
-	    } else {
-		Tcl_SetResult(interp, value.pv.buffer, TCL_VOLATILE);
-	    }
-	}
-    }
-    if (value.pv.buffer != value.staticSpace) {
-	ckfree(value.pv.buffer);
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateMathFunc --
- *
- *	Creates a new math function for expressions in a given
- *	interpreter.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The function defined by "name" is created;  if such a function
- *	already existed then its definition is overriden.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
-    Tcl_Interp *interp;			/* Interpreter in which function is
-					 * to be available. */
-    char *name;				/* Name of function (e.g. "sin"). */
-    int numArgs;			/* Nnumber of arguments required by
-					 * function. */
-    Tcl_ValueType *argTypes;		/* Array of types acceptable for
-					 * each argument. */
-    Tcl_MathProc *proc;			/* Procedure that implements the
-					 * math function. */
-    ClientData clientData;		/* Additional value to pass to the
-					 * function. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr;
-    MathFunc *mathFuncPtr;
-    int new, i;
-
-    hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
-    if (new) {
-	Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
-    }
-    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
-    if (numArgs > MAX_MATH_ARGS) {
-	numArgs = MAX_MATH_ARGS;
-    }
-    mathFuncPtr->numArgs = numArgs;
-    for (i = 0; i < numArgs; i++) {
-	mathFuncPtr->argTypes[i] = argTypes[i];
-    }
-    mathFuncPtr->proc = proc;
-    mathFuncPtr->clientData = clientData;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExprMathFunc --
- *
- *	This procedure is invoked to parse a math function from an
- *	expression string, carry out the function, and return the
- *	value computed.
- *
- * Results:
- *	TCL_OK is returned if all went well and the function's value
- *	was computed successfully.  If an error occurred, TCL_ERROR
- *	is returned and an error message is left in interp->result.
- *	After a successful return infoPtr has been updated to refer
- *	to the character just after the function call, the token is
- *	set to VALUE, and the value is stored in valuePtr.
- *
- * Side effects:
- *	Embedded commands could have arbitrary side-effects.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprMathFunc(interp, infoPtr, valuePtr)
-    Tcl_Interp *interp;			/* Interpreter to use for error
-					 * reporting. */
-    register ExprInfo *infoPtr;		/* Describes the state of the parse.
-					 * infoPtr->expr must point to the
-					 * first character of the function's
-					 * name. */
-    register Value *valuePtr;		/* Where to store value, if that is
-					 * what's parsed from string.  Caller
-					 * must have initialized pv field
-					 * correctly. */
-{
-    Interp *iPtr = (Interp *) interp;
-    MathFunc *mathFuncPtr;		/* Info about math function. */
-    Tcl_Value args[MAX_MATH_ARGS];	/* Arguments for function call. */
-    Tcl_Value funcResult;		/* Result of function call. */
-    Tcl_HashEntry *hPtr;
-    char *p, *funcName, savedChar;
-    int i, result;
-
-    /*
-     * Find the end of the math function's name and lookup the MathFunc
-     * record for the function.
-     */
-
-    p = funcName = infoPtr->expr;
-    while (isalnum(UCHAR(*p)) || (*p == '_')) {
-	p++;
-    }
-    infoPtr->expr = p;
-    result = ExprLex(interp, infoPtr, valuePtr);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (infoPtr->token != OPEN_PAREN) {
-	goto syntaxError;
-    }
-    savedChar = *p;
-    *p = 0;
-    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
-    if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "unknown math function \"", funcName,
-		"\"", (char *) NULL);
-	*p = savedChar;
-	return TCL_ERROR;
-    }
-    *p = savedChar;
-    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
-
-    /*
-     * Scan off the arguments for the function, if there are any.
-     */
-
-    if (mathFuncPtr->numArgs == 0) {
-	result = ExprLex(interp, infoPtr, valuePtr);
-	if ((result != TCL_OK) || (infoPtr->token != CLOSE_PAREN)) {
-	    goto syntaxError;
-	}
-    } else {
-	for (i = 0; ; i++) {
-	    valuePtr->pv.next = valuePtr->pv.buffer;
-	    result = ExprGetValue(interp, infoPtr, -1, valuePtr);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    if (valuePtr->type == TYPE_STRING) {
-		interp->result =
-			"argument to math function didn't have numeric value";
-		return TCL_ERROR;
-	    }
-    
-	    /*
-	     * Copy the value to the argument record, converting it if
-	     * necessary.
-	     */
-    
-	    if (valuePtr->type == TYPE_INT) {
-		if (mathFuncPtr->argTypes[i] == TCL_DOUBLE) {
-		    args[i].type = TCL_DOUBLE;
-		    args[i].doubleValue = valuePtr->intValue;
-		} else {
-		    args[i].type = TCL_INT;
-		    args[i].intValue = valuePtr->intValue;
-		}
-	    } else {
-		if (mathFuncPtr->argTypes[i] == TCL_INT) {
-		    args[i].type = TCL_INT;
-		    args[i].intValue = (long) valuePtr->doubleValue;
-		} else {
-		    args[i].type = TCL_DOUBLE;
-		    args[i].doubleValue = valuePtr->doubleValue;
-		}
-	    }
-    
-	    /*
-	     * Check for a comma separator between arguments or a close-paren
-	     * to end the argument list.
-	     */
-    
-	    if (i == (mathFuncPtr->numArgs-1)) {
-		if (infoPtr->token == CLOSE_PAREN) {
-		    break;
-		}
-		if (infoPtr->token == COMMA) {
-		    interp->result = "too many arguments for math function";
-		    return TCL_ERROR;
-		} else {
-		    goto syntaxError;
-		}
-	    }
-	    if (infoPtr->token != COMMA) {
-		if (infoPtr->token == CLOSE_PAREN) {
-		    interp->result = "too few arguments for math function";
-		    return TCL_ERROR;
-		} else {
-		    goto syntaxError;
-		}
-	    }
-	}
-    }
-    if (iPtr->noEval) {
-	valuePtr->type = TYPE_INT;
-	valuePtr->intValue = 0;
-	infoPtr->token = VALUE;
-	return TCL_OK;
-    }
-
-    /*
-     * Invoke the function and copy its result back into valuePtr.
-     */
-
-    tcl_MathInProgress++;
-    result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
-	    &funcResult);
-    tcl_MathInProgress--;
-    if (result != TCL_OK) {
-	return result;
-    }
-    if (funcResult.type == TCL_INT) {
-	valuePtr->type = TYPE_INT;
-	valuePtr->intValue = funcResult.intValue;
-    } else {
-	valuePtr->type = TYPE_DOUBLE;
-	valuePtr->doubleValue = funcResult.doubleValue;
-    }
-    infoPtr->token = VALUE;
-    return TCL_OK;
-
-    syntaxError:
-    Tcl_AppendResult(interp, "syntax error in expression \"",
-	    infoPtr->originalExpr, "\"", (char *) NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclExprFloatError --
- *
- *	This procedure is called when an error occurs during a
- *	floating-point operation.  It reads errno and sets
- *	interp->result accordingly.
- *
- * Results:
- *	Interp->result is set to hold an error message.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclExprFloatError(interp, value)
-    Tcl_Interp *interp;		/* Where to store error message. */
-    double value;		/* Value returned after error;  used to
-				 * distinguish underflows from overflows. */
-{
-    char buf[20];
-
-    if ((errno == EDOM) || (value != value)) {
-	interp->result = "domain error: argument not in valid range";
-	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", interp->result,
-		(char *) NULL);
-    } else if ((errno == ERANGE) || IS_INF(value)) {
-	if (value == 0.0) {
-	    interp->result = "floating-point value too small to represent";
-	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", interp->result,
-		    (char *) NULL);
-	} else {
-	    interp->result = "floating-point value too large to represent";
-	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", interp->result,
-		    (char *) NULL);
-	}
-    } else {
-	sprintf(buf, "%d", errno);
-	Tcl_AppendResult(interp, "unknown floating-point error, ",
-		"errno = ", buf, (char *) NULL);
-	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", interp->result,
-		(char *) NULL);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Math Functions --
- *
- *	This page contains the procedures that implement all of the
- *	built-in math functions for expressions.
- *
- * Results:
- *	Each procedure returns TCL_OK if it succeeds and places result
- *	information at *resultPtr.  If it fails it returns TCL_ERROR
- *	and leaves an error message in interp->result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprUnaryFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;		/* Contains address of procedure that
-					 * takes one double argument and
-					 * returns a double result. */
-    Tcl_Interp *interp;
-    Tcl_Value *args;
-    Tcl_Value *resultPtr;
-{
-    double (*func) _ANSI_ARGS_((double)) = (double (*)_ANSI_ARGS_((double))) clientData;
-
-    errno = 0;
-    resultPtr->type = TCL_DOUBLE;
-    resultPtr->doubleValue = (*func)(args[0].doubleValue);
-    if (errno != 0) {
-	TclExprFloatError(interp, resultPtr->doubleValue);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-static int
-ExprBinaryFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;		/* Contains address of procedure that
-					 * takes two double arguments and
-					 * returns a double result. */
-    Tcl_Interp *interp;
-    Tcl_Value *args;
-    Tcl_Value *resultPtr;
-{
-    double (*func) _ANSI_ARGS_((double, double))
-	= (double (*)_ANSI_ARGS_((double, double))) clientData;
-
-    errno = 0;
-    resultPtr->type = TCL_DOUBLE;
-    resultPtr->doubleValue = (*func)(args[0].doubleValue, args[1].doubleValue);
-    if (errno != 0) {
-	TclExprFloatError(interp, resultPtr->doubleValue);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-	/* ARGSUSED */
-static int
-ExprAbsFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;
-    Tcl_Interp *interp;
-    Tcl_Value *args;
-    Tcl_Value *resultPtr;
-{
-    resultPtr->type = TCL_DOUBLE;
-    if (args[0].type == TCL_DOUBLE) {
-	resultPtr->type = TCL_DOUBLE;
-	if (args[0].doubleValue < 0) {
-	    resultPtr->doubleValue = -args[0].doubleValue;
-	} else {
-	    resultPtr->doubleValue = args[0].doubleValue;
-	}
-    } else {
-	resultPtr->type = TCL_INT;
-	if (args[0].intValue < 0) {
-	    resultPtr->intValue = -args[0].intValue;
-	    if (resultPtr->intValue < 0) {
-		interp->result = "integer value too large to represent";
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", interp->result,
-			(char *) NULL);
-		return TCL_ERROR;
-	    }
-	} else {
-	    resultPtr->intValue = args[0].intValue;
-	}
-    }
-    return TCL_OK;
-}
-
-	/* ARGSUSED */
-static int
-ExprDoubleFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;
-    Tcl_Interp *interp;
-    Tcl_Value *args;
-    Tcl_Value *resultPtr;
-{
-    resultPtr->type = TCL_DOUBLE;
-    if (args[0].type == TCL_DOUBLE) {
-	resultPtr->doubleValue = args[0].doubleValue;
-    } else {
-	resultPtr->doubleValue = args[0].intValue;
-    }
-    return TCL_OK;
-}
-
-	/* ARGSUSED */
-static int
-ExprIntFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;
-    Tcl_Interp *interp;
-    Tcl_Value *args;
-    Tcl_Value *resultPtr;
-{
-    resultPtr->type = TCL_INT;
-    if (args[0].type == TCL_INT) {
-	resultPtr->intValue = args[0].intValue;
-    } else {
-	if (args[0].doubleValue < 0) {
-	    if (args[0].doubleValue < (double) (long) LONG_MIN) {
-		tooLarge:
-		interp->result = "integer value too large to represent";
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			interp->result, (char *) NULL);
-		return TCL_ERROR;
-	    }
-	} else {
-	    if (args[0].doubleValue > (double) LONG_MAX) {
-		goto tooLarge;
-	    }
-	}
-	resultPtr->intValue = (long) args[0].doubleValue;
-    }
-    return TCL_OK;
-}
-
-	/* ARGSUSED */
-static int
-ExprRoundFunc(clientData, interp, args, resultPtr)
-    ClientData clientData;
-    Tcl_Interp *interp;
-    Tcl_Value *args;
-    Tcl_Value *resultPtr;
-{
-    resultPtr->type = TCL_INT;
-    if (args[0].type == TCL_INT) {
-	resultPtr->intValue = args[0].intValue;
-    } else {
-	if (args[0].doubleValue < 0) {
-	    if (args[0].doubleValue <= (((double) (long) LONG_MIN) - 0.5)) {
-		tooLarge:
-		interp->result = "integer value too large to represent";
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			interp->result, (char *) NULL);
-		return TCL_ERROR;
-	    }
-	    resultPtr->intValue = (long) (args[0].doubleValue - 0.5);
-	} else {
-	    if (args[0].doubleValue >= (((double) LONG_MAX + 0.5))) {
-		goto tooLarge;
-	    }
-	    resultPtr->intValue = (long) (args[0].doubleValue + 0.5);
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExprLooksLikeInt --
- *
- *	This procedure decides whether the leading characters of a
- *	string look like an integer or something else (such as a
- *	floating-point number or string).
- *
- * Results:
- *	The return value is 1 if the leading characters of p look
- *	like a valid Tcl integer.  If they look like a floating-point
- *	number (e.g. "e01" or "2.4"), or if they don't look like a
- *	number at all, then 0 is returned.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ExprLooksLikeInt(p)
-    char *p;			/* Pointer to string. */
-{
-    while (isspace(UCHAR(*p))) {
-	p++;
-    }
-    if ((*p == '+') || (*p == '-')) {
-	p++;
-    }
-    if (!isdigit(UCHAR(*p))) {
-	return 0;
-    }
-    p++;
-    while (isdigit(UCHAR(*p))) {
-	p++;
-    }
-    if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
-	return 1;
-    }
-    return 0;
-}
diff --git a/contrib/tcl/generic/tclFHandle.c b/contrib/tcl/generic/tclFHandle.c
deleted file mode 100644
index f8b3798b3e70..000000000000
--- a/contrib/tcl/generic/tclFHandle.c
+++ /dev/null
@@ -1,259 +0,0 @@
-/* 
- * tclFHandle.c --
- *
- *	This file contains functions for manipulating Tcl file handles.
- *
- * Copyright (c) 1995 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclFHandle.c 1.8 96/06/27 15:31:34
- */
-
-#include "tcl.h"
-#include "tclInt.h"
-#include "tclPort.h"
-
-/*
- * The FileHashKey structure is used to associate the OS file handle and type
- * with the corresponding notifier data in a FileHandle.
- */
-
-typedef struct FileHashKey {
-    int type;			/* File handle type. */
-    ClientData osHandle;	/* Platform specific OS file handle. */
-} FileHashKey;
-
-typedef struct FileHandle {
-    FileHashKey key;		/* Hash key for a given file. */
-    ClientData data;		/* Platform specific notifier data. */
-    Tcl_FileFreeProc *proc;	/* Callback to invoke when file is freed. */
-} FileHandle;
-
-/*
- * Static variables used in this file:
- */
-
-static Tcl_HashTable fileTable;	/* Hash table containing file handles. */
-static int initialized = 0;	/* 1 if this module has been initialized. */
-
-/*
- * Static procedures used in this file:
- */
-
-static void 		FileExitProc _ANSI_ARGS_((ClientData clientData));
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetFile --
- *
- *	This function retrieves the file handle associated with a
- *	platform specific file handle of the given type.  It creates
- *	a new file handle if needed.
- *
- * Results:
- *	Returns the file handle associated with the file descriptor.
- *
- * Side effects:
- *	Initializes the file handle table if necessary.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_File
-Tcl_GetFile(osHandle, type)
-    ClientData osHandle;	/* Platform specific file handle. */
-    int type;			/* Type of file handle. */
-{
-    FileHashKey key;
-    Tcl_HashEntry *entryPtr;
-    int new;
-
-    if (!initialized) {
-	Tcl_InitHashTable(&fileTable, sizeof(FileHashKey)/sizeof(int));
-	Tcl_CreateExitHandler(FileExitProc, 0);
-	initialized = 1;
-    }
-    key.osHandle = osHandle;
-    key.type = type;
-    entryPtr = Tcl_CreateHashEntry(&fileTable, (char *) &key, &new);
-    if (new) {
-	FileHandle *newHandlePtr;
-	newHandlePtr = (FileHandle *) ckalloc(sizeof(FileHandle));
-	newHandlePtr->key = key;
-	newHandlePtr->data = NULL;
-	newHandlePtr->proc = NULL;
-	Tcl_SetHashValue(entryPtr, newHandlePtr);
-    }
-    
-    return (Tcl_File) Tcl_GetHashValue(entryPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FreeFile --
- *
- *	Deallocates an entry in the file handle table.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_FreeFile(handle)
-    Tcl_File handle;
-{
-    Tcl_HashEntry *entryPtr;
-    FileHandle *handlePtr = (FileHandle *) handle;
-    
-    /*
-     * Invoke free procedure, then delete the handle.
-     */
-
-    if (handlePtr->proc) {
-	(*handlePtr->proc)(handlePtr->data);
-    }
-
-    /*
-     * Tcl_File structures may be freed as a result of running the
-     * channel table exit handler. The file table is freed by the file
-     * table exit handler, which may run before the channel table exit
-     * handler. The file table exit handler sets the "initialized"
-     * variable back to zero, so that the Tcl_FreeFile (when invoked
-     * from the channel table exit handler) can notice that the file
-     * table has already been destroyed. Otherwise, accessing a
-     * deleted hash table would cause a panic.
-     */
-     
-    if (initialized) {
-        entryPtr = Tcl_FindHashEntry(&fileTable, (char *) &handlePtr->key);
-        if (entryPtr) {
-            Tcl_DeleteHashEntry(entryPtr);
-        }
-    }
-    ckfree((char *) handlePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetFileInfo --
- *
- *	This function retrieves the platform specific file data and
- *	type from the file handle.
- *
- * Results:
- *	If typePtr is not NULL, sets *typePtr to the type of the file.
- *	Returns the platform specific file data.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-ClientData
-Tcl_GetFileInfo(handle, typePtr)
-    Tcl_File handle;
-    int *typePtr;
-{
-    FileHandle *handlePtr = (FileHandle *) handle;
-
-    if (typePtr) {
-	*typePtr = handlePtr->key.type;
-    }
-    return handlePtr->key.osHandle;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetNotifierData --
- *
- *	This function is used by the notifier to associate platform
- *	specific notifier information and a deletion procedure with
- *	a file handle.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Updates the data and delProc slots in the file handle.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetNotifierData(handle, proc, data)
-    Tcl_File handle;
-    Tcl_FileFreeProc *proc;
-    ClientData data;
-{
-    FileHandle *handlePtr = (FileHandle *) handle;
-    handlePtr->proc = proc;
-    handlePtr->data = data;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetNotifierData --
- *
- *	This function is used by the notifier to retrieve the platform
- *	specific notifier information associated with a file handle.
- *
- * Results:
- *	Returns the data stored in a file handle by a previous call to
- *	Tcl_SetNotifierData, and places a pointer to the free proc
- *	in the location referred to by procPtr.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-ClientData
-Tcl_GetNotifierData(handle, procPtr)
-    Tcl_File handle;
-    Tcl_FileFreeProc **procPtr;
-{
-    FileHandle *handlePtr = (FileHandle *) handle;
-    if (procPtr != NULL) {
-	*procPtr = handlePtr->proc;
-    }
-    return handlePtr->data;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileExitProc --
- *
- *	This function an exit handler that frees any memory allocated
- *	for the file handle table.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Cleans up the file handle table.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FileExitProc(clientData)
-    ClientData clientData;	/* Not used. */
-{
-    Tcl_DeleteHashTable(&fileTable);
-    initialized = 0;
-}
diff --git a/contrib/tcl/library/safeinit.tcl b/contrib/tcl/library/safeinit.tcl
deleted file mode 100644
index e1ce1a039599..000000000000
--- a/contrib/tcl/library/safeinit.tcl
+++ /dev/null
@@ -1,461 +0,0 @@
-# safeinit.tcl --
-#
-# This code runs in a master to manage a safe slave with Safe Tcl.
-# See the safe.n man page for details.
-#
-# Copyright (c) 1996-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.
-#
-# SCCS: @(#) safeinit.tcl 1.38 97/06/20 12:57:39
-
-# This procedure creates a safe slave, initializes it with the
-# safe base and installs the aliases for the security policy mechanism.
-
-proc tcl_safeCreateInterp {slave} {
-    global auto_path
-
-    # Create the slave.
-    interp create -safe $slave
-
-    # Set its auto_path
-    interp eval $slave [list set auto_path $auto_path]
-
-    # And initialize it.
-    return [tcl_safeInitInterp $slave]
-}
-
-# This procedure applies the initializations to an already existing
-# interpreter. It is useful when you want to enable an interpreter
-# created with "interp create -safe" to use security policies.
-
-proc tcl_safeInitInterp {slave} {
-    upvar #0 tclSafe$slave state
-    global tcl_library tk_library auto_path tcl_platform
-
-    # These aliases let the slave load files to define new commands
-
-    interp alias $slave source {} tclSafeAliasSource $slave
-    interp alias $slave load {} tclSafeAliasLoad $slave
-
-    # This alias lets the slave have access to a subset of the 'file'
-    # command functionality.
-    tclAliasSubset $slave file file dir.* join root.* ext.* tail \
-	path.* split
-
-    # This alias interposes on the 'exit' command and cleanly terminates
-    # the slave.
-    interp alias $slave exit {} tcl_safeDeleteInterp $slave
-
-    # Source init.tcl into the slave, to get auto_load and other
-    # procedures defined:
-
-    if {$tcl_platform(platform) == "macintosh"} {
-	if {[catch {interp eval $slave [list source -rsrc Init]}]} {
-	    if {[catch {interp eval $slave \
-			[list source [file join $tcl_library init.tcl]]}]} {
-		error "can't source init.tcl into slave $slave"
-	    }
-	}
-    } else {
-	if {[catch {interp eval $slave \
-			[list source [file join $tcl_library init.tcl]]}]} {
-	    error "can't source init.tcl into slave $slave"
-	}
-    }
-
-    # Loading packages into slaves is handled by their master.
-    # This is overloaded to deal with regular packages and security policies
-
-    interp alias $slave tclPkgUnknown {} tclSafeAliasPkgUnknown $slave
-    interp eval $slave {package unknown tclPkgUnknown}
-
-    # We need a helper procedure to define a $dir variable and then
-    # do a source of the pkgIndex.tcl file
-    interp eval $slave \
-	[list proc tclPkgSource {dir args} {
-		if {[llength $args] == 2} {
-		    source [lindex $args 0] [lindex $args 1]
-		} else {
-		    source [lindex $args 0]
-		}
-	      }]
-
-    # Let the slave inherit a few variables
-    foreach varName \
-	{tcl_library tcl_version tcl_patchLevel \
-	 tcl_platform(platform) auto_path} {
-	upvar #0 $varName var
-	interp eval $slave [list set $varName $var]
-    }
-
-    # Other variables are predefined with set values
-    foreach {varName value} {
-	    auto_noexec 1
-	    errorCode {}
-	    errorInfo {}
-	    env() {}
-	    argv0 {}
-	    argv {}
-	    argc 0
-	    tcl_interactive 0
-	    } {
-	interp eval $slave [list set $varName $value]
-    }
-
-    # If auto_path is not set in the slave, set it to empty so it has
-    # a value and exists. Otherwise auto_loading and package require
-    # will complain.
-
-    interp eval $slave {
-	if {![info exists auto_path]} {
-	    set auto_path {}
-	}
-    }
-
-    # If we have Tk, make the slave have the same library as us:
-
-    if {[info exists tk_library]} {
-        interp eval $slave [list set tk_library $tk_library]
-    }
-
-    # Stub out auto-exec mechanism in slave
-    interp eval $slave [list proc auto_execok {name} {return {}}]
-
-    return $slave
-}
-
-# This procedure deletes a safe slave managed by Safe Tcl and
-# cleans up associated state:
-
-proc tcl_safeDeleteInterp {slave args} {
-    upvar #0 tclSafe$slave state
-
-    # If the slave has a policy loaded, clean it up now.
-    if {[info exists state(policyLoaded)]} {
-	set policy $state(policyLoaded)
-	set proc ${policy}_PolicyCleanup
-	if {[string compare [info proc $proc] $proc] == 0} {
-	    $proc $slave
-	}
-    }
-
-    # Discard the global array of state associated with the slave, and
-    # delete the interpreter.
-    catch {unset state}
-    catch {interp delete $slave}
-
-    return
-}
-
-# This procedure computes the global security policy search path.
-
-proc tclSafeComputePolicyPath {} {
-    global auto_path tclSafeAutoPathComputed tclSafePolicyPath
-
-    set recompute 0
-    if {(![info exists tclSafePolicyPath]) ||
-	    ("$tclSafePolicyPath" == "")} {
-	set tclSafePolicyPath ""
-	set tclSafeAutoPathComputed ""
-	set recompute 1
-    }
-    if {"$tclSafeAutoPathComputed" != "$auto_path"} {
-	set recompute 1
-	set tclSafeAutoPathComputed $auto_path
-    }
-    if {$recompute == 1} {
-	set tclSafePolicyPath ""
-	foreach i $auto_path {
-	    lappend tclSafePolicyPath [file join $i policies]
-	}
-    }
-    return $tclSafePolicyPath
-}
-
-# ---------------------------------------------------------------------------
-# ---------------------------------------------------------------------------
-
-# tclSafeAliasSource is the target of the "source" alias in safe interpreters.
-
-proc tclSafeAliasSource {slave args} {
-    global auto_path errorCode errorInfo
-
-    if {[llength $args] == 2} {
-	if {[string compare "-rsrc" [lindex $args 0]] != 0} {
-	    return -code error "incorrect arguments to source"
-	}
-	if {[catch {interp invokehidden $slave source -rsrc [lindex $args 1]} \
-		 msg]} {
-	    return -code error $msg
-	}
-    } else {
-	set file [lindex $args 0]
-	if {[catch {tclFileInPath $file $auto_path $slave} msg]} {
-	    return -code error "permission denied"
-	}
-	set errorInfo ""
-	if {[catch {interp invokehidden $slave source $file} msg]} {
-	    return -code error $msg
-	}
-    }
-    return $msg
-}
-
-# tclSafeAliasLoad is the target of the "load" alias in safe interpreters.
-
-proc tclSafeAliasLoad {slave file args} {
-    global auto_path
-
-    if {[llength $args] == 2} {
-	# Trying to load into another interpreter
-	# Allow this for a child of the slave, or itself
-	set other [lindex $args 1]
-	foreach x $slave y $other {
-	    if {[string length $x] == 0} {
-		break
-	    } elseif {[string compare $x $y] != 0} {
-		return -code error "permission denied"
-	    }
-	}
-	set slave $other
-    }
-
-    if {[string length $file] && \
-		[catch {tclFileInPath $file $auto_path $slave} msg]} {
-	return -code error "permission denied"
-    }
-    if {[catch {
-	switch [llength $args] {
-	    0 {
-		interp invokehidden $slave load $file
-	    }
-	    1 -
-	    2 {
-		interp invokehidden $slave load $file [lindex $args 0]
-	    }
-	    default {
-		error "too many arguments to load"
-	    }
-	}
-    } msg]} {
-	return -code error $msg
-    }
-    return $msg
-}
-
-# tclFileInPath raises an error if the file is not found in
-# the list of directories contained in path.
-
-proc tclFileInPath {file path slave} {
-    set realcheckpath [tclSafeCheckAutoPath $path $slave]
-    set pwd [pwd]
-    if {[file isdirectory $file]} {
-	error "$file: not found"
-    }
-    set parent [file dirname $file]
-    if {[catch {cd $parent} msg]} {
-	error "$file: not found"
-    }
-    set realfilepath [file split [pwd]]
-    foreach dir $realcheckpath {
-	set match 1
-	foreach a [file split $dir] b $realfilepath {
-	    if {[string length $a] == 0} {
-		break
-	    } elseif {[string compare $a $b] != 0} {
-		set match 0
-		break
-	    }
-	}
-	if {$match} {
-	    cd $pwd
-	    return 1
-	}
-    }
-    cd $pwd
-    error "$file: not found"
-}
-
-# This procedure computes our expanded copy of the path, as needed.
-# It returns the path after expanding out all aliases.
-
-proc tclSafeCheckAutoPath {path slave} {
-    global auto_path
-    upvar #0 tclSafe$slave state
-
-    if {![info exists state(expanded_auto_path)]} {
-	# Compute for the first time:
-	set state(cached_auto_path) $path
-    } elseif {"$state(cached_auto_path)" != "$path"} {
-	# The value of our path changed, so recompute:
-	set state(cached_auto_path) $path
-    } else {
-	# No change: no need to recompute.
-	return $state(expanded_auto_path)
-    }
-
-    set pwd [pwd]
-    set state(expanded_auto_path) ""
-    foreach dir $state(cached_auto_path) {
-	if {![catch {cd $dir}]} {
-	    lappend state(expanded_auto_path) [pwd]
-	}
-    }
-    cd $pwd
-    return $state(expanded_auto_path)
-}
-
-proc tclSafeAliasPkgUnknown {slave package version {exact {}}} {
-    tclSafeLoadPkg $slave $package $version $exact
-}
-
-proc tclSafeLoadPkg {slave package version exact} {
-    if {[string length $version] == 0} {
-	set version 1.0
-    }
-    tclSafeLoadPkgInternal $slave $package $version $exact 0
-}
-
-proc tclSafeLoadPkgInternal {slave package version exact round} {
-    global auto_path
-    upvar #0 tclSafe$slave state
-
-    # Search the policy path again; it might have changed in the meantime.
-
-    if {$round == 1} {
-	tclSafeResearchPolicyPath
-
-	if {[tclSafeLoadPolicy $slave $package $version]} {
-	    return
-	}
-    }
-
-    # Try to load as a policy.
-
-    if [tclSafeLoadPolicy $slave $package $version] {
-	return
-    }
-
-    # The package is not a security policy, so do the regular setup.
-
-    # Here we run tclPkgUnknown in the master, but we hijack
-    # the source command so the setup ends up happening in the slave.
-
-    rename source source.orig
-    proc source {args} "upvar dir dir
-	interp eval [list $slave] tclPkgSource \[list \$dir\] \$args"
-
-    if [catch {tclPkgUnknown $package $version $exact} err] {
-	global errorInfo
-
-	rename source {}
-	rename source.orig source
-
-	error "$err\n$errorInfo"
-    }
-    rename source {}
-    rename source.orig source
-
-    # If we are in the first round, check if the package
-    # is now known in the slave:
-
-    if {$round == 0} {
-        set ifneeded \
-		[interp eval $slave [list package ifneeded $package $version]]
-
-	if {"$ifneeded" == ""} {
-	    return [tclSafeLoadPkgInternal $slave $package $version $exact 1]
-	}
-    }
-}
-
-proc tclSafeResearchPolicyPath {} {
-    global tclSafePolicyPath auto_index auto_path
-
-    # If there was no change, do not search again.
-
-    if {![info exists tclSafePolicyPath]} {
-	set tclSafePolicyPath ""
-    }
-    set oldPolicyPath $tclSafePolicyPath
-    set newPolicyPath [tclSafeComputePolicyPath]
-    if {"$newPolicyPath" == "$oldPolicyPath"} {
-	return
-    }
-
-    # Loop through the path from back to front so early directories
-    # end up overriding later directories.  This code is like auto_load,
-    # but only new-style tclIndex files (version 2) are supported.
-
-    for {set i [expr [llength $newPolicyPath] - 1]} \
-	    {$i >= 0} \
-	    {incr i -1} {
-	set dir [lindex $newPolicyPath $i]
-        set file [file join $dir tclIndex]
-	if {[file exists $file]} {
-	    if {[catch {source $file} msg]} {
-		puts stderr "error sourcing $file: $msg"
-	    }
-	}
-	foreach file [lsort [glob -nocomplain [file join $dir *]]] {
-	    if {[file isdir $file]} {
-		set dir $file
-		set file [file join $file tclIndex]
-		if {[file exists $file]} {
-		    if {[catch {source $file} msg]} {
-			puts stderr "error sourcing $file: $msg"
-		    }
-		}
-	    }
-	}
-    }
-}
-
-proc tclSafeLoadPolicy {slave package version} {
-    upvar #0 tclSafe$slave state
-    global auto_index
-
-    set proc ${package}_PolicyInit
-
-    if {[info command $proc] == "$proc" ||
-	    [info exists auto_index($proc)]} {
-	if [info exists state(policyLoaded)] {
-	    error "security policy $state(policyLoaded) already loaded"
-	}	
-	$proc $slave $version
-	interp eval $slave [list package provide $package $version]
-	set state(policyLoaded) $package
-	return 1
-    } else {
-	return 0
-    }
-}
-# This procedure enables access from a safe interpreter to only a subset of
-# the subcommands of a command:
-
-proc tclSafeSubset {command okpat args} {
-    set subcommand [lindex $args 0]
-    if {[regexp $okpat $subcommand]} {
-	return [eval {$command $subcommand} [lrange $args 1 end]]
-    }
-    error "not allowed to invoke subcommand $subcommand of $command"
-}
-
-# This procedure installs an alias in a slave that invokes "safesubset"
-# in the master to execute allowed subcommands. It precomputes the pattern
-# of allowed subcommands; you can use wildcards in the pattern if you wish
-# to allow subcommand abbreviation.
-#
-# Syntax is: tclAliasSubset slave alias target subcommand1 subcommand2...
-
-proc tclAliasSubset {slave alias target args} {
-    set pat ^(; set sep ""
-    foreach sub $args {
-	append pat $sep$sub
-	set sep |
-    }
-    append pat )\$
-    interp alias $slave $alias {} tclSafeSubset $target $pat
-}
diff --git a/contrib/tcl/tests/fhandle.test b/contrib/tcl/tests/fhandle.test
deleted file mode 100644
index 18fdb903978a..000000000000
--- a/contrib/tcl/tests/fhandle.test
+++ /dev/null
@@ -1,63 +0,0 @@
-# This file tests the functions in tclFHandle.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
-#
-# Copyright (c) 1995-1996 by Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) fhandle.test 1.3 96/03/26 11:49:04
-
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {[info commands testfhandle] == {}} {
-    puts "This application hasn't been compiled with the \"testfhandle\""
-    puts "command, so I can't test the procedures in tclFHandle.c."
-    return 
-} 
-
-test fhandle-1.1 {file handle creation/retrieval} {
-    testfhandle get 0 2 3
-    testfhandle get 1 2 3
-    set result [testfhandle compare 0 1]
-    testfhandle free 0
-    set result
-} {equal}
-test fhandle-1.2 {file handle creation/retrieval} {
-    testfhandle get 0 2 3
-    testfhandle get 1 2 4
-    set result [testfhandle compare 0 1]
-    testfhandle free 0
-    set result
-} {notequal}
-test fhandle-1.3 {file handle creation/retrieval} {
-    testfhandle get 0 2 3
-    testfhandle get 1 2 4
-    set result [testfhandle compare 0 1]
-    testfhandle free 0
-    testfhandle free 1
-    set result
-} {notequal}
-test fhandle-1.4 {file handle creation/retrieval} {
-    testfhandle get 0 2 3
-    testfhandle get 1 5 3
-    set result [testfhandle compare 0 1]
-    testfhandle free 0
-    testfhandle free 1
-    set result
-} {notequal}
-test fhandle-1.5 {file handle creation/retrieval} {
-    testfhandle get 0 5 6
-    set result [testfhandle info2 0]
-    testfhandle free 0
-    set result
-} {5 6}
-test fhandle-1.6 {file handle creation/retrieval} {
-    testfhandle get 0 5 6
-    set result [testfhandle info1 0]
-    testfhandle free 0
-    set result
-} {5}
diff --git a/contrib/tcl/tests/lsort.test b/contrib/tcl/tests/lsort.test
deleted file mode 100644
index 907dfbf0c919..000000000000
--- a/contrib/tcl/tests/lsort.test
+++ /dev/null
@@ -1,126 +0,0 @@
-# Commands covered:  lsort
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
-#
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) lsort.test 1.8 96/02/16 08:56:17
-
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-test lsort-1.1 {lsort command} {
-    lsort {abdeq ab 1 ac a}
-} {1 a ab abdeq ac}
-test lsort-1.2 {lsort command} {
-    lsort -decreasing {abdeq ab 1 ac a}
-} {ac abdeq ab a 1}
-test lsort-1.3 {lsort command} {
-    lsort -increasing {abdeq ab 1 ac a}
-} {1 a ab abdeq ac}
-test lsort-1.4 {lsort command} {
-    lsort {{one long element}}
-} {{one long element}}
-test lsort-1.5 {lsort command} {
-    lsort {}
-} {}
-test lsort-1.6 {lsort with characters needing backslashes} {
-    lsort {$ \\ [] \{}
-} {{$} {[]} \\ \{}
-
-test lsort-2.1 {lsort -integer} {
-    lsort -integer -inc {1 180 62 040 180 -42 33 0x40}
-} {-42 1 040 33 62 0x40 180 180}
-test lsort-2.2 {lsort -integer} {
-    lsort -int -dec {1 180 62 040 180 -42 33 0x40}
-} {180 180 0x40 62 33 040 1 -42}
-test lsort-2.3 {lsort -integer} {
-    list [catch {lsort -integer {xxx 180.2 62 040 180 -42 33 0x40}} msg] $msg $errorInfo
-} {1 {expected integer but got "xxx"} {expected integer but got "xxx"
-    (converting list element from string to integer)
-    invoked from within
-"lsort -integer {xxx 180.2 62 040 180 -42 33 0x40}"}}
-test lsort-2.4 {lsort -integer} {
-    list [catch {lsort -integer {1 180.2 62 040 180 -42 33 0x40}} msg] $msg $errorInfo
-} {1 {expected integer but got "180.2"} {expected integer but got "180.2"
-    (converting list element from string to integer)
-    invoked from within
-"lsort -integer {1 180.2 62 040 180 -42 33 0x40}"}}
-
-test lsort-3.1 {lsort -real} {
-    lsort -real {1 180.1 62 040 180 -42.7 33}
-} {-42.7 1 33 040 62 180 180.1}
-test lsort-3.2 {lsort -real} {
-    lsort -r -d {1 180.1 62 040 180 -42.7 33}
-} {180.1 180 62 040 33 1 -42.7}
-test lsort-3.3 {lsort -real} {
-    list [catch {lsort -real -inc {xxx 20 62 180 -42.7 33}} msg] $msg $errorInfo
-} {1 {expected floating-point number but got "xxx"} {expected floating-point number but got "xxx"
-    (converting list element from string to real)
-    invoked from within
-"lsort -real -inc {xxx 20 62 180 -42.7 33}"}}
-test lsort-3.4 {lsort -real} {
-    list [catch {lsort -real -inc {1 0x40 62 180 -42.7 33}} msg] $msg $errorInfo
-} {1 {expected floating-point number but got "0x40"} {expected floating-point number but got "0x40"
-    (converting list element from string to real)
-    invoked from within
-"lsort -real -inc {1 0x40 62 180 -42.7 33}"}}
-
-proc lsort1 {a b} {
-    expr {2*([string match x* $a] - [string match x* $b])
-	    + [string match *y $a] - [string match *y $b]}
-}
-proc lsort2 {a b} {
-    error "comparison error"
-}
-proc lsort3 {a b} {
-    concat "foobar"
-}
-
-test lsort-4.1 {lsort -command} {
-    lsort -command lsort1 {xxx yyy abc {xx y}}
-} {abc yyy xxx {xx y}}
-test lsort-4.2 {lsort -command} {
-    lsort -command lsort1 -dec {xxx yyy abc {xx y}}
-} {{xx y} xxx yyy abc}
-test lsort-4.3 {lsort -command} {
-    list [catch {lsort -command lsort2 -dec {1 1 1 1}} msg] $msg $errorInfo
-} {1 {comparison error} {comparison error
-    while executing
-"error "comparison error""
-    (procedure "lsort2" line 2)
-    invoked from within
-"lsort2 1 1"
-    (user-defined comparison command)
-    invoked from within
-"lsort -command lsort2 -dec {1 1 1 1}"}}
-test lsort-4.4 {lsort -command} {
-    list [catch {lsort -command lsort3 -dec {1 2 3 4}} msg] $msg $errorInfo
-} {1 {comparison command returned non-numeric result} {comparison command returned non-numeric result
-    while executing
-"lsort -command lsort3 -dec {1 2 3 4}"}}
-test lsort-4.5 {lsort -command} {
-    list [catch {lsort -command {xxx yyy xxy abc}} msg] $msg
-} {1 {"-command" must be followed by comparison command}}
-
-test lsort-5.1 {lsort errors} {
-    list [catch lsort msg] $msg
-} {1 {wrong # args: should be "lsort ?-ascii? ?-integer? ?-real? ?-increasing? ?-decreasing? ?-command string? list"}}
-test lsort-5.2 {lsort errors} {
-    list [catch {lsort a b} msg] $msg
-} {1 {bad switch "a": must be -ascii, -integer, -real, -increasing -decreasing, or -command}}
-test lsort-5.3 {lsort errors} {
-    list [catch {lsort "\{"} msg] $msg
-} {1 {unmatched open brace in list}}
-test lsort-5.4 {lsort errors} {
-    list [catch {lsort -in {1 180.0 040 62 180 -42.7 33}} msg] $msg
-} {1 {bad switch "-in": must be -ascii, -integer, -real, -increasing -decreasing, or -command}}
-test lsort-5.5 {lsort errors: disallow recursion} {
-    proc x args {lsort {a b c}}
-    list [catch {lsort -command x {3 7}} msg] $msg
-} {1 {can't invoke "lsort" recursively}}
diff --git a/contrib/tcl/tests/policies/globalPolicy.tcl b/contrib/tcl/tests/policies/globalPolicy.tcl
deleted file mode 100644
index 11904d4ffa5c..000000000000
--- a/contrib/tcl/tests/policies/globalPolicy.tcl
+++ /dev/null
@@ -1,4 +0,0 @@
-proc globalPolicy_PolicyInit {slave {version {}}} {
-    interp alias $slave tada {} tada $slave
-}
-proc tada {slave} {}
diff --git a/contrib/tcl/tests/policies/packages/pkgA.tcl b/contrib/tcl/tests/policies/packages/pkgA.tcl
deleted file mode 100644
index d54d2215c269..000000000000
--- a/contrib/tcl/tests/policies/packages/pkgA.tcl
+++ /dev/null
@@ -1,3 +0,0 @@
-package provide packageA 1.0
-
-proc hoohum {} {return bazooka}
diff --git a/contrib/tcl/tests/policies/packages/pkgIndex.tcl b/contrib/tcl/tests/policies/packages/pkgIndex.tcl
deleted file mode 100644
index 5d39a66ef355..000000000000
--- a/contrib/tcl/tests/policies/packages/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# Tcl package index file, version 1.0
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script.  It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands.  When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded packageA 1.0 [list tclPkgSetup $dir packageA 1.0 {{pkgA.tcl source hoohum}}]
diff --git a/contrib/tcl/tests/policies/policyA/policy.tcl b/contrib/tcl/tests/policies/policyA/policy.tcl
deleted file mode 100644
index cfd558f4160d..000000000000
--- a/contrib/tcl/tests/policies/policyA/policy.tcl
+++ /dev/null
@@ -1,5 +0,0 @@
-proc policyA_PolicyInit {slave {version {}}} {
-    interp alias $slave tada {} tada $slave
-}
-proc tada {slave} {}
-
diff --git a/contrib/tcl/tests/policies/policyA/tclIndex b/contrib/tcl/tests/policies/policyA/tclIndex
deleted file mode 100644
index 5a555373249e..000000000000
--- a/contrib/tcl/tests/policies/policyA/tclIndex
+++ /dev/null
@@ -1,9 +0,0 @@
-# Tcl autoload index file, version 2.0
-# This file is generated by the "auto_mkindex" command
-# and sourced to set up indexing information for one or
-# more commands.  Typically each line is a command that
-# sets an element in the auto_index array, where the
-# element name is the name of a command and the value is
-# a script that loads the command.
-
-set auto_index(policyA_PolicyInit) [list source [file join $dir policy.tcl]]
diff --git a/contrib/tcl/tests/policies/policyB/policy.tcl b/contrib/tcl/tests/policies/policyB/policy.tcl
deleted file mode 100644
index 51ceff7186f5..000000000000
--- a/contrib/tcl/tests/policies/policyB/policy.tcl
+++ /dev/null
@@ -1,2 +0,0 @@
-proc policyB_PolicyInit {slave {version 1.0}} {
-}
diff --git a/contrib/tcl/tests/policies/policyB/tclIndex b/contrib/tcl/tests/policies/policyB/tclIndex
deleted file mode 100644
index 8abf6d11d749..000000000000
--- a/contrib/tcl/tests/policies/policyB/tclIndex
+++ /dev/null
@@ -1,9 +0,0 @@
-# Tcl autoload index file, version 2.0
-# This file is generated by the "auto_mkindex" command
-# and sourced to set up indexing information for one or
-# more commands.  Typically each line is a command that
-# sets an element in the auto_index array, where the
-# element name is the name of a command and the value is
-# a script that loads the command.
-
-set auto_index(policyB_PolicyInit) [list source [file join $dir policy.tcl]]
diff --git a/contrib/tcl/tests/policies/policyC/policy.tcl b/contrib/tcl/tests/policies/policyC/policy.tcl
deleted file mode 100644
index 2615b316bbb6..000000000000
--- a/contrib/tcl/tests/policies/policyC/policy.tcl
+++ /dev/null
@@ -1,7 +0,0 @@
-proc policyC_PolicyInit {slave {version 1.0}} {
-}
-proc policyC_PolicyCleanup {slave} {
-    global l
-
-    lappend l bye
-}
diff --git a/contrib/tcl/tests/policies/policyC/tclIndex b/contrib/tcl/tests/policies/policyC/tclIndex
deleted file mode 100644
index d56e723a9969..000000000000
--- a/contrib/tcl/tests/policies/policyC/tclIndex
+++ /dev/null
@@ -1,10 +0,0 @@
-# Tcl autoload index file, version 2.0
-# This file is generated by the "auto_mkindex" command
-# and sourced to set up indexing information for one or
-# more commands.  Typically each line is a command that
-# sets an element in the auto_index array, where the
-# element name is the name of a command and the value is
-# a script that loads the command.
-
-set auto_index(policyC_PolicyInit) [list source [file join $dir policy.tcl]]
-set auto_index(policyC_PolicyCleanup) [list source [file join $dir policy.tcl]]
diff --git a/contrib/tcl/tests/policies/tclIndex b/contrib/tcl/tests/policies/tclIndex
deleted file mode 100644
index ce2fa7f02751..000000000000
--- a/contrib/tcl/tests/policies/tclIndex
+++ /dev/null
@@ -1,10 +0,0 @@
-# Tcl autoload index file, version 2.0
-# This file is generated by the "auto_mkindex" command
-# and sourced to set up indexing information for one or
-# more commands.  Typically each line is a command that
-# sets an element in the auto_index array, where the
-# element name is the name of a command and the value is
-# a script that loads the command.
-
-set auto_index(globalPolicy_PolicyInit) [list source [file join $dir globalPolicy.tcl]]
-set auto_index(tada) [list source [file join $dir globalPolicy.tcl]]
diff --git a/contrib/tcl/unix/bp.c b/contrib/tcl/unix/bp.c
deleted file mode 100644
index b8c7a49b2f43..000000000000
--- a/contrib/tcl/unix/bp.c
+++ /dev/null
@@ -1,127 +0,0 @@
-/* 
- * bp.c --
- *
- *	This file contains the "bp" ("binary patch") program.  It is used
- *	to replace configuration strings in Tcl/Tk binaries as part of
- *	installation.
- *
- *	Usage:  bp file search replace
- *
- *	This program searches file bp for the first occurrence of the
- *	character string given by "search".  If it is found, then the
- *	first characters of that string get replaced by the string
- *	given by "replace".  The replacement string is NULL-terminated.
- *
- * Copyright (c) 1996 Sun Microsystems, Inc.
- * All rights reserved.
- * This file is NOT subject to the terms described in "license.terms".
- *
- * SCCS: @(#) bp.c 1.2 96/03/12 09:08:26
- */
-
-#include <stdio.h>
-#include <string.h>
-
-extern int errno;
-
-/*
- * The array below saves the last few bytes read from the file, so that
- * they can be compared against a particular string that we're looking
- * for.
- */
-
-#define BUFFER_SIZE 200
-char buffer[BUFFER_SIZE];
-
-int
-main(argc, argv)
-    int argc;			/* Number of command-line arguments. */
-    char **argv;		/* Values of command-line arguments. */
-{
-    int length, matchChar, fileChar, cur, fileIndex, stringIndex;
-    char *s;
-    FILE *f;
-
-    if (argc != 4) {
-	fprintf(stderr,
-		"Wrong # args: should be \"%s fileName string replace\"\n",
-		argv[0]);
-	exit(1);
-    }
-    f = fopen(argv[1], "r+");
-    if (f == NULL) {
-	fprintf(stderr,
-		"Couldn't open \"%s\" for writing: %s\n",
-		argv[1], strerror(errno));
-	exit(1);
-    }
-
-    for (cur = 0; cur < BUFFER_SIZE; cur++) {
-	buffer[cur] = 0;
-    }
-    s = argv[2];
-    length = strlen(s);
-    if (length > BUFFER_SIZE) {
-	fprintf(stderr,
-	    "String \"%s\" too long;  must be %d or fewer chars.\n",
-	    s, BUFFER_SIZE);
-	exit(1);
-    }
-    matchChar = s[length-1];
-
-    while (1) {
-	fileChar = getc(f);
-	if (fileChar == EOF) {
-	    if (ferror(f)) {
-		goto ioError;
-	    }
-	    fprintf(stderr, "Couldn't find string \"%s\"\n", argv[2]);
-	    exit(1);
-	}
-	buffer[cur] = fileChar;
-	if (fileChar == matchChar) {
-	    /*
-	     * Last character of the string matches the current character
-	     * from the file.  Search backwards through the buffer to
-	     * see if the preceding characters from the file match the
-	     * characters from the string.
-	     */
-	    for (fileIndex = cur-1, stringIndex = length-2;
-		    stringIndex >= 0; fileIndex--, stringIndex--) {
-		if (fileIndex < 0) {
-		    fileIndex = BUFFER_SIZE-1;
-		}
-		if (buffer[fileIndex] != s[stringIndex]) {
-		    goto noMatch;
-		}
-	    }
-
-	    /*
-	     * Matched!  Backup to the start of the string, then
-	     * overwrite it with the replacement value.
-	     */
-
-	    if (fseek(f, -length, SEEK_CUR) == -1) {
-		goto ioError;
-	    }
-	    if (fwrite(argv[3], strlen(argv[3])+1, 1, f) == 0) {
-		goto ioError;
-	    }
-	    exit(0);
-	}
-
-	/*
-	 * No match;  go on to next character of file.
-	 */
-
-	noMatch:
-	cur++;
-	if (cur >= BUFFER_SIZE) {
-	    cur = 0;
-	}
-    }
-
-    ioError:
-    fprintf(stderr, "I/O error: %s\n", strerror(errno));
-    exit(1);
-}
diff --git a/contrib/tcl/unix/tclLoadDl2.c b/contrib/tcl/unix/tclLoadDl2.c
deleted file mode 100644
index ad18537f1440..000000000000
--- a/contrib/tcl/unix/tclLoadDl2.c
+++ /dev/null
@@ -1,113 +0,0 @@
-/* 
- * tclLoadDl2.c --
- *
- *	This procedure provides a version of the TclLoadFile that
- *	works with the "dlopen" and "dlsym" library procedures for
- *	dynamic loading.  It is identical to tclLoadDl.c except that
- *	it adds a "_" character to symbol names before looking them
- *	up.
- *
- * Copyright (c) 1995 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclLoadDl2.c 1.3 96/02/15 11:58:45
- */
-
-#include "tcl.h"
-#include "dlfcn.h"
-
-/*
- * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
- * and this argument to dlopen must always be 1.
- */
-
-#ifndef RTLD_NOW
-#   define RTLD_NOW 1
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * TclLoadFile --
- *
- *	Dynamically loads a binary code file into memory and returns
- *	the addresses of two procedures within that file, if they
- *	are defined.
- *
- * Results:
- *	A standard Tcl completion code.  If an error occurs, an error
- *	message is left in interp->result.  *proc1Ptr and *proc2Ptr
- *	are filled in with the addresses of the symbols given by
- *	*sym1 and *sym2, or NULL if those symbols can't be found.
- *
- * Side effects:
- *	New code suddenly appears in memory.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
-    Tcl_Interp *interp;		/* Used for error reporting. */
-    char *fileName;		/* Name of the file containing the desired
-				 * code. */
-    char *sym1, *sym2;		/* Names of two procedures to look up in
-				 * the file's symbol table. */
-    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
-				/* Where to return the addresses corresponding
-				 * to sym1 and sym2. */
-{
-    VOID *handle;
-    Tcl_DString newName;
-
-    handle = dlopen(fileName, RTLD_NOW);
-    if (handle == NULL) {
-	Tcl_AppendResult(interp, "couldn't load file \"", fileName,
-		"\": ", dlerror(), (char *) NULL);
-	return TCL_ERROR;
-    }
-    Tcl_DStringInit(&newName);
-    Tcl_DStringAppend(&newName, "_", 1);
-    Tcl_DStringAppend(&newName, sym1, -1);
-    *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
-	    Tcl_DStringValue(&newName));
-    Tcl_DStringSetLength(&newName, 0);
-    Tcl_DStringAppend(&newName, "_", 1);
-    Tcl_DStringAppend(&newName, sym2, -1);
-    *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
-	    Tcl_DStringValue(&newName));
-    Tcl_DStringFree(&newName);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGuessPackageName --
- *
- *	If the "load" command is invoked without providing a package
- *	name, this procedure is invoked to try to figure it out.
- *
- * Results:
- *	Always returns 0 to indicate that we couldn't figure out a
- *	package name;  generic code will then try to guess the package
- *	from the file name.  A return value of 1 would have meant that
- *	we figured out the package name and put it in bufPtr.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGuessPackageName(fileName, bufPtr)
-    char *fileName;		/* Name of file containing package (already
-				 * translated to local form if needed). */
-    Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
-				 * package name to this if possible. */
-{
-    return 0;
-}